source: codes/icosagcm/trunk/src/omp_para.F90 @ 342

Last change on this file since 342 was 327, checked in by ymipsl, 9 years ago

Merge recent developments from saturn branch onto trunk.

  • lmdz generic physics interface
  • performance improvment on mix mpi/openmp
  • asynchrone and overlaping communication
  • best domain distribution between process and threads
  • ....

This version is compatible with the actual saturn version and the both branches are considered merged on dynamico component.

YM
File size: 7.5 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  SUBROUTINE init_omp_para(is_mpi_master)
63  USE grid_param
64  USE ioipsl, ONLY : getin
65#ifdef CPP_USING_OMP
66  USE omp_lib
67#endif
68  IMPLICIT NONE
69  LOGICAL, INTENT(IN) :: is_mpi_master
70  INTEGER :: ll_nb,i,llb,lle
71
72#ifdef CPP_USING_OMP
73  using_openmp=.TRUE.
74#else
75  using_openmp=.FALSE.
76#endif
77
78  IF (using_openmp) THEN   
79!$OMP PARALLEL PRIVATE(ll_nb,i,llb,lle)
80 
81!$OMP MASTER
82#ifdef CPP_USING_OMP
83    omp_size=OMP_GET_NUM_THREADS()
84#endif
85!$OMP END MASTER
86!$OMP BARRIER
87#ifdef CPP_USING_OMP
88    omp_rank=OMP_GET_THREAD_NUM()
89#endif
90   
91    is_omp_master=.FALSE.
92    is_master=.FALSE.
93     
94    IF (omp_rank==0) THEN
95      is_omp_master=.TRUE.
96      IF (is_mpi_master) is_master=.TRUE.
97    ENDIF
98
99    omp_level_size=1 
100    CALL getin("omp_level_size",omp_level_size)
101    IF(is_mpi_master) PRINT *,'GETIN omp_level_size', ' = ', omp_level_size
102
103    IF (MOD(omp_size,omp_level_size)/=0) THEN
104      IF (is_mpi_master) PRINT*,"omp_size /= omp_level_size x omp_domain_size  => disable omp threads on vertical layers"
105      omp_level_size=1
106    ENDIF
107    omp_domain_size=omp_size/omp_level_size
108    omp_domain_rank = omp_rank / omp_level_size   
109    omp_level_rank = MOD(omp_rank, omp_level_size)   
110   
111    IF (is_mpi_master) PRINT*,"omp_domain_size",omp_domain_size,"omp_domain_rank", omp_domain_rank
112    IF (is_mpi_master) PRINT*,"omp_level_size",omp_level_size,"omp_level_rank", omp_level_rank
113   
114    is_omp_first_level=.FALSE.
115    is_omp_last_level= .FALSE.
116    is_omp_domain_master=.FALSE.
117    is_omp_level_master=.FALSE.
118
119    IF (omp_domain_rank==0) is_omp_domain_master = .TRUE.
120    IF (omp_level_rank==0) is_omp_level_master = .TRUE.
121    IF (omp_level_rank==0) is_omp_first_level=.TRUE.
122   
123    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE.
124   
125    lle=0
126   
127    DO i=0,omp_level_rank
128      llb=lle+1
129      ll_nb=llm/omp_level_size
130      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1
131      lle=llb+ll_nb-1
132    ENDDO
133    ll_begin=llb
134    ll_end=lle
135   
136    ll_beginp1=ll_begin
137    ll_endp1=ll_end
138    ll_endm1=ll_end
139
140    IF (is_omp_first_level) ll_beginp1=ll_begin+1
141    IF (is_omp_last_level) ll_endp1=ll_endp1+1
142    IF (is_omp_last_level) ll_endm1=ll_endm1-1
143   
144   
145   
146    is_omp_first_level_distrib = is_omp_first_level
147    is_omp_last_level_distrib  = is_omp_last_level
148    ll_begin_distrib           = ll_begin
149    ll_beginp1_distrib         = ll_beginp1
150    ll_end_distrib             = ll_end
151    ll_endm1_distrib           = ll_endm1
152    ll_endp1_distrib           = ll_endp1
153   
154    is_omp_first_level_full = .TRUE.
155    is_omp_last_level_full  = .TRUE.
156    ll_begin_full           = 1
157    ll_beginp1_full         = 2
158    ll_end_full             = llm
159    ll_endm1_full           = llm-1
160    ll_endp1_full           = llm+1   
161
162!$OMP END PARALLEL
163
164   ELSE
165     omp_size=1
166     omp_level_size=1
167     omp_domain_size=1
168     omp_rank=0
169     omp_level_rank=0
170     omp_domain_rank=0
171     is_omp_first_level=.TRUE.
172     is_omp_last_level=.TRUE.
173     is_omp_master=.TRUE.
174     is_omp_domain_master=.TRUE.
175     is_omp_level_master=.TRUE.
176     ll_begin=1
177     ll_beginp1=2
178     ll_end=llm
179     ll_endm1=llm-1
180     ll_endp1=llm+1
181     
182     is_omp_first_level_distrib = is_omp_first_level
183     is_omp_last_level_distrib  = is_omp_last_level
184     ll_begin_distrib           = ll_begin
185     ll_beginp1_distrib         = ll_beginp1
186     ll_end_distrib             = ll_end
187     ll_endm1_distrib           = ll_endm1
188     ll_endp1_distrib           = ll_endp1
189   
190     is_omp_first_level_full = .TRUE.
191     is_omp_last_level_full  = .TRUE.
192     ll_begin_full           = 1
193     ll_beginp1_full         = 2
194     ll_end_full             = llm
195     ll_endm1_full           = llm-1
196     ll_endp1_full           = llm+1   
197
198   ENDIF
199   
200  END SUBROUTINE init_omp_para
201
202  SUBROUTINE distrib_level(size,lbegin,lend)
203  IMPLICIT NONE
204    INTEGER,INTENT(IN)  :: size 
205    INTEGER,INTENT(OUT) :: lbegin 
206    INTEGER,INTENT(OUT) :: lend 
207    INTEGER :: div,rest
208   
209    div=size/omp_level_size
210    rest=MOD(size,omp_level_size)
211    IF (omp_level_rank<rest) THEN
212      lbegin=(div+1)*omp_level_rank+1
213      lend=lbegin+div
214    ELSE
215      lbegin=(div+1)*rest + (omp_level_rank-rest)*div+1
216      lend=lbegin+div-1
217    ENDIF
218  END SUBROUTINE distrib_level
219
220
221  SUBROUTINE switch_omp_distrib_level
222  IMPLICIT NONE
223     is_omp_first_level = is_omp_first_level_distrib 
224     is_omp_last_level  = is_omp_last_level_distrib 
225     ll_begin           = ll_begin_distrib 
226     ll_beginp1         = ll_beginp1_distrib 
227     ll_end             = ll_end_distrib 
228     ll_endm1           = ll_endm1_distrib 
229     ll_endp1           = ll_endp1_distrib 
230 
231  END SUBROUTINE switch_omp_distrib_level
232 
233
234  SUBROUTINE switch_omp_no_distrib_level
235  IMPLICIT NONE
236
237     is_omp_first_level = is_omp_first_level_full 
238     is_omp_last_level  = is_omp_last_level_full 
239     ll_begin           = ll_begin_full 
240     ll_beginp1         = ll_beginp1_full 
241     ll_end             = ll_end_full 
242     ll_endm1           = ll_endm1_full 
243     ll_endp1           = ll_endp1_full 
244 
245  END SUBROUTINE switch_omp_no_distrib_level
246 
247
248  FUNCTION omp_in_parallel()
249#ifdef CPP_USING_OMP
250  USE omp_lib, ONLY : omp_in_parallel_=>omp_in_parallel
251#endif
252  IMPLICIT NONE
253    LOGICAL :: omp_in_parallel
254   
255#ifdef CPP_USING_OMP
256    omp_in_parallel=omp_in_parallel_()
257#else
258    omp_in_parallel=.FALSE.
259#endif
260
261  END FUNCTION  omp_in_parallel 
262     
263END MODULE omp_para
264   
265   
266     
267             
268 
269   
Note: See TracBrowser for help on using the repository browser.