source: LMDZ4/trunk/libf/phylmd/mod_surf_para.F90 @ 5442

Last change on this file since 5442 was 1023, checked in by lsce, 16 years ago

Bug parallélisme en MPI/OPENMP lorsque pour un grand nombre de CPU, le processus maître et/ou la tâche maitre se retrouve sans points de terre, et sont donc exlus de la liste des domaines dans orchidee.
YM
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 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, 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
350END MODULE mod_surf_para
Note: See TracBrowser for help on using the repository browser.