eesupp/src/exch_rx_recv_get_x.template

C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_x.template,v 1.14 2010/05/17 02:28:06 jmc Exp $
C $Name:  $
#include "CPP_EEOPTIONS.h"
#undef EXCH_USE_SPINNING

CBOP
C     !ROUTINE: EXCH_RX_RECV_GET_X

C     !INTERFACE:
      SUBROUTINE EXCH_RX_RECV_GET_X( array,
     I            myOLw, myOLe, myOLs, myOLn, myNz,
     I            exchWidthX, exchWidthY,
     I            theSimulationMode, theCornerMode, myThid )
      IMPLICIT NONE

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE RECV_RX_GET_X
C     | o "Send" or "put" X edges for RX array.
C     *==========================================================*
C     | Routine that invokes actual message passing send or
C     | direct "put" of data to update X faces of an XY[R] array.
C     *==========================================================*

C     !USES:
C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "EXCH.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     array :: Array with edges to exchange.
C     myOLw :: West, East, North and South overlap region sizes.
C     myOLe
C     myOLn
C     myOLs
C     exchWidthX :: Width of data region exchanged.
C     exchWidthY
C     theSimulationMode :: Forward or reverse mode exchange ( provides
C                         support for adjoint integration of code. )
C     theCornerMode     :: Flag indicating whether corner updates are
C                         needed.
C     myThid            :: Thread number of this instance of S/R EXCH...
C     eBl               :: Edge buffer level
      INTEGER myOLw
      INTEGER myOLe
      INTEGER myOLs
      INTEGER myOLn
      INTEGER myNz
      _RX array(1-myOLw:sNx+myOLe,
     &          1-myOLs:sNy+myOLn,
     &          myNZ, nSx, nSy)
      INTEGER exchWidthX
      INTEGER exchWidthY
      INTEGER theSimulationMode
      INTEGER theCornerMode
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i, j, k, iMin, iMax, iB    :: Loop counters and extents
C     bi, bj
C     biW, bjW                   :: West tile indices
C     biE, bjE                   :: East tile indices
C     eBl                        :: Current exchange buffer level
C     theProc, theTag, theType,  :: Variables used in message building
C     theSize
C     westCommMode               :: Working variables holding type
C     eastCommMode                  of communication a particular
C                                   tile face uses.
      INTEGER i, j, k, iMin, iMax, iB, iB0
      INTEGER bi, bj, biW, bjW, biE, bjE
      INTEGER eBl
      INTEGER westCommMode
      INTEGER eastCommMode
#ifdef EXCH_USE_SPINNING
      INTEGER spinCount
#endif
#ifdef ALLOW_USE_MPI
      INTEGER theProc, theTag, theType, theSize, pReqI
      INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
#endif
CEOP

C--   Under a "put" scenario we
C--     i. set completetion signal for buffer we put into.
C--    ii. wait for completetion signal indicating data has been put in
C--        our buffer.
C--   Under a messaging mode we "receive" the message.
C--   Under a "get" scenario we
C--     i. Check that the data is ready.
C--    ii. Read the data.
C--   iii. Set data read flag + memory sync.

#ifdef ALLOW_USE_MPI
#ifndef ALWAYS_USE_MPI
      IF ( usingMPI ) THEN
#endif
C--   Receive buffer data: Only Master Thread do proc communication
      _BEGIN_MASTER(myThid)

      DO bj=1,nSy
       DO bi=1,nSx
        eBl = exchangeBufLevel(1,bi,bj)
        westCommMode = _tileCommModeW(bi,bj)
        eastCommMode = _tileCommModeE(bi,bj)
        biE = _tileBiE(bi,bj)
        bjE = _tileBjE(bi,bj)
        biW = _tileBiW(bi,bj)
        bjW = _tileBjW(bi,bj)
        theType = _MPI_TYPE_RX
        theSize = sNy*exchWidthX*myNz

        IF ( westCommMode .EQ. COMM_MSG ) THEN
         theProc = tilePidW(bi,bj)
         theTag  = _tileTagRecvW(bi,bj)
# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
         CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize,
     &                  theType, theProc, theTag, MPI_COMM_MODEL,
     &                  mpiStatus, mpiRc )
# else
         pReqI=exchNReqsX(1,bi,bj)+1
         CALL ampi_recv_RX(
     &        westRecvBuf_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 */
         westRecvAck(eBl,bi,bj) = 1
        ENDIF

        IF ( eastCommMode .EQ. COMM_MSG ) THEN
         theProc = tilePidE(bi,bj)
         theTag  = _tileTagRecvE(bi,bj)
# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
         CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize,
     &                  theType, theProc, theTag, MPI_COMM_MODEL,
     &                  mpiStatus, mpiRc )
# else
         pReqI=exchNReqsX(1,bi,bj)+1
         CALL ampi_recv_RX(
     &        eastRecvBuf_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 */
         eastRecvAck(eBl,bi,bj) = 1
        ENDIF
       ENDDO
      ENDDO

C--   Processes wait for buffers I am going to read to be ready.
      IF ( .NOT.exchUsesBarrier  ) THEN
       DO bj=1,nSy
        DO bi=1,nSx
         IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
          CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
     &                      mpiStatus, mpiRC )
# else
          CALL ampi_waitall(
     &         exchNReqsX(1,bi,bj),
     &         exchReqIdX(1,1,bi,bj),
     &         mpiStatus,
     &         mpiRC )
# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
         ENDIF
C        Clear outstanding requests counter
         exchNReqsX(1,bi,bj) = 0
        ENDDO
       ENDDO
      ENDIF

      _END_MASTER(myThid)
C--   need to sync threads after master has received data ;
C     (done after mpi waitall in case waitall is really needed)
      _BARRIER

#ifndef ALWAYS_USE_MPI
      ENDIF
#endif
#endif /* ALLOW_USE_MPI */
C--   Threads wait for buffers I am going to read to be ready.
C     note: added BARRIER in exch_send_put S/R and here above (message mode)
C           so that we no longer needs this (undef EXCH_USE_SPINNING)
#ifdef EXCH_USE_SPINNING
      IF ( exchUsesBarrier  ) THEN
C      o On some machines ( T90 ) use system barrier rather than spinning.
       CALL BARRIER( myThid )
      ELSE
C      o Spin waiting for completetion flag. This avoids a global-lock
C        i.e. we only lock waiting for data that we need.
       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)

         spinCount = 0
         eBl = exchangeBufLevel(1,bi,bj)
         westCommMode = _tileCommModeW(bi,bj)
         eastCommMode = _tileCommModeE(bi,bj)
# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
   10    CONTINUE
          CALL FOOL_THE_COMPILER( spinCount )
          spinCount = spinCount+1
C         IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
C          WRITE(*,*) ' eBl = ', ebl
C          STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
C         ENDIF
          IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
          IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
# else
         DO WHILE ((westRecvAck(eBl,bi,bj) .EQ. 0
     &             .OR.
     &              eastRecvAck(eBl,bi,bj) .EQ. 0 ))
          CALL FOOL_THE_COMPILER( spinCount )
          spinCount = spinCount+1
         ENDDO
# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
C        Clear outstanding requests
         westRecvAck(eBl,bi,bj) = 0
         eastRecvAck(eBl,bi,bj) = 0
C        Update statistics
         IF ( exchCollectStatistics ) THEN
          exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
          exchRecvXSpinCount(1,bi,bj) =
     &    exchRecvXSpinCount(1,bi,bj)+spinCount
          exchRecvXSpinMax(1,bi,bj) =
     &    MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
          exchRecvXSpinMin(1,bi,bj) =
     &    MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
         ENDIF

        ENDDO
       ENDDO
      ENDIF
#endif /* EXCH_USE_SPINNING */

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Read from the buffers
      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)

        eBl = exchangeBufLevel(1,bi,bj)
        biE = _tileBiE(bi,bj)
        bjE = _tileBjE(bi,bj)
        biW = _tileBiW(bi,bj)
        bjW = _tileBjW(bi,bj)
        westCommMode = _tileCommModeW(bi,bj)
        eastCommMode = _tileCommModeE(bi,bj)

        IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
         iMin = sNx+1
         iMax = sNx+exchWidthX
         iB0  = 0
         IF (     eastCommMode .EQ. COMM_PUT
     &       .OR. eastCommMode .EQ. COMM_MSG ) THEN
          iB  = 0
          DO k=1,myNz
           DO j=1,sNy
            DO i=iMin,iMax
             iB = iB + 1
             array(i,j,k,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
            ENDDO
           ENDDO
          ENDDO
         ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
          DO k=1,myNz
           DO j=1,sNy
            iB = iB0
            DO i=iMin,iMax
             iB = iB+1
             array(i,j,k,bi,bj) = array(iB,j,k,biE,bjE)
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
         iMin = sNx-exchWidthX+1
         iMax = sNx
         iB0  = 1-exchWidthX-1
         IF (     eastCommMode .EQ. COMM_PUT
     &       .OR. eastCommMode .EQ. COMM_MSG ) THEN
          iB  = 0
          DO k=1,myNz
           DO j=1,sNy
            DO i=iMin,iMax
             iB = iB + 1
             array(i,j,k,bi,bj) =
     &       array(i,j,k,bi,bj) + eastRecvBuf_RX(iB,eBl,bi,bj)
            ENDDO
           ENDDO
          ENDDO
         ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
          DO k=1,myNz
           DO j=1,sNy
            iB = iB0
            DO i=iMin,iMax
             iB = iB+1
             array(i,j,k,bi,bj) =
     &       array(i,j,k,bi,bj) + array(iB,j,k,biE,bjE)
             array(iB,j,k,biE,bjE) = 0.0
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ENDIF

        IF     ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
         iMin = 1-exchWidthX
         iMax = 0
         iB0  = sNx-exchWidthX
         IF (      westCommMode .EQ. COMM_PUT
     &        .OR. westCommMode .EQ. COMM_MSG ) THEN
          iB  = 0
          DO k=1,myNz
           DO j=1,sNy
            DO i=iMin,iMax
             iB = iB + 1
             array(i,j,k,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
            ENDDO
           ENDDO
          ENDDO
         ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
          DO k=1,myNz
           DO j=1,sNy
            iB = iB0
            DO i=iMin,iMax
             iB = iB+1
             array(i,j,k,bi,bj) = array(iB,j,k,biW,bjW)
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
         iMin = 1
         iMax = 1+exchWidthX-1
         iB0  = sNx
         IF (     westCommMode .EQ. COMM_PUT
     &       .OR. westCommMode .EQ. COMM_MSG ) THEN
          iB  = 0
          DO k=1,myNz
           DO j=1,sNy
            DO i=iMin,iMax
             iB = iB + 1
             array(i,j,k,bi,bj) =
     &       array(i,j,k,bi,bj) + westRecvBuf_RX(iB,eBl,bi,bj)
            ENDDO
           ENDDO
          ENDDO
         ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
          DO k=1,myNz
           DO j=1,sNy
            iB = iB0
            DO i=iMin,iMax
             iB = iB+1
             array(i,j,k,bi,bj) =
     &       array(i,j,k,bi,bj) + array(iB,j,k,biW,bjW)
             array(iB,j,k,biW,bjW) = 0.0
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ENDIF

       ENDDO
      ENDDO

      RETURN
      END
1	mlosch	1.15	C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_x.template,v 1.14 2010/05/17 02:28:06 jmc Exp $
2	cnh	1.2	C $Name: $
3	adcroft	1.1	#include "CPP_EEOPTIONS.h"
4	jmc	1.14	#undef EXCH_USE_SPINNING
5	adcroft	1.1
6	cnh	1.2	CBOP
7			C !ROUTINE: EXCH_RX_RECV_GET_X
8
9			C !INTERFACE:
10	adcroft	1.1	SUBROUTINE EXCH_RX_RECV_GET_X( array,
11			I myOLw, myOLe, myOLs, myOLn, myNz,
12			I exchWidthX, exchWidthY,
13			I theSimulationMode, theCornerMode, myThid )
14			IMPLICIT NONE
15
16	cnh	1.2	C !DESCRIPTION:
17			C ==========================================================
18	jmc	1.14	C \| SUBROUTINE RECV_RX_GET_X
19			C \| o "Send" or "put" X edges for RX array.
20	cnh	1.2	C ==========================================================
21	jmc	1.14	C \| Routine that invokes actual message passing send or
22			C \| direct "put" of data to update X faces of an XY[R] array.
23	cnh	1.2	C ==========================================================
24
25			C !USES:
26	adcroft	1.1	C == Global variables ==
27			#include "SIZE.h"
28			#include "EEPARAMS.h"
29			#include "EESUPPORT.h"
30			#include "EXCH.h"
31
32	cnh	1.2	C !INPUT/OUTPUT PARAMETERS:
33	adcroft	1.1	C == Routine arguments ==
34	cnh	1.2	C array :: Array with edges to exchange.
35			C myOLw :: West, East, North and South overlap region sizes.
36	adcroft	1.1	C myOLe
37			C myOLn
38			C myOLs
39	cnh	1.2	C exchWidthX :: Width of data region exchanged.
40	adcroft	1.1	C exchWidthY
41	cnh	1.2	C theSimulationMode :: Forward or reverse mode exchange ( provides
42	adcroft	1.1	C support for adjoint integration of code. )
43	cnh	1.2	C theCornerMode :: Flag indicating whether corner updates are
44	adcroft	1.1	C needed.
45	cnh	1.2	C myThid :: Thread number of this instance of S/R EXCH...
46			C eBl :: Edge buffer level
47	adcroft	1.1	INTEGER myOLw
48			INTEGER myOLe
49			INTEGER myOLs
50			INTEGER myOLn
51			INTEGER myNz
52			_RX array(1-myOLw:sNx+myOLe,
53			& 1-myOLs:sNy+myOLn,
54			& myNZ, nSx, nSy)
55			INTEGER exchWidthX
56			INTEGER exchWidthY
57			INTEGER theSimulationMode
58			INTEGER theCornerMode
59			INTEGER myThid
60
61	cnh	1.2	C !LOCAL VARIABLES:
62	adcroft	1.1	C == Local variables ==
63	jmc	1.14	C i, j, k, iMin, iMax, iB :: Loop counters and extents
64	adcroft	1.1	C bi, bj
65	cnh	1.2	C biW, bjW :: West tile indices
66			C biE, bjE :: East tile indices
67			C eBl :: Current exchange buffer level
68			C theProc, theTag, theType, :: Variables used in message building
69	adcroft	1.1	C theSize
70	cnh	1.2	C westCommMode :: Working variables holding type
71			C eastCommMode of communication a particular
72			C tile face uses.
73	jmc	1.14	INTEGER i, j, k, iMin, iMax, iB, iB0
74	adcroft	1.1	INTEGER bi, bj, biW, bjW, biE, bjE
75			INTEGER eBl
76			INTEGER westCommMode
77			INTEGER eastCommMode
78	jmc	1.14	#ifdef EXCH_USE_SPINNING
79	adcroft	1.1	INTEGER spinCount
80	jmc	1.14	#endif
81	adcroft	1.1	#ifdef ALLOW_USE_MPI
82	utke	1.11	INTEGER theProc, theTag, theType, theSize, pReqI
83	adcroft	1.1	INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
84			#endif
85	cnh	1.2	CEOP
86	adcroft	1.1
87	jmc	1.14	C-- Under a "put" scenario we
88	adcroft	1.1	C-- i. set completetion signal for buffer we put into.
89	jmc	1.14	C-- ii. wait for completetion signal indicating data has been put in
90	adcroft	1.1	C-- our buffer.
91			C-- Under a messaging mode we "receive" the message.
92			C-- Under a "get" scenario we
93			C-- i. Check that the data is ready.
94			C-- ii. Read the data.
95			C-- iii. Set data read flag + memory sync.
96
97			#ifdef ALLOW_USE_MPI
98			#ifndef ALWAYS_USE_MPI
99	jmc	1.14	IF ( usingMPI ) THEN
100	adcroft	1.1	#endif
101	jmc	1.14	C-- Receive buffer data: Only Master Thread do proc communication
102			_BEGIN_MASTER(myThid)
103
104			DO bj=1,nSy
105			DO bi=1,nSx
106			eBl = exchangeBufLevel(1,bi,bj)
107			westCommMode = _tileCommModeW(bi,bj)
108			eastCommMode = _tileCommModeE(bi,bj)
109			biE = _tileBiE(bi,bj)
110			bjE = _tileBjE(bi,bj)
111			biW = _tileBiW(bi,bj)
112			bjW = _tileBjW(bi,bj)
113			theType = _MPI_TYPE_RX
114			theSize = sNyexchWidthXmyNz
115
116			IF ( westCommMode .EQ. COMM_MSG ) THEN
117	adcroft	1.1	theProc = tilePidW(bi,bj)
118			theTag = _tileTagRecvW(bi,bj)
119	utke	1.12	# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
120	jmc	1.14	CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize,
121			& theType, theProc, theTag, MPI_COMM_MODEL,
122	adcroft	1.1	& mpiStatus, mpiRc )
123	utke	1.9	# else
124	jmc	1.13	pReqI=exchNReqsX(1,bi,bj)+1
125	jmc	1.14	CALL ampi_recv_RX(
126			& westRecvBuf_RX(1,eBl,bi,bj) ,
127			& theSize ,
128			& theType ,
129			& theProc ,
130			& theTag ,
131			& MPI_COMM_MODEL ,
132			& exchReqIdX(pReqI,1,bi,bj),
133			& exchNReqsX(1,bi,bj),
134			& mpiStatus ,
135			& mpiRc )
136	utke	1.12	# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
137	jmc	1.14	westRecvAck(eBl,bi,bj) = 1
138	adcroft	1.1	ENDIF
139	jmc	1.14
140	adcroft	1.1	IF ( eastCommMode .EQ. COMM_MSG ) THEN
141			theProc = tilePidE(bi,bj)
142			theTag = _tileTagRecvE(bi,bj)
143	utke	1.12	# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
144	jmc	1.14	CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize,
145			& theType, theProc, theTag, MPI_COMM_MODEL,
146	adcroft	1.1	& mpiStatus, mpiRc )
147	utke	1.9	# else
148	jmc	1.13	pReqI=exchNReqsX(1,bi,bj)+1
149	jmc	1.14	CALL ampi_recv_RX(
150			& eastRecvBuf_RX(1,eBl,bi,bj) ,
151			& theSize ,
152			& theType ,
153			& theProc ,
154			& theTag ,
155			& MPI_COMM_MODEL ,
156			& exchReqIdX(pReqI,1,bi,bj),
157			& exchNReqsX(1,bi,bj),
158			& mpiStatus ,
159			& mpiRc )
160	utke	1.12	# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
161	jmc	1.14	eastRecvAck(eBl,bi,bj) = 1
162	adcroft	1.1	ENDIF
163			ENDDO
164			ENDDO
165
166	jmc	1.14	C-- Processes wait for buffers I am going to read to be ready.
167			IF ( .NOT.exchUsesBarrier ) THEN
168			DO bj=1,nSy
169			DO bi=1,nSx
170			IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
171			# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
172			CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
173			& mpiStatus, mpiRC )
174			# else
175			CALL ampi_waitall(
176			& exchNReqsX(1,bi,bj),
177			& exchReqIdX(1,1,bi,bj),
178			& mpiStatus,
179			& mpiRC )
180			# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
181			ENDIF
182			C Clear outstanding requests counter
183			exchNReqsX(1,bi,bj) = 0
184			ENDDO
185			ENDDO
186			ENDIF
187
188			_END_MASTER(myThid)
189			C-- need to sync threads after master has received data ;
190			C (done after mpi waitall in case waitall is really needed)
191			_BARRIER
192
193			#ifndef ALWAYS_USE_MPI
194			ENDIF
195			#endif
196			#endif /* ALLOW_USE_MPI */
197			C-- Threads wait for buffers I am going to read to be ready.
198			C note: added BARRIER in exch_send_put S/R and here above (message mode)
199			C so that we no longer needs this (undef EXCH_USE_SPINNING)
200			#ifdef EXCH_USE_SPINNING
201	adcroft	1.1	IF ( exchUsesBarrier ) THEN
202			C o On some machines ( T90 ) use system barrier rather than spinning.
203			CALL BARRIER( myThid )
204			ELSE
205			C o Spin waiting for completetion flag. This avoids a global-lock
206			C i.e. we only lock waiting for data that we need.
207			DO bj=myByLo(myThid),myByHi(myThid)
208			DO bi=myBxLo(myThid),myBxHi(myThid)
209	jmc	1.14
210	adcroft	1.1	spinCount = 0
211	jmc	1.14	eBl = exchangeBufLevel(1,bi,bj)
212	adcroft	1.1	westCommMode = _tileCommModeW(bi,bj)
213			eastCommMode = _tileCommModeE(bi,bj)
214	utke	1.12	# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
215	adcroft	1.1	10 CONTINUE
216	jmc	1.4	CALL FOOL_THE_COMPILER( spinCount )
217	adcroft	1.1	spinCount = spinCount+1
218			C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
219			C WRITE(,) ' eBl = ', ebl
220			C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
221			C ENDIF
222	jmc	1.8	IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
223			IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
224	jmc	1.14	# else
225			DO WHILE ((westRecvAck(eBl,bi,bj) .EQ. 0
226			& .OR.
227			& eastRecvAck(eBl,bi,bj) .EQ. 0 ))
228	utke	1.9	CALL FOOL_THE_COMPILER( spinCount )
229			spinCount = spinCount+1
230	jmc	1.14	ENDDO
231	utke	1.12	# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
232	adcroft	1.1	C Clear outstanding requests
233	jmc	1.8	westRecvAck(eBl,bi,bj) = 0
234			eastRecvAck(eBl,bi,bj) = 0
235	adcroft	1.1	C Update statistics
236			IF ( exchCollectStatistics ) THEN
237			exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
238	jmc	1.14	exchRecvXSpinCount(1,bi,bj) =
239	adcroft	1.1	& exchRecvXSpinCount(1,bi,bj)+spinCount
240	jmc	1.14	exchRecvXSpinMax(1,bi,bj) =
241	adcroft	1.1	& MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
242	jmc	1.14	exchRecvXSpinMin(1,bi,bj) =
243	adcroft	1.1	& MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
244			ENDIF
245	jmc	1.14
246	adcroft	1.1	ENDDO
247			ENDDO
248			ENDIF
249	jmc	1.14	#endif /* EXCH_USE_SPINNING */
250
251			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
252	adcroft	1.1
253			C-- Read from the buffers
254			DO bj=myByLo(myThid),myByHi(myThid)
255			DO bi=myBxLo(myThid),myBxHi(myThid)
256
257	jmc	1.14	eBl = exchangeBufLevel(1,bi,bj)
258			biE = _tileBiE(bi,bj)
259			bjE = _tileBjE(bi,bj)
260			biW = _tileBiW(bi,bj)
261			bjW = _tileBjW(bi,bj)
262	adcroft	1.1	westCommMode = _tileCommModeW(bi,bj)
263			eastCommMode = _tileCommModeE(bi,bj)
264	jmc	1.14
265	adcroft	1.1	IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
266			iMin = sNx+1
267			iMax = sNx+exchWidthX
268			iB0 = 0
269			IF ( eastCommMode .EQ. COMM_PUT
270			& .OR. eastCommMode .EQ. COMM_MSG ) THEN
271			iB = 0
272	jmc	1.14	DO k=1,myNz
273			DO j=1,sNy
274			DO i=iMin,iMax
275	adcroft	1.1	iB = iB + 1
276	jmc	1.14	array(i,j,k,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
277	adcroft	1.1	ENDDO
278			ENDDO
279			ENDDO
280			ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
281	jmc	1.14	DO k=1,myNz
282			DO j=1,sNy
283	adcroft	1.1	iB = iB0
284	jmc	1.14	DO i=iMin,iMax
285	adcroft	1.1	iB = iB+1
286	jmc	1.14	array(i,j,k,bi,bj) = array(iB,j,k,biE,bjE)
287	adcroft	1.1	ENDDO
288			ENDDO
289			ENDDO
290			ENDIF
291			ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
292			iMin = sNx-exchWidthX+1
293			iMax = sNx
294			iB0 = 1-exchWidthX-1
295	jmc	1.14	IF ( eastCommMode .EQ. COMM_PUT
296	adcroft	1.1	& .OR. eastCommMode .EQ. COMM_MSG ) THEN
297			iB = 0
298	jmc	1.14	DO k=1,myNz
299			DO j=1,sNy
300			DO i=iMin,iMax
301	adcroft	1.1	iB = iB + 1
302	jmc	1.14	array(i,j,k,bi,bj) =
303			& array(i,j,k,bi,bj) + eastRecvBuf_RX(iB,eBl,bi,bj)
304	adcroft	1.1	ENDDO
305			ENDDO
306			ENDDO
307			ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
308	jmc	1.14	DO k=1,myNz
309			DO j=1,sNy
310	adcroft	1.1	iB = iB0
311	jmc	1.14	DO i=iMin,iMax
312	adcroft	1.1	iB = iB+1
313	jmc	1.14	array(i,j,k,bi,bj) =
314			& array(i,j,k,bi,bj) + array(iB,j,k,biE,bjE)
315			array(iB,j,k,biE,bjE) = 0.0
316	adcroft	1.1	ENDDO
317			ENDDO
318			ENDDO
319			ENDIF
320			ENDIF
321	jmc	1.14
322	adcroft	1.1	IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
323			iMin = 1-exchWidthX
324			iMax = 0
325			iB0 = sNx-exchWidthX
326			IF ( westCommMode .EQ. COMM_PUT
327			& .OR. westCommMode .EQ. COMM_MSG ) THEN
328			iB = 0
329	jmc	1.14	DO k=1,myNz
330			DO j=1,sNy
331			DO i=iMin,iMax
332	adcroft	1.1	iB = iB + 1
333	jmc	1.14	array(i,j,k,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
334	adcroft	1.1	ENDDO
335			ENDDO
336			ENDDO
337			ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
338	jmc	1.14	DO k=1,myNz
339			DO j=1,sNy
340	adcroft	1.1	iB = iB0
341	jmc	1.14	DO i=iMin,iMax
342	adcroft	1.1	iB = iB+1
343	jmc	1.14	array(i,j,k,bi,bj) = array(iB,j,k,biW,bjW)
344	adcroft	1.1	ENDDO
345			ENDDO
346			ENDDO
347			ENDIF
348			ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
349			iMin = 1
350			iMax = 1+exchWidthX-1
351			iB0 = sNx
352	jmc	1.14	IF ( westCommMode .EQ. COMM_PUT
353			& .OR. westCommMode .EQ. COMM_MSG ) THEN
354	adcroft	1.1	iB = 0
355	jmc	1.14	DO k=1,myNz
356			DO j=1,sNy
357			DO i=iMin,iMax
358	adcroft	1.1	iB = iB + 1
359	jmc	1.14	array(i,j,k,bi,bj) =
360			& array(i,j,k,bi,bj) + westRecvBuf_RX(iB,eBl,bi,bj)
361	adcroft	1.1	ENDDO
362			ENDDO
363			ENDDO
364			ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
365	jmc	1.14	DO k=1,myNz
366			DO j=1,sNy
367	adcroft	1.1	iB = iB0
368	jmc	1.14	DO i=iMin,iMax
369	adcroft	1.1	iB = iB+1
370	jmc	1.14	array(i,j,k,bi,bj) =
371			& array(i,j,k,bi,bj) + array(iB,j,k,biW,bjW)
372			array(iB,j,k,biW,bjW) = 0.0
373	adcroft	1.1	ENDDO
374			ENDDO
375			ENDDO
376			ENDIF
377			ENDIF
378
379			ENDDO
380			ENDDO
381
382			RETURN
383			END