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 |