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 1149 : 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 1149 : 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 1149 : write(my_unt,'(/,a)') " ==== OpenMP parallelism is OFF ===="
97 : #endif
98 :
99 1149 : write(my_unt,*)""
100 :
101 1149 : 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 16882 : 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 16882 : xomp_get_max_threads = 1
129 : #endif
130 :
131 16882 : 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 70216616 : 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 70216616 : 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 70216616 : nthreads = 1
214 : #endif
215 :
216 70216616 : 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 183030 : 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 183030 : 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 183030 : ABI_UNUSED_A(ptr)
553 : #endif
554 :
555 183030 : 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 : !!***
|
