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

Last change on this file since 988 was 987, checked in by Laurent Fairhead, 16 years ago

Du nettoyage sur le parallelisme, inclusion de nouvelles interfaces pour OPA9
et ORCHIDEE YM
LF
  • 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_PARA
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_ok_mpi) THEN
90#ifdef CPP_PARA
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)
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_PARA
172  INCLUDE 'mpif.h'
173#endif
174    INTEGER :: FieldIn(:)
175    INTEGER :: FieldOut(:)
176    INTEGER :: ierr
177   
178    IF (is_ok_mpi) THEN
179#ifdef CPP_PARA
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_PARA
227  INCLUDE 'mpif.h'
228#endif
229    REAL :: FieldIn(:)
230    REAL :: FieldOut(:)
231    REAL :: ierr
232   
233    IF (is_ok_mpi) THEN
234#ifdef CPP_PARA
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_PARA
280  INCLUDE 'mpif.h'
281#endif
282    INTEGER :: FieldIn(:)
283    INTEGER :: FieldOut(:)
284    INTEGER :: ierr
285   
286    IF (is_ok_mpi) THEN
287#ifdef CPP_PARA
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_PARA
332  INCLUDE 'mpif.h'
333#endif
334    REAL :: FieldIn(:)
335    REAL :: FieldOut(:)
336    INTEGER :: ierr
337   
338    IF (is_ok_mpi) THEN
339#ifdef CPP_PARA
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.