source: LMDZ6/branches/Amaury_dev/libf/phylmd/mod_surf_para.F90 @ 5093

Last change on this file since 5093 was 4600, checked in by yann meurdesoif, 18 months ago

Suppress CPP_MPI key usage in source code. MPI wrappers is used to supress missing symbol if the mpi library is not linked

YM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.0 KB
Line 
1MODULE 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 
48CONTAINS
49
50  SUBROUTINE Init_surf_para(knon)
51  USE mod_phys_lmdz_para
52  USE lmdz_mpi
53
54    INTEGER :: knon
55    INTEGER :: i,ierr
56   
57    knon_omp=knon
58    IF (is_omp_root) THEN
59      ALLOCATE(knon_omp_para(0:omp_size-1))
60      ALLOCATE(knon_omp_begin_para(0:omp_size-1))
61      ALLOCATE(knon_omp_end_para(0:omp_size-1))
62    ENDIF
63!$OMP BARRIER
64    knon_omp_para(omp_rank)=knon
65!$OMP BARRIER
66    IF (is_omp_root) THEN
67      knon_omp_begin_para(0)=1
68      knon_omp_end_para(0)=knon_omp_para(0)
69      DO i=1,omp_size-1
70        knon_omp_begin_para(i)=knon_omp_end_para(i-1)+1
71        knon_omp_end_para(i)=knon_omp_begin_para(i)+knon_omp_para(i)-1
72      ENDDO
73    ENDIF
74!$OMP BARRIER
75    knon_omp_begin=knon_omp_begin_para(omp_rank)
76    knon_omp_end=knon_omp_end_para(omp_rank)
77!$OMP BARRIER   
78    IF (is_omp_root) THEN
79      knon_mpi=sum(knon_omp_para)
80      ALLOCATE(knon_mpi_para(0:mpi_size-1))
81      ALLOCATE(knon_mpi_begin_para(0:mpi_size-1))
82      ALLOCATE(knon_mpi_end_para(0:mpi_size-1))
83     
84      ALLOCATE(knon_glo_para(0:mpi_size*omp_size-1))
85      ALLOCATE(knon_glo_begin_para(0:mpi_size*omp_size-1))
86      ALLOCATE(knon_glo_end_para(0:mpi_size*omp_size-1))
87     
88      IF (is_using_mpi) THEN
89        CALL MPI_ALLGather(knon_mpi,1,MPI_INTEGER,knon_mpi_para,1,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
90        CALL MPI_ALLGather(knon_omp_para,omp_size,MPI_INTEGER,knon_glo_para,omp_size,MPI_INTEGER,COMM_LMDZ_PHY,ierr)
91      ELSE
92        knon_mpi_para(:)=knon_mpi
93        knon_glo_para(:)=knon_omp_para(:)
94      ENDIF     
95     
96      knon_glo=sum(knon_mpi_para(:))
97     
98      knon_mpi_begin_para(0)=1
99      knon_mpi_end_para(0)=knon_mpi_para(0)
100      DO i=1,mpi_size-1
101        knon_mpi_begin_para(i)=knon_mpi_end_para(i-1)+1
102        knon_mpi_end_para(i)=knon_mpi_begin_para(i)+knon_mpi_para(i)-1
103      ENDDO
104     
105      knon_glo_begin_para(0)=1
106      knon_glo_end_para(0)=knon_glo_para(0)
107      DO i=1,mpi_size*omp_size-1
108        knon_glo_begin_para(i)=knon_glo_end_para(i-1)+1
109        knon_glo_end_para(i)= knon_glo_begin_para(i)+knon_glo_para(i)-1
110      ENDDO
111   ENDIF
112!$OMP BARRIER
113
114  END SUBROUTINE Init_surf_para
115
116 
117  SUBROUTINE Finalize_surf_para
118  USE mod_phys_lmdz_para
119
120!$OMP BARRIER   
121   IF (is_omp_root) THEN
122      DEALLOCATE(knon_omp_para)
123      DEALLOCATE(knon_omp_begin_para)
124      DEALLOCATE(knon_omp_end_para)
125      DEALLOCATE(knon_mpi_para)
126      DEALLOCATE(knon_mpi_begin_para)
127      DEALLOCATE(knon_mpi_end_para)
128      DEALLOCATE(knon_glo_para) 
129      DEALLOCATE(knon_glo_begin_para)
130      DEALLOCATE(knon_glo_end_para)
131    ENDIF
132   
133  END SUBROUTINE Finalize_surf_para
134 
135 
136  SUBROUTINE gather_surf_i(FieldIn, FieldOut)
137  USE mod_phys_lmdz_para
138    INTEGER :: FieldIn(:)
139    INTEGER :: FieldOut(:)
140    INTEGER :: FieldTmp(knon_mpi)
141   
142    CALL gather_surf_omp_i(FieldIn,FieldTmp)
143    IF (is_omp_root) CALL gather_surf_mpi_i(FieldTmp,FieldOut)
144   
145  END SUBROUTINE gather_surf_i
146
147
148  SUBROUTINE gather_surf_omp_i(FieldIn,FieldOut)
149  USE mod_phys_lmdz_para
150    INTEGER :: FieldIn(:)
151    INTEGER :: FieldOut(:)
152 
153    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
154   
155    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
156!$OMP BARRIER
157    Field_tmp(knon_omp_begin:knon_omp_end)=FieldIn(:)
158!$OMP BARRIER       
159    IF (is_omp_root) FieldOut(:)=Field_tmp(:)
160!$OMP BARRIER
161    IF (is_omp_root) DEALLOCATE(Field_tmp)
162   
163  END SUBROUTINE  gather_surf_omp_i
164 
165     
166  SUBROUTINE gather_surf_mpi_i(FieldIn,FieldOut)
167  USE mod_phys_lmdz_para
168  USE lmdz_mpi
169
170    INTEGER :: FieldIn(:)
171    INTEGER :: FieldOut(:)
172    INTEGER :: ierr
173   
174    IF (is_using_mpi) THEN
175      CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_INTEGER,                                &
176                       FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER, &
177                       mpi_master,COMM_LMDZ_PHY,ierr)
178    ELSE
179      FieldOut(:)=FieldIn(:)
180    ENDIF
181 
182  END SUBROUTINE gather_surf_mpi_i
183 
184
185
186
187
188  SUBROUTINE gather_surf_r(FieldIn, FieldOut)
189  USE mod_phys_lmdz_para
190    REAL :: FieldIn(:)
191    REAL :: FieldOut(:)
192    REAL :: FieldTmp(knon_mpi)
193   
194    CALL gather_surf_omp_r(FieldIn,FieldTmp)
195    IF (is_omp_root) CALL gather_surf_mpi_r(FieldTmp,FieldOut)
196   
197  END SUBROUTINE gather_surf_r
198
199
200  SUBROUTINE gather_surf_omp_r(FieldIn,FieldOut)
201  USE mod_phys_lmdz_para
202    REAL :: FieldIn(:)
203    REAL :: FieldOut(:)
204 
205    REAL,SAVE,ALLOCATABLE :: Field_tmp(:)
206   
207    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
208!$OMP BARRIER
209    Field_tmp(knon_omp_begin:knon_omp_end)=FieldIn(:)
210!$OMP BARRIER       
211    IF (is_omp_root) FieldOut(:)=Field_tmp(:)
212!$OMP BARRIER
213    IF (is_omp_root) DEALLOCATE(Field_tmp)
214   
215  END SUBROUTINE  gather_surf_omp_r
216 
217     
218  SUBROUTINE gather_surf_mpi_r(FieldIn,FieldOut)
219  USE mod_phys_lmdz_para
220  USE lmdz_mpi
221
222    REAL :: FieldIn(:)
223    REAL :: FieldOut(:)
224    REAL :: ierr
225   
226    IF (is_using_mpi) THEN
227      CALL MPI_Gatherv(FieldIn,knon_mpi,MPI_REAL_LMDZ,                                 &
228                       FieldOut,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_REAL_LMDZ,  &
229                       mpi_master,COMM_LMDZ_PHY,ierr)           
230    ELSE
231      FieldOut(:)=FieldIn(:)
232    ENDIF
233 
234  END SUBROUTINE gather_surf_mpi_r
235
236
237
238
239  SUBROUTINE scatter_surf_i(FieldIn, FieldOut)
240  USE mod_phys_lmdz_para
241    INTEGER :: FieldIn(:)
242    INTEGER :: FieldOut(:)
243    INTEGER :: FieldTmp(knon_mpi)
244   
245    IF (is_omp_root) CALL scatter_surf_mpi_i(FieldIn,FieldTmp)
246    CALL scatter_surf_omp_i(FieldTmp,FieldOut)
247   
248  END SUBROUTINE scatter_surf_i
249
250
251  SUBROUTINE scatter_surf_omp_i(FieldIn,FieldOut)
252  USE mod_phys_lmdz_para
253    INTEGER :: FieldIn(:)
254    INTEGER :: FieldOut(:)
255 
256    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
257   
258    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
259    IF (is_omp_root) Field_tmp(:)=FieldIn(:)
260!$OMP BARRIER       
261    FieldOut(:)=Field_tmp(knon_omp_begin:knon_omp_end)
262!$OMP BARRIER
263    IF (is_omp_root) DEALLOCATE(Field_tmp)
264   
265  END SUBROUTINE  scatter_surf_omp_i
266 
267     
268  SUBROUTINE scatter_surf_mpi_i(FieldIn,FieldOut)
269  USE mod_phys_lmdz_para
270  USE lmdz_mpi
271
272    INTEGER :: FieldIn(:)
273    INTEGER :: FieldOut(:)
274    INTEGER :: ierr
275   
276    IF (is_using_mpi) THEN
277      CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
278                        FieldOut,knon_mpi,MPI_INTEGER,                                &
279                        mpi_master,COMM_LMDZ_PHY,ierr)
280    ELSE
281      FieldOut(:)=FieldIn(:)
282    ENDIF
283 
284  END SUBROUTINE scatter_surf_mpi_i
285
286
287
288  SUBROUTINE scatter_surf_r(FieldIn, FieldOut)
289  USE mod_phys_lmdz_para
290    REAL :: FieldIn(:)
291    REAL :: FieldOut(:)
292    REAL :: FieldTmp(knon_mpi)
293   
294    IF (is_omp_root) CALL scatter_surf_mpi_r(FieldIn,FieldTmp)
295    CALL scatter_surf_omp_r(FieldTmp,FieldOut)
296   
297  END SUBROUTINE scatter_surf_r
298
299
300  SUBROUTINE scatter_surf_omp_r(FieldIn,FieldOut)
301  USE mod_phys_lmdz_para
302    REAL :: FieldIn(:)
303    REAL :: FieldOut(:)
304 
305    INTEGER,SAVE,ALLOCATABLE :: Field_tmp(:)
306   
307    IF (is_omp_root) ALLOCATE(Field_tmp(knon_mpi))
308    IF (is_omp_root) Field_tmp(:)=FieldIn(:)
309!$OMP BARRIER       
310    FieldOut(:)=Field_tmp(knon_omp_begin:knon_omp_end)
311!$OMP BARRIER
312    IF (is_omp_root) DEALLOCATE(Field_tmp)
313   
314  END SUBROUTINE  scatter_surf_omp_r
315 
316     
317  SUBROUTINE scatter_surf_mpi_r(FieldIn,FieldOut)
318  USE mod_phys_lmdz_para
319  USE lmdz_mpi
320
321    REAL :: FieldIn(:)
322    REAL :: FieldOut(:)
323    INTEGER :: ierr
324   
325    IF (is_using_mpi) THEN
326      CALL MPI_Scatterv(FieldIn,knon_mpi_para,knon_mpi_begin_para(:)-1,MPI_INTEGER,   &
327                        FieldOut,knon_mpi,MPI_INTEGER,                                &
328                        mpi_master,COMM_LMDZ_PHY,ierr)
329    ELSE
330      FieldOut(:)=FieldIn(:)
331    ENDIF
332 
333  END SUBROUTINE scatter_surf_mpi_r
334
335END MODULE mod_surf_para
336
Note: See TracBrowser for help on using the repository browser.