My Project
 All Classes Files Functions Variables Macros
mod_surf_para.F90
Go to the documentation of this file.
1 MODULE mod_surf_para
2  IMPLICIT NONE
3 
4  INTERFACE gather_surf
5  MODULE PROCEDURE gather_surf_i,gather_surf_r
6  END INTERFACE gather_surf
7 
8  INTERFACE gather_surf_omp
9  MODULE PROCEDURE gather_surf_omp_i,gather_surf_omp_r
10  END INTERFACE gather_surf_omp
11 
12  INTERFACE gather_surf_mpi
13  MODULE PROCEDURE gather_surf_mpi_i,gather_surf_mpi_r
14  END INTERFACE gather_surf_mpi
15 
16  INTERFACE scatter_surf
17  MODULE PROCEDURE scatter_surf_i,scatter_surf_r
18  END INTERFACE scatter_surf
19 
20  INTERFACE scatter_surf_omp
21  MODULE PROCEDURE scatter_surf_omp_i,scatter_surf_omp_r
22  END INTERFACE scatter_surf_omp
23 
24  INTERFACE scatter_surf_mpi
25  MODULE PROCEDURE scatter_surf_mpi_i,scatter_surf_mpi_r
26  END INTERFACE scatter_surf_mpi
27 
28 
29  INTEGER,SAVE :: knon_omp
30  INTEGER,SAVE :: knon_omp_begin
31  INTEGER,SAVE :: knon_omp_end
32 !$OMP THREADPRIVATE(knon_omp,knon_omp_begin,knon_omp_end)
33  INTEGER,ALLOCATABLE,SAVE :: knon_omp_para(:)
34  INTEGER,ALLOCATABLE,SAVE :: knon_omp_begin_para(:)
35  INTEGER,ALLOCATABLE,SAVE :: knon_omp_end_para(:)
36 
37  INTEGER,SAVE :: knon_mpi
38  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_para(:)
39  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_begin_para(:)
40  INTEGER,ALLOCATABLE,SAVE :: knon_mpi_end_para(:)
41 
42  INTEGER,SAVE :: knon_glo
43  INTEGER,SAVE,ALLOCATABLE :: knon_glo_para(:)
44  INTEGER,ALLOCATABLE,SAVE :: knon_glo_begin_para(:)
45  INTEGER,ALLOCATABLE,SAVE :: knon_glo_end_para(:)
46 
47 
48 CONTAINS
49 
50  SUBROUTINE init_surf_para(knon)
51  USE mod_phys_lmdz_para, mpi_rank_root=>mpi_root
52 #ifdef CPP_MPI
53  include 'mpif.h'
54 #endif
55  INTEGER :: knon
56  INTEGER :: i,ierr
57 
58  knon_omp=knon
59  IF (is_omp_root) THEN
60  ALLOCATE(knon_omp_para(0:omp_size-1))
61  ALLOCATE(knon_omp_begin_para(0:omp_size-1))
62  ALLOCATE(knon_omp_end_para(0:omp_size-1))
63  ENDIF
64 !$OMP BARRIER
65  knon_omp_para(omp_rank)=knon
66 !$OMP BARRIER
67  IF (is_omp_root) THEN
68  knon_omp_begin_para(0)=1
69  knon_omp_end_para(0)=knon_omp_para(0)
70  DO i=1,omp_size-1
71  knon_omp_begin_para(i)=knon_omp_end_para(i-1)+1
72  knon_omp_end_para(i)=knon_omp_begin_para(i)+knon_omp_para(i)-1
73  ENDDO
74  ENDIF
75 !$OMP BARRIER
76  knon_omp_begin=knon_omp_begin_para(omp_rank)
77  knon_omp_end=knon_omp_end_para(omp_rank)
78 !$OMP BARRIER
79  IF (is_omp_root) THEN
80  knon_mpi=sum(knon_omp_para)
81  ALLOCATE(knon_mpi_para(0:mpi_size-1))
82  ALLOCATE(knon_mpi_begin_para(0:mpi_size-1))
83  ALLOCATE(knon_mpi_end_para(0:mpi_size-1))
84 
85  ALLOCATE(knon_glo_para(0:mpi_size*omp_size-1))
86  ALLOCATE(knon_glo_begin_para(0:mpi_size*omp_size-1))
87  ALLOCATE(knon_glo_end_para(0:mpi_size*omp_size-1))
88 
89  IF (is_using_mpi) THEN
90 #ifdef CPP_MPI
91  CALL mpi_allgather(knon_mpi,1,mpi_integer,knon_mpi_para,1,mpi_integer,comm_lmdz_phy,ierr)
92  CALL mpi_allgather(knon_omp_para,omp_size,mpi_integer,knon_glo_para,omp_size,mpi_integer,comm_lmdz_phy,ierr)
93 #endif
94  ELSE
95  knon_mpi_para(:)=knon_mpi
96  knon_glo_para(:)=knon_omp_para(:)
97  ENDIF
98 
99  knon_glo=sum(knon_mpi_para(:))
100 
101  knon_mpi_begin_para(0)=1
102  knon_mpi_end_para(0)=knon_mpi_para(0)
103  DO i=1,mpi_size-1
104  knon_mpi_begin_para(i)=knon_mpi_end_para(i-1)+1
105  knon_mpi_end_para(i)=knon_mpi_begin_para(i)+knon_mpi_para(i)-1
106  ENDDO
107 
108  knon_glo_begin_para(0)=1
109  knon_glo_end_para(0)=knon_glo_para(0)
110  DO i=1,mpi_size*omp_size-1
111  knon_glo_begin_para(i)=knon_glo_end_para(i-1)+1
112  knon_glo_end_para(i)= knon_glo_begin_para(i)+knon_glo_para(i)-1
113  ENDDO
114  ENDIF
115 !$OMP BARRIER
116 
117  END SUBROUTINE init_surf_para
118 
119 
120  SUBROUTINE finalize_surf_para
121  USE mod_phys_lmdz_para
122 
123 !$OMP BARRIER
124  IF (is_omp_root) THEN
125  DEALLOCATE(knon_omp_para)
126  DEALLOCATE(knon_omp_begin_para)
127  DEALLOCATE(knon_omp_end_para)
128  DEALLOCATE(knon_mpi_para)
129  DEALLOCATE(knon_mpi_begin_para)
130  DEALLOCATE(knon_mpi_end_para)
131  DEALLOCATE(knon_glo_para)
132  DEALLOCATE(knon_glo_begin_para)
133  DEALLOCATE(knon_glo_end_para)
134  ENDIF
135 
136  END SUBROUTINE finalize_surf_para
137 
138 
139  SUBROUTINE gather_surf_i(FieldIn, FieldOut)
140  USE mod_phys_lmdz_para
141  INTEGER :: fieldin(:)
142  INTEGER :: fieldout(:)
143  INTEGER :: fieldtmp(knon_mpi)
144 
145  CALL gather_surf_omp_i(fieldin,fieldtmp)
146  IF (is_omp_root) CALL gather_surf_mpi_i(fieldtmp,fieldout)
147 
148  END SUBROUTINE gather_surf_i
149 
150 
151  SUBROUTINE gather_surf_omp_i(FieldIn,FieldOut)
152  USE mod_phys_lmdz_para
153  INTEGER :: fieldin(:)
154  INTEGER :: fieldout(:)
155 
156  INTEGER,SAVE,ALLOCATABLE :: field_tmp(:)
157 
158  IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
159 !$OMP BARRIER
160  field_tmp(knon_omp_begin:knon_omp_end)=fieldin(:)
161 !$OMP BARRIER
162  IF (is_omp_root) fieldout(:)=field_tmp(:)
163 !$OMP BARRIER
164  IF (is_omp_root) DEALLOCATE(field_tmp)
165 
166  END SUBROUTINE gather_surf_omp_i
167 
168 
169  SUBROUTINE gather_surf_mpi_i(FieldIn,FieldOut)
170  USE mod_phys_lmdz_para, mpi_rank_root => mpi_root
171 #ifdef CPP_MPI
172  include 'mpif.h'
173 #endif
174  INTEGER :: fieldin(:)
175  INTEGER :: fieldout(:)
176  INTEGER :: ierr
177 
178  IF (is_using_mpi) THEN
179 #ifdef CPP_MPI
180  CALL mpi_gatherv(fieldin,knon_mpi,mpi_integer, &
181  fieldout,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer, &
182  mpi_rank_root,comm_lmdz_phy,ierr)
183 #endif
184  ELSE
185  fieldout(:)=fieldin(:)
186  ENDIF
187 
188  END SUBROUTINE gather_surf_mpi_i
189 
190 
191 
192 
193 
194  SUBROUTINE gather_surf_r(FieldIn, FieldOut)
195  USE mod_phys_lmdz_para
196  REAL :: fieldin(:)
197  REAL :: fieldout(:)
198  REAL :: fieldtmp(knon_mpi)
199 
200  CALL gather_surf_omp_r(fieldin,fieldtmp)
201  IF (is_omp_root) CALL gather_surf_mpi_r(fieldtmp,fieldout)
202 
203  END SUBROUTINE gather_surf_r
204 
205 
206  SUBROUTINE gather_surf_omp_r(FieldIn,FieldOut)
207  USE mod_phys_lmdz_para
208  REAL :: fieldin(:)
209  REAL :: fieldout(:)
210 
211  REAL,SAVE,ALLOCATABLE :: field_tmp(:)
212 
213  IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
214 !$OMP BARRIER
215  field_tmp(knon_omp_begin:knon_omp_end)=fieldin(:)
216 !$OMP BARRIER
217  IF (is_omp_root) fieldout(:)=field_tmp(:)
218 !$OMP BARRIER
219  IF (is_omp_root) DEALLOCATE(field_tmp)
220 
221  END SUBROUTINE gather_surf_omp_r
222 
223 
224  SUBROUTINE gather_surf_mpi_r(FieldIn,FieldOut)
225  USE mod_phys_lmdz_para, mpi_rank_root => mpi_root
226 #ifdef CPP_MPI
227  include 'mpif.h'
228 #endif
229  REAL :: fieldin(:)
230  REAL :: fieldout(:)
231  REAL :: ierr
232 
233  IF (is_using_mpi) THEN
234 #ifdef CPP_MPI
235  CALL mpi_gatherv(fieldin,knon_mpi,mpi_real_lmdz, &
236  fieldout,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_real_lmdz, &
237  mpi_rank_root,comm_lmdz_phy,ierr)
238 #endif
239  ELSE
240  fieldout(:)=fieldin(:)
241  ENDIF
242 
243  END SUBROUTINE gather_surf_mpi_r
244 
245 
246 
247 
248  SUBROUTINE scatter_surf_i(FieldIn, FieldOut)
249  USE mod_phys_lmdz_para
250  INTEGER :: fieldin(:)
251  INTEGER :: fieldout(:)
252  INTEGER :: fieldtmp(knon_mpi)
253 
254  IF (is_omp_root) CALL scatter_surf_mpi_i(fieldin,fieldtmp)
255  CALL scatter_surf_omp_i(fieldtmp,fieldout)
256 
257  END SUBROUTINE scatter_surf_i
258 
259 
260  SUBROUTINE scatter_surf_omp_i(FieldIn,FieldOut)
261  USE mod_phys_lmdz_para
262  INTEGER :: fieldin(:)
263  INTEGER :: fieldout(:)
264 
265  INTEGER,SAVE,ALLOCATABLE :: field_tmp(:)
266 
267  IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
268  IF (is_omp_root) field_tmp(:)=fieldin(:)
269 !$OMP BARRIER
270  fieldout(:)=field_tmp(knon_omp_begin:knon_omp_end)
271 !$OMP BARRIER
272  IF (is_omp_root) DEALLOCATE(field_tmp)
273 
274  END SUBROUTINE scatter_surf_omp_i
275 
276 
277  SUBROUTINE scatter_surf_mpi_i(FieldIn,FieldOut)
278  USE mod_phys_lmdz_para, mpi_rank_root => mpi_root
279 #ifdef CPP_MPI
280  include 'mpif.h'
281 #endif
282  INTEGER :: fieldin(:)
283  INTEGER :: fieldout(:)
284  INTEGER :: ierr
285 
286  IF (is_using_mpi) THEN
287 #ifdef CPP_MPI
288  CALL mpi_scatterv(fieldin,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer, &
289  fieldout,knon_mpi,mpi_integer, &
290  mpi_rank_root,comm_lmdz_phy,ierr)
291 #endif
292  ELSE
293  fieldout(:)=fieldin(:)
294  ENDIF
295 
296  END SUBROUTINE scatter_surf_mpi_i
297 
298 
299 
300  SUBROUTINE scatter_surf_r(FieldIn, FieldOut)
301  USE mod_phys_lmdz_para
302  REAL :: fieldin(:)
303  REAL :: fieldout(:)
304  REAL :: fieldtmp(knon_mpi)
305 
306  IF (is_omp_root) CALL scatter_surf_mpi_r(fieldin,fieldtmp)
307  CALL scatter_surf_omp_r(fieldtmp,fieldout)
308 
309  END SUBROUTINE scatter_surf_r
310 
311 
312  SUBROUTINE scatter_surf_omp_r(FieldIn,FieldOut)
313  USE mod_phys_lmdz_para
314  REAL :: fieldin(:)
315  REAL :: fieldout(:)
316 
317  INTEGER,SAVE,ALLOCATABLE :: field_tmp(:)
318 
319  IF (is_omp_root) ALLOCATE(field_tmp(knon_mpi))
320  IF (is_omp_root) field_tmp(:)=fieldin(:)
321 !$OMP BARRIER
322  fieldout(:)=field_tmp(knon_omp_begin:knon_omp_end)
323 !$OMP BARRIER
324  IF (is_omp_root) DEALLOCATE(field_tmp)
325 
326  END SUBROUTINE scatter_surf_omp_r
327 
328 
329  SUBROUTINE scatter_surf_mpi_r(FieldIn,FieldOut)
330  USE mod_phys_lmdz_para, mpi_rank_root => mpi_root
331 #ifdef CPP_MPI
332  include 'mpif.h'
333 #endif
334  REAL :: fieldin(:)
335  REAL :: fieldout(:)
336  INTEGER :: ierr
337 
338  IF (is_using_mpi) THEN
339 #ifdef CPP_MPI
340  CALL mpi_scatterv(fieldin,knon_mpi_para,knon_mpi_begin_para(:)-1,mpi_integer, &
341  fieldout,knon_mpi,mpi_integer, &
342  mpi_rank_root,comm_lmdz_phy,ierr)
343 #endif
344  ELSE
345  fieldout(:)=fieldin(:)
346  ENDIF
347 
348  END SUBROUTINE scatter_surf_mpi_r
349 
350 END MODULE mod_surf_para