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

Diff of /MITgcm/eesupp/src/exch_rx_recv_get_x.template

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

revision 1.13 by jmc, Fri Jan 9 22:51:12 2009 UTC revision 1.16 by jmc, Mon Sep 3 19:37:54 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
4    #undef EXCH_USE_SPINNING
5    
6  CBOP  CBOP
7  C     !ROUTINE: EXCH_RX_RECV_GET_X  C     !ROUTINE: EXCH_RX_RECV_GET_X
# Line 14  C     !INTERFACE: Line 15  C     !INTERFACE:
15    
16  C     !DESCRIPTION:  C     !DESCRIPTION:
17  C     *==========================================================*  C     *==========================================================*
18  C     | SUBROUTINE RECV_RX_GET_X                                    C     | SUBROUTINE RECV_RX_GET_X
19  C     | o "Send" or "put" X edges for RX array.                    C     | o "Send" or "put" X edges for RX array.
20  C     *==========================================================*  C     *==========================================================*
21  C     | Routine that invokes actual message passing send or        C     | Routine that invokes actual message passing send or
22  C     | direct "put" of data to update X faces of an XY[R] array.  C     | direct "put" of data to update X faces of an XY[R] array.
23  C     *==========================================================*  C     *==========================================================*
24    
25  C     !USES:  C     !USES:
# Line 59  C     eBl               :: Edge buffer l Line 60  C     eBl               :: Edge buffer l
60    
61  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
62  C     == Local variables ==  C     == Local variables ==
63  C     I, J, K, iMin, iMax, iB    :: Loop counters and extents  C     i, j, k, iMin, iMax, iB    :: Loop counters and extents
64  C     bi, bj  C     bi, bj
65  C     biW, bjW                   :: West tile indices  C     biW, bjW                   :: West tile indices
66  C     biE, bjE                   :: East tile indices  C     biE, bjE                   :: East tile indices
# Line 69  C     theSize Line 70  C     theSize
70  C     westCommMode               :: Working variables holding type  C     westCommMode               :: Working variables holding type
71  C     eastCommMode                  of communication a particular  C     eastCommMode                  of communication a particular
72  C                                   tile face uses.  C                                   tile face uses.
73        INTEGER I, J, K, iMin, iMax, iB, iB0        INTEGER i, j, k, iMin, iMax, iB, iB0
74        INTEGER bi, bj, biW, bjW, biE, bjE        INTEGER bi, bj, biW, bjW, biE, bjE
75        INTEGER eBl        INTEGER eBl
76        INTEGER westCommMode        INTEGER westCommMode
77        INTEGER eastCommMode        INTEGER eastCommMode
78    #ifdef EXCH_USE_SPINNING
79        INTEGER spinCount        INTEGER spinCount
80    #endif
81  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
82        INTEGER theProc, theTag, theType, theSize, pReqI        INTEGER theProc, theTag, theType, theSize
83        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
84  #endif  # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
85          INTEGER pReqI
86    # endif
87    #endif /* ALLOW_USE_MPI */
88  CEOP  CEOP
89    
90         INTEGER myBxLoSave(MAX_NO_THREADS)  C--   Under a "put" scenario we
        INTEGER myBxHiSave(MAX_NO_THREADS)  
        INTEGER myByLoSave(MAX_NO_THREADS)  
        INTEGER myByHiSave(MAX_NO_THREADS)  
        LOGICAL doingSingleThreadedComms  
   
        doingSingleThreadedComms = .FALSE.  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
       IF ( usingMPI ) THEN  
 #endif  
 C      Set default behavior to have MPI comms done by a single thread.  
 C      Most MPI implementations do not support concurrent comms from  
 C      several threads.  
        IF ( nThreads .GT. 1 ) THEN  
         _BARRIER  
         _BEGIN_MASTER( myThid )  
          DO I=1,nThreads  
           myBxLoSave(I) = myBxLo(I)  
           myBxHiSave(I) = myBxHi(I)  
           myByLoSave(I) = myByLo(I)  
           myByHiSave(I) = myByHi(I)  
          ENDDO  
 C        Comment out loop below and myB[xy][Lo|Hi](1) settings below  
 C        if you want to get multi-threaded MPI comms.  
          DO I=1,nThreads  
           myBxLo(I) = 0  
           myBxHi(I) = -1  
           myByLo(I) = 0  
           myByHi(I) = -1  
          ENDDO  
          myBxLo(1) = 1  
          myBxHi(1) = nSx  
          myByLo(1) = 1  
          myByHi(1) = nSy  
          doingSingleThreadedComms = .TRUE.  
         _END_MASTER( myThid )  
         _BARRIER  
       ENDIF  
 #ifndef ALWAYS_USE_MPI  
       ENDIF  
 #endif  
 #endif  
   
 C--   Under a "put" scenario we  
91  C--     i. set completetion signal for buffer we put into.  C--     i. set completetion signal for buffer we put into.
92  C--    ii. wait for completetion signal indicating data has been put in  C--    ii. wait for completetion signal indicating data has been put in
93  C--        our buffer.  C--        our buffer.
94  C--   Under a messaging mode we "receive" the message.  C--   Under a messaging mode we "receive" the message.
95  C--   Under a "get" scenario we  C--   Under a "get" scenario we
# Line 135  C--     i. Check that the data is ready. Line 97  C--     i. Check that the data is ready.
97  C--    ii. Read the data.  C--    ii. Read the data.
98  C--   iii. Set data read flag + memory sync.  C--   iii. Set data read flag + memory sync.
99    
100    #ifdef ALLOW_USE_MPI
101          IF ( usingMPI ) THEN
102    
103    C--   Receive buffer data: Only Master Thread do proc communication
104          _BEGIN_MASTER(myThid)
105    
106          DO bj=1,nSy
107           DO bi=1,nSx
108            eBl = exchangeBufLevel(1,bi,bj)
109            westCommMode = _tileCommModeW(bi,bj)
110            eastCommMode = _tileCommModeE(bi,bj)
111            biE = _tileBiE(bi,bj)
112            bjE = _tileBjE(bi,bj)
113            biW = _tileBiW(bi,bj)
114            bjW = _tileBjW(bi,bj)
115            theType = _MPI_TYPE_RX
116            theSize = sNy*exchWidthX*myNz
117    
       DO bj=myByLo(myThid),myByHi(myThid)  
        DO bi=myBxLo(myThid),myBxHi(myThid)  
         ebL = exchangeBufLevel(1,bi,bj)  
         westCommMode  = _tileCommModeW(bi,bj)  
         eastCommMode  = _tileCommModeE(bi,bj)  
         biE =  _tileBiE(bi,bj)  
         bjE =  _tileBjE(bi,bj)  
         biW =  _tileBiW(bi,bj)  
         bjW =  _tileBjW(bi,bj)  
118          IF ( westCommMode .EQ. COMM_MSG ) THEN          IF ( westCommMode .EQ. COMM_MSG ) THEN
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
          IF ( usingMPI ) THEN  
 #endif  
119           theProc = tilePidW(bi,bj)           theProc = tilePidW(bi,bj)
120           theTag  = _tileTagRecvW(bi,bj)           theTag  = _tileTagRecvW(bi,bj)
          theType = _MPI_TYPE_RX  
          theSize = sNy*exchWidthX*myNz  
121  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
122           CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize,
123       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theType, theProc, theTag, MPI_COMM_MODEL,
124       &                  mpiStatus, mpiRc )       &                  mpiStatus, mpiRc )
125  # else  # else
126           pReqI=exchNReqsX(1,bi,bj)+1           pReqI=exchNReqsX(1,bi,bj)+1
127           CALL ampi_recv_RX(           CALL ampi_recv_RX(
128       & westRecvBuf_RX(1,eBl,bi,bj) ,       &        westRecvBuf_RX(1,eBl,bi,bj) ,
129       & theSize ,       &        theSize ,
130       & theType ,       &        theType ,
131       & theProc ,       &        theProc ,
132       & theTag ,       &        theTag ,
133       & MPI_COMM_MODEL ,       &        MPI_COMM_MODEL ,
134       & exchReqIdX(pReqI,1,bi,bj),       &        exchReqIdX(pReqI,1,bi,bj),
135       & exchNReqsX(1,bi,bj),       &        exchNReqsX(1,bi,bj),
136       & mpiStatus ,       &        mpiStatus ,
137       & mpiRc )       &        mpiRc )
138  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
139  #ifndef ALWAYS_USE_MPI           westRecvAck(eBl,bi,bj) = 1
         ENDIF                  
 #endif  
 #endif /* ALLOW_USE_MPI */  
140          ENDIF          ENDIF
141    
142          IF ( eastCommMode .EQ. COMM_MSG ) THEN          IF ( eastCommMode .EQ. COMM_MSG ) THEN
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
          IF ( usingMPI ) THEN  
 #endif  
143           theProc = tilePidE(bi,bj)           theProc = tilePidE(bi,bj)
144           theTag  = _tileTagRecvE(bi,bj)           theTag  = _tileTagRecvE(bi,bj)
          theType = _MPI_TYPE_RX  
          theSize = sNy*exchWidthX*myNz  
145  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
146           CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize, theType,           CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize,
147       &                  theProc, theTag, MPI_COMM_MODEL,       &                  theType, theProc, theTag, MPI_COMM_MODEL,
148       &                  mpiStatus, mpiRc )       &                  mpiStatus, mpiRc )
149  # else  # else
150           pReqI=exchNReqsX(1,bi,bj)+1           pReqI=exchNReqsX(1,bi,bj)+1
151           CALL ampi_recv_RX(           CALL ampi_recv_RX(
152       & eastRecvBuf_RX(1,eBl,bi,bj) ,       &        eastRecvBuf_RX(1,eBl,bi,bj) ,
153       & theSize ,       &        theSize ,
154       & theType ,       &        theType ,
155       & theProc ,       &        theProc ,
156       & theTag ,       &        theTag ,
157       & MPI_COMM_MODEL ,       &        MPI_COMM_MODEL ,
158       & exchReqIdX(pReqI,1,bi,bj),       &        exchReqIdX(pReqI,1,bi,bj),
159       & exchNReqsX(1,bi,bj),       &        exchNReqsX(1,bi,bj),
160       & mpiStatus ,       &        mpiStatus ,
161       & mpiRc )       &        mpiRc )
162  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
163  #ifndef ALWAYS_USE_MPI           eastRecvAck(eBl,bi,bj) = 1
         ENDIF                  
 #endif  
 #endif /* ALLOW_USE_MPI */  
164          ENDIF          ENDIF
165         ENDDO         ENDDO
166        ENDDO        ENDDO
167    
168  C--   Wait for buffers I am going read to be ready.  C--   Processes wait for buffers I am going to read to be ready.
169          IF ( .NOT.exchUsesBarrier  ) THEN
170           DO bj=1,nSy
171            DO bi=1,nSx
172             IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
173    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
174              CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
175         &                      mpiStatus, mpiRC )
176    # else
177              CALL ampi_waitall(
178         &         exchNReqsX(1,bi,bj),
179         &         exchReqIdX(1,1,bi,bj),
180         &         mpiStatus,
181         &         mpiRC )
182    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
183             ENDIF
184    C        Clear outstanding requests counter
185             exchNReqsX(1,bi,bj) = 0
186            ENDDO
187           ENDDO
188          ENDIF
189    
190          _END_MASTER(myThid)
191    C--   need to sync threads after master has received data ;
192    C     (done after mpi waitall in case waitall is really needed)
193          _BARRIER
194    
195          ENDIF
196    #endif /* ALLOW_USE_MPI */
197    
198    C--   Threads wait for buffers I am going to read to be ready.
199    C     note: added BARRIER in exch_send_put S/R and here above (message mode)
200    C           so that we no longer needs this (undef EXCH_USE_SPINNING)
201    #ifdef EXCH_USE_SPINNING
202        IF ( exchUsesBarrier  ) THEN        IF ( exchUsesBarrier  ) THEN
203  C      o On some machines ( T90 ) use system barrier rather than spinning.  C      o On some machines ( T90 ) use system barrier rather than spinning.
204         CALL BARRIER( myThid )         CALL BARRIER( myThid )
# Line 221  C      o Spin waiting for completetion f Line 207  C      o Spin waiting for completetion f
207  C        i.e. we only lock waiting for data that we need.  C        i.e. we only lock waiting for data that we need.
208         DO bj=myByLo(myThid),myByHi(myThid)         DO bj=myByLo(myThid),myByHi(myThid)
209          DO bi=myBxLo(myThid),myBxHi(myThid)          DO bi=myBxLo(myThid),myBxHi(myThid)
210    
211           spinCount = 0           spinCount = 0
212           ebL = exchangeBufLevel(1,bi,bj)           eBl = exchangeBufLevel(1,bi,bj)
213           westCommMode = _tileCommModeW(bi,bj)           westCommMode = _tileCommModeW(bi,bj)
214           eastCommMode = _tileCommModeE(bi,bj)           eastCommMode = _tileCommModeE(bi,bj)
215  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
# Line 235  C          STOP ' S/R EXCH_RECV_GET_X: s Line 222  C          STOP ' S/R EXCH_RECV_GET_X: s
222  C         ENDIF  C         ENDIF
223            IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10            IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
224            IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10            IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
225  # else  # else
226           do while ((westRecvAck(eBl,bi,bj) .EQ. 0.           DO WHILE ((westRecvAck(eBl,bi,bj) .EQ. 0
227       &             .or.       &             .OR.
228       &              eastRecvAck(eBl,bi,bj) .EQ. 0. ))       &              eastRecvAck(eBl,bi,bj) .EQ. 0 ))
229            CALL FOOL_THE_COMPILER( spinCount )            CALL FOOL_THE_COMPILER( spinCount )
230            spinCount = spinCount+1            spinCount = spinCount+1
231           end do           ENDDO
232  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */  # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
233  C        Clear outstanding requests  C        Clear outstanding requests
234           westRecvAck(eBl,bi,bj) = 0           westRecvAck(eBl,bi,bj) = 0
235           eastRecvAck(eBl,bi,bj) = 0           eastRecvAck(eBl,bi,bj) = 0
   
          IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
          IF ( usingMPI ) THEN  
 #endif  
 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  
           CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),  
      &                      mpiStatus, mpiRC )  
 # else  
           CALL ampi_waitall(  
      & exchNReqsX(1,bi,bj),  
      & exchReqIdX(1,1,bi,bj),  
      & mpiStatus,  
      & mpiRC )  
 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */  
 #ifndef ALWAYS_USE_MPI  
         ENDIF                  
 #endif  
 #endif /* ALLOW_USE_MPI */  
          ENDIF  
 C        Clear outstanding requests counter  
          exchNReqsX(1,bi,bj) = 0  
236  C        Update statistics  C        Update statistics
237           IF ( exchCollectStatistics ) THEN           IF ( exchCollectStatistics ) THEN
238            exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1            exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
239            exchRecvXSpinCount(1,bi,bj) =            exchRecvXSpinCount(1,bi,bj) =
240       &    exchRecvXSpinCount(1,bi,bj)+spinCount       &    exchRecvXSpinCount(1,bi,bj)+spinCount
241            exchRecvXSpinMax(1,bi,bj) =            exchRecvXSpinMax(1,bi,bj) =
242       &    MAX(exchRecvXSpinMax(1,bi,bj),spinCount)       &    MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
243            exchRecvXSpinMin(1,bi,bj) =            exchRecvXSpinMin(1,bi,bj) =
244       &    MIN(exchRecvXSpinMin(1,bi,bj),spinCount)       &    MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
245           ENDIF           ENDIF
246    
247          ENDDO          ENDDO
248         ENDDO         ENDDO
249        ENDIF        ENDIF
250    #endif /* EXCH_USE_SPINNING */
251    
252    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
253    
254  C--   Read from the buffers  C--   Read from the buffers
255        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
256         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
257    
258          ebL = exchangeBufLevel(1,bi,bj)          eBl = exchangeBufLevel(1,bi,bj)
259          biE =  _tileBiE(bi,bj)          biE = _tileBiE(bi,bj)
260          bjE =  _tileBjE(bi,bj)          bjE = _tileBjE(bi,bj)
261          biW =  _tileBiW(bi,bj)          biW = _tileBiW(bi,bj)
262          bjW =  _tileBjW(bi,bj)          bjW = _tileBjW(bi,bj)
263          westCommMode = _tileCommModeW(bi,bj)          westCommMode = _tileCommModeW(bi,bj)
264          eastCommMode = _tileCommModeE(bi,bj)          eastCommMode = _tileCommModeE(bi,bj)
265    
266          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
267           iMin = sNx+1           iMin = sNx+1
268           iMax = sNx+exchWidthX           iMax = sNx+exchWidthX
# Line 301  C--   Read from the buffers Line 270  C--   Read from the buffers
270           IF (     eastCommMode .EQ. COMM_PUT           IF (     eastCommMode .EQ. COMM_PUT
271       &       .OR. eastCommMode .EQ. COMM_MSG ) THEN       &       .OR. eastCommMode .EQ. COMM_MSG ) THEN
272            iB  = 0            iB  = 0
273            DO K=1,myNz            DO k=1,myNz
274             DO J=1,sNy             DO j=1,sNy
275              DO I=iMin,iMax              DO i=iMin,iMax
276               iB = iB + 1               iB = iB + 1
277               array(I,J,K,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)               array(i,j,k,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
278              ENDDO              ENDDO
279             ENDDO             ENDDO
280            ENDDO            ENDDO
281           ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN           ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
282            DO K=1,myNz            DO k=1,myNz
283             DO J=1,sNy             DO j=1,sNy
284              iB = iB0              iB = iB0
285              DO I=iMin,iMax              DO i=iMin,iMax
286               iB = iB+1               iB = iB+1
287               array(I,J,K,bi,bj) = array(iB,J,K,biE,bjE)               array(i,j,k,bi,bj) = array(iB,j,k,biE,bjE)
288              ENDDO              ENDDO
289             ENDDO             ENDDO
290            ENDDO            ENDDO
# Line 324  C--   Read from the buffers Line 293  C--   Read from the buffers
293           iMin = sNx-exchWidthX+1           iMin = sNx-exchWidthX+1
294           iMax = sNx           iMax = sNx
295           iB0  = 1-exchWidthX-1           iB0  = 1-exchWidthX-1
296           IF (     eastCommMode .EQ. COMM_PUT           IF (     eastCommMode .EQ. COMM_PUT
297       &       .OR. eastCommMode .EQ. COMM_MSG ) THEN       &       .OR. eastCommMode .EQ. COMM_MSG ) THEN
298            iB  = 0            iB  = 0
299            DO K=1,myNz            DO k=1,myNz
300             DO J=1,sNy             DO j=1,sNy
301              DO I=iMin,iMax              DO i=iMin,iMax
302               iB = iB + 1               iB = iB + 1
303               array(I,J,K,bi,bj) =               array(i,j,k,bi,bj) =
304       &       array(I,J,K,bi,bj)+eastRecvBuf_RX(iB,eBl,bi,bj)       &       array(i,j,k,bi,bj) + eastRecvBuf_RX(iB,eBl,bi,bj)
305              ENDDO              ENDDO
306             ENDDO             ENDDO
307            ENDDO            ENDDO
308           ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN           ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
309            DO K=1,myNz            DO k=1,myNz
310             DO J=1,sNy             DO j=1,sNy
311              iB = iB0              iB = iB0
312              DO I=iMin,iMax              DO i=iMin,iMax
313               iB = iB+1               iB = iB+1
314               array(I,J,K,bi,bj) =               array(i,j,k,bi,bj) =
315       &       array(I,J,K,bi,bj)+array(iB,J,K,biE,bjE)       &       array(i,j,k,bi,bj) + array(iB,j,k,biE,bjE)
316                 array(iB,j,k,biE,bjE) = 0.0
317              ENDDO              ENDDO
318             ENDDO             ENDDO
319            ENDDO            ENDDO
320           ENDIF           ENDIF
321          ENDIF          ENDIF
322    
323          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
324           iMin = 1-exchWidthX           iMin = 1-exchWidthX
325           iMax = 0           iMax = 0
# Line 356  C--   Read from the buffers Line 327  C--   Read from the buffers
327           IF (      westCommMode .EQ. COMM_PUT           IF (      westCommMode .EQ. COMM_PUT
328       &        .OR. westCommMode .EQ. COMM_MSG ) THEN       &        .OR. westCommMode .EQ. COMM_MSG ) THEN
329            iB  = 0            iB  = 0
330            DO K=1,myNz            DO k=1,myNz
331             DO J=1,sNy             DO j=1,sNy
332              DO I=iMin,iMax              DO i=iMin,iMax
333               iB = iB + 1               iB = iB + 1
334               array(I,J,K,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)               array(i,j,k,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
335              ENDDO              ENDDO
336             ENDDO             ENDDO
337            ENDDO            ENDDO
338           ELSEIF ( westCommMode .EQ. COMM_GET ) THEN           ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
339            DO K=1,myNz            DO k=1,myNz
340             DO J=1,sNy             DO j=1,sNy
341              iB = iB0              iB = iB0
342              DO I=iMin,iMax              DO i=iMin,iMax
343               iB = iB+1               iB = iB+1
344               array(I,J,K,bi,bj) = array(iB,J,K,biW,bjW)               array(i,j,k,bi,bj) = array(iB,j,k,biW,bjW)
345              ENDDO              ENDDO
346             ENDDO             ENDDO
347            ENDDO            ENDDO
# Line 379  C--   Read from the buffers Line 350  C--   Read from the buffers
350           iMin = 1           iMin = 1
351           iMax = 1+exchWidthX-1           iMax = 1+exchWidthX-1
352           iB0  = sNx           iB0  = sNx
353           IF (      westCommMode .EQ. COMM_PUT           IF (     westCommMode .EQ. COMM_PUT
354       &        .OR. westCommMode .EQ. COMM_MSG ) THEN       &       .OR. westCommMode .EQ. COMM_MSG ) THEN
355            iB  = 0            iB  = 0
356            DO K=1,myNz            DO k=1,myNz
357             DO J=1,sNy             DO j=1,sNy
358              DO I=iMin,iMax              DO i=iMin,iMax
359               iB = iB + 1               iB = iB + 1
360               array(I,J,K,bi,bj) =               array(i,j,k,bi,bj) =
361       &       array(I,J,K,bi,bj)+westRecvBuf_RX(iB,eBl,bi,bj)       &       array(i,j,k,bi,bj) + westRecvBuf_RX(iB,eBl,bi,bj)
362              ENDDO              ENDDO
363             ENDDO             ENDDO
364            ENDDO            ENDDO
365           ELSEIF ( westCommMode .EQ. COMM_GET ) THEN           ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
366            DO K=1,myNz            DO k=1,myNz
367             DO J=1,sNy             DO j=1,sNy
368              iB = iB0              iB = iB0
369              DO I=iMin,iMax              DO i=iMin,iMax
370               iB = iB+1               iB = iB+1
371               array(I,J,K,bi,bj) =               array(i,j,k,bi,bj) =
372       &       array(I,J,K,bi,bj)+array(iB,J,K,biW,bjW)       &       array(i,j,k,bi,bj) + array(iB,j,k,biW,bjW)
373                 array(iB,j,k,biW,bjW) = 0.0
374              ENDDO              ENDDO
375             ENDDO             ENDDO
376            ENDDO            ENDDO
# Line 408  C--   Read from the buffers Line 380  C--   Read from the buffers
380         ENDDO         ENDDO
381        ENDDO        ENDDO
382    
       _BARRIER  
       IF ( doingSingleThreadedComms ) THEN  
 C      Restore saved settings that were stored to allow  
 C      single thred comms.  
        _BEGIN_MASTER(myThid)  
         DO I=1,nThreads  
          myBxLo(I) = myBxLoSave(I)  
          myBxHi(I) = myBxHiSave(I)  
          myByLo(I) = myByLoSave(I)  
          myByHi(I) = myByHiSave(I)  
         ENDDO  
        _END_MASTER(myThid)  
       ENDIF                  
       _BARRIER  
   
383        RETURN        RETURN
384        END        END
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22