/[MITgcm]/MITgcm/eesupp/src/gather_2d_rx.template
ViewVC logotype

Annotation of /MITgcm/eesupp/src/gather_2d_rx.template

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (hide annotations) (download)
Fri May 15 16:04:22 2009 UTC (15 years, 1 month ago) by jmc
Branch: MAIN
Changes since 1.2: +8 -8 lines
rename argument (useExch2GlobLayOut) to better fit what it is doing.

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/eesupp/src/gather_2d_rx.template,v 1.2 2009/05/12 19:53:02 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_EEOPTIONS.h"
6    
7     CBOP
8     C !ROUTINE: GATHER_2D_RX
9     C !INTERFACE:
10     SUBROUTINE GATHER_2D_RX(
11     O gloBuff,
12     I myField,
13     I xSize, ySize,
14 jmc 1.3 I useExch2GlobLayOut,
15 jmc 1.1 I zeroBuff,
16     I myThid )
17     C !DESCRIPTION:
18     C Gather elements of a global 2-D array from all mpi processes to process 0.
19    
20     C !USES:
21     IMPLICIT NONE
22     #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #include "EESUPPORT.h"
25     #ifdef ALLOW_EXCH2
26 jmc 1.2 #include "W2_EXCH2_SIZE.h"
27 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
28     #endif /* ALLOW_EXCH2 */
29    
30     C !INPUT/OUTPUT PARAMETERS:
31     C gloBuff ( _RX ) :: full-domain 2D IO-buffer array (Output)
32     C myField ( _RX ) :: tiled, local (i.e. my Proc. tiles) 2D array (Input)
33     C xSize (integer):: global buffer 1rst dim (x)
34     C ySize (integer):: global buffer 2nd dim (y)
35 jmc 1.3 C useExch2GlobLayOut:: =T: Use Exch2 global-map layout (only with EXCH2)
36 jmc 1.1 C zeroBuff (logical):: =T: initialise the buffer to zero before copy
37     C myThid (integer):: my Thread Id number
38    
39     INTEGER xSize, ySize
40     _RX gloBuff(xSize,ySize)
41     _RX myField(1:sNx,1:sNy,nSx,nSy)
42 jmc 1.3 LOGICAL useExch2GlobLayOut
43 jmc 1.1 LOGICAL zeroBuff
44     INTEGER myThid
45     CEOP
46    
47     C !LOCAL VARIABLES:
48     INTEGER i,j, bi,bj
49     INTEGER iG, jG
50     INTEGER iBase, jBase
51     #ifdef ALLOW_EXCH2
52     INTEGER iGjLoc, jGjLoc
53     INTEGER tN
54     #endif /* ALLOW_EXCH2 */
55     #ifdef ALLOW_USE_MPI
56     INTEGER np0, np
57     _RX temp(1:sNx,1:sNy,nSx,nSy)
58     INTEGER istatus(MPI_STATUS_SIZE), ierr
59     INTEGER lbuff, idest, itag, ready_to_receive
60     #endif /* ALLOW_USE_MPI */
61    
62     C-- Make everyone wait except for master thread.
63     _BARRIER
64     _BEGIN_MASTER( myThid )
65    
66     IF( myProcId .EQ. 0 ) THEN
67     C-- Process 0 fills-in its local data
68    
69     #ifdef ALLOW_EXCH2
70 jmc 1.3 IF ( useExch2GlobLayOut ) THEN
71 jmc 1.1 C-- If using blank-tiles, buffer will not be completely filled;
72     C safer to reset to zero to avoid unknown values in output file
73     IF ( zeroBuff ) THEN
74     DO j=1,ySize
75     DO i=1,xSize
76     gloBuff(i,j) = 0.
77     ENDDO
78     ENDDO
79     ENDIF
80    
81     c DO bj=1,nSy
82     bj=1
83     DO bi=1,nSx
84     tN = W2_myTileList(bi)
85     IF ( exch2_mydNx(tN) .GT. xSize ) THEN
86     C- face x-size larger than glob-size : fold it
87     iGjLoc = 0
88     jGjLoc = exch2_mydNx(tN) / xSize
89     ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
90     C- tile y-size larger than glob-size : make a long line
91     iGjLoc = exch2_mydNx(tN)
92     jGjLoc = 0
93     ELSE
94     C- default (face fit into global-IO-array)
95     iGjLoc = 0
96     jGjLoc = 1
97     ENDIF
98    
99     DO j=1,sNy
100     #ifdef TARGET_NEC_SX
101     !cdir novector
102     #endif
103     iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
104     jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
105     DO i=1,sNx
106     gloBuff(iG+i,jG) = myField(i,j,bi,bj)
107     ENDDO
108     ENDDO
109    
110     ENDDO
111     c ENDDO
112    
113     ELSE
114     #else /* ALLOW_EXCH2 */
115     IF (.TRUE.) THEN
116     #endif /* ALLOW_EXCH2 */
117    
118     iBase = 0
119     jBase = 0
120     c iBase = myXGlobalLo-1
121     c jBase = myYGlobalLo-1
122    
123     DO bj=1,nSy
124     DO bi=1,nSx
125     DO j=1,sNy
126     #ifdef TARGET_NEC_SX
127     !cdir novector
128     #endif
129     iG = iBase+(bi-1)*sNx
130     jG = jBase+(bj-1)*sNy+j
131     DO i=1,sNx
132     gloBuff(iG+i,jG) = myField(i,j,bi,bj)
133     ENDDO
134     ENDDO
135     ENDDO
136     ENDDO
137    
138 jmc 1.3 C end if-else useExch2GlobLayOut
139 jmc 1.1 ENDIF
140    
141     C- end if myProcId = 0
142     ENDIF
143    
144     #ifdef ALLOW_USE_MPI
145    
146     lbuff = sNx*nSx*sNy*nSy
147     idest = 0
148     itag = 0
149     ready_to_receive = 0
150    
151     IF( mpiMyId .EQ. 0 ) THEN
152    
153     C-- Process 0 polls and receives data from each process in turn
154     DO np = 2, numberOfProcs
155     np0 = np - 1
156     #ifndef DISABLE_MPI_READY_TO_RECEIVE
157     CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
158     & np0, itag, MPI_COMM_MODEL, ierr)
159     #endif
160     CALL MPI_RECV (temp, lbuff, _MPI_TYPE_RX,
161     & np0, itag, MPI_COMM_MODEL, istatus, ierr)
162    
163     C-- Process 0 gathers the local arrays into the global buffer.
164     #ifdef ALLOW_EXCH2
165 jmc 1.3 IF ( useExch2GlobLayOut ) THEN
166 jmc 1.1
167     c DO bj=1,nSy
168     bj=1
169     DO bi=1,nSx
170 jmc 1.2 tN = W2_procTileList(bi,np)
171 jmc 1.1 IF ( exch2_mydNx(tN) .GT. xSize ) THEN
172     C- face x-size larger than glob-size : fold it
173     iGjLoc = 0
174     jGjLoc = exch2_mydNx(tN) / xSize
175     ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
176     C- tile y-size larger than glob-size : make a long line
177     iGjLoc = exch2_mydNx(tN)
178     jGjLoc = 0
179     ELSE
180     C- default (face fit into global-IO-array)
181     iGjLoc = 0
182     jGjLoc = 1
183     ENDIF
184    
185     DO j=1,sNy
186     #ifdef TARGET_NEC_SX
187     !cdir novector
188     #endif
189     iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
190     jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
191     DO i=1,sNx
192     gloBuff(iG+i,jG) = temp(i,j,bi,bj)
193     ENDDO
194     ENDDO
195    
196     ENDDO
197     c ENDDO
198    
199     ELSE
200     #else /* ALLOW_EXCH2 */
201     IF (.TRUE.) THEN
202     #endif /* ALLOW_EXCH2 */
203    
204     iBase = MOD(np0,nPx)
205     jBase = np0/nPx
206     iBase = iBase*nSx*sNx
207     jBase = jBase*nSy*sNy
208     c iBase = mpi_myXGlobalLo(np)-1
209     c jBase = mpi_myYGlobalLo(np)-1
210    
211     DO bj=1,nSy
212     DO bi=1,nSx
213     DO j=1,sNy
214     #ifdef TARGET_NEC_SX
215     !cdir novector
216     #endif
217     iG = iBase+(bi-1)*sNx
218     jG = jBase+(bj-1)*sNy+j
219     DO i=1,sNx
220     gloBuff(iG+i,jG) = temp(i,j,bi,bj)
221     ENDDO
222     ENDDO
223     ENDDO
224     ENDDO
225    
226 jmc 1.3 C end if-else useExch2GlobLayOut
227 jmc 1.1 ENDIF
228    
229     C- end loop on np
230     ENDDO
231    
232     ELSE
233    
234     C-- All proceses except 0 wait to be polled then send local array
235     #ifndef DISABLE_MPI_READY_TO_RECEIVE
236     CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
237     & idest, itag, MPI_COMM_MODEL, istatus, ierr)
238     #endif
239     CALL MPI_SEND (myField, lbuff, _MPI_TYPE_RX,
240     & idest, itag, MPI_COMM_MODEL, ierr)
241    
242     ENDIF
243    
244     #endif /* ALLOW_USE_MPI */
245    
246     _END_MASTER( myThid )
247     _BARRIER
248    
249     RETURN
250     END

  ViewVC Help
Powered by ViewVC 1.1.22