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

Last change on this file since 324 was 324, checked in by dubos, 9 years ago

Minor fixes
File size: 7.0 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
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)
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    ll_end=0
126    DO i=0,omp_level_rank
127      ll_begin=ll_end+1
128      ll_nb=llm/omp_level_size
129      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1
130      ll_end=ll_begin+ll_nb-1
131    ENDDO
132   
133    ll_beginp1=ll_begin
134    ll_endp1=ll_end
135    ll_endm1=ll_end
136
137    IF (is_omp_first_level) ll_beginp1=ll_begin+1
138    IF (is_omp_last_level) ll_endp1=ll_endp1+1
139    IF (is_omp_last_level) ll_endm1=ll_endm1-1
140   
141   
142   
143    is_omp_first_level_distrib = is_omp_first_level
144    is_omp_last_level_distrib  = is_omp_last_level
145    ll_begin_distrib           = ll_begin
146    ll_beginp1_distrib         = ll_beginp1
147    ll_end_distrib             = ll_end
148    ll_endm1_distrib           = ll_endm1
149    ll_endp1_distrib           = ll_endp1
150   
151    is_omp_first_level_full = .TRUE.
152    is_omp_last_level_full  = .TRUE.
153    ll_begin_full           = 1
154    ll_beginp1_full         = 2
155    ll_end_full             = llm
156    ll_endm1_full           = llm-1
157    ll_endp1_full           = llm+1   
158
159!$OMP END PARALLEL
160
161   ELSE
162     is_master=is_mpi_master
163     omp_size=1
164     omp_level_size=1
165     omp_domain_size=1
166     omp_rank=0
167     omp_level_rank=0
168     omp_domain_rank=0
169     is_omp_first_level=.TRUE.
170     is_omp_last_level=.TRUE.
171     is_omp_master=.TRUE.
172     is_omp_domain_master=.TRUE.
173     is_omp_level_master=.TRUE.
174     ll_begin=1
175     ll_beginp1=2
176     ll_end=llm
177     ll_endm1=llm-1
178     ll_endp1=llm+1
179     
180     is_omp_first_level_distrib = is_omp_first_level
181     is_omp_last_level_distrib  = is_omp_last_level
182     ll_begin_distrib           = ll_begin
183     ll_beginp1_distrib         = ll_beginp1
184     ll_end_distrib             = ll_end
185     ll_endm1_distrib           = ll_endm1
186     ll_endp1_distrib           = ll_endp1
187   
188     is_omp_first_level_full = .TRUE.
189     is_omp_last_level_full  = .TRUE.
190     ll_begin_full           = 1
191     ll_beginp1_full         = 2
192     ll_end_full             = llm
193     ll_endm1_full           = llm-1
194     ll_endp1_full           = llm+1   
195
196   ENDIF
197   
198  END SUBROUTINE init_omp_para
199
200
201  SUBROUTINE switch_omp_distrib_level
202  IMPLICIT NONE
203     is_omp_first_level = is_omp_first_level_distrib 
204     is_omp_last_level  = is_omp_last_level_distrib 
205     ll_begin           = ll_begin_distrib 
206     ll_beginp1         = ll_beginp1_distrib 
207     ll_end             = ll_end_distrib 
208     ll_endm1           = ll_endm1_distrib 
209     ll_endp1           = ll_endp1_distrib 
210 
211  END SUBROUTINE switch_omp_distrib_level
212 
213
214  SUBROUTINE switch_omp_no_distrib_level
215  IMPLICIT NONE
216
217     is_omp_first_level = is_omp_first_level_full 
218     is_omp_last_level  = is_omp_last_level_full 
219     ll_begin           = ll_begin_full 
220     ll_beginp1         = ll_beginp1_full 
221     ll_end             = ll_end_full 
222     ll_endm1           = ll_endm1_full 
223     ll_endp1           = ll_endp1_full 
224 
225  END SUBROUTINE switch_omp_no_distrib_level
226 
227
228  FUNCTION omp_in_parallel()
229#ifdef CPP_USING_OMP
230  USE omp_lib, ONLY : omp_in_parallel_=>omp_in_parallel
231#endif
232  IMPLICIT NONE
233    LOGICAL :: omp_in_parallel
234   
235#ifdef CPP_USING_OMP
236    omp_in_parallel=omp_in_parallel_()
237#else
238    omp_in_parallel=.FALSE.
239#endif
240
241  END FUNCTION  omp_in_parallel 
242     
243END MODULE omp_para
244   
245   
246     
247             
248 
249   
Note: See TracBrowser for help on using the repository browser.