Branch data Line data Source code
1 : : !!****m* ABINIT/m_xomp
2 : : !! NAME
3 : : !! m_xomp
4 : : !!
5 : : !! FUNCTION
6 : : !! Thin wrappers and tools for OpenMP parallelization.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2008-2026 ABINIT group (MG)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : MODULE m_xomp
23 : :
24 : : use defs_basis, only : std_out
25 : : use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int, c_null_ptr
26 : : #ifdef HAVE_OPENMP
27 : : use omp_lib
28 : : #endif
29 : :
30 : : implicit none
31 : :
32 : : private
33 : :
34 : : public :: xomp_show_info
35 : : public :: xomp_get_max_threads
36 : : public :: xomp_get_thread_num
37 : : public :: xomp_get_num_threads
38 : : public :: xomp_set_num_threads
39 : : public :: xomp_in_parallel
40 : : public :: xomp_get_num_cores_node
41 : : ! OpenMP 5.0 GPU device routines
42 : : public :: xomp_set_default_device
43 : : public :: xomp_get_default_device
44 : : public :: xomp_get_device_num
45 : : public :: xomp_get_initial_device
46 : : public :: xomp_get_num_devices
47 : : public :: xomp_is_initial_device
48 : : public :: xomp_target_is_present
49 : : ! OpenMP 5.1 GPU device routine
50 : : public :: xomp_get_mapped_ptr
51 : :
52 : : !----------------------------------------------------------------------
53 : :
54 : : CONTAINS !=========================================================================================================================
55 : :
56 : : !!***
57 : :
58 : : !----------------------------------------------------------------------
59 : :
60 : : !!****f* m_xomp/xomp_show_info
61 : : !! NAME
62 : : !! xomp_show_info
63 : : !!
64 : : !! FUNCTION
65 : : !! Printout of the most important OMP environment variables.
66 : : !!
67 : : !! INPUTS
68 : : !! unit=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
69 : : !!
70 : : !! OUTPUT
71 : : !! (only writing)
72 : : !!
73 : : !! SOURCE
74 : :
75 : 1164 : subroutine xomp_show_info(unit)
76 : :
77 : : !Arguments-------------------------
78 : : integer,optional,intent(in) :: unit
79 : :
80 : : !Local variables-------------------
81 : : integer :: my_unt
82 : : ! *************************************************************************
83 : :
84 [ + - ]: 1164 : my_unt = std_out; if (PRESENT(unit)) my_unt=unit
85 : :
86 : : #ifdef HAVE_OPENMP
87 : : write(my_unt,'(/,a)') " ==== OpenMP parallelism is ON ===="
88 : : write(my_unt,'(a,i0)') "- Max_threads: ",xomp_get_max_threads()
89 : : write(my_unt,'(a,i0)') "- Num_threads: ",xomp_get_num_threads(open_parallel=.True.)
90 : : write(my_unt,'(a,i0)') "- Num_procs: ",omp_get_num_procs()
91 : : write(my_unt,'(a,l1)') "- Dynamic: ",omp_get_dynamic()
92 : : !write(my_unt,'(a,l1)') "- Nested: ",omp_get_nested()
93 : : !write(my_unt,'(a,i0)')"- Thread_limit: ",omp_get_thread_limit()
94 : : !write(my_unt,'(a,i0)')"- Max_active_levels: ",omp_get_max_active_levels()
95 : : #else
96 : 1164 : write(my_unt,'(/,a)') " ==== OpenMP parallelism is OFF ===="
97 : : #endif
98 : :
99 : 1164 : write(my_unt,*)""
100 : :
101 : 1164 : end subroutine xomp_show_info
102 : : !!***
103 : :
104 : : !----------------------------------------------------------------------
105 : :
106 : : !!****f* m_xomp/xomp_get_max_threads
107 : : !! NAME
108 : : !! xomp_get_max_threads
109 : : !!
110 : : !! FUNCTION
111 : : !! Wrapper for omp_get_max_threads.
112 : : !!
113 : : !! OUTPUT
114 : : !! Return the maximum number of threads used for the current parallel region that
115 : : !! does not use the clause num_threads. Return 1 if OMP is disabled.
116 : : !!
117 : : !! SOURCE
118 : :
119 : 40860 : function xomp_get_max_threads()
120 : :
121 : : !Arguments ------------------------------------
122 : : integer :: xomp_get_max_threads
123 : : ! *************************************************************************
124 : :
125 : : #ifdef HAVE_OPENMP
126 : : xomp_get_max_threads = omp_get_max_threads()
127 : : #else
128 : 40860 : xomp_get_max_threads = 1
129 : : #endif
130 : :
131 : 40860 : end function xomp_get_max_threads
132 : : !!***
133 : :
134 : : !----------------------------------------------------------------------
135 : :
136 : : !!****f* m_xomp/xomp_get_thread_num
137 : : !! NAME
138 : : !! xomp_get_thread_num
139 : : !!
140 : : !! FUNCTION
141 : : !! Wrapper for omp_get_thread_num
142 : : !! Returns a unique thread identification number within the current team.
143 : : !! In a sequential parts of the program, omp_get_thread_num always returns 0.
144 : : !! In parallel regions the return value varies from 0 to omp_get_num_threads-1 inclusive.
145 : : !! The return value of the master thread of a team is always 0.
146 : : !!
147 : : !! SOURCE
148 : :
149 : 3590 : function xomp_get_thread_num()
150 : :
151 : : !Arguments ------------------------------------
152 : : !scalars
153 : : integer :: xomp_get_thread_num
154 : : ! *************************************************************************
155 : :
156 : : #ifdef HAVE_OPENMP
157 : : xomp_get_thread_num = omp_get_thread_num()
158 : : #else
159 : 3590 : xomp_get_thread_num = 0
160 : : #endif
161 : :
162 : 3590 : end function xomp_get_thread_num
163 : : !!***
164 : :
165 : : !----------------------------------------------------------------------
166 : :
167 : : !!****f* m_xomp/xomp_get_num_threads
168 : : !! NAME
169 : : !! xomp_get_num_threads
170 : : !!
171 : : !! FUNCTION
172 : : !! Wrapper for omp_get_num_threads.
173 : : !! The omp_get_num_threads function returns the number of threads in the team currently executing
174 : : !! the parallel region from which it is called. The function binds to the closest enclosing PARALLEL directive.
175 : : !! The omp_set_num_threads subroutine and the OMP_NUM_THREADS environment variable control the number of threads in a team.
176 : : !! If you do not explicitly set the number of threads, the run-time environment will use the number of online processors
177 : : !! on the machine by default. If you call omp_get_num_threads from a serial portion of your program or from a
178 : : !! nested parallel region that is serialized, the function returns 1.
179 : : !!
180 : : !! INPUTS
181 : : !! [open_parallel]= If .TRUE., a temporary OMP parallel region will be open and omp_get_num_threads
182 : : !! will be called inside this region.
183 : : !! Default to .FALSE. so that we have consistent with the OMP API.
184 : : !!
185 : : !! SOURCE
186 : :
187 : 70945906 : function xomp_get_num_threads(open_parallel) result(nthreads)
188 : :
189 : : !Arguments ------------------------------------
190 : : !scalars
191 : : logical,optional,intent(in) :: open_parallel
192 : : integer :: nthreads
193 : :
194 : : !Local variables-------------------------------
195 : : !scalars
196 : : logical :: do_open
197 : : ! *************************************************************************
198 : :
199 : 70945906 : do_open = .FALSE.; if (PRESENT(open_parallel)) do_open = open_parallel
200 : :
201 : : #ifdef HAVE_OPENMP
202 : : if (do_open .and. .not.xomp_in_parallel()) then
203 : : !$OMP PARALLEL
204 : : !$OMP SINGLE
205 : : nthreads = omp_get_num_threads()
206 : : !$OMP END SINGLE
207 : : !$OMP END PARALLEL
208 : : else
209 : : nthreads = omp_get_num_threads()
210 : : end if
211 : :
212 : : #else
213 : 70945906 : nthreads = 1
214 : : #endif
215 : :
216 : 70945906 : end function xomp_get_num_threads
217 : : !!***
218 : :
219 : : !----------------------------------------------------------------------
220 : :
221 : : !!****f* m_xomp/xomp_set_num_threads
222 : : !! NAME
223 : : !! xomp_set_num_threads
224 : : !!
225 : : !! FUNCTION
226 : : !! Specifies the number of threads used by default in subsequent parallel sections,
227 : : !! if those do not specify a num_threads clause. The argument of xomp_set_num_threads shall be a positive integer.
228 : : !!
229 : : !! INPUTS
230 : : !! nthreads = number of threads
231 : : !!
232 : : !! SIDE EFFECTS
233 : : !! See description.
234 : : !!
235 : : !! SOURCE
236 : :
237 : 323 : subroutine xomp_set_num_threads(nthreads)
238 : :
239 : : !Arguments ------------------------------------
240 : : !scalars
241 : : integer,intent(in) :: nthreads
242 : : ! *************************************************************************
243 : :
244 : : #ifdef HAVE_OPENMP
245 : : call omp_set_num_threads(nthreads)
246 : : #else
247 : : if (.FALSE.) write(std_out,*) nthreads
248 : : #endif
249 : :
250 : 323 : end subroutine xomp_set_num_threads
251 : : !!***
252 : :
253 : : !----------------------------------------------------------------------
254 : :
255 : : !!****f* m_xomp/xomp_in_parallel
256 : : !! NAME
257 : : !! xomp_in_parallel
258 : : !!
259 : : !! FUNCTION
260 : : !! This function returns true if are currently running in parallel, false otherwise
261 : : !!
262 : : !! SOURCE
263 : :
264 : 0 : function xomp_in_parallel() result(ans)
265 : :
266 : : !Arguments-------------------------
267 : : logical :: ans
268 : : ! *************************************************************************
269 : :
270 : : #ifdef HAVE_OPENMP
271 : : ans = omp_in_parallel()
272 : : #else
273 : 0 : ans = .FALSE.
274 : : #endif
275 : :
276 : 0 : end function xomp_in_parallel
277 : : !!***
278 : :
279 : : !----------------------------------------------------------------------
280 : :
281 : : !!****f* m_xomp/xomp_get_num_cores_node
282 : : !! NAME
283 : : !! xomp_get_num_cores_node
284 : : !!
285 : : !! FUNCTION
286 : : !! Wrapper for omp_get_num_procs
287 : : !!
288 : : !! OUTPUT
289 : : !! Return the maximum number of cores in one shared memory system
290 : : !! Return 0 if OMP is disabled.
291 : : !!
292 : : !! SOURCE
293 : :
294 : 0 : function xomp_get_num_cores_node()
295 : :
296 : : !Arguments ------------------------------------
297 : : !scalars
298 : : integer :: xomp_get_num_cores_node
299 : : ! *************************************************************************
300 : :
301 : : #ifdef HAVE_OPENMP
302 : : xomp_get_num_cores_node=omp_get_thread_limit()
303 : : !We test if thread_limit has been set (if not it should be a large value)
304 : : ! In 2012, 4096 cores is the biggest known shared memory system
305 : : if(xomp_get_num_cores_node > 4096) then
306 : : !so if not set, we used system 'num procs' values which should be the default case
307 : : xomp_get_num_cores_node=omp_get_num_procs()
308 : : end if
309 : : #else
310 : 0 : xomp_get_num_cores_node=0
311 : : #endif
312 : :
313 : 0 : end function xomp_get_num_cores_node
314 : : !!***
315 : :
316 : : !----------------------------------------------------------------------
317 : :
318 : : !!****f* m_xomp/xomp_set_default_device
319 : : !! NAME
320 : : !! xomp_set_default_device
321 : : !!
322 : : !! FUNCTION
323 : : !! Wrapper for omp_set_default_device
324 : : !!
325 : : !! INPUTS
326 : : !! device_id = id of offload device (ie: GPU, accelerator) to be used
327 : : !!
328 : : !! SOURCE
329 : :
330 : 0 : subroutine xomp_set_default_device(device_id)
331 : :
332 : : !Arguments ------------------------------------
333 : : !scalars
334 : : integer,intent(in) :: device_id
335 : : ! *************************************************************************
336 : :
337 : : #ifdef HAVE_OPENMP_OFFLOAD
338 : : call omp_set_default_device(device_id)
339 : : #else
340 : : ! this macro is being called before m_errors is available
341 : : ! ABI_UNUSED(device_id)
342 : : if (.FALSE.) write(std_out,*)device_id
343 : : #endif
344 : :
345 : 0 : end subroutine xomp_set_default_device
346 : : !!***
347 : :
348 : : !----------------------------------------------------------------------
349 : :
350 : : !!****f* m_xomp/xomp_get_default_device
351 : : !! NAME
352 : : !! xomp_get_default_device
353 : : !!
354 : : !! FUNCTION
355 : : !! Wrapper for omp_get_default_device
356 : : !!
357 : : !! OUTPUT
358 : : !! (integer) id of default offload device (ie: GPU, accelerator) on which
359 : : !! "target" regions will be run on.
360 : : !! -1 if no offload device is used.
361 : : !!
362 : : !! SOURCE
363 : :
364 : 0 : function xomp_get_default_device()
365 : :
366 : : !Arguments ------------------------------------
367 : : !scalars
368 : : integer :: xomp_get_default_device
369 : : ! *************************************************************************
370 : :
371 : : #ifdef HAVE_OPENMP_OFFLOAD
372 : : xomp_get_default_device = omp_get_default_device()
373 : : #else
374 : 0 : xomp_get_default_device = -1
375 : : #endif
376 : :
377 : 0 : end function xomp_get_default_device
378 : : !!***
379 : :
380 : : !----------------------------------------------------------------------
381 : :
382 : : !!****f* m_xomp/xomp_get_device_num
383 : : !! NAME
384 : : !! xomp_get_device_num
385 : : !!
386 : : !! FUNCTION
387 : : !! Wrapper for omp_get_device_num
388 : : !!
389 : : !! OUTPUT
390 : : !! (integer) id of OpenMP device on which the calling thread is executing.
391 : : !! When called on the host device, it will return the same value as the
392 : : !! omp_get_initial_device routine.
393 : : !! Inside a target OpenMP region: device number executing that region.
394 : : !! CPU-only this is host (device 0).
395 : : !! Outside a target region: return -1 as running on host not a device.
396 : : !!
397 : : !! SOURCE
398 : :
399 : 0 : function xomp_get_device_num()
400 : :
401 : : !Arguments ------------------------------------
402 : : !scalars
403 : : integer :: xomp_get_device_num
404 : :
405 : : ! *************************************************************************
406 : :
407 : : #ifdef HAVE_OPENMP_OFFLOAD
408 : : xomp_get_device_num = omp_get_device_num()
409 : : #else
410 : 0 : xomp_get_device_num = -1
411 : : #endif
412 : :
413 : 0 : end function xomp_get_device_num
414 : : !!***
415 : :
416 : : !----------------------------------------------------------------------
417 : :
418 : : !!****f* m_xomp/xomp_get_initial_device
419 : : !! NAME
420 : : !! xomp_get_initial_device
421 : : !!
422 : : !! FUNCTION
423 : : !! Wrapper for omp_get_initial_device
424 : : !!
425 : : !! OUTPUT
426 : : !! (integer) id of OpenMP device which targets host rather than
427 : : !! acclerator devices.
428 : : !!
429 : : !! SOURCE
430 : :
431 : 0 : function xomp_get_initial_device()
432 : :
433 : : !Arguments ------------------------------------
434 : : !scalars
435 : : integer :: xomp_get_initial_device
436 : : ! *************************************************************************
437 : :
438 : : #ifdef HAVE_OPENMP_OFFLOAD
439 : : xomp_get_initial_device = omp_get_initial_device()
440 : : #else
441 : 0 : xomp_get_initial_device = -1
442 : : #endif
443 : :
444 : 0 : end function xomp_get_initial_device
445 : : !!***
446 : :
447 : : !----------------------------------------------------------------------
448 : :
449 : : !!****f* m_xomp/xomp_get_num_devices
450 : : !! NAME
451 : : !! xomp_get_num_devices
452 : : !!
453 : : !! FUNCTION
454 : : !! Wrapper for omp_get_num_devices
455 : : !!
456 : : !! OUTPUT
457 : : !! (integer) id of OpenMP device which targets host rather than
458 : : !! acclerator devices.
459 : : !!
460 : : !! SOURCE
461 : :
462 : 0 : function xomp_get_num_devices()
463 : :
464 : : !Arguments ------------------------------------
465 : : !scalars
466 : : integer :: xomp_get_num_devices
467 : : ! *************************************************************************
468 : :
469 : : #ifdef HAVE_OPENMP_OFFLOAD
470 : : xomp_get_num_devices = omp_get_num_devices()
471 : : #else
472 : 0 : xomp_get_num_devices = 0
473 : : #endif
474 : :
475 : 0 : end function xomp_get_num_devices
476 : : !!***
477 : :
478 : : !----------------------------------------------------------------------
479 : :
480 : : !!****f* m_xomp/xomp_is_initial_device
481 : : !! NAME
482 : : !! xomp_is_initial_device
483 : : !!
484 : : !! FUNCTION
485 : : !! Wrapper for omp_is_initial_device
486 : : !!
487 : : !! OUTPUT
488 : : !! (integer) id of OpenMP device which targets host rather than
489 : : !! acclerator devices.
490 : : !!
491 : : !! SOURCE
492 : :
493 : 0 : function xomp_is_initial_device()
494 : :
495 : : !Arguments ------------------------------------
496 : : !scalars
497 : : logical :: xomp_is_initial_device
498 : : ! *************************************************************************
499 : :
500 : : #ifdef HAVE_OPENMP_OFFLOAD
501 : : xomp_is_initial_device = omp_is_initial_device()
502 : : #else
503 : 0 : xomp_is_initial_device = .true.
504 : : #endif
505 : :
506 : 0 : end function xomp_is_initial_device
507 : : !!***
508 : :
509 : : !----------------------------------------------------------------------
510 : :
511 : : !!****f* m_xomp/xomp_target_is_present
512 : : !! NAME
513 : : !! xomp_target_is_present
514 : : !!
515 : : !! FUNCTION
516 : : !! Wrapper for omp_target_is_present
517 : : !!
518 : : !! INPUTS
519 : : !! ptr = C pointer, likely matching a Fortran array wrapped in c_loc
520 : : !!
521 : : !! OUTPUT
522 : : !! (logical) .true. if given ptr has an associate pointer in device
523 : : !! memory, .false. otherwise
524 : : !!
525 : : !! SOURCE
526 : :
527 : 183190 : function xomp_target_is_present(ptr)
528 : :
529 : : !Arguments ------------------------------------
530 : : type(c_ptr),intent(in) :: ptr
531 : :
532 : : logical :: xomp_target_is_present
533 : : integer(kind=c_int) :: device_id, rc
534 : : ! *************************************************************************
535 : :
536 : : #ifdef HAVE_OPENMP_OFFLOAD
537 : : #ifdef HAVE_GPU_UNIFIED_MEMORY
538 : : xomp_target_is_present = .true. ! No check needed in unified memory
539 : : #else
540 : : device_id = xomp_get_default_device()
541 : : rc = omp_target_is_present(ptr, device_id)
542 : : xomp_target_is_present = .true.
543 : : if(rc==0) xomp_target_is_present = .false.
544 : : #endif
545 : : #else
546 : 183190 : xomp_target_is_present = .false.
547 : : ! this macro is called before m_errors is compiled
548 : : ! ABI_UNUSED(device_id)
549 : : ! ABI_UNUSED(rc)
550 : : if (.FALSE.) write(std_out,*)device_id
551 : : if (.FALSE.) write(std_out,*)rc
552 : 183190 : ABI_UNUSED_A(ptr)
553 : : #endif
554 : :
555 : 183190 : end function xomp_target_is_present
556 : : !!***
557 : :
558 : : !----------------------------------------------------------------------
559 : :
560 : : !!****f* m_xomp/xomp_get_mapped_ptr
561 : : !! NAME
562 : : !! xomp_get_mapped_ptr
563 : : !!
564 : : !! FUNCTION
565 : : !! Wrapper for omp_get_mapped_ptr
566 : : !!
567 : : !! INPUTS
568 : : !! ptr = C pointer, likely matching a Fortran array wrapped in c_loc
569 : : !!
570 : : !! OUTPUT
571 : : !! (c_ptr) Pointer to device memory matching given input ptr
572 : : !!
573 : : !! SOURCE
574 : :
575 : 0 : function xomp_get_mapped_ptr(ptr) result(gpu_ptr)
576 : :
577 : : !Arguments ------------------------------------
578 : : type(c_ptr),intent(in) :: ptr
579 : : integer :: device_id, rc
580 : : type(c_ptr) :: gpu_ptr
581 : : ! *************************************************************************
582 : :
583 : : #ifdef HAVE_OPENMP_OFFLOAD
584 : : device_id = xomp_get_default_device()
585 : : if(xomp_target_is_present(ptr)) then
586 : : #ifdef HAVE_OPENMP_GET_MAPPED_PTR
587 : : gpu_ptr = omp_get_mapped_ptr(ptr, device_id)
588 : : #else
589 : : gpu_ptr = c_null_ptr
590 : : #endif
591 : : else
592 : : gpu_ptr = c_null_ptr
593 : : end if
594 : : #else
595 : 0 : gpu_ptr = c_null_ptr
596 : : if (.FALSE.) write(std_out,*)device_id
597 : : if (.FALSE.) write(std_out,*)rc
598 : 0 : ABI_UNUSED_A(ptr)
599 : : #endif
600 : :
601 : 0 : end function xomp_get_mapped_ptr
602 : : !!***
603 : :
604 : 0 : END MODULE m_xomp
605 : : !!***
|
