8 public:: omp_get_thread_num, omp_get_num_threads, omp_in_parallel
9 logical,
save:: omp_trace=.false.
15 logical:: trace=.false.
16 logical:: master=.true.
19 procedure,
nopass:: mythread
20 procedure,
nopass:: numthreads => omp_numthreads
21 procedure,
nopass:: set_stacksize
23 logical,
public,
save:: omp_master
24 integer,
public,
save:: omp_nthreads
25 integer,
public,
save:: omp_mythread
26 public:: omp_numthreads
27 type(
omp_t),
public,
save:: omp
32 SUBROUTINE init (self)
38 omp_master = (omp_get_thread_num() == 0)
39 omp_mythread = omp_get_thread_num()
41 omp_nthreads = omp_get_num_threads()
48 omp%nthreads = omp_nthreads
49 omp%thread = omp_mythread
50 omp%master = omp_master
51 io_unit%master = io_unit%master .and. omp_master
55 #if ! defined (_OPENMP) 56 #if ! defined (__xlc__) 59 LOGICAL FUNCTION omp_in_parallel()
60 omp_in_parallel = .false.
69 INTEGER FUNCTION mythread()
71 if (omp_in_parallel())
then 72 mythread = omp_get_thread_num()
82 INTEGER FUNCTION omp_numthreads()
84 if (omp_in_parallel())
then 85 omp_numthreads = omp_get_num_threads()
98 SUBROUTINE set_stacksize (nv)
99 #ifdef __INTEL_COMPILER 101 USE omp_lib
, only : kmp_set_stacksize_s, kmp_get_stacksize_s, kmp_size_t_kind
102 integer(kind=kmp_size_t_kind) :: stacksize, new_stacksize
106 integer:: nv, recommended
107 character(len=16):: envvar
108 logical,
save:: first_time=.true., printed=.false.
110 if (io_unit%do_validate)
return 111 recommended = (4*1024**2*nv) / 8
113 #ifdef __INTEL_COMPILER 114 call getenv (
'OMP_STACKSIZE', envvar)
115 if (envvar /=
'' .and. io_unit%master .and. first_time)
then 116 if (.not.printed) print
'(1x,a)', &
117 '*************************************************************************************' 119 '* WARNING: environment variable OMP_STACKSIZE is set, this assumes non-Intel MPI' 122 stacksize = kmp_get_stacksize_s()
123 new_stacksize = recommended
124 if (kind(r)==kind(1.0e0_8)) new_stacksize = new_stacksize * 2
125 if (new_stacksize > stacksize)
then 126 call kmp_set_stacksize_s(new_stacksize)
127 if (io_unit%master .and. first_time)
then 128 if (.not.printed) print
'(1x,a)', &
129 '*************************************************************************************' 130 print
'(1x,a,f5.1,a)', &
131 '* WARNING! OpenMP stacksize has been reset to ', new_stacksize/1024.**2, &
132 ' MB to avoid segfault' 135 else if (first_time.and.io_unit%master)
then 136 print
'(1x,a,f5.1,a)',
'OpenMP stacksize default:', stacksize/1024.**2,
' MB' 140 call getenv (
'KMP_STACKSIZE', envvar)
141 if (envvar /=
'' .and. io_unit%master .and. first_time)
then 142 if (.not.printed) print
'(1x,a)', &
143 '*************************************************************************************' 145 '* WARNING: environment variable KMP_STACKSIZE is set, this assumes Intel MPI' 148 call getenv (
'OMP_STACKSIZE', envvar)
149 if (envvar ==
'' .and. io_unit%master .and. first_time)
then 150 print
'(/,1x,a,/,1x,a,i9)', &
151 '*************************************************************************************', &
152 '* WARNING: environment variable OMP_STACKSIZE not set, recommended value =',recommended
157 if (printed .and. io_unit%master .and. first_time)
then 160 '*************************************************************************************' 162 END SUBROUTINE set_stacksize