GCC Code Coverage Report

Directory: ./
File: rad/yomoml.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 34 0.0%
Branches: 0 12 0.0%
Line Branch Exec Source
1 MODULE YOMOML
2
3 !-- the following system specific omp_lib-module is not always available (e.g. pgf90)
4 !! use omp_lib
5
6 USE PARKIND1 ,ONLY : JPIM, JPIB
7
8 !**SS/18-Feb-2005
9 !--Dr.Hook references removed, because these locks may also be
10 ! called from within drhook.c itself !!
11 !--Also, there could be considerable & unjustified overhead
12 ! when using Dr.Hook in such a low level
13
14 !**SS/15-Dec-2005
15 !--The size of lock-variables are now OMP_LOCK_KIND as of in OMP_LIB,
16 ! and OMP_LOCK_KIND is aliased to OML_LOCK_KIND
17 ! OMP_LOCK_KIND is usually 4 in 32-bit addressing mode
18 ! 8 in 64-bit addressing mode
19 !--M_OML_LOCK changed to M_EVENT and kept as 32-bit int
20 !--OML_FUNCT changed to OML_TEST_EVENT
21 !--M_LOCK initialized to -1
22 !--M_EVENT initialized to 0
23 !--Added intent(s)
24 !--Support for omp_lib (but not always available)
25 !--Locks can now also be set/unset OUTSIDE the parallel regions
26 !--Added routine OML_TEST_LOCK (attempts to set lock, but if *un*successful, does NOT block)
27 !--Buffer-zone for M_LOCK; now a vector of 2 elements in case problems/inconsistencies with OMP_LOCK_KIND 4/8
28
29 !**SS/22-Feb-2006
30 !--Locking routines are doing nothing unless OMP_GET_MAX_THREADS() > 1
31 ! This is to avoid unacceptable deadlocks/timeouts with signal handlers when
32 ! the only thread receives signal while inside locked region
33 !--Affected routines: OML_TEST_LOCK() --> always receives .TRUE.
34 ! OML_SET_LOCK() --> sets nothing
35 ! OML_UNSET_LOCK() --> unsets nothing
36 ! OML_INIT_LOCK() --> inits nothing
37
38 !**SS/11-Sep-2006
39 !--Added OML_DEBUG feature
40
41 IMPLICIT NONE
42
43 SAVE
44
45 PRIVATE
46
47 LOGICAL :: OML_DEBUG = .FALSE.
48 !$OMP THREADPRIVATE(OML_DEBUG)
49
50 PUBLIC OML_WAIT_EVENT, OML_SET_EVENT, OML_INCR_EVENT, &
51 & OML_MY_THREAD, OML_MAX_THREADS , OML_OMP, &
52 & OML_IN_PARALLEL, OML_TEST_EVENT, &
53 & OML_UNSET_LOCK, OML_INIT_LOCK, OML_SET_LOCK, OML_DESTROY_LOCK, &
54 & OML_LOCK_KIND, OML_TEST_LOCK, OML_DEBUG
55
56 !-- The following should normally be 4 in 32-bit addressing mode
57 ! 8 in 64-bit addressing mode
58 ! Since system specific omp_lib-module is not always available (e.g. pgf90)
59 ! we hardcode OML_LOCK_KIND to JPIB (usually 8) for now
60 !!INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = OMP_LOCK_KIND
61 INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = JPIB
62
63 !-- Note: Still JPIM !!
64 INTEGER(KIND=JPIM) :: M_EVENT = 0
65 !$OMP THREADPRIVATE(M_EVENT)
66
67 !-- Note: OML_LOCK_KIND, not JPIM !!
68 INTEGER(KIND=OML_LOCK_KIND) :: M_LOCK(2) = (/-1, -1/)
69 !$OMP THREADPRIVATE(M_LOCK)
70
71 CONTAINS
72
73 ✗ FUNCTION OML_OMP()
74 LOGICAL :: OML_OMP
75 OML_OMP=.FALSE.
76 !$ OML_OMP=.TRUE.
77 ✗ END FUNCTION OML_OMP
78
79 ✗ FUNCTION OML_IN_PARALLEL()
80 LOGICAL :: OML_IN_PARALLEL
81 !$ LOGICAL :: OMP_IN_PARALLEL
82 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
83 OML_IN_PARALLEL=.FALSE.
84 !$ OML_IN_PARALLEL=((OMP_GET_MAX_THREADS() > 1).AND.OMP_IN_PARALLEL())
85 ✗ END FUNCTION OML_IN_PARALLEL
86
87 ✗ FUNCTION OML_TEST_LOCK(MYLOCK)
88 INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
89 LOGICAL :: OML_TEST_LOCK
90 !$ LOGICAL :: OMP_TEST_LOCK
91 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
92 OML_TEST_LOCK = .TRUE.
93 !$ IF(OMP_GET_MAX_THREADS() > 1) THEN
94 !$ IF(PRESENT(MYLOCK))THEN
95 !$ OML_TEST_LOCK = OMP_TEST_LOCK(MYLOCK)
96 !$ ELSE
97 !$ OML_TEST_LOCK = OMP_TEST_LOCK(M_LOCK(1))
98 !$ ENDIF
99 !$ ENDIF
100 ✗ END FUNCTION OML_TEST_LOCK
101
102 ✗ SUBROUTINE OML_UNSET_LOCK(MYLOCK)
103 INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
104 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
105 !$ IF(OMP_GET_MAX_THREADS() > 1) THEN
106 !$ IF(PRESENT(MYLOCK))THEN
107 !$ CALL OMP_UNSET_LOCK(MYLOCK)
108 !$ ELSE
109 !$ CALL OMP_UNSET_LOCK(M_LOCK(1))
110 !$ ENDIF
111 !$ ENDIF
112 ✗ END SUBROUTINE OML_UNSET_LOCK
113
114 ✗ SUBROUTINE OML_SET_LOCK(MYLOCK)
115 INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
116 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
117 !$ IF(OMP_GET_MAX_THREADS() > 1) THEN
118 !$ IF(PRESENT(MYLOCK))THEN
119 !$ CALL OMP_SET_LOCK(MYLOCK)
120 !$ ELSE
121 !$ CALL OMP_SET_LOCK(M_LOCK(1))
122 !$ ENDIF
123 !$ ENDIF
124 ✗ END SUBROUTINE OML_SET_LOCK
125
126 ✗ SUBROUTINE OML_INIT_LOCK(MYLOCK)
127 INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
128 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
129 !$ IF(OMP_GET_MAX_THREADS() > 1) THEN
130 !$ IF(PRESENT(MYLOCK))THEN
131 !$ CALL OMP_INIT_LOCK(MYLOCK)
132 !$ ELSE
133 !$ CALL OMP_INIT_LOCK(M_LOCK(1))
134 !$ ENDIF
135 !$ ENDIF
136 ✗ END SUBROUTINE OML_INIT_LOCK
137
138 ✗ SUBROUTINE OML_DESTROY_LOCK(MYLOCK)
139 INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
140 !$ IF(PRESENT(MYLOCK))THEN
141 !$ CALL OMP_DESTROY_LOCK(MYLOCK)
142 !$ ELSE
143 !$ CALL OMP_DESTROY_LOCK(M_LOCK(1))
144 !$ ENDIF
145 ✗ END SUBROUTINE OML_DESTROY_LOCK
146
147 ✗ FUNCTION OML_TEST_EVENT(K,MYEVENT)
148 LOGICAL :: OML_TEST_EVENT
149 INTEGER(KIND=JPIM),intent(in) :: K,MYEVENT
150 ✗ IF(K.EQ.MYEVENT) THEN
151 OML_TEST_EVENT =.TRUE.
152 ELSE
153 OML_TEST_EVENT=.FALSE.
154 ENDIF
155 ✗ END FUNCTION OML_TEST_EVENT
156
157 ✗ SUBROUTINE OML_WAIT_EVENT(K,MYEVENT)
158 INTEGER(KIND=JPIM),intent(in) :: K
159 INTEGER(KIND=JPIM),intent(in),OPTIONAL :: MYEVENT
160 ✗ IF(PRESENT(MYEVENT))THEN
161 DO
162 IF(OML_TEST_EVENT(K,MYEVENT)) EXIT
163 ENDDO
164 ELSE
165 DO
166 IF(OML_TEST_EVENT(K,M_EVENT)) EXIT
167 ENDDO
168 ENDIF
169 ✗ END SUBROUTINE OML_WAIT_EVENT
170
171 ✗ SUBROUTINE OML_SET_EVENT(K,MYEVENT)
172 INTEGER(KIND=JPIM),intent(in) :: K
173 INTEGER(KIND=JPIM),intent(out),OPTIONAL :: MYEVENT
174 ✗ IF(PRESENT(MYEVENT))THEN
175 ✗ MYEVENT=K
176 ELSE
177 ✗ M_EVENT=K
178 ENDIF
179 ✗ END SUBROUTINE OML_SET_EVENT
180
181 ✗ SUBROUTINE OML_INCR_EVENT(K,MYEVENT)
182 INTEGER(KIND=JPIM) :: K
183 INTEGER(KIND=JPIM),intent(inout),OPTIONAL :: MYEVENT
184 ✗ IF(PRESENT(MYEVENT))THEN
185 ✗ MYEVENT=MYEVENT+K
186 ELSE
187 ✗ M_EVENT=M_EVENT+K
188 ENDIF
189 ✗ END SUBROUTINE OML_INCR_EVENT
190
191 ✗ FUNCTION OML_MY_THREAD()
192 INTEGER(KIND=JPIM) :: OML_MY_THREAD
193 !$ INTEGER(KIND=JPIM) OMP_GET_THREAD_NUM
194 OML_MY_THREAD = 1
195 !$ OML_MY_THREAD = OMP_GET_THREAD_NUM() + 1
196 ✗ END FUNCTION OML_MY_THREAD
197
198 ✗ FUNCTION OML_MAX_THREADS()
199 INTEGER(KIND=JPIM) :: OML_MAX_THREADS
200 !$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
201 OML_MAX_THREADS = 1
202 !$ OML_MAX_THREADS = OMP_GET_MAX_THREADS()
203 ✗ END FUNCTION OML_MAX_THREADS
204
205 END MODULE YOMOML
206