eesupp/src/gather_2d_rx.template

C $Header: /u/gcmpack/MITgcm/eesupp/src/gather_2d_rx.template,v 1.6 2009/06/28 01:02:17 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"

CBOP
C !ROUTINE: GATHER_2D_RX
C !INTERFACE:
      SUBROUTINE GATHER_2D_RX(
     O                  gloBuff,
     I                  myField,
     I                  xSize, ySize,
     I                  useExch2GlobLayOut,
     I                  zeroBuff,
     I                  myThid )
C !DESCRIPTION:
C     Gather elements of a global 2-D array from all mpi processes to process 0.
C     Note: done by Master-Thread ; might need barrier calls before and after
C           this S/R call.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#ifdef ALLOW_EXCH2
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#endif /* ALLOW_EXCH2 */

C     !INPUT/OUTPUT PARAMETERS:
C gloBuff   ( _RX ) :: full-domain 2D IO-buffer array             (Output)
C myField   ( _RX ) :: tiled, local (i.e. my Proc. tiles) 2D array (Input)
C xSize    (integer):: global buffer 1rst dim (x)
C ySize    (integer):: global buffer 2nd  dim (y)
C useExch2GlobLayOut:: =T: Use Exch2 global-map layout (only with EXCH2)
C zeroBuff (logical):: =T: initialise the buffer to zero before copy
C myThid   (integer):: my Thread Id number

      INTEGER xSize, ySize
      _RX     gloBuff(xSize,ySize)
      _RX     myField(1:sNx,1:sNy,nSx,nSy)
      LOGICAL useExch2GlobLayOut
      LOGICAL zeroBuff
      INTEGER myThid
CEOP

C !LOCAL VARIABLES:
      INTEGER i,j, bi,bj
      INTEGER iG, jG
      INTEGER iBase, jBase
#ifdef ALLOW_EXCH2
      INTEGER iGjLoc, jGjLoc
      INTEGER tN
#endif /* ALLOW_EXCH2 */
#ifdef ALLOW_USE_MPI
      INTEGER np, pId
      _RX     temp(1:sNx,1:sNy,nSx,nSy)
      INTEGER istatus(MPI_STATUS_SIZE), ierr
      INTEGER lbuff, idest, itag, ready_to_receive
#endif /* ALLOW_USE_MPI */

      _BEGIN_MASTER( myThid )

      IF( myProcId .EQ. 0 ) THEN
C--   Process 0 fills-in its local data

#ifdef ALLOW_EXCH2
        IF ( useExch2GlobLayOut ) THEN
C--   If using blank-tiles, buffer will not be completely filled;
C     safer to reset to zero to avoid unknown values in output file
          IF ( zeroBuff ) THEN
            DO j=1,ySize
             DO i=1,xSize
               gloBuff(i,j) = 0.
             ENDDO
            ENDDO
          ENDIF

          DO bj=1,nSy
           DO bi=1,nSx
             tN = W2_myTileList(bi,bj)
             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
C-           face x-size larger than glob-size : fold it
               iGjLoc = 0
               jGjLoc = exch2_mydNx(tN) / xSize
             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
C-           tile y-size larger than glob-size : make a long line
               iGjLoc = exch2_mydNx(tN)
               jGjLoc = 0
             ELSE
C-           default (face fit into global-IO-array)
               iGjLoc = 0
               jGjLoc = 1
             ENDIF

             DO j=1,sNy
#ifdef TARGET_NEC_SX
!cdir novector
#endif
              iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
              jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
              DO i=1,sNx
                gloBuff(iG+i,jG) = myField(i,j,bi,bj)
              ENDDO
             ENDDO

           ENDDO
          ENDDO

        ELSE
#else /* ALLOW_EXCH2 */
        IF (.TRUE.) THEN
#endif /* ALLOW_EXCH2 */

          iBase = myXGlobalLo-1
          jBase = myYGlobalLo-1

          DO bj=1,nSy
           DO bi=1,nSx
             DO j=1,sNy
#ifdef TARGET_NEC_SX
!cdir novector
#endif
              iG = iBase+(bi-1)*sNx
              jG = jBase+(bj-1)*sNy+j
              DO i=1,sNx
                gloBuff(iG+i,jG) = myField(i,j,bi,bj)
              ENDDO
             ENDDO
           ENDDO
          ENDDO

C       end if-else useExch2GlobLayOut
        ENDIF

C-    end if myProcId = 0
      ENDIF

#ifdef ALLOW_USE_MPI
      IF ( usingMPI ) THEN

       lbuff = sNx*nSx*sNy*nSy
       idest = 0
       itag  = 0
       ready_to_receive = 0

       IF( mpiMyId .EQ. 0 ) THEN

C--   Process 0 polls and receives data from each process in turn
        DO np = 2, nPx*nPy
         pId = np - 1
#ifndef DISABLE_MPI_READY_TO_RECEIVE
         CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
     &           pId, itag, MPI_COMM_MODEL, ierr)
#endif
         CALL MPI_RECV (temp, lbuff, _MPI_TYPE_RX,
     &           pId, itag, MPI_COMM_MODEL, istatus, ierr)

C--   Process 0 gathers the local arrays into the global buffer.
#ifdef ALLOW_EXCH2
         IF ( useExch2GlobLayOut ) THEN

          DO bj=1,nSy
           DO bi=1,nSx
             tN = W2_procTileList(bi,bj,np)
             IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
C-           face x-size larger than glob-size : fold it
               iGjLoc = 0
               jGjLoc = exch2_mydNx(tN) / xSize
             ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
C-           tile y-size larger than glob-size : make a long line
               iGjLoc = exch2_mydNx(tN)
               jGjLoc = 0
             ELSE
C-           default (face fit into global-IO-array)
               iGjLoc = 0
               jGjLoc = 1
             ENDIF

             DO j=1,sNy
#ifdef TARGET_NEC_SX
!cdir novector
#endif
              iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
              jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
              DO i=1,sNx
                gloBuff(iG+i,jG) = temp(i,j,bi,bj)
              ENDDO
             ENDDO

           ENDDO
          ENDDO

         ELSE
#else /* ALLOW_EXCH2 */
         IF (.TRUE.) THEN
#endif /* ALLOW_EXCH2 */

          iBase = mpi_myXGlobalLo(np)-1
          jBase = mpi_myYGlobalLo(np)-1

          DO bj=1,nSy
           DO bi=1,nSx
             DO j=1,sNy
#ifdef TARGET_NEC_SX
!cdir novector
#endif
              iG = iBase+(bi-1)*sNx
              jG = jBase+(bj-1)*sNy+j
              DO i=1,sNx
                gloBuff(iG+i,jG) = temp(i,j,bi,bj)
              ENDDO
             ENDDO
           ENDDO
          ENDDO

C        end if-else useExch2GlobLayOut
         ENDIF

C-      end loop on np
        ENDDO

       ELSE

C--   All proceses except 0 wait to be polled then send local array
#ifndef DISABLE_MPI_READY_TO_RECEIVE
         CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
     &        idest, itag, MPI_COMM_MODEL, istatus, ierr)
#endif
         CALL MPI_SEND (myField, lbuff, _MPI_TYPE_RX,
     &        idest, itag, MPI_COMM_MODEL, ierr)

       ENDIF

      ENDIF
#endif /* ALLOW_USE_MPI */

      _END_MASTER( myThid )

      RETURN
      END
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/eesupp/src/gather_2d_rx.template,v 1.6 2009/06/28 01:02:17 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	jmc	1.5	C Note: done by Master-Thread ; might need barrier calls before and after
20			C this S/R call.
21	jmc	1.1
22			C !USES:
23			IMPLICIT NONE
24			#include "SIZE.h"
25			#include "EEPARAMS.h"
26			#include "EESUPPORT.h"
27			#ifdef ALLOW_EXCH2
28	jmc	1.2	#include "W2_EXCH2_SIZE.h"
29	jmc	1.1	#include "W2_EXCH2_TOPOLOGY.h"
30			#endif /* ALLOW_EXCH2 */
31
32			C !INPUT/OUTPUT PARAMETERS:
33			C gloBuff ( _RX ) :: full-domain 2D IO-buffer array (Output)
34			C myField ( _RX ) :: tiled, local (i.e. my Proc. tiles) 2D array (Input)
35			C xSize (integer):: global buffer 1rst dim (x)
36			C ySize (integer):: global buffer 2nd dim (y)
37	jmc	1.3	C useExch2GlobLayOut:: =T: Use Exch2 global-map layout (only with EXCH2)
38	jmc	1.1	C zeroBuff (logical):: =T: initialise the buffer to zero before copy
39			C myThid (integer):: my Thread Id number
40
41			INTEGER xSize, ySize
42			_RX gloBuff(xSize,ySize)
43			_RX myField(1:sNx,1:sNy,nSx,nSy)
44	jmc	1.3	LOGICAL useExch2GlobLayOut
45	jmc	1.1	LOGICAL zeroBuff
46			INTEGER myThid
47			CEOP
48
49			C !LOCAL VARIABLES:
50			INTEGER i,j, bi,bj
51			INTEGER iG, jG
52			INTEGER iBase, jBase
53			#ifdef ALLOW_EXCH2
54			INTEGER iGjLoc, jGjLoc
55			INTEGER tN
56			#endif /* ALLOW_EXCH2 */
57			#ifdef ALLOW_USE_MPI
58	jmc	1.7	INTEGER np, pId
59	jmc	1.1	_RX temp(1:sNx,1:sNy,nSx,nSy)
60			INTEGER istatus(MPI_STATUS_SIZE), ierr
61			INTEGER lbuff, idest, itag, ready_to_receive
62			#endif /* ALLOW_USE_MPI */
63
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	jmc	1.6	DO bj=1,nSy
82	jmc	1.1	DO bi=1,nSx
83	jmc	1.6	tN = W2_myTileList(bi,bj)
84	jmc	1.1	IF ( exch2_mydNx(tN) .GT. xSize ) THEN
85			C- face x-size larger than glob-size : fold it
86			iGjLoc = 0
87			jGjLoc = exch2_mydNx(tN) / xSize
88			ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
89			C- tile y-size larger than glob-size : make a long line
90			iGjLoc = exch2_mydNx(tN)
91			jGjLoc = 0
92			ELSE
93			C- default (face fit into global-IO-array)
94			iGjLoc = 0
95			jGjLoc = 1
96			ENDIF
97
98			DO j=1,sNy
99			#ifdef TARGET_NEC_SX
100			!cdir novector
101			#endif
102			iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
103			jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
104			DO i=1,sNx
105			gloBuff(iG+i,jG) = myField(i,j,bi,bj)
106			ENDDO
107			ENDDO
108
109			ENDDO
110	jmc	1.6	ENDDO
111	jmc	1.1
112			ELSE
113			#else /* ALLOW_EXCH2 */
114			IF (.TRUE.) THEN
115			#endif /* ALLOW_EXCH2 */
116
117	jmc	1.4	iBase = myXGlobalLo-1
118			jBase = myYGlobalLo-1
119	jmc	1.1
120			DO bj=1,nSy
121			DO bi=1,nSx
122			DO j=1,sNy
123			#ifdef TARGET_NEC_SX
124			!cdir novector
125			#endif
126			iG = iBase+(bi-1)*sNx
127			jG = jBase+(bj-1)*sNy+j
128			DO i=1,sNx
129			gloBuff(iG+i,jG) = myField(i,j,bi,bj)
130			ENDDO
131			ENDDO
132			ENDDO
133			ENDDO
134
135	jmc	1.3	C end if-else useExch2GlobLayOut
136	jmc	1.1	ENDIF
137
138			C- end if myProcId = 0
139			ENDIF
140
141			#ifdef ALLOW_USE_MPI
142	jmc	1.7	IF ( usingMPI ) THEN
143	jmc	1.1
144	jmc	1.7	lbuff = sNxnSxsNy*nSy
145			idest = 0
146			itag = 0
147			ready_to_receive = 0
148	jmc	1.1
149	jmc	1.7	IF( mpiMyId .EQ. 0 ) THEN
150	jmc	1.1
151			C-- Process 0 polls and receives data from each process in turn
152	jmc	1.7	DO np = 2, nPx*nPy
153			pId = np - 1
154	jmc	1.1	#ifndef DISABLE_MPI_READY_TO_RECEIVE
155			CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
156	jmc	1.7	& pId, itag, MPI_COMM_MODEL, ierr)
157	jmc	1.1	#endif
158			CALL MPI_RECV (temp, lbuff, _MPI_TYPE_RX,
159	jmc	1.7	& pId, itag, MPI_COMM_MODEL, istatus, ierr)
160	jmc	1.1
161			C-- Process 0 gathers the local arrays into the global buffer.
162			#ifdef ALLOW_EXCH2
163	jmc	1.3	IF ( useExch2GlobLayOut ) THEN
164	jmc	1.1
165	jmc	1.6	DO bj=1,nSy
166	jmc	1.1	DO bi=1,nSx
167	jmc	1.6	tN = W2_procTileList(bi,bj,np)
168	jmc	1.1	IF ( exch2_mydNx(tN) .GT. xSize ) THEN
169			C- face x-size larger than glob-size : fold it
170			iGjLoc = 0
171			jGjLoc = exch2_mydNx(tN) / xSize
172			ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
173			C- tile y-size larger than glob-size : make a long line
174			iGjLoc = exch2_mydNx(tN)
175			jGjLoc = 0
176			ELSE
177			C- default (face fit into global-IO-array)
178			iGjLoc = 0
179			jGjLoc = 1
180			ENDIF
181
182			DO j=1,sNy
183			#ifdef TARGET_NEC_SX
184			!cdir novector
185			#endif
186			iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
187			jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
188			DO i=1,sNx
189			gloBuff(iG+i,jG) = temp(i,j,bi,bj)
190			ENDDO
191			ENDDO
192
193			ENDDO
194	jmc	1.6	ENDDO
195	jmc	1.1
196			ELSE
197			#else /* ALLOW_EXCH2 */
198			IF (.TRUE.) THEN
199			#endif /* ALLOW_EXCH2 */
200
201	jmc	1.4	iBase = mpi_myXGlobalLo(np)-1
202			jBase = mpi_myYGlobalLo(np)-1
203	jmc	1.1
204			DO bj=1,nSy
205			DO bi=1,nSx
206			DO j=1,sNy
207			#ifdef TARGET_NEC_SX
208			!cdir novector
209			#endif
210			iG = iBase+(bi-1)*sNx
211			jG = jBase+(bj-1)*sNy+j
212			DO i=1,sNx
213			gloBuff(iG+i,jG) = temp(i,j,bi,bj)
214			ENDDO
215			ENDDO
216			ENDDO
217			ENDDO
218
219	jmc	1.3	C end if-else useExch2GlobLayOut
220	jmc	1.1	ENDIF
221
222			C- end loop on np
223			ENDDO
224
225	jmc	1.7	ELSE
226	jmc	1.1
227			C-- All proceses except 0 wait to be polled then send local array
228			#ifndef DISABLE_MPI_READY_TO_RECEIVE
229			CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
230			& idest, itag, MPI_COMM_MODEL, istatus, ierr)
231			#endif
232			CALL MPI_SEND (myField, lbuff, _MPI_TYPE_RX,
233			& idest, itag, MPI_COMM_MODEL, ierr)
234
235	jmc	1.7	ENDIF
236
237	jmc	1.1	ENDIF
238			#endif /* ALLOW_USE_MPI */
239
240			_END_MASTER( myThid )
241
242			RETURN
243			END