source: codes/icosagcm/trunk/src/parallel/omp_para.F90

Last change on this file was 962, checked in by adurocher, 5 years ago

Merge 'profiling' to trunk
File size: 7.9 KB
Line 
1MODULE omp_para
2
3  INTEGER,SAVE :: omp_size
4  INTEGER,SAVE :: omp_rank
5!$OMP THREADPRIVATE(omp_rank)
6
7  LOGICAL,SAVE :: is_omp_first_level
8  LOGICAL,SAVE :: is_omp_last_level
9  LOGICAL,SAVE :: is_omp_master
10!$OMP THREADPRIVATE(is_omp_first_level, is_omp_last_level,is_omp_master)
11
12  INTEGER,SAVE :: ll_begin
13  INTEGER,SAVE :: ll_beginp1
14  INTEGER,SAVE :: ll_end
15  INTEGER,SAVE :: ll_endm1
16  INTEGER,SAVE :: ll_endp1
17!$OMP THREADPRIVATE(ll_begin,ll_beginp1,ll_end,ll_endm1,ll_endp1)
18  LOGICAL,SAVE :: using_openmp
19 
20  INTEGER,SAVE :: omp_domain_size
21  INTEGER,SAVE :: omp_domain_rank
22  INTEGER,SAVE :: omp_level_size
23  INTEGER,SAVE :: omp_level_rank
24!$OMP THREADPRIVATE( omp_domain_size, omp_level_size,omp_domain_rank,omp_level_rank)
25  LOGICAL,SAVE :: is_omp_domain_master
26  LOGICAL,SAVE :: is_omp_level_master
27!$OMP THREADPRIVATE(is_omp_domain_master,is_omp_level_master )
28 
29  LOGICAL,PARAMETER :: omp_by_domain=.TRUE. 
30  LOGICAL,SAVE :: is_master
31!$OMP THREADPRIVATE(is_master)
32
33
34   LOGICAL,SAVE :: is_omp_first_level_full
35   LOGICAL,SAVE :: is_omp_last_level_full
36   INTEGER,SAVE :: ll_begin_full
37   INTEGER,SAVE :: ll_beginp1_full
38   INTEGER,SAVE :: ll_end_full
39   INTEGER,SAVE :: ll_endm1_full
40   INTEGER,SAVE :: ll_endp1_full
41!$OMP THREADPRIVATE(is_omp_first_level_full,is_omp_last_level_full)   
42!$OMP THREADPRIVATE( ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full)
43  PRIVATE :: is_omp_first_level_full,is_omp_last_level_full
44  PRIVATE :: ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full 
45 
46
47   LOGICAL,SAVE :: is_omp_first_level_distrib
48   LOGICAL,SAVE :: is_omp_last_level_distrib
49   INTEGER,SAVE :: ll_begin_distrib
50   INTEGER,SAVE :: ll_beginp1_distrib
51   INTEGER,SAVE :: ll_end_distrib
52   INTEGER,SAVE :: ll_endm1_distrib
53   INTEGER,SAVE :: ll_endp1_distrib
54!$OMP THREADPRIVATE(is_omp_first_level_distrib,is_omp_last_level_distrib)   
55!$OMP THREADPRIVATE( ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib)
56
57  PRIVATE :: is_omp_first_level_distrib,is_omp_last_level_distrib
58  PRIVATE :: ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib 
59
60CONTAINS
61
62  FUNCTION get_omp_size() result(omp_size)
63#ifdef CPP_USING_OMP
64    use omp_lib, only : omp_get_max_threads
65    integer :: omp_size
66    omp_size = omp_get_max_threads()
67#else
68    integer :: omp_size
69    omp_size = 1
70#endif
71  END FUNCTION
72
73  SUBROUTINE init_omp_para(is_mpi_master)
74  USE grid_param
75  USE ioipsl, ONLY : getin
76#ifdef CPP_USING_OMP
77  USE omp_lib
78#endif
79  IMPLICIT NONE
80  LOGICAL, INTENT(IN) :: is_mpi_master
81  INTEGER :: ll_nb,i,llb,lle
82
83#ifdef CPP_USING_OMP
84  using_openmp=.TRUE.
85#else
86  using_openmp=.FALSE.
87#endif
88
89  IF (using_openmp) THEN   
90!$OMP PARALLEL PRIVATE(ll_nb,i,llb,lle)
91 
92!$OMP MASTER
93#ifdef CPP_USING_OMP
94    omp_size=OMP_GET_NUM_THREADS()
95#endif
96!$OMP END MASTER
97!$OMP BARRIER
98#ifdef CPP_USING_OMP
99    omp_rank=OMP_GET_THREAD_NUM()
100#endif
101   
102    is_omp_master=.FALSE.
103    is_master=.FALSE.
104     
105    IF (omp_rank==0) THEN
106      is_omp_master=.TRUE.
107      IF (is_mpi_master) is_master=.TRUE.
108    ENDIF
109
110    !$OMP CRITICAL
111    omp_level_size=1
112    CALL getin("omp_level_size",omp_level_size)
113    !$OMP END CRITICAL
114
115    IF(is_mpi_master) PRINT *,'GETIN omp_level_size', ' = ', omp_level_size
116
117    IF (MOD(omp_size,omp_level_size)/=0) THEN
118      IF (is_mpi_master) PRINT*,"omp_size /= omp_level_size x omp_domain_size  => disable omp threads on vertical layers"
119      omp_level_size=1
120    ENDIF
121    omp_domain_size=omp_size/omp_level_size
122    omp_domain_rank = omp_rank / omp_level_size   
123    omp_level_rank = MOD(omp_rank, omp_level_size)   
124   
125    IF (is_mpi_master) PRINT*,"omp_domain_size",omp_domain_size,"omp_domain_rank", omp_domain_rank
126    IF (is_mpi_master) PRINT*,"omp_level_size",omp_level_size,"omp_level_rank", omp_level_rank
127   
128    is_omp_first_level=.FALSE.
129    is_omp_last_level= .FALSE.
130    is_omp_domain_master=.FALSE.
131    is_omp_level_master=.FALSE.
132
133    IF (omp_domain_rank==0) is_omp_domain_master = .TRUE.
134    IF (omp_level_rank==0) is_omp_level_master = .TRUE.
135    IF (omp_level_rank==0) is_omp_first_level=.TRUE.
136   
137    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE.
138   
139    lle=0
140   
141    DO i=0,omp_level_rank
142      llb=lle+1
143      ll_nb=llm/omp_level_size
144      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1
145      lle=llb+ll_nb-1
146    ENDDO
147    ll_begin=llb
148    ll_end=lle
149   
150    ll_beginp1=ll_begin
151    ll_endp1=ll_end
152    ll_endm1=ll_end
153
154    IF (is_omp_first_level) ll_beginp1=ll_begin+1
155    IF (is_omp_last_level) ll_endp1=ll_endp1+1
156    IF (is_omp_last_level) ll_endm1=ll_endm1-1
157   
158   
159   
160    is_omp_first_level_distrib = is_omp_first_level
161    is_omp_last_level_distrib  = is_omp_last_level
162    ll_begin_distrib           = ll_begin
163    ll_beginp1_distrib         = ll_beginp1
164    ll_end_distrib             = ll_end
165    ll_endm1_distrib           = ll_endm1
166    ll_endp1_distrib           = ll_endp1
167   
168    is_omp_first_level_full = .TRUE.
169    is_omp_last_level_full  = .TRUE.
170    ll_begin_full           = 1
171    ll_beginp1_full         = 2
172    ll_end_full             = llm
173    ll_endm1_full           = llm-1
174    ll_endp1_full           = llm+1   
175
176!$OMP END PARALLEL
177
178   ELSE
179     omp_size=1
180     omp_level_size=1
181     omp_domain_size=1
182     omp_rank=0
183     omp_level_rank=0
184     omp_domain_rank=0
185     is_master=is_mpi_master
186     is_omp_first_level=.TRUE.
187     is_omp_last_level=.TRUE.
188     is_omp_master=.TRUE.
189     is_omp_domain_master=.TRUE.
190     is_omp_level_master=.TRUE.
191     ll_begin=1
192     ll_beginp1=2
193     ll_end=llm
194     ll_endm1=llm-1
195     ll_endp1=llm+1
196     
197     is_omp_first_level_distrib = is_omp_first_level
198     is_omp_last_level_distrib  = is_omp_last_level
199     ll_begin_distrib           = ll_begin
200     ll_beginp1_distrib         = ll_beginp1
201     ll_end_distrib             = ll_end
202     ll_endm1_distrib           = ll_endm1
203     ll_endp1_distrib           = ll_endp1
204   
205     is_omp_first_level_full = .TRUE.
206     is_omp_last_level_full  = .TRUE.
207     ll_begin_full           = 1
208     ll_beginp1_full         = 2
209     ll_end_full             = llm
210     ll_endm1_full           = llm-1
211     ll_endp1_full           = llm+1   
212
213   ENDIF
214   
215  END SUBROUTINE init_omp_para
216
217  SUBROUTINE distrib_level(ibegin,iend, lbegin,lend)
218  IMPLICIT NONE
219    INTEGER,INTENT(IN)  :: ibegin,iend 
220    INTEGER,INTENT(OUT) :: lbegin 
221    INTEGER,INTENT(OUT) :: lend 
222    INTEGER :: size,div,rest
223    size=iend-ibegin+1
224    div=size/omp_level_size
225    rest=MOD(size,omp_level_size)
226    IF (omp_level_rank<rest) THEN
227      lbegin=(div+1)*omp_level_rank + ibegin
228      lend=lbegin+div
229    ELSE
230      lbegin=(div+1)*rest + (omp_level_rank-rest)*div + ibegin
231      lend=lbegin+div-1
232    ENDIF
233  END SUBROUTINE distrib_level
234
235
236  SUBROUTINE switch_omp_distrib_level
237  IMPLICIT NONE
238     is_omp_first_level = is_omp_first_level_distrib 
239     is_omp_last_level  = is_omp_last_level_distrib 
240     ll_begin           = ll_begin_distrib 
241     ll_beginp1         = ll_beginp1_distrib 
242     ll_end             = ll_end_distrib 
243     ll_endm1           = ll_endm1_distrib 
244     ll_endp1           = ll_endp1_distrib 
245 
246  END SUBROUTINE switch_omp_distrib_level
247 
248
249  SUBROUTINE switch_omp_no_distrib_level
250  IMPLICIT NONE
251
252     is_omp_first_level = is_omp_first_level_full 
253     is_omp_last_level  = is_omp_last_level_full 
254     ll_begin           = ll_begin_full 
255     ll_beginp1         = ll_beginp1_full 
256     ll_end             = ll_end_full 
257     ll_endm1           = ll_endm1_full 
258     ll_endp1           = ll_endp1_full 
259 
260  END SUBROUTINE switch_omp_no_distrib_level
261 
262
263  FUNCTION omp_in_parallel()
264#ifdef CPP_USING_OMP
265  USE omp_lib, ONLY : omp_in_parallel_=>omp_in_parallel
266#endif
267  IMPLICIT NONE
268    LOGICAL :: omp_in_parallel
269   
270#ifdef CPP_USING_OMP
271    omp_in_parallel=omp_in_parallel_()
272#else
273    omp_in_parallel=.FALSE.
274#endif
275
276  END FUNCTION  omp_in_parallel 
277     
278END MODULE omp_para
279   
280   
281     
282             
283 
284   
Note: See TracBrowser for help on using the repository browser.