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

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

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

revision 1.11 by utke, Wed Apr 9 22:33:42 2008 UTC revision 1.15 by jmc, Thu Sep 6 15:25:01 2012 UTC
# Line 14  C     !INTERFACE: Line 14  C     !INTERFACE:
14        IMPLICIT NONE        IMPLICIT NONE
15  C     !DESCRIPTION:  C     !DESCRIPTION:
16  C     *==========================================================*  C     *==========================================================*
17  C     | SUBROUTINE EXCH_RX_SEND_PUT_X                              C     | SUBROUTINE EXCH_RX_SEND_PUT_X
18  C     | o "Send" or "put" X edges for RX array.                    C     | o "Send" or "put" X edges for RX array.
19  C     *==========================================================*  C     *==========================================================*
20  C     | Routine that invokes actual message passing send or        C     | Routine that invokes actual message passing send or
21  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.
22  C     *==========================================================*  C     *==========================================================*
23    
24  C     !USES:  C     !USES:
# Line 37  C     myOLn Line 37  C     myOLn
37  C     myOLs  C     myOLs
38  C     exchWidthX :: Width of data region exchanged.  C     exchWidthX :: Width of data region exchanged.
39  C     exchWidthY  C     exchWidthY
40  C     theSimulationMode :: Forward or reverse mode exchange ( provides  C     theSimulationMode :: Forward or reverse mode exchange ( provides
41  C                          support for adjoint integration of code. )  C                          support for adjoint integration of code. )
42  C     theCornerMode     :: Flag indicating whether corner updates are  C     theCornerMode     :: Flag indicating whether corner updates are
43  C                          needed.  C                          needed.
44  C     myThid            :: Thread number of this instance of S/R EXCH...  C     myThid            :: Thread number of this instance of S/R EXCH...
45  C     eBl               :: Edge buffer level  C     eBl               :: Edge buffer level
# Line 49  C     eBl               :: Edge buffer l Line 49  C     eBl               :: Edge buffer l
49        INTEGER myOLn        INTEGER myOLn
50        INTEGER myNz        INTEGER myNz
51        _RX array(1-myOLw:sNx+myOLe,        _RX array(1-myOLw:sNx+myOLe,
52       &          1-myOLs:sNy+myOLn,       &          1-myOLs:sNy+myOLn,
53       &          myNZ, nSx, nSy)       &          myNZ, nSx, nSy)
54        INTEGER exchWidthX        INTEGER exchWidthX
55        INTEGER exchWidthY        INTEGER exchWidthY
# Line 59  C     eBl               :: Edge buffer l Line 59  C     eBl               :: Edge buffer l
59    
60  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
61  C     == Local variables ==  C     == Local variables ==
62  C     I, J, K, iMin, iMax, iB    :: Loop counters and extents  C     i, j, k, iMin, iMax, iB    :: Loop counters and extents
63  C     bi, bj    C     bi, bj
64  C     biW, bjW                   :: West tile indices  C     biW, bjW                   :: West tile indices
65  C     biE, bjE                   :: East tile indices  C     biE, bjE                   :: East tile indices
66  C     eBl                        :: Current exchange buffer level  C     eBl                        :: Current exchange buffer level
# Line 69  C     theSize Line 69  C     theSize
69  C     westCommMode               :: Working variables holding type  C     westCommMode               :: Working variables holding type
70  C     eastCommMode                  of communication a particular  C     eastCommMode                  of communication a particular
71  C                                   tile face uses.  C                                   tile face uses.
72        INTEGER I, J, K, iMin, iMax, iB        INTEGER i, j, k, iMin, iMax, iB
73        INTEGER bi, bj, biW, bjW, biE, bjE        INTEGER bi, bj, biW, bjW, biE, bjE
74        INTEGER eBl        INTEGER eBl
75        INTEGER westCommMode        INTEGER westCommMode
# Line 77  C                                   tile Line 77  C                                   tile
77    
78  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
79        INTEGER theProc, theTag, theType, theSize, mpiRc        INTEGER theProc, theTag, theType, theSize, mpiRc
80  # ifdef ALLOW_AUTODIFF_OPENAD  # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
81        INTEGER mpiStatus(MPI_STATUS_SIZE)        INTEGER mpiStatus(MPI_STATUS_SIZE)
82        INTEGER pReqI        INTEGER pReqI
83  # endif  # endif
84  #endif  #endif
85  C--   Write data to exchange buffer  C--   Write data to exchange buffer
86  C     Various actions are possible depending on the communication mode  C     Various actions are possible depending on the communication mode
87  C     as follows:  C     as follows:
88  C       Mode      Action  C       Mode      Action
89  C     --------   ---------------------------  C     --------   ---------------------------
# Line 104  C                tile Line 104  C                tile
104  C                Write data-ready Ack for west edge of east-neighbor  C                Write data-ready Ack for west edge of east-neighbor
105  C                tile  C                tile
106  C                Sync. memory  C                Sync. memory
107  C        C
108  CEOP  CEOP
109    
110         INTEGER myBxLoSave(MAX_NO_THREADS)  #ifdef ALLOW_AUTODIFF_OPENAD_AMPI
111         INTEGER myBxHiSave(MAX_NO_THREADS)  # ifdef ALLOW_USE_MPI
        INTEGER myByLoSave(MAX_NO_THREADS)  
        INTEGER myByHiSave(MAX_NO_THREADS)  
        LOGICAL doingSingleThreadedComms  
   
        doingSingleThreadedComms = .FALSE.  
 #ifdef ALLOW_USE_MPI  
 #ifndef ALWAYS_USE_MPI  
112        IF ( usingMPI ) THEN        IF ( usingMPI ) THEN
113  #endif        _BEGIN_MASTER(myThid)
114  C      Set default behavior to have MPI comms done by a single thread.         DO bj=1,nSy
115  C      Most MPI implementations don't support concurrent comms from          DO bi=1,nSx
116  C      several threads.            CALL ampi_awaitall (
117         IF ( nThreads .GT. 1 ) THEN       &         exchNReqsX(1,bi,bj) ,
118          _BARRIER       &         exchReqIdX(1,1,bi,bj) ,
119          _BEGIN_MASTER( myThid )       &         mpiStatus ,
120           DO I=1,nThreads       &         mpiRC )
121            myBxLoSave(I) = myBxLo(I)          ENDDO
122            myBxHiSave(I) = myBxHi(I)         ENDDO
123            myByLoSave(I) = myByLo(I)        _END_MASTER(myThid)
           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  
124        ENDIF        ENDIF
125  #endif  # endif
126  #endif  #endif
127    
128  #ifdef ALLOW_AUTODIFF_OPENAD  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 # ifdef ALLOW_USE_MPI  
       DO bj=myByLo(myThid),myByHi(myThid)  
        DO bi=myBxLo(myThid),myBxHi(myThid)  
129    
130  #  ifndef ALWAYS_USE_MPI  C     Prevent anyone to access shared buffer while an other thread modifies it
131           IF ( usingMPI ) THEN        _BARRIER
132  #  endif  
133            CALL ampi_awaitall (  C     Fill shared buffers from array values
      & exchNReqsX(1,bi,bj) ,  
      & exchReqIdX(1,1,bi,bj) ,  
      & mpiStatus ,  
      & mpiRC )  
 #  ifndef ALWAYS_USE_MPI  
          ENDIF  
 #  endif  
        ENDDO  
       ENDDO  
 # endif  
 #endif  
134        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
135         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
136    
137          ebL = exchangeBufLevel(1,bi,bj)          eBl = exchangeBufLevel(1,bi,bj)
138          westCommMode  = _tileCommModeW(bi,bj)          westCommMode = _tileCommModeW(bi,bj)
139          eastCommMode  = _tileCommModeE(bi,bj)          eastCommMode = _tileCommModeE(bi,bj)
140          biE =  _tileBiE(bi,bj)          biE = _tileBiE(bi,bj)
141          bjE =  _tileBjE(bi,bj)          bjE = _tileBjE(bi,bj)
142          biW =  _tileBiW(bi,bj)          biW = _tileBiW(bi,bj)
143          bjW =  _tileBjW(bi,bj)          bjW = _tileBjW(bi,bj)
144    
145    C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
146    
147  C       o Send or Put west edge          IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
148    
149          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN  C       o Send or Put west edge
150           iMin = 1           iMin = 1
151           iMax = 1+exchWidthX-1           iMax = 1+exchWidthX-1
152          IF ( westCommMode .EQ. COMM_MSG  ) THEN           IF ( westCommMode .EQ. COMM_MSG  ) THEN
153           iB = 0            iB = 0
154           DO K=1,myNz            DO k=1,myNz
155            DO J=1,sNy             DO j=1,sNy
156             DO I=iMin,iMax              DO i=iMin,iMax
157              iB = iB + 1               iB = iB + 1
158              westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
159                ENDDO
160             ENDDO             ENDDO
161            ENDDO            ENDDO
162           ENDDO           ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
163  C        Send the data            iB  = 0
164  #ifdef ALLOW_USE_MPI            DO k=1,myNz
165  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
166           IF ( usingMPI ) THEN              DO i=iMin,iMax
167  #endif               iB = iB + 1
168           theProc = tilePidW(bi,bj)               eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
169           theTag  = _tileTagSendW(bi,bj)              ENDDO
          theSize = iB  
          theType = _MPI_TYPE_RX  
 # ifndef ALLOW_AUTODIFF_OPENAD  
          exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1  
          CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,  
      &                  theProc, theTag, MPI_COMM_MODEL,  
      &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )  
 # else  
          pReqI=exchNReqsX(1,bi,bj)+1  
          CALL ampi_isend_RX(  
      & westSendBuf_RX(1,eBl,bi,bj),  
      & theSize,  
      & theType,  
      & theProc,  
      & theTag,  
      & MPI_COMM_MODEL,  
      & exchReqIdX(pReqI,1,bi,bj),  
      & exchNReqsX(1,bi,bj),  
      & mpiStatus ,  
      & mpiRc )  
 # endif /* ALLOW_AUTODIFF_OPENAD */  
 #ifndef ALWAYS_USE_MPI  
          ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
          eastRecvAck(eBl,biW,bjW) = 1  
         ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN  
          iB  = 0  
          DO K=1,myNz  
           DO J=1,sNy  
            DO I=iMin,iMax  
             iB = iB + 1  
             eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)  
170             ENDDO             ENDDO
171            ENDDO            ENDDO
172           ENDDO           ELSEIF ( westCommMode .NE. COMM_NONE
173          ELSEIF ( westCommMode .NE. COMM_NONE       &    .AND.   westCommMode .NE. COMM_GET ) THEN
174       &   .AND.   westCommMode .NE. COMM_GET ) THEN            STOP ' S/R EXCH: Invalid commW mode.'
175           STOP ' S/R EXCH: Invalid commW mode.'           ENDIF
         ENDIF  
176    
177  C       o Send or Put east edge  C       o Send or Put east edge
178           iMin = sNx-exchWidthX+1           iMin = sNx-exchWidthX+1
179           iMax = sNx           iMax = sNx
180          IF ( eastCommMode .EQ. COMM_MSG  ) THEN           IF ( eastCommMode .EQ. COMM_MSG  ) THEN
181           iB = 0            iB = 0
182           DO K=1,myNz            DO k=1,myNz
183            DO J=1,sNy             DO j=1,sNy
184             DO I=iMin,iMax              DO i=iMin,iMax
185              iB = iB + 1               iB = iB + 1
186              eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
187                ENDDO
188             ENDDO             ENDDO
189            ENDDO            ENDDO
190           ENDDO           ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
191  C        Send the data            iB  = 0
192  #ifdef ALLOW_USE_MPI            DO k=1,myNz
193  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
194           IF ( usingMPI ) THEN              DO i=iMin,iMax
195  #endif               iB = iB + 1
196           theProc = tilePidE(bi,bj)               westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
197           theTag  = _tileTagSendE(bi,bj)              ENDDO
          theSize = iB  
          theType = _MPI_TYPE_RX  
 # ifndef ALLOW_AUTODIFF_OPENAD  
          exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1  
          CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,  
      &                  theProc, theTag, MPI_COMM_MODEL,  
      &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )  
 # else  
          pReqI=exchNReqsX(1,bi,bj)+1  
          CALL ampi_isend_RX(  
      & eastSendBuf_RX(1,eBl,bi,bj) ,  
      & theSize ,  
      & theType ,  
      & theProc ,  
      & theTag ,  
      & MPI_COMM_MODEL ,  
      & exchReqIdX(pReqI,1,bi,bj) ,  
      & exchNReqsX(1,bi,bj),  
      & mpiStatus ,  
      & mpiRc  )  
 # endif /* ALLOW_AUTODIFF_OPENAD */  
 #ifndef ALWAYS_USE_MPI  
          ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
          westRecvAck(eBl,biE,bjE) = 1  
         ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN  
          iB  = 0  
          DO K=1,myNz  
           DO J=1,sNy  
            DO I=iMin,iMax  
             iB = iB + 1  
             westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)  
198             ENDDO             ENDDO
199            ENDDO            ENDDO
200           ENDDO           ELSEIF ( eastCommMode .NE. COMM_NONE
201          ELSEIF ( eastCommMode .NE. COMM_NONE       &    .AND.   eastCommMode .NE. COMM_GET  ) THEN
202       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN            STOP ' S/R EXCH: Invalid commE mode.'
203           STOP ' S/R EXCH: Invalid commE mode.'           ENDIF
         ENDIF  
204    
205  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
 c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
206          ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN          ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
207    
208    C       o Send or Put west edge
209           iMin = 1-exchWidthX           iMin = 1-exchWidthX
210           iMax = 0           iMax = 0
211          IF ( westCommMode .EQ. COMM_MSG  ) THEN           IF ( westCommMode .EQ. COMM_MSG  ) THEN
212           iB = 0            iB = 0
213           DO K=1,myNz            DO k=1,myNz
214            DO J=1,sNy             DO j=1,sNy
215             DO I=iMin,iMax              DO i=iMin,iMax
216              iB = iB + 1               iB = iB + 1
217              westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
218              array(I,J,K,bi,bj) = 0.0               array(i,j,k,bi,bj) = 0.0
219                ENDDO
220             ENDDO             ENDDO
221            ENDDO            ENDDO
222           ENDDO           ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
223  C        Send the data            iB  = 0
224  #ifdef ALLOW_USE_MPI            DO k=1,myNz
225  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
226           IF ( usingMPI ) THEN              DO i=iMin,iMax
227  #endif               iB = iB + 1
228           theProc = tilePidW(bi,bj)               eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
229           theTag  = _tileTagSendW(bi,bj)               array(i,j,k,bi,bj) = 0.0
230           theSize = iB              ENDDO
          theType = _MPI_TYPE_RX  
          exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1  
          CALL MPI_Isend(westSendBuf_RX(1,eBl,bi,bj), theSize, theType,  
      &                  theProc, theTag, MPI_COMM_MODEL,  
      &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )  
 #ifndef ALWAYS_USE_MPI  
          ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
          eastRecvAck(eBl,biW,bjW) = 1  
         ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN  
          iB  = 0  
          DO K=1,myNz  
           DO J=1,sNy  
            DO I=iMin,iMax  
             iB = iB + 1  
             eastRecvBuf_RX(iB,eBl,biW,bjW) = array(I,J,K,bi,bj)  
             array(I,J,K,bi,bj) = 0.0  
231             ENDDO             ENDDO
232            ENDDO            ENDDO
233           ENDDO           ELSEIF ( westCommMode .NE. COMM_NONE
234          ELSEIF ( westCommMode .NE. COMM_NONE       &    .AND.   westCommMode .NE. COMM_GET ) THEN
235       &   .AND.   westCommMode .NE. COMM_GET ) THEN            STOP ' S/R EXCH: Invalid commW mode.'
236           STOP ' S/R EXCH: Invalid commW mode.'           ENDIF
         ENDIF  
237    
238  C       o Send or Put east edge  C       o Send or Put east edge
239           iMin = sNx+1           iMin = sNx+1
240           iMax = sNx+exchWidthX           iMax = sNx+exchWidthX
241          IF ( eastCommMode .EQ. COMM_MSG  ) THEN           IF ( eastCommMode .EQ. COMM_MSG  ) THEN
242           iB = 0            iB = 0
243           DO K=1,myNz            DO k=1,myNz
244            DO J=1,sNy             DO j=1,sNy
245             DO I=iMin,iMax              DO i=iMin,iMax
246              iB = iB + 1               iB = iB + 1
247              eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
248              array(I,J,K,bi,bj) = 0.0               array(i,j,k,bi,bj) = 0.0
249                ENDDO
250             ENDDO             ENDDO
251            ENDDO            ENDDO
252           ENDDO           ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
253  C        Send the data            iB  = 0
254  #ifdef ALLOW_USE_MPI            DO k=1,myNz
255  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
256           IF ( usingMPI ) THEN              DO i=iMin,iMax
257  #endif               iB = iB + 1
258           theProc = tilePidE(bi,bj)               westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
259           theTag  = _tileTagSendE(bi,bj)               array(i,j,k,bi,bj) = 0.0
260           theSize = iB              ENDDO
          theType = _MPI_TYPE_RX  
          exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1  
          CALL MPI_Isend(eastSendBuf_RX(1,eBl,bi,bj), theSize, theType,  
      &                  theProc, theTag, MPI_COMM_MODEL,  
      &                  exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj), mpiRc )  
 #ifndef ALWAYS_USE_MPI  
          ENDIF  
 #endif  
 #endif /* ALLOW_USE_MPI */  
          westRecvAck(eBl,biE,bjE) = 1  
         ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN  
          iB  = 0  
          DO K=1,myNz  
           DO J=1,sNy  
            DO I=iMin,iMax  
             iB = iB + 1  
             westRecvBuf_RX(iB,eBl,biE,bjE) = array(I,J,K,bi,bj)  
             array(I,J,K,bi,bj) = 0.0  
261             ENDDO             ENDDO
262            ENDDO            ENDDO
263           ENDDO           ELSEIF ( eastCommMode .NE. COMM_NONE
264          ELSEIF ( eastCommMode .NE. COMM_NONE       &    .AND.   eastCommMode .NE. COMM_GET  ) THEN
265       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN            STOP ' S/R EXCH: Invalid commE mode.'
266           STOP ' S/R EXCH: Invalid commE mode.'           ENDIF
         ENDIF  
267    
268          ENDIF          ENDIF
269    
270         ENDDO         ENDDO
271        ENDDO        ENDDO
272    
273    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
274  C--   Signal completetion ( making sure system-wide memory state is  C--   Signal completetion ( making sure system-wide memory state is
275  C--                         consistent ).  C--                         consistent ).
276    
# Line 424  C     overlap region data that will be e Line 282  C     overlap region data that will be e
282    
283        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
284         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
285          ebL = exchangeBufLevel(1,bi,bj)          eBl = exchangeBufLevel(1,bi,bj)
286          biE = _tileBiE(bi,bj)          biE = _tileBiE(bi,bj)
287          bjE = _tileBjE(bi,bj)          bjE = _tileBjE(bi,bj)
288          biW = _tileBiW(bi,bj)          biW = _tileBiW(bi,bj)
# Line 444  C     sure that processes that might spi Line 302  C     sure that processes that might spi
302  C     will see the setting.  C     will see the setting.
303  C     ** NOTE ** On some machines we wont spin on the Ack setting  C     ** NOTE ** On some machines we wont spin on the Ack setting
304  C     ( particularly the T90 ), instead we will use s system barrier.  C     ( particularly the T90 ), instead we will use s system barrier.
305  C     On the T90 the system barrier is very fast and switches out the  C     On the T90 the system barrier is very fast and switches out the
306  C     thread while it waits. On most machines the system barrier  C     thread while it waits. On most machines the system barrier
307  C     is much too slow and if we own the machine and have one thread  C     is much too slow and if we own the machine and have one thread
308  C     per process preemption is not a problem.  C     per process preemption is not a problem.
309        IF ( exchNeedsMemSync  ) CALL MEMSYNC        IF ( exchNeedsMemSync  ) CALL MEMSYNC
310    
311    C     Wait until all threads finish filling buffer
312        _BARRIER        _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  
313    
314        RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
315    
316    #ifdef ALLOW_USE_MPI
317          IF ( usingMPI ) THEN
318    C--   Send buffer data: Only Master Thread do proc communication
319          _BEGIN_MASTER(myThid)
320    
321          DO bj=1,nSy
322           DO bi=1,nSx
323    
324            eBl = exchangeBufLevel(1,bi,bj)
325            westCommMode = _tileCommModeW(bi,bj)
326            eastCommMode = _tileCommModeE(bi,bj)
327            biE = _tileBiE(bi,bj)
328            bjE = _tileBjE(bi,bj)
329            biW = _tileBiW(bi,bj)
330            bjW = _tileBjW(bi,bj)
331            theType = _MPI_TYPE_RX
332            theSize = sNy*exchWidthX*myNz
333    
334            IF ( westCommMode .EQ. COMM_MSG  ) THEN
335    C       Send buffer data (copied from west edge)
336             theProc = tilePidW(bi,bj)
337             theTag  = _tileTagSendW(bi,bj)
338    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
339             exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
340             CALL MPI_Isend( westSendBuf_RX(1,eBl,bi,bj), theSize,
341         &                   theType, theProc, theTag, MPI_COMM_MODEL,
342         &                   exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
343         &                   mpiRc )
344    # else
345             pReqI=exchNReqsX(1,bi,bj)+1
346             CALL ampi_isend_RX(
347         &        westSendBuf_RX(1,eBl,bi,bj),
348         &        theSize,
349         &        theType,
350         &        theProc,
351         &        theTag,
352         &        MPI_COMM_MODEL,
353         &        exchReqIdX(pReqI,1,bi,bj),
354         &        exchNReqsX(1,bi,bj),
355         &        mpiStatus ,
356         &        mpiRc )
357    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
358    c        eastRecvAck(eBl,biW,bjW) = 1
359            ENDIF
360    
361            IF ( eastCommMode .EQ. COMM_MSG  ) THEN
362    C       Send buffer data (copied from east edge)
363             theProc = tilePidE(bi,bj)
364             theTag  = _tileTagSendE(bi,bj)
365    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
366             exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
367             CALL MPI_Isend( eastSendBuf_RX(1,eBl,bi,bj), theSize,
368         &                   theType, theProc, theTag, MPI_COMM_MODEL,
369         &                   exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
370         &                   mpiRc )
371    # else
372             pReqI=exchNReqsX(1,bi,bj)+1
373             CALL ampi_isend_RX(
374         &        eastSendBuf_RX(1,eBl,bi,bj) ,
375         &        theSize ,
376         &        theType ,
377         &        theProc ,
378         &        theTag ,
379         &        MPI_COMM_MODEL ,
380         &        exchReqIdX(pReqI,1,bi,bj) ,
381         &        exchNReqsX(1,bi,bj),
382         &        mpiStatus ,
383         &        mpiRc )
384    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
385    c        westRecvAck(eBl,biE,bjE) = 1
386            ENDIF
387    
388           ENDDO
389          ENDDO
390    
391          _END_MASTER(myThid)
392    
393          ENDIF
394    #endif /* ALLOW_USE_MPI */
395    
396    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
397          RETURN
398        END        END
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22