source: lmdz_wrf/WRFV3/external/atm_ocn/module_PATCH_QUILT.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

  • Property svn:executable set to *
File size: 10.8 KB
Line 
1!-----------------------------------------------------------------------
2!
3!NCEP_MESO:MODEL_LAYER: SOLVER
4!
5!-----------------------------------------------------------------------
6!
7      MODULE MODULE_PATCH_QUILT
8!
9!-----------------------------------------------------------------------
10      USE MODULE_EXT_INTERNAL
11!-----------------------------------------------------------------------
12!
13      PRIVATE
14      PUBLIC :: PATCH,QUILT_2
15!
16!-----------------------------------------------------------------------
17!
18      CONTAINS
19!
20!-----------------------------------------------------------------------
21!***********************************************************************
22!-----------------------------------------------------------------------
23      SUBROUTINE PATCH(ARRAYG,ARRAYL                                    &
24     &,                IDS,IDE,JDS,JDE,KDS,KDE                          &
25     &,                IMS,IME,JMS,JME,KMS,KME                          &
26     &,                ITS,ITE,JTS,JTE,KTS,KTE)
27!-----------------------------------------------------------------------
28!     PATCH DISTRIBUTES THE ELEMENTS OF REAL GLOBAL 2-D ARRAY ARRAYG TO
29!     THE REAL LOCAL 2-D ARRAY ARRAYL.
30!
31!     AUTHOR: TOM BLACK
32!-----------------------------------------------------------------------
33!
34      IMPLICIT NONE
35!
36!-----------------------------------------------------------------------
37!
38      INCLUDE "mpif.h"
39!
40!-----------------------------------------------------------------------
41!***  ARGUMENT VARIABLES
42!-----------------------------------------------------------------------
43!
44      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
45     &,                     IMS,IME,JMS,JME,KMS,KME                     &
46     &,                     ITS,ITE,JTS,JTE,KTS,KTE
47!
48      REAL,DIMENSION(IDS:IDE,JDS:JDE),INTENT(IN) :: ARRAYG
49      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: ARRAYL
50!
51!-----------------------------------------------------------------------
52!***  LOCAL VARIABLES
53!-----------------------------------------------------------------------
54!
55      REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
56!
57      INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
58     &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
59!
60      INTEGER,DIMENSION(4) :: LIMITS
61!
62      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
63!-----------------------------------------------------------------------
64!***********************************************************************
65!-----------------------------------------------------------------------
66!
67!-----------------------------------------------------------------------
68!***  GET OUR TASK ID AND THE COMMUNICATOR
69!-----------------------------------------------------------------------
70!
71      CALL WRF_GET_MYPROC(MYPE)
72      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
73      CALL WRF_GET_NPROC(NPES)
74!
75!-----------------------------------------------------------------------
76!***  INITIALIZE THE OUTPUT ARRAY
77!-----------------------------------------------------------------------
78!
79      DO J=JMS,JME
80      DO I=IMS,IME
81        ARRAYL(I,J)=0.
82      ENDDO
83      ENDDO
84!
85!-----------------------------------------------------------------------
86!***  TASK 0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER
87!***  PIECES TO THE OTHER TASKS.
88!-----------------------------------------------------------------------
89!
90!-----------------------------------------------------------------------
91      tasks : IF(MYPE==0)THEN
92!-----------------------------------------------------------------------
93!
94        DO J=JTS,JTE
95        DO I=ITS,ITE
96          ARRAYL(I,J)=ARRAYG(I,J)
97        ENDDO
98        ENDDO
99!
100!-----------------------------------------------------------------------
101!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
102!***  SENDS OUT THE APPROPRIATE PIECE OF THE GLOBAL ARRAY.
103!-----------------------------------------------------------------------
104!
105        DO IPE=1,NPES-1
106!
107          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
108      &                ,ISTAT,IRECV)
109!
110          ISTART=LIMITS(1)
111          IEND=LIMITS(2)
112          JSTART=LIMITS(3)
113          JEND=LIMITS(4)
114!
115          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)
116          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
117 
118          KNT=0
119!
120          DO J=JSTART,JEND
121          DO I=ISTART,IEND
122            KNT=KNT+1
123            ARRAYX(KNT)=ARRAYG(I,J)
124          ENDDO
125          ENDDO
126!
127          CALL MPI_SEND(ARRAYX,KNT,MPI_REAL,IPE,IPE,MPI_COMM_COMP,ISEND)
128!
129          DEALLOCATE(ARRAYX)
130!
131        ENDDO
132!
133!-----------------------------------------------------------------------
134!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
135!***  RECEIVE THEIR PIECE OF THE GLOBAL ARRAY FROM TASK 0.
136!-----------------------------------------------------------------------
137!
138      ELSE
139!
140        LIMITS(1)=ITS
141        LIMITS(2)=ITE
142        LIMITS(3)=JTS
143        LIMITS(4)=JTE
144!
145        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
146!
147        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)
148        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
149!
150        CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
151     &,               ISTAT,IRECV)
152!
153        KNT=0
154!
155        DO J=JTS,JTE
156        DO I=ITS,ITE
157          KNT=KNT+1
158          ARRAYL(I,J)=ARRAYX(KNT)
159        ENDDO
160        ENDDO
161!
162        DEALLOCATE(ARRAYX)
163!
164!-----------------------------------------------------------------------
165!
166      ENDIF tasks
167!
168!-----------------------------------------------------------------------
169!     CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
170!-----------------------------------------------------------------------
171!
172      END SUBROUTINE PATCH
173!
174!-----------------------------------------------------------------------
175!***********************************************************************
176!-----------------------------------------------------------------------
177      SUBROUTINE QUILT_2(ARRAYL,ARRAYG                                  &
178     &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
179     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
180     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
181!-----------------------------------------------------------------------
182!     QUILT_2 PULLS TOGETHER THE MPI TASKS' LOCAL ARRAYS ARRAYL AND
183!     THEN QUILTS THEM TOGETHER INTO A SINGLE GLOBAL ARRAY ARRAYG.
184!
185!     AUTHOR: TOM BLACK
186!-----------------------------------------------------------------------
187!
188      IMPLICIT NONE
189!
190!-----------------------------------------------------------------------
191!
192      INCLUDE "mpif.h"
193!
194!-----------------------------------------------------------------------
195!***  ARGUMENT VARIABLES
196!-----------------------------------------------------------------------
197!
198      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
199     &,                     IMS,IME,JMS,JME,KMS,KME                     &
200     &,                     ITS,ITE,JTS,JTE,KTS,KTE
201!
202      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN)  :: ARRAYL
203      REAL,DIMENSION(IDS:IDE,JDS:JDE),INTENT(OUT) :: ARRAYG
204!
205!-----------------------------------------------------------------------
206!***  LOCAL VARIABLES
207!-----------------------------------------------------------------------
208!
209      REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
210!
211      INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
212     &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
213!
214      INTEGER,DIMENSION(4) :: LIMITS
215!
216      INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
217!-----------------------------------------------------------------------
218!***********************************************************************
219!-----------------------------------------------------------------------
220!
221!-----------------------------------------------------------------------
222!***  GET OUR TASK ID AND THE COMMUNICATOR
223!-----------------------------------------------------------------------
224!
225      CALL WRF_GET_MYPROC(MYPE)
226      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
227      CALL WRF_GET_NPROC(NPES)
228!
229!-----------------------------------------------------------------------
230!***  INITIALIZE THE OUTPUT ARRAY
231!-----------------------------------------------------------------------
232!
233      DO J=JDS,JDE
234      DO I=IDS,IDE
235        ARRAYG(I,J)=0.
236      ENDDO
237      ENDDO
238!
239!-----------------------------------------------------------------------
240!***  TASK 0 FILLS ITS OWN PART OF THE GLOBAL FIRST.
241!-----------------------------------------------------------------------
242!
243!-----------------------------------------------------------------------
244      tasks : IF(MYPE==0)THEN
245!-----------------------------------------------------------------------
246!
247        DO J=JTS,JTE
248        DO I=ITS,ITE
249          ARRAYG(I,J)=ARRAYL(I,J)
250        ENDDO
251        ENDDO
252!
253!-----------------------------------------------------------------------
254!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
255!***  PULLS IN THE APPROPRIATE PIECES FROM ALL OTHER TASKS.
256!-----------------------------------------------------------------------
257!
258        DO IPE=1,NPES-1
259!
260          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
261      &                ,ISTAT,IRECV)
262!
263          ISTART=LIMITS(1)
264          IEND=LIMITS(2)
265          JSTART=LIMITS(3)
266          JEND=LIMITS(4)
267!
268          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)
269          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
270!
271          CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,IPE,IPE,MPI_COMM_COMP   &
272     &                 ,ISTAT,IRECV)
273!
274          KNT=0
275!
276          DO J=JSTART,JEND
277          DO I=ISTART,IEND
278            KNT=KNT+1
279            ARRAYG(I,J)=ARRAYX(KNT)
280          ENDDO
281          ENDDO
282!
283          DEALLOCATE(ARRAYX)
284!
285        ENDDO
286!
287!-----------------------------------------------------------------------
288!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
289!***  SEND THEIR LOCAL ARRAY TO TASK 0.
290!-----------------------------------------------------------------------
291!
292      ELSE
293!
294        LIMITS(1)=ITS
295        LIMITS(2)=ITE
296        LIMITS(3)=JTS
297        LIMITS(4)=JTE
298!
299        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
300!
301        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)
302        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
303!
304        KNT=0
305!
306        DO J=JTS,JTE
307        DO I=ITS,ITE
308          KNT=KNT+1
309          ARRAYX(KNT)=ARRAYL(I,J)
310        ENDDO
311        ENDDO
312!
313        CALL MPI_SEND(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
314     &,               ISEND)
315!
316        DEALLOCATE(ARRAYX)
317!
318!-----------------------------------------------------------------------
319!
320      ENDIF tasks
321!
322!-----------------------------------------------------------------------
323!     CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
324!-----------------------------------------------------------------------
325!
326      END SUBROUTINE QUILT_2
327!
328!-----------------------------------------------------------------------
329!
330      END MODULE MODULE_PATCH_QUILT
331!
332!-----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.