/[MITgcm]/MITgcm/pkg/flt/exch_recv_get_vec.F
ViewVC logotype

Diff of /MITgcm/pkg/flt/exch_recv_get_vec.F

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

revision 1.4 by jmc, Wed Jan 7 23:17:23 2009 UTC revision 1.10 by jmc, Thu Sep 6 16:13:53 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    #undef EXCH_USE_SPINNING
6    #undef DBUG_EXCH_VEC
7    
8  C--   Contents  C--   Contents
9  C--   o EXCH_RL_RECV_GET_VEC_X  C--   o EXCH_RECV_GET_VEC_X_RL
10  C--   o EXCH_RL_RECV_GET_VEC_Y  C--   o EXCH_RECV_GET_VEC_Y_RL
11    
12  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
13    CBOP 0
14    C !ROUTINE: EXCH_RECV_GET_VEC_X_RL
15    
16        SUBROUTINE EXCH_RL_RECV_GET_VEC_X(  C !INTERFACE:
17          SUBROUTINE EXCH_RECV_GET_VEC_X_RL(
18       U                        arrayE, arrayW,       U                        arrayE, arrayW,
19       I                        myd1, myThid )       I                        myd1, myThid )
20  C     /==========================================================\  C     !DESCRIPTION:
21  C     | SUBROUTINE RECV_RL_GET_X                                 |  C     *==========================================================*
22  C     | o "Send" or "put" X edges for RL array.                  |  C     | SUBROUTINE EXCH_RECV_GET_VEC_X_RL
23  C     |==========================================================|  C     | o "Receive" or "Get" X edges for RL array.
24  C     | Routine that invokes actual message passing send or      |  C     *==========================================================*
25  C     | direct "put" of data to update X faces of an XY[R] array.|  C     | Routine that invokes actual message passing receive
26  C     \==========================================================/  C     | of data to update buffer in X direction
27    C     *==========================================================*
28    
29    C     !USES:
30        IMPLICIT NONE        IMPLICIT NONE
31    
32  C     == Global variables ==  C     == Global variables ==
33  #include "SIZE.h"  #include "SIZE.h"
34  #include "EEPARAMS.h"  #include "EEPARAMS.h"
35  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 #include "FLT.h"  
36  #include "EXCH.h"  #include "EXCH.h"
37    
38  C     == Routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
39  C     arrayE - Arrays to exchange be exchanged.  C     arrayE        :: buffer array to collect Eastern Neighbour values
40  C     arrayW  C     arrayW        :: buffer array to collect Western Neighbour values
41  C     myd1   - sizes.  C     myd1          :: size
42  C     theSimulationMode - Forward or reverse mode exchange ( provides  C     myThid        :: my Thread Id. number
 C                         support for adjoint integration of code. )  
 C     myThid            - Thread number of this instance of S/R EXCH...  
 C     eBl               - Edge buffer level  
43        INTEGER myd1        INTEGER myd1
44        _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)        _RL arrayE(myd1, nSx, nSy), arrayW(myd1, nSx, nSy)
45        INTEGER myThid        INTEGER myThid
46  CEndOfInterface  CEOP
47    
48  C     == Local variables ==  C     !LOCAL VARIABLES:
49  C     I, J                       - Loop counters and extents  C     bi, bj        :: tile indices
50  C     bi, bj  C     biW, bjW      :: West tile indices
51  C     biW, bjW                   - West tile indices  C     biE, bjE      :: East tile indices
52  C     biE, bjE                   - East tile indices  C     theProc       :: Variables used in message building
53  C     theProc, theTag, theType,  - Variables used in message building  C     theTag        :: Variables used in message building
54  C     theSize  C     theType       :: Variables used in message building
55  C     westCommMode               - Working variables holding type  C     theSize       :: Variables used in message building
56  C     eastCommMode                 of communication a particular  C     westCommMode  :: variables holding type of communication
57  C                                  tile face uses.  C     eastCommMode  ::  a particular tile face uses.
58        INTEGER bi, bj        INTEGER bi, bj
59  c     INTEGER biW, bjW, biE, bjE  c     INTEGER biW, bjW, biE, bjE
60        INTEGER westCommMode        INTEGER westCommMode
61        INTEGER eastCommMode        INTEGER eastCommMode
62          INTEGER ioUnit
63    #ifdef EXCH_USE_SPINNING
64        INTEGER spinCount        INTEGER spinCount
65    #endif
66  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
67        INTEGER theProc, theTag, theType, theSize        INTEGER theProc, theTag, theType, theSize
68        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
69  #endif  #endif
70    
   
71  C--   Under a "put" scenario we  C--   Under a "put" scenario we
72  C--     i. set completetion signal for buffer we put into.  C--     i. set completetion signal for buffer we put into.
73  C--    ii. wait for completetion signal indicating data has been put in  C--    ii. wait for completetion signal indicating data has been put in
74  C--        our buffer.  C--        our buffer.
75  C--   Under a messaging mode we "receive" the message.  C--   Under a messaging mode we "receive" the message.
76  C--   Under a "get" scenario we  C--   Under a "get" scenario <= not implemented, we
77  C--     i. Check that the data is ready.  C--     i. Check that the data is ready.
78  C--    ii. Read the data.  C--    ii. Read the data.
79  C--   iii. Set data read flag + memory sync.  C--   iii. Set data read flag + memory sync.
80    
81          ioUnit = errorMessageUnit
82    
83        DO bj=myByLo(myThid),myByHi(myThid)        _BEGIN_MASTER(myThid)
84         DO bi=myBxLo(myThid),myBxHi(myThid)  
85          DO bj=1,nSy
86           DO bi=1,nSx
87          westCommMode  = _tileCommModeW(bi,bj)          westCommMode  = _tileCommModeW(bi,bj)
88          eastCommMode  = _tileCommModeE(bi,bj)          eastCommMode  = _tileCommModeE(bi,bj)
89    #ifdef DBUG_EXCH_VEC
90            write(ioUnit,'(A,5I6)') 'RECV_X,0 :',myProcId,bi,bj
91    #endif
92  c       biE =  _tileBiE(bi,bj)  c       biE =  _tileBiE(bi,bj)
93  c       bjE =  _tileBjE(bi,bj)  c       bjE =  _tileBjE(bi,bj)
94  c       biW =  _tileBiW(bi,bj)  c       biW =  _tileBiW(bi,bj)
95  c       bjW =  _tileBjW(bi,bj)  c       bjW =  _tileBjW(bi,bj)
96          IF ( westCommMode .EQ. COMM_MSG ) THEN          IF ( westCommMode .EQ. COMM_MSG ) THEN
97  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
 #ifndef ALWAYS_USE_MPI  
98           IF ( usingMPI ) THEN           IF ( usingMPI ) THEN
99  #endif            theProc = tilePidW(bi,bj)
100           theProc = tilePidW(bi,bj)            theTag  = _tileTagRecvW(bi,bj)
101           theTag  = _tileTagRecvW(bi,bj)            theType = _MPI_TYPE_RL
102           theType = MPI_DOUBLE_PRECISION            theSize = myd1
103           theSize = myd1  #ifdef DBUG_EXCH_VEC
104           CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,            write(ioUnit,'(A,5I5,I8)') 'qq2xW: ',myProcId,bi,bj,
105       &                  theProc, theTag, MPI_COMM_MODEL,       &          theProc,theTag,theSize
106       &                  mpiStatus, mpiRc )  #endif
107              CALL MPI_Recv( arrayW(1,bi,bj), theSize, theType,
108         &                   theProc, theTag, MPI_COMM_MODEL,
109         &                   mpiStatus, mpiRc )
110  c         if (theProc .eq. 0 .or. theProc .eq. 2) then  c         if (theProc .eq. 0 .or. theProc .eq. 2) then
111  c         if (arrayW(1,bi,bj) .ne. 0.) then  c         if (arrayW(1,bi,bj) .ne. 0.) then
112  c            write(errormessageunit,*) 'qq2y: ',myprocid,  c            write(errormessageunit,*) 'qq2y: ',myProcId,
113  c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)  c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
114  c         else  c         else
115  c            write(errormessageunit,*) 'qq2n: ',myprocid,  c            write(errormessageunit,*) 'qq2n: ',myProcId,
116  c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)  c     &      theProc,theTag,theSize,(arrayW(i,bi,bj),i=1,32)
117  c         endif  c         endif
118  c         endif  c         endif
119  #ifndef ALWAYS_USE_MPI           ENDIF
         ENDIF  
 #endif  
120  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
121          ENDIF          ENDIF
122    #ifdef DBUG_EXCH_VEC
123            write(ioUnit,'(A,5I6)') 'RECV_X,1 :',myProcId,bi,bj
124    #endif
125    
126          IF ( eastCommMode .EQ. COMM_MSG ) THEN          IF ( eastCommMode .EQ. COMM_MSG ) THEN
127  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
 #ifndef ALWAYS_USE_MPI  
128           IF ( usingMPI ) THEN           IF ( usingMPI ) THEN
129  #endif            theProc = tilePidE(bi,bj)
130           theProc = tilePidE(bi,bj)            theTag  = _tileTagRecvE(bi,bj)
131           theTag  = _tileTagRecvE(bi,bj)            theType = _MPI_TYPE_RL
132           theType = MPI_DOUBLE_PRECISION            theSize = myd1
133           theSize = myd1  #ifdef DBUG_EXCH_VEC
134           CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,            write(ioUnit,'(A,5I5,I8)') 'qq2xE: ',myProcId,bi,bj,
135       &                  theProc, theTag, MPI_COMM_MODEL,       &          theProc,theTag,theSize
136       &                  mpiStatus, mpiRc )  #endif
137  #ifndef ALWAYS_USE_MPI            CALL MPI_Recv( arrayE(1,bi,bj), theSize, theType,
138          ENDIF       &                   theProc, theTag, MPI_COMM_MODEL,
139  #endif       &                   mpiStatus, mpiRc )
140             ENDIF
141  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
142          ENDIF          ENDIF
143    #ifdef DBUG_EXCH_VEC
144            write(ioUnit,'(A,5I6)') 'RECV_X,2 :',myProcId,bi,bj
145    #endif
146         ENDDO         ENDDO
147        ENDDO        ENDDO
148    #ifdef DBUG_EXCH_VEC
149          write(ioUnit,'(A,5I6,I12)') 'RECV_X:',myProcId
150    #endif
151    
152  C--   Wait for buffers I am going read to be ready.        IF ( .NOT.exchUsesBarrier  ) THEN
153           DO bj=1,nSy
154            DO bi=1,nSx
155             IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
156    #ifdef ALLOW_USE_MPI
157              IF ( usingMPI )
158         &    CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
159         &                      mpiStatus, mpiRC )
160    #endif /* ALLOW_USE_MPI */
161             ENDIF
162    C        Clear outstanding requests counter
163             exchNReqsX(1,bi,bj) = 0
164            ENDDO
165           ENDDO
166          ENDIF
167    
168          _END_MASTER(myThid)
169    
170    C--   need to sync threads after master has received data ;
171    C     (done after mpi waitall in case waitall is really needed)
172          _BARRIER
173    
174    C--   Threads wait for buffers I am going to read to be ready.
175    C     note: added BARRIER in exch_send_put S/R and here above (message
176    C     mode) so that we no longer needs this (undef EXCH_USE_SPINNING)
177    #ifdef EXCH_USE_SPINNING
178        IF ( exchUsesBarrier  ) THEN        IF ( exchUsesBarrier  ) THEN
179  C      o On some machines ( T90 ) use system barrier rather than spinning.  C      o On some machines ( T90 ) use system barrier rather than spinning.
180         CALL BARRIER( myThid )         CALL BARRIER( myThid )
# Line 139  C        i.e. we only lock waiting for d Line 186  C        i.e. we only lock waiting for d
186           spinCount = 0           spinCount = 0
187           westCommMode = _tileCommModeW(bi,bj)           westCommMode = _tileCommModeW(bi,bj)
188           eastCommMode = _tileCommModeE(bi,bj)           eastCommMode = _tileCommModeE(bi,bj)
189    #ifdef DBUG_EXCH_VEC
190              write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
191         &          westRecvAck(1,bi,bj), eastRecvAck(1,bi,bj), spinCount
192    #endif
193     10    CONTINUE     10    CONTINUE
194            CALL FOOL_THE_COMPILER            CALL FOOL_THE_COMPILER( spinCount )
195            spinCount = spinCount+1            spinCount = spinCount+1
196  C         IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN  #ifdef DBUG_EXCH_VEC
197  C          WRITE(0,*) ' eBl = ', ebl            write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
198  C          STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'       &          westRecvAck(1,bi,bj), eastRecvAck(1,bi,bj), spinCount
199  C         ENDIF            IF ( myThid.EQ.1 .AND. spinCount.GT. _EXCH_SPIN_LIMIT ) THEN
200            IF ( westRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10             STOP ' S/R EXCH_RECV_GET_X: spinCount > _EXCH_SPIN_LIMIT'
201            IF ( eastRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10            ENDIF
 C        Clear outstanding requests  
          westRecvAck(1,bi,bj) = 0.  
          eastRecvAck(1,bi,bj) = 0.  
   
 c         IF ( exchVReqsX(1,bi,bj) .GT. 0 ) THEN  
          IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
          IF ( usingMPI ) THEN  
 #endif  
 c          CALL MPI_Waitall( exchVReqsX(1,bi,bj), exchReqVIdX(1,1,bi,bj),  
           CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),  
      &                      mpiStatus, mpiRC )  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
202  #endif  #endif
203  #endif /* ALLOW_USE_MPI */            IF ( westRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
204           ENDIF            IF ( eastRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
205  C        Clear outstanding requests counter  C        Clear outstanding requests
206  c         exchVReqsX(1,bi,bj) = 0           westRecvAck(1,bi,bj) = 0
207           exchNReqsX(1,bi,bj) = 0           eastRecvAck(1,bi,bj) = 0
 C        Update statistics  
208          ENDDO          ENDDO
209         ENDDO         ENDDO
210        ENDIF        ENDIF
211    #endif /* EXCH_USE_SPINNING */
212    
213        RETURN        RETURN
214        END        END
215    
216  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
217    CBOP 0
218    C !ROUTINE: EXCH_RECV_GET_VEC_Y_RL
219    
220        SUBROUTINE EXCH_RL_RECV_GET_VEC_Y(  C !INTERFACE:
221          SUBROUTINE EXCH_RECV_GET_VEC_Y_RL(
222       U                        arrayN, arrayS,       U                        arrayN, arrayS,
223       I                        myd1, myThid )       I                        myd1, myThid )
224  C     /==========================================================\  C     !DESCRIPTION:
225  C     | SUBROUTINE RECV_RL_GET_Y                                 |  C     *==========================================================*
226  C     | o "Send" or "put" Y edges for RL array.                  |  C     | SUBROUTINE EXCH_RECV_GET_VEC_Y_RL
227  C     |==========================================================|  C     | o "Receive" or "Get" Y edges for RL array.
228  C     | Routine that invokes actual message passing send or      |  C     *==========================================================*
229  C     | direct "put" of data to update Y faces of an XY[R] array.|  C     | Routine that invokes actual message passing receive
230  C     \==========================================================/  C     | of data to update buffer in Y direction
231    C     *==========================================================*
232    
233    C     !USES:
234        IMPLICIT NONE        IMPLICIT NONE
235    
236  C     == Global variables ==  C     == Global variables ==
237  #include "SIZE.h"  #include "SIZE.h"
238  #include "EEPARAMS.h"  #include "EEPARAMS.h"
239  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 #include "FLT.h"  
240  #include "EXCH.h"  #include "EXCH.h"
241    
242  C     == Routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
243  C     arrayN - Arrays to exchange be exchanged.  C     arrayN        :: buffer array to collect Northern Neighbour values
244  C     arrayS  C     arrayS        :: buffer array to collect Southern Neighbour values
245  C     myd1   - sizes.  C     myd1          :: size
246  C     theSimulationMode - Forward or reverse mode exchange ( provides  C     myThid        :: my Thread Id. number
 C                         support for adjoint integration of code. )  
 C     myThid            - Thread number of this instance of S/R EXCH...  
247        INTEGER myd1        INTEGER myd1
248        _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)        _RL arrayN(myd1, nSx, nSy), arrayS(myd1, nSx, nSy)
249        INTEGER myThid        INTEGER myThid
250  CEndOfInterface  CEOP
251    
252  C     == Local variables ==  C     !LOCAL VARIABLES:
253  C     I, J                       - Loop counters and extents  C     bi, bj        :: tile indices
254  C     bi, bj  C     biS, bjS      :: South tile indices
255  C     biS, bjS                   - South tile indices  C     biN, bjN      :: North tile indices
256  C     biE, bjE                   - North tile indices  C     theProc       :: Variables used in message building
257  C     theProc, theTag, theType,  - Variables used in message building  C     theTag        :: Variables used in message building
258  C     theSize  C     theType       :: Variables used in message building
259  C     southCommMode               - Working variables holding type  C     theSize       :: Variables used in message building
260  C     northCommMode                 of communication a particular  C     southCommMode :: variables holding type of communication
261  C                                  tile face uses.  C     northCommMode ::  a particular tile face uses.
262        INTEGER bi, bj        INTEGER bi, bj
263  c     INTEGER biS, bjS, biN, bjN  c     INTEGER biS, bjS, biN, bjN
264        INTEGER southCommMode        INTEGER southCommMode
265        INTEGER northCommMode        INTEGER northCommMode
266          INTEGER ioUnit
267    #ifdef EXCH_USE_SPINNING
268        INTEGER spinCount        INTEGER spinCount
269    #endif
270  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
271        INTEGER theProc, theTag, theType, theSize        INTEGER theProc, theTag, theType, theSize
272        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc        INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
273  #endif  #endif
274    
   
275  C--   Under a "put" scenario we  C--   Under a "put" scenario we
276  C--     i. set completetion signal for buffer we put into.  C--     i. set completetion signal for buffer we put into.
277  C--    ii. wait for completetion signal indicating data has been put in  C--    ii. wait for completetion signal indicating data has been put in
278  C--        our buffer.  C--        our buffer.
279  C--   Under a messaging mode we "receive" the message.  C--   Under a messaging mode we "receive" the message.
280  C--   Under a "get" scenario we  C--   Under a "get" scenario <= not implemented, we
281  C--     i. Check that the data is ready.  C--     i. Check that the data is ready.
282  C--    ii. Read the data.  C--    ii. Read the data.
283  C--   iii. Set data read flag + memory sync.  C--   iii. Set data read flag + memory sync.
284    
285          ioUnit = errorMessageUnit
286    
287        DO bj=myByLo(myThid),myByHi(myThid)        _BEGIN_MASTER(myThid)
288         DO bi=myBxLo(myThid),myBxHi(myThid)  
289          DO bj=1,nSy
290           DO bi=1,nSx
291          southCommMode  = _tileCommModeS(bi,bj)          southCommMode  = _tileCommModeS(bi,bj)
292          northCommMode  = _tileCommModeN(bi,bj)          northCommMode  = _tileCommModeN(bi,bj)
293    #ifdef DBUG_EXCH_VEC
294            write(ioUnit,'(A,5I6)') 'RECV_Y,0 :',myProcId,bi,bj
295    #endif
296  c       biN =  _tileBiN(bi,bj)  c       biN =  _tileBiN(bi,bj)
297  c       bjN =  _tileBjN(bi,bj)  c       bjN =  _tileBjN(bi,bj)
298  c       biS =  _tileBiS(bi,bj)  c       biS =  _tileBiS(bi,bj)
299  c       bjS =  _tileBjS(bi,bj)  c       bjS =  _tileBjS(bi,bj)
300          IF ( southCommMode .EQ. COMM_MSG ) THEN          IF ( southCommMode .EQ. COMM_MSG ) THEN
301  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
 #ifndef ALWAYS_USE_MPI  
302           IF ( usingMPI ) THEN           IF ( usingMPI ) THEN
303  #endif            theProc = tilePidS(bi,bj)
304           theProc = tilePidS(bi,bj)            theTag  = _tileTagRecvS(bi,bj)
305           theTag  = _tileTagRecvS(bi,bj)            theType = _MPI_TYPE_RL
306           theType = MPI_DOUBLE_PRECISION            theSize = myd1
307           theSize = myd1            CALL MPI_Recv( arrayS(1,bi,bj), theSize, theType,
308           CALL MPI_Recv( arrayS(1,bi,bj), theSize, theType,       &                   theProc, theTag, MPI_COMM_MODEL,
309       &                  theProc, theTag, MPI_COMM_MODEL,       &                   mpiStatus, mpiRc )
310       &                  mpiStatus, mpiRc )           ENDIF
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
311  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
312          ENDIF          ENDIF
313    #ifdef DBUG_EXCH_VEC
314            write(ioUnit,'(A,5I6)') 'RECV_Y,1 :',myProcId,bi,bj
315    #endif
316    
317          IF ( northCommMode .EQ. COMM_MSG ) THEN          IF ( northCommMode .EQ. COMM_MSG ) THEN
318  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
 #ifndef ALWAYS_USE_MPI  
319           IF ( usingMPI ) THEN           IF ( usingMPI ) THEN
320  #endif            theProc = tilePidN(bi,bj)
321           theProc = tilePidN(bi,bj)            theTag  = _tileTagRecvN(bi,bj)
322           theTag  = _tileTagRecvN(bi,bj)            theType = _MPI_TYPE_RL
323           theType = MPI_DOUBLE_PRECISION            theSize = myd1
324           theSize = myd1            CALL MPI_Recv( arrayN(1,bi,bj), theSize, theType,
325           CALL MPI_Recv( arrayN(1,bi,bj), theSize, theType,       &                   theProc, theTag, MPI_COMM_MODEL,
326       &                  theProc, theTag, MPI_COMM_MODEL,       &                   mpiStatus, mpiRc )
327       &                  mpiStatus, mpiRc )           ENDIF
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
 #endif  
328  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
329          ENDIF          ENDIF
330    #ifdef DBUG_EXCH_VEC
331            write(ioUnit,'(A,5I6)') 'RECV_Y,2 :',myProcId,bi,bj
332    #endif
333         ENDDO         ENDDO
334        ENDDO        ENDDO
335    #ifdef DBUG_EXCH_VEC
336          write(ioUnit,'(A,5I6,I12)') 'RECV_Y:',myProcId
337    #endif
338    
339  C--   Wait for buffers I am going read to be ready.  C--   Processes wait for buffers I am going to read to be ready.
340          IF ( .NOT.exchUsesBarrier  ) THEN
341           DO bj=1,nSy
342            DO bi=1,nSx
343             IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
344    #ifdef ALLOW_USE_MPI
345              IF ( usingMPI )
346         &    CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
347         &                      mpiStatus, mpiRC )
348    #endif /* ALLOW_USE_MPI */
349             ENDIF
350    C        Clear outstanding requests counter
351             exchNReqsY(1,bi,bj) = 0
352            ENDDO
353           ENDDO
354          ENDIF
355    
356          _END_MASTER(myThid)
357    
358    C--   need to sync threads after master has received data ;
359    C     (done after mpi waitall in case waitall is really needed)
360          _BARRIER
361    
362    C--   Threads wait for buffers I am going to read to be ready.
363    C     note: added BARRIER in exch_send_put S/R and here above (message
364    C     mode) so that we no longer needs this (undef EXCH_USE_SPINNING)
365    #ifdef EXCH_USE_SPINNING
366        IF ( exchUsesBarrier  ) THEN        IF ( exchUsesBarrier  ) THEN
367  C      o On some machines ( T90 ) use system barrier rather than spinning.  C      o On some machines ( T90 ) use system barrier rather than spinning.
368         CALL BARRIER( myThid )         CALL BARRIER( myThid )
# Line 299  C        i.e. we only lock waiting for d Line 374  C        i.e. we only lock waiting for d
374           spinCount = 0           spinCount = 0
375           southCommMode = _tileCommModeS(bi,bj)           southCommMode = _tileCommModeS(bi,bj)
376           northCommMode = _tileCommModeN(bi,bj)           northCommMode = _tileCommModeN(bi,bj)
377    #ifdef DBUG_EXCH_VEC
378              write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
379         &          southRecvAck(1,bi,bj), northRecvAck(1,bi,bj), spinCount
380    #endif
381     10    CONTINUE     10    CONTINUE
382            CALL FOOL_THE_COMPILER            CALL FOOL_THE_COMPILER( spinCount )
383            spinCount = spinCount+1            spinCount = spinCount+1
384  C         IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN  #ifdef DBUG_EXCH_VEC
385  C          WRITE(0,*) ' eBl = ', ebl            write(ioUnit,'(A,5I6,I12)') 'spin:', myProcId,bi,bj,
386  C          STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'       &          southRecvAck(1,bi,bj), northRecvAck(1,bi,bj), spinCount
387  C         ENDIF            IF ( myThid.EQ.1 .AND. spinCount.GT. _EXCH_SPIN_LIMIT ) THEN
388            IF ( southRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10             STOP ' S/R EXCH_RECV_GET_X: spinCount > _EXCH_SPIN_LIMIT'
389            IF ( northRecvAck(1,bi,bj) .EQ. 0. ) GOTO 10            ENDIF
 C        Clear outstanding requests  
          southRecvAck(1,bi,bj) = 0.  
          northRecvAck(1,bi,bj) = 0.  
   
 c         IF ( exchVReqsY(1,bi,bj) .GT. 0 ) THEN  
          IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
          IF ( usingMPI ) THEN  
 #endif  
 c          CALL MPI_Waitall( exchVReqsY(1,bi,bj), exchReqVIdY(1,1,bi,bj),  
           CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),  
      &                      mpiStatus, mpiRC )  
 #ifndef ALWAYS_USE_MPI  
         ENDIF  
390  #endif  #endif
391  #endif /* ALLOW_USE_MPI */            IF ( southRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
392           ENDIF            IF ( northRecvAck(1,bi,bj) .EQ. 0 ) GOTO 10
393  C        Clear outstanding requests counter  C        Clear outstanding requests
394  c         exchVReqsY(1,bi,bj) = 0           southRecvAck(1,bi,bj) = 0
395           exchNReqsY(1,bi,bj) = 0           northRecvAck(1,bi,bj) = 0
 C        Update statistics  
396          ENDDO          ENDDO
397         ENDDO         ENDDO
398        ENDIF        ENDIF
399    #endif /* EXCH_USE_SPINNING */
400    
401        RETURN        RETURN
402        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22