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