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