/[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.13 by jmc, Fri Jan 9 22:51:12 2009 UTC revision 1.14 by jmc, Mon May 17 02:28:06 2010 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 83  C                                   tile Line 83  C                                   tile
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    
        INTEGER myBxLoSave(MAX_NO_THREADS)  
        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  
   
110  #ifdef ALLOW_AUTODIFF_OPENAD_AMPI  #ifdef ALLOW_AUTODIFF_OPENAD_AMPI
111  # ifdef ALLOW_USE_MPI  # ifdef ALLOW_USE_MPI
       DO bj=myByLo(myThid),myByHi(myThid)  
        DO bi=myBxLo(myThid),myBxHi(myThid)  
   
112  #  ifndef ALWAYS_USE_MPI  #  ifndef ALWAYS_USE_MPI
113           IF ( usingMPI ) THEN        IF ( usingMPI ) THEN
114  #  endif  #  endif
115            CALL ampi_awaitall (        _BEGIN_MASTER(myThid)
116       & exchNReqsX(1,bi,bj) ,         DO bj=1,nSy
117       & exchReqIdX(1,1,bi,bj) ,          DO bi=1,nSx
118       & mpiStatus ,            CALL ampi_awaitall (
119       & mpiRC )       &         exchNReqsX(1,bi,bj) ,
120         &         exchReqIdX(1,1,bi,bj) ,
121         &         mpiStatus ,
122         &         mpiRC )
123            ENDDO
124           ENDDO
125          _END_MASTER(myThid)
126  #  ifndef ALWAYS_USE_MPI  #  ifndef ALWAYS_USE_MPI
127           ENDIF        ENDIF
128  #  endif  #  endif
        ENDDO  
       ENDDO  
129  # endif  # endif
130  #endif  #endif
131    
132    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133    
134    C     Prevent anyone to access shared buffer while an other thread modifies it
135          _BARRIER
136    
137    C     Fill shared buffers from array values
138        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
139         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
140    
141          ebL = exchangeBufLevel(1,bi,bj)          eBl = exchangeBufLevel(1,bi,bj)
142          westCommMode  = _tileCommModeW(bi,bj)          westCommMode = _tileCommModeW(bi,bj)
143          eastCommMode  = _tileCommModeE(bi,bj)          eastCommMode = _tileCommModeE(bi,bj)
144          biE =  _tileBiE(bi,bj)          biE = _tileBiE(bi,bj)
145          bjE =  _tileBjE(bi,bj)          bjE = _tileBjE(bi,bj)
146          biW =  _tileBiW(bi,bj)          biW = _tileBiW(bi,bj)
147          bjW =  _tileBjW(bi,bj)          bjW = _tileBjW(bi,bj)
148    
149    C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
150    
151  C       o Send or Put west edge          IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
152    
153          IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN  C       o Send or Put west edge
154           iMin = 1           iMin = 1
155           iMax = 1+exchWidthX-1           iMax = 1+exchWidthX-1
156          IF ( westCommMode .EQ. COMM_MSG  ) THEN           IF ( westCommMode .EQ. COMM_MSG  ) THEN
157           iB = 0            iB = 0
158           DO K=1,myNz            DO k=1,myNz
159            DO J=1,sNy             DO j=1,sNy
160             DO I=iMin,iMax              DO i=iMin,iMax
161              iB = iB + 1               iB = iB + 1
162              westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
163                ENDDO
164             ENDDO             ENDDO
165            ENDDO            ENDDO
166           ENDDO           ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
167  C        Send the data            iB  = 0
168  #ifdef ALLOW_USE_MPI            DO k=1,myNz
169  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
170           IF ( usingMPI ) THEN              DO i=iMin,iMax
171  #endif               iB = iB + 1
172           theProc = tilePidW(bi,bj)               eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
173           theTag  = _tileTagSendW(bi,bj)              ENDDO
          theSize = iB  
          theType = _MPI_TYPE_RX  
 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  
          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_AMPI */  
 #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)  
174             ENDDO             ENDDO
175            ENDDO            ENDDO
176           ENDDO           ELSEIF ( westCommMode .NE. COMM_NONE
177          ELSEIF ( westCommMode .NE. COMM_NONE       &    .AND.   westCommMode .NE. COMM_GET ) THEN
178       &   .AND.   westCommMode .NE. COMM_GET ) THEN            STOP ' S/R EXCH: Invalid commW mode.'
179           STOP ' S/R EXCH: Invalid commW mode.'           ENDIF
         ENDIF  
180    
181  C       o Send or Put east edge  C       o Send or Put east edge
182           iMin = sNx-exchWidthX+1           iMin = sNx-exchWidthX+1
183           iMax = sNx           iMax = sNx
184          IF ( eastCommMode .EQ. COMM_MSG  ) THEN           IF ( eastCommMode .EQ. COMM_MSG  ) THEN
185           iB = 0            iB = 0
186           DO K=1,myNz            DO k=1,myNz
187            DO J=1,sNy             DO j=1,sNy
188             DO I=iMin,iMax              DO i=iMin,iMax
189              iB = iB + 1               iB = iB + 1
190              eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
191                ENDDO
192             ENDDO             ENDDO
193            ENDDO            ENDDO
194           ENDDO           ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
195  C        Send the data            iB  = 0
196  #ifdef ALLOW_USE_MPI            DO k=1,myNz
197  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
198           IF ( usingMPI ) THEN              DO i=iMin,iMax
199  #endif               iB = iB + 1
200           theProc = tilePidE(bi,bj)               westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
201           theTag  = _tileTagSendE(bi,bj)              ENDDO
          theSize = iB  
          theType = _MPI_TYPE_RX  
 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI  
          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_AMPI */  
 #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)  
202             ENDDO             ENDDO
203            ENDDO            ENDDO
204           ENDDO           ELSEIF ( eastCommMode .NE. COMM_NONE
205          ELSEIF ( eastCommMode .NE. COMM_NONE       &    .AND.   eastCommMode .NE. COMM_GET  ) THEN
206       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN            STOP ' S/R EXCH: Invalid commE mode.'
207           STOP ' S/R EXCH: Invalid commE mode.'           ENDIF
         ENDIF  
208    
209  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
 c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  
 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
210          ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN          ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
211    
212    C       o Send or Put west edge
213           iMin = 1-exchWidthX           iMin = 1-exchWidthX
214           iMax = 0           iMax = 0
215          IF ( westCommMode .EQ. COMM_MSG  ) THEN           IF ( westCommMode .EQ. COMM_MSG  ) THEN
216           iB = 0            iB = 0
217           DO K=1,myNz            DO k=1,myNz
218            DO J=1,sNy             DO j=1,sNy
219             DO I=iMin,iMax              DO i=iMin,iMax
220              iB = iB + 1               iB = iB + 1
221              westSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               westSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
222              array(I,J,K,bi,bj) = 0.0               array(i,j,k,bi,bj) = 0.0
223                ENDDO
224             ENDDO             ENDDO
225            ENDDO            ENDDO
226           ENDDO           ELSEIF ( westCommMode .EQ. COMM_PUT  ) THEN
227  C        Send the data            iB  = 0
228  #ifdef ALLOW_USE_MPI            DO k=1,myNz
229  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
230           IF ( usingMPI ) THEN              DO i=iMin,iMax
231  #endif               iB = iB + 1
232           theProc = tilePidW(bi,bj)               eastRecvBuf_RX(iB,eBl,biW,bjW) = array(i,j,k,bi,bj)
233           theTag  = _tileTagSendW(bi,bj)               array(i,j,k,bi,bj) = 0.0
234           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  
235             ENDDO             ENDDO
236            ENDDO            ENDDO
237           ENDDO           ELSEIF ( westCommMode .NE. COMM_NONE
238          ELSEIF ( westCommMode .NE. COMM_NONE       &    .AND.   westCommMode .NE. COMM_GET ) THEN
239       &   .AND.   westCommMode .NE. COMM_GET ) THEN            STOP ' S/R EXCH: Invalid commW mode.'
240           STOP ' S/R EXCH: Invalid commW mode.'           ENDIF
         ENDIF  
241    
242  C       o Send or Put east edge  C       o Send or Put east edge
243           iMin = sNx+1           iMin = sNx+1
244           iMax = sNx+exchWidthX           iMax = sNx+exchWidthX
245          IF ( eastCommMode .EQ. COMM_MSG  ) THEN           IF ( eastCommMode .EQ. COMM_MSG  ) THEN
246           iB = 0            iB = 0
247           DO K=1,myNz            DO k=1,myNz
248            DO J=1,sNy             DO j=1,sNy
249             DO I=iMin,iMax              DO i=iMin,iMax
250              iB = iB + 1               iB = iB + 1
251              eastSendBuf_RX(iB,eBl,bi,bj) = array(I,J,K,bi,bj)               eastSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
252              array(I,J,K,bi,bj) = 0.0               array(i,j,k,bi,bj) = 0.0
253                ENDDO
254             ENDDO             ENDDO
255            ENDDO            ENDDO
256           ENDDO           ELSEIF ( eastCommMode .EQ. COMM_PUT  ) THEN
257  C        Send the data            iB  = 0
258  #ifdef ALLOW_USE_MPI            DO k=1,myNz
259  #ifndef ALWAYS_USE_MPI             DO j=1,sNy
260           IF ( usingMPI ) THEN              DO i=iMin,iMax
261  #endif               iB = iB + 1
262           theProc = tilePidE(bi,bj)               westRecvBuf_RX(iB,eBl,biE,bjE) = array(i,j,k,bi,bj)
263           theTag  = _tileTagSendE(bi,bj)               array(i,j,k,bi,bj) = 0.0
264           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  
265             ENDDO             ENDDO
266            ENDDO            ENDDO
267           ENDDO           ELSEIF ( eastCommMode .NE. COMM_NONE
268          ELSEIF ( eastCommMode .NE. COMM_NONE       &    .AND.   eastCommMode .NE. COMM_GET  ) THEN
269       &   .AND.   eastCommMode .NE. COMM_GET  ) THEN            STOP ' S/R EXCH: Invalid commE mode.'
270           STOP ' S/R EXCH: Invalid commE mode.'           ENDIF
         ENDIF  
271    
272          ENDIF          ENDIF
273    
274         ENDDO         ENDDO
275        ENDDO        ENDDO
276    
277    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
278  C--   Signal completetion ( making sure system-wide memory state is  C--   Signal completetion ( making sure system-wide memory state is
279  C--                         consistent ).  C--                         consistent ).
280    
# Line 424  C     overlap region data that will be e Line 286  C     overlap region data that will be e
286    
287        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
288         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
289          ebL = exchangeBufLevel(1,bi,bj)          eBl = exchangeBufLevel(1,bi,bj)
290          biE = _tileBiE(bi,bj)          biE = _tileBiE(bi,bj)
291          bjE = _tileBjE(bi,bj)          bjE = _tileBjE(bi,bj)
292          biW = _tileBiW(bi,bj)          biW = _tileBiW(bi,bj)
# Line 444  C     sure that processes that might spi Line 306  C     sure that processes that might spi
306  C     will see the setting.  C     will see the setting.
307  C     ** NOTE ** On some machines we wont spin on the Ack setting  C     ** NOTE ** On some machines we wont spin on the Ack setting
308  C     ( particularly the T90 ), instead we will use s system barrier.  C     ( particularly the T90 ), instead we will use s system barrier.
309  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
310  C     thread while it waits. On most machines the system barrier  C     thread while it waits. On most machines the system barrier
311  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
312  C     per process preemption is not a problem.  C     per process preemption is not a problem.
313        IF ( exchNeedsMemSync  ) CALL MEMSYNC        IF ( exchNeedsMemSync  ) CALL MEMSYNC
314    
315    C     Wait until all threads finish filling buffer
316        _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  
317    
318        RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
319    
320    #ifdef ALLOW_USE_MPI
321    #ifndef ALWAYS_USE_MPI
322          IF ( usingMPI ) THEN
323    #endif
324    C--   Send buffer data: Only Master Thread do proc communication
325          _BEGIN_MASTER(myThid)
326    
327          DO bj=1,nSy
328           DO bi=1,nSx
329    
330            eBl = exchangeBufLevel(1,bi,bj)
331            westCommMode = _tileCommModeW(bi,bj)
332            eastCommMode = _tileCommModeE(bi,bj)
333            biE = _tileBiE(bi,bj)
334            bjE = _tileBjE(bi,bj)
335            biW = _tileBiW(bi,bj)
336            bjW = _tileBjW(bi,bj)
337            theType = _MPI_TYPE_RX
338            theSize = sNy*exchWidthX*myNz
339    
340            IF ( westCommMode .EQ. COMM_MSG  ) THEN
341    C       Send buffer data (copied from west edge)
342             theProc = tilePidW(bi,bj)
343             theTag  = _tileTagSendW(bi,bj)
344    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
345             exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
346             CALL MPI_Isend( westSendBuf_RX(1,eBl,bi,bj), theSize,
347         &                   theType, theProc, theTag, MPI_COMM_MODEL,
348         &                   exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
349         &                   mpiRc )
350    # else
351             pReqI=exchNReqsX(1,bi,bj)+1
352             CALL ampi_isend_RX(
353         &        westSendBuf_RX(1,eBl,bi,bj),
354         &        theSize,
355         &        theType,
356         &        theProc,
357         &        theTag,
358         &        MPI_COMM_MODEL,
359         &        exchReqIdX(pReqI,1,bi,bj),
360         &        exchNReqsX(1,bi,bj),
361         &        mpiStatus ,
362         &        mpiRc )
363    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
364    c        eastRecvAck(eBl,biW,bjW) = 1
365            ENDIF
366    
367            IF ( eastCommMode .EQ. COMM_MSG  ) THEN
368    C       Send buffer data (copied from east edge)
369             theProc = tilePidE(bi,bj)
370             theTag  = _tileTagSendE(bi,bj)
371    # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
372             exchNReqsX(1,bi,bj) = exchNReqsX(1,bi,bj)+1
373             CALL MPI_Isend( eastSendBuf_RX(1,eBl,bi,bj), theSize,
374         &                   theType, theProc, theTag, MPI_COMM_MODEL,
375         &                   exchReqIdX(exchNReqsX(1,bi,bj),1,bi,bj),
376         &                   mpiRc )
377    # else
378             pReqI=exchNReqsX(1,bi,bj)+1
379             CALL ampi_isend_RX(
380         &        eastSendBuf_RX(1,eBl,bi,bj) ,
381         &        theSize ,
382         &        theType ,
383         &        theProc ,
384         &        theTag ,
385         &        MPI_COMM_MODEL ,
386         &        exchReqIdX(pReqI,1,bi,bj) ,
387         &        exchNReqsX(1,bi,bj),
388         &        mpiStatus ,
389         &        mpiRc )
390    # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
391    c        westRecvAck(eBl,biE,bjE) = 1
392            ENDIF
393    
394           ENDDO
395          ENDDO
396    
397          _END_MASTER(myThid)
398    
399    #ifndef ALWAYS_USE_MPI
400          ENDIF
401    #endif
402    #endif /* ALLOW_USE_MPI */
403    
404    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
405          RETURN
406        END        END
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22