source: LMDZ6/branches/Test_modipsl/libf/phylmd/rrtm/yomoml.F90 @ 5454

Last change on this file since 5454 was 2010, checked in by Laurent Fairhead, 11 years ago

Modifications pour OpenMP


OpenMP modifications

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.8 KB
Line 
1MODULE YOMOML
2
3!-- the following system specific omp_lib-module is not always available (e.g. pgf90)
4!! use omp_lib
5
6USE 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
41IMPLICIT NONE
42
43SAVE
44
45PRIVATE
46
47LOGICAL :: OML_DEBUG = .FALSE.
48!$OMP THREADPRIVATE(OML_DEBUG)
49
50PUBLIC 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
61INTEGER(KIND=JPIM), PARAMETER :: OML_LOCK_KIND = JPIB
62
63!-- Note: Still JPIM !!
64INTEGER(KIND=JPIM) :: M_EVENT = 0
65!$OMP THREADPRIVATE(M_EVENT)
66
67!-- Note: OML_LOCK_KIND, not JPIM !!
68INTEGER(KIND=OML_LOCK_KIND) :: M_LOCK(2) = (/-1, -1/)
69!$OMP THREADPRIVATE(M_LOCK)
70
71CONTAINS
72
73FUNCTION OML_OMP()
74LOGICAL :: OML_OMP
75OML_OMP=.FALSE.
76!$ OML_OMP=.TRUE.
77END FUNCTION OML_OMP
78
79FUNCTION OML_IN_PARALLEL()
80LOGICAL :: OML_IN_PARALLEL
81!$ LOGICAL :: OMP_IN_PARALLEL
82!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
83OML_IN_PARALLEL=.FALSE.
84!$ OML_IN_PARALLEL=((OMP_GET_MAX_THREADS() > 1).AND.OMP_IN_PARALLEL())
85END FUNCTION OML_IN_PARALLEL
86
87FUNCTION OML_TEST_LOCK(MYLOCK)
88INTEGER(KIND=OML_LOCK_KIND),intent(inout),optional :: MYLOCK
89LOGICAL :: OML_TEST_LOCK
90!$ LOGICAL :: OMP_TEST_LOCK
91!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
92OML_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
100END FUNCTION OML_TEST_LOCK
101
102SUBROUTINE OML_UNSET_LOCK(MYLOCK)
103INTEGER(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
112END SUBROUTINE OML_UNSET_LOCK
113
114SUBROUTINE OML_SET_LOCK(MYLOCK)
115INTEGER(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
124END SUBROUTINE OML_SET_LOCK
125
126SUBROUTINE OML_INIT_LOCK(MYLOCK)
127INTEGER(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
136END SUBROUTINE OML_INIT_LOCK
137
138SUBROUTINE OML_DESTROY_LOCK(MYLOCK)
139INTEGER(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
145END SUBROUTINE OML_DESTROY_LOCK
146
147FUNCTION OML_TEST_EVENT(K,MYEVENT)
148LOGICAL :: OML_TEST_EVENT
149INTEGER(KIND=JPIM),intent(in) :: K,MYEVENT
150IF(K.EQ.MYEVENT) THEN
151 OML_TEST_EVENT =.TRUE.
152ELSE
153 OML_TEST_EVENT=.FALSE.
154ENDIF
155END FUNCTION OML_TEST_EVENT
156
157SUBROUTINE OML_WAIT_EVENT(K,MYEVENT)
158INTEGER(KIND=JPIM),intent(in) :: K
159INTEGER(KIND=JPIM),intent(in),OPTIONAL :: MYEVENT
160IF(PRESENT(MYEVENT))THEN
161  DO
162    IF(OML_TEST_EVENT(K,MYEVENT)) EXIT
163  ENDDO
164ELSE
165  DO
166    IF(OML_TEST_EVENT(K,M_EVENT)) EXIT
167  ENDDO
168ENDIF
169END SUBROUTINE OML_WAIT_EVENT
170
171SUBROUTINE OML_SET_EVENT(K,MYEVENT)
172INTEGER(KIND=JPIM),intent(in) :: K
173INTEGER(KIND=JPIM),intent(out),OPTIONAL :: MYEVENT
174IF(PRESENT(MYEVENT))THEN
175  MYEVENT=K
176ELSE
177  M_EVENT=K
178ENDIF
179END SUBROUTINE OML_SET_EVENT
180
181SUBROUTINE OML_INCR_EVENT(K,MYEVENT)
182INTEGER(KIND=JPIM) :: K
183INTEGER(KIND=JPIM),intent(inout),OPTIONAL :: MYEVENT
184IF(PRESENT(MYEVENT))THEN
185  MYEVENT=MYEVENT+K
186ELSE
187  M_EVENT=M_EVENT+K
188ENDIF
189END SUBROUTINE OML_INCR_EVENT
190
191FUNCTION OML_MY_THREAD()
192INTEGER(KIND=JPIM) :: OML_MY_THREAD
193!$ INTEGER(KIND=JPIM) OMP_GET_THREAD_NUM
194OML_MY_THREAD = 1
195!$ OML_MY_THREAD = OMP_GET_THREAD_NUM() + 1
196END FUNCTION OML_MY_THREAD
197
198FUNCTION OML_MAX_THREADS()
199INTEGER(KIND=JPIM) :: OML_MAX_THREADS
200!$ INTEGER(KIND=JPIM) OMP_GET_MAX_THREADS
201OML_MAX_THREADS = 1
202!$ OML_MAX_THREADS = OMP_GET_MAX_THREADS()
203END FUNCTION OML_MAX_THREADS
204
205END MODULE YOMOML
Note: See TracBrowser for help on using the repository browser.