TABLE OF CONTENTS

ABINIT/m_xomp [ Modules ]

[ Top ] [ Modules ]

NAME

 m_xomp

FUNCTION

  Thin wrappers and tools for OpenMP parallelization.

COPYRIGHT

  Copyright (C) 2008-2024 ABINIT group (MG)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

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_initial_device
45  public :: xomp_get_num_devices
46  public :: xomp_is_initial_device
47  public :: xomp_target_is_present
48  ! OpenMP 5.1 GPU device routine
49  public :: xomp_get_mapped_ptr
50 
51 
52 !----------------------------------------------------------------------
53 
54 CONTAINS  !=========================================================================================================================

m_xomp/xomp_get_default_device [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_default_device

FUNCTION

  Wrapper for omp_get_default_device

OUTPUT

  (integer) id of default offload device (ie: GPU, accelerator) on which
      "target" regions will be run on.
      -1 if no offload device is used.

SOURCE

372 function xomp_get_default_device()
373 
374 !Arguments ------------------------------------
375 !scalars
376  integer :: xomp_get_default_device
377 
378 ! *************************************************************************
379 
380 #ifdef HAVE_OPENMP_OFFLOAD
381  xomp_get_default_device = omp_get_default_device()
382 #else
383  xomp_get_default_device = -1
384 #endif
385 
386 end function xomp_get_default_device

m_xomp/xomp_get_initial_device [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_initial_device

FUNCTION

  Wrapper for omp_get_initial_device

OUTPUT

  (integer) id of OpenMP device which targets host rather than
    acclerator devices.

SOURCE

404 function xomp_get_initial_device()
405 
406 !Arguments ------------------------------------
407 !scalars
408  integer :: xomp_get_initial_device
409 
410 ! *************************************************************************
411 
412 #ifdef HAVE_OPENMP_OFFLOAD
413  xomp_get_initial_device = omp_get_initial_device()
414 #else
415  xomp_get_initial_device = -1
416 #endif
417 
418 end function xomp_get_initial_device

m_xomp/xomp_get_mapped_ptr [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_mapped_ptr

FUNCTION

  Wrapper for omp_get_mapped_ptr

INPUTS

  ptr = C pointer, likely matching a Fortran array wrapped in c_loc

OUTPUT

  (c_ptr) Pointer to device memory matching given input ptr

SOURCE

548 function xomp_get_mapped_ptr(ptr) result(gpu_ptr)
549 
550 !Arguments ------------------------------------
551  type(c_ptr),intent(in) :: ptr
552  integer :: device_id, rc
553  type(c_ptr) :: gpu_ptr
554 
555 ! *************************************************************************
556 
557 #ifdef HAVE_OPENMP_OFFLOAD
558  device_id = xomp_get_default_device()
559  if(xomp_target_is_present(ptr)) then
560 #ifdef HAVE_OPENMP_GET_MAPPED_PTR
561    gpu_ptr = omp_get_mapped_ptr(ptr, device_id)
562 #else
563    gpu_ptr = c_null_ptr
564 #endif
565  else
566    gpu_ptr = c_null_ptr
567  end if
568 #else
569  gpu_ptr = c_null_ptr
570  ! this macro is called before m_errors is compiled
571 ! ABI_UNUSED(device_id)
572 ! ABI_UNUSED(rc)
573  if (.FALSE.) write(std_out,*)device_id
574  if (.FALSE.) write(std_out,*)rc
575  ABI_UNUSED_A(ptr)
576 #endif
577 
578 end function xomp_get_mapped_ptr

m_xomp/xomp_get_max_threads [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_max_threads

FUNCTION

  Wrapper for omp_get_max_threads.

OUTPUT

  Return the maximum number of threads used for the current parallel region that
  does not use the clause num_threads. Return 1 if OMP is disabled.

SOURCE

120 function xomp_get_max_threads()
121 
122 !Arguments ------------------------------------
123  integer :: xomp_get_max_threads
124 
125 ! *************************************************************************
126 
127 #ifdef HAVE_OPENMP
128  xomp_get_max_threads = omp_get_max_threads()
129 #else
130  xomp_get_max_threads = 1
131 #endif
132 
133 end function xomp_get_max_threads

m_xomp/xomp_get_num_cores_node [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_num_cores_node

FUNCTION

  Wrapper for omp_get_num_procs

OUTPUT

  Return the maximum number of cores in one shared memory system
  Return 0 if OMP is disabled.

SOURCE

300 function xomp_get_num_cores_node()
301 
302 !Arguments ------------------------------------
303 !scalars
304  integer :: xomp_get_num_cores_node
305 
306 ! *************************************************************************
307 
308 #ifdef HAVE_OPENMP
309  xomp_get_num_cores_node=omp_get_thread_limit()
310  !We test if thread_limit has been set (if not it should be a large value)
311  ! In 2012, 4096 cores is the biggest known shared memory system
312  if(xomp_get_num_cores_node > 4096) then
313     !so if not set, we used system 'num procs' values which should be the default case
314     xomp_get_num_cores_node=omp_get_num_procs()
315  end if
316 #else
317  xomp_get_num_cores_node=0
318 #endif
319 
320 end function xomp_get_num_cores_node

m_xomp/xomp_get_num_devices [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_num_devices

FUNCTION

  Wrapper for omp_get_num_devices

OUTPUT

  (integer) id of OpenMP device which targets host rather than
    acclerator devices.

SOURCE

436 function xomp_get_num_devices()
437 
438 !Arguments ------------------------------------
439 !scalars
440  integer :: xomp_get_num_devices
441 
442 ! *************************************************************************
443 
444 #ifdef HAVE_OPENMP_OFFLOAD
445  xomp_get_num_devices = omp_get_num_devices()
446 #else
447  xomp_get_num_devices = 0
448 #endif
449 
450 end function xomp_get_num_devices

m_xomp/xomp_get_num_threads [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_num_threads

FUNCTION

  Wrapper for omp_get_num_threads.
  The omp_get_num_threads function returns the number of threads in the team currently executing
  the parallel region from which it is called. The function binds to the closest enclosing PARALLEL directive.
  The omp_set_num_threads subroutine and the OMP_NUM_THREADS environment variable control the number of threads in a team.
  If you do not explicitly set the number of threads, the run-time environment will use the number of online processors
  on the machine by default. If you call omp_get_num_threads from a serial portion of your program or from a
  nested parallel region that is serialized, the function returns 1.

INPUTS

  [open_parallel]= If .TRUE., a temporary OMP parallel region will be open and omp_get_num_threads
                   will be called inside this region.
                   Default to .FALSE. so that we have consistent with the OMP API.

SOURCE

190 function xomp_get_num_threads(open_parallel) result(nthreads)
191 
192 !Arguments ------------------------------------
193 !scalars
194  logical,optional,intent(in) :: open_parallel
195  integer :: nthreads
196 
197 !Local variables-------------------------------
198 !scalars
199  logical :: do_open
200 
201 ! *************************************************************************
202 
203  do_open = .FALSE.; if (PRESENT(open_parallel)) do_open = open_parallel
204 
205 #ifdef HAVE_OPENMP
206  if (do_open .and. .not.xomp_in_parallel()) then
207 !$OMP PARALLEL
208 !$OMP SINGLE
209   nthreads = omp_get_num_threads()
210 !$OMP END SINGLE
211 !$OMP END PARALLEL
212  else
213    nthreads = omp_get_num_threads()
214  end if
215 
216 #else
217  nthreads = 1
218 #endif
219 
220 end function xomp_get_num_threads

m_xomp/xomp_get_thread_num [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_get_thread_num

FUNCTION

  Wrapper for omp_get_thread_num
  Returns a unique thread identification number within the current team.
  In a sequential parts of the program, omp_get_thread_num always returns 0.
  In parallel regions the return value varies from 0 to omp_get_num_threads-1 inclusive.
  The return value of the master thread of a team is always 0.

SOURCE

151 function xomp_get_thread_num()
152 
153 !Arguments ------------------------------------
154 !scalars
155  integer :: xomp_get_thread_num
156 
157 ! *************************************************************************
158 
159 #ifdef HAVE_OPENMP
160  xomp_get_thread_num = omp_get_thread_num()
161 #else
162  xomp_get_thread_num = 0
163 #endif
164 
165 end function xomp_get_thread_num

m_xomp/xomp_in_parallel [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_in_parallel

FUNCTION

  This function returns true if are currently running in parallel, false otherwise

SOURCE

269 function xomp_in_parallel() result(ans)
270 
271 !Arguments-------------------------
272  logical :: ans
273 
274 ! *************************************************************************
275 
276 #ifdef HAVE_OPENMP
277  ans = omp_in_parallel()
278 #else
279  ans = .FALSE.
280 #endif
281 
282 end function xomp_in_parallel

m_xomp/xomp_is_initial_device [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_is_initial_device

FUNCTION

  Wrapper for omp_is_initial_device

OUTPUT

  (integer) id of OpenMP device which targets host rather than
    acclerator devices.

SOURCE

468 function xomp_is_initial_device()
469 
470 !Arguments ------------------------------------
471 !scalars
472  logical :: xomp_is_initial_device
473 
474 ! *************************************************************************
475 
476 #ifdef HAVE_OPENMP_OFFLOAD
477  xomp_is_initial_device = omp_is_initial_device()
478 #else
479  xomp_is_initial_device = .true.
480 #endif
481 
482 end function xomp_is_initial_device

m_xomp/xomp_set_default_device [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_set_default_device

FUNCTION

  Wrapper for omp_set_default_device

INPUTS

  device_id = id of offload device (ie: GPU, accelerator) to be used

SOURCE

337 subroutine xomp_set_default_device(device_id)
338 
339 !Arguments ------------------------------------
340 !scalars
341  integer,intent(in) :: device_id
342 
343 ! *************************************************************************
344 
345 #ifdef HAVE_OPENMP_OFFLOAD
346  call omp_set_default_device(device_id)
347 #else
348 ! this macro is being called before m_errors is available
349 ! ABI_UNUSED(device_id)
350  if (.FALSE.) write(std_out,*)device_id
351 #endif
352 
353 end subroutine xomp_set_default_device

m_xomp/xomp_set_num_threads [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_set_num_threads

FUNCTION

  Specifies the number of threads used by default in subsequent parallel sections,
  if those do not specify a num_threads clause. The argument of xomp_set_num_threads shall be a positive integer.

INPUTS

  nthreads = number of threads

SIDE EFFECTS

  See description.

SOURCE

241 subroutine xomp_set_num_threads(nthreads)
242 
243 !Arguments ------------------------------------
244 !scalars
245  integer,intent(in) :: nthreads
246 
247 ! *************************************************************************
248 
249 #ifdef HAVE_OPENMP
250  call omp_set_num_threads(nthreads)
251 #else
252  if (.FALSE.) write(std_out,*) nthreads
253 #endif
254 
255 end subroutine xomp_set_num_threads

m_xomp/xomp_show_info [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_show_info

FUNCTION

  Printout of the most important OMP environment variables.

INPUTS

  unit=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.

OUTPUT

  (only writing)

SOURCE

 75 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 
 85  my_unt = std_out; if (PRESENT(unit)) my_unt=unit
 86 
 87 #ifdef HAVE_OPENMP
 88  write(my_unt,'(/,a)')  "  ==== OpenMP parallelism is ON ===="
 89  write(my_unt,'(a,i0)') "- Max_threads:       ",xomp_get_max_threads()
 90  write(my_unt,'(a,i0)') "- Num_threads:       ",xomp_get_num_threads(open_parallel=.True.)
 91  write(my_unt,'(a,i0)') "- Num_procs:         ",omp_get_num_procs()
 92  write(my_unt,'(a,l1)') "- Dynamic:           ",omp_get_dynamic()
 93  !write(my_unt,'(a,l1)') "- Nested:            ",omp_get_nested()
 94  !write(my_unt,'(a,i0)')"- Thread_limit:      ",omp_get_thread_limit()
 95  !write(my_unt,'(a,i0)')"- Max_active_levels: ",omp_get_max_active_levels()
 96 #else
 97  write(my_unt,'(/,a)')  "  ==== OpenMP parallelism is OFF ===="
 98 #endif
 99 
100  write(my_unt,*)""
101 
102 end subroutine xomp_show_info

m_xomp/xomp_target_is_present [ Functions ]

[ Top ] [ m_xomp ] [ Functions ]

NAME

  xomp_target_is_present

FUNCTION

  Wrapper for omp_target_is_present

INPUTS

  ptr = C pointer, likely matching a Fortran array wrapped in c_loc

OUTPUT

  (logical) .true. if given ptr has an associate pointer in device
    memory, .false. otherwise

SOURCE

503 function xomp_target_is_present(ptr)
504 
505 !Arguments ------------------------------------
506  type(c_ptr),intent(in) :: ptr
507 
508  logical :: xomp_target_is_present
509  integer(kind=c_int) :: device_id, rc
510 
511 ! *************************************************************************
512 
513 #ifdef HAVE_OPENMP_OFFLOAD
514  device_id = xomp_get_default_device()
515  rc = omp_target_is_present(ptr, device_id)
516  xomp_target_is_present = .true.
517  if(rc==0) xomp_target_is_present = .false.
518 #else
519  xomp_target_is_present = .false.
520  ! this macro is called before m_errors is compiled
521  ! ABI_UNUSED(device_id)
522  ! ABI_UNUSED(rc)
523  if (.FALSE.) write(std_out,*)device_id
524  if (.FALSE.) write(std_out,*)rc
525  ABI_UNUSED_A(ptr)
526 #endif
527 
528 end function xomp_target_is_present