eesupp/src/exch_rx_recv_get_x.template

C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_x.template,v 1.13 2009/01/09 22:51:12 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	jmc	1.14	C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_rx_recv_get_x.template,v 1.13 2009/01/09 22:51:12 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			#
198			C-- Threads wait for buffers I am going to read to be ready.
199			C note: added BARRIER in exch_send_put S/R and here above (message mode)
200			C so that we no longer needs this (undef EXCH_USE_SPINNING)
201			#ifdef EXCH_USE_SPINNING
202	adcroft	1.1	IF ( exchUsesBarrier ) THEN
203			C o On some machines ( T90 ) use system barrier rather than spinning.
204			CALL BARRIER( myThid )
205			ELSE
206			C o Spin waiting for completetion flag. This avoids a global-lock
207			C i.e. we only lock waiting for data that we need.
208			DO bj=myByLo(myThid),myByHi(myThid)
209			DO bi=myBxLo(myThid),myBxHi(myThid)
210	jmc	1.14
211	adcroft	1.1	spinCount = 0
212	jmc	1.14	eBl = exchangeBufLevel(1,bi,bj)
213	adcroft	1.1	westCommMode = _tileCommModeW(bi,bj)
214			eastCommMode = _tileCommModeE(bi,bj)
215	utke	1.12	# ifndef ALLOW_AUTODIFF_OPENAD_AMPI
216	adcroft	1.1	10 CONTINUE
217	jmc	1.4	CALL FOOL_THE_COMPILER( spinCount )
218	adcroft	1.1	spinCount = spinCount+1
219			C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
220			C WRITE(,) ' eBl = ', ebl
221			C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
222			C ENDIF
223	jmc	1.8	IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
224			IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
225	jmc	1.14	# else
226			DO WHILE ((westRecvAck(eBl,bi,bj) .EQ. 0
227			& .OR.
228			& eastRecvAck(eBl,bi,bj) .EQ. 0 ))
229	utke	1.9	CALL FOOL_THE_COMPILER( spinCount )
230			spinCount = spinCount+1
231	jmc	1.14	ENDDO
232	utke	1.12	# endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
233	adcroft	1.1	C Clear outstanding requests
234	jmc	1.8	westRecvAck(eBl,bi,bj) = 0
235			eastRecvAck(eBl,bi,bj) = 0
236	adcroft	1.1	C Update statistics
237			IF ( exchCollectStatistics ) THEN
238			exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
239	jmc	1.14	exchRecvXSpinCount(1,bi,bj) =
240	adcroft	1.1	& exchRecvXSpinCount(1,bi,bj)+spinCount
241	jmc	1.14	exchRecvXSpinMax(1,bi,bj) =
242	adcroft	1.1	& MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
243	jmc	1.14	exchRecvXSpinMin(1,bi,bj) =
244	adcroft	1.1	& MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
245			ENDIF
246	jmc	1.14
247	adcroft	1.1	ENDDO
248			ENDDO
249			ENDIF
250	jmc	1.14	#endif /* EXCH_USE_SPINNING */
251
252			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
253	adcroft	1.1
254			C-- Read from the buffers
255			DO bj=myByLo(myThid),myByHi(myThid)
256			DO bi=myBxLo(myThid),myBxHi(myThid)
257
258	jmc	1.14	eBl = exchangeBufLevel(1,bi,bj)
259			biE = _tileBiE(bi,bj)
260			bjE = _tileBjE(bi,bj)
261			biW = _tileBiW(bi,bj)
262			bjW = _tileBjW(bi,bj)
263	adcroft	1.1	westCommMode = _tileCommModeW(bi,bj)
264			eastCommMode = _tileCommModeE(bi,bj)
265	jmc	1.14
266	adcroft	1.1	IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
267			iMin = sNx+1
268			iMax = sNx+exchWidthX
269			iB0 = 0
270			IF ( eastCommMode .EQ. COMM_PUT
271			& .OR. eastCommMode .EQ. COMM_MSG ) THEN
272			iB = 0
273	jmc	1.14	DO k=1,myNz
274			DO j=1,sNy
275			DO i=iMin,iMax
276	adcroft	1.1	iB = iB + 1
277	jmc	1.14	array(i,j,k,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
278	adcroft	1.1	ENDDO
279			ENDDO
280			ENDDO
281			ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
282	jmc	1.14	DO k=1,myNz
283			DO j=1,sNy
284	adcroft	1.1	iB = iB0
285	jmc	1.14	DO i=iMin,iMax
286	adcroft	1.1	iB = iB+1
287	jmc	1.14	array(i,j,k,bi,bj) = array(iB,j,k,biE,bjE)
288	adcroft	1.1	ENDDO
289			ENDDO
290			ENDDO
291			ENDIF
292			ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
293			iMin = sNx-exchWidthX+1
294			iMax = sNx
295			iB0 = 1-exchWidthX-1
296	jmc	1.14	IF ( eastCommMode .EQ. COMM_PUT
297	adcroft	1.1	& .OR. eastCommMode .EQ. COMM_MSG ) THEN
298			iB = 0
299	jmc	1.14	DO k=1,myNz
300			DO j=1,sNy
301			DO i=iMin,iMax
302	adcroft	1.1	iB = iB + 1
303	jmc	1.14	array(i,j,k,bi,bj) =
304			& array(i,j,k,bi,bj) + eastRecvBuf_RX(iB,eBl,bi,bj)
305	adcroft	1.1	ENDDO
306			ENDDO
307			ENDDO
308			ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
309	jmc	1.14	DO k=1,myNz
310			DO j=1,sNy
311	adcroft	1.1	iB = iB0
312	jmc	1.14	DO i=iMin,iMax
313	adcroft	1.1	iB = iB+1
314	jmc	1.14	array(i,j,k,bi,bj) =
315			& array(i,j,k,bi,bj) + array(iB,j,k,biE,bjE)
316			array(iB,j,k,biE,bjE) = 0.0
317	adcroft	1.1	ENDDO
318			ENDDO
319			ENDDO
320			ENDIF
321			ENDIF
322	jmc	1.14
323	adcroft	1.1	IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
324			iMin = 1-exchWidthX
325			iMax = 0
326			iB0 = sNx-exchWidthX
327			IF ( westCommMode .EQ. COMM_PUT
328			& .OR. westCommMode .EQ. COMM_MSG ) THEN
329			iB = 0
330	jmc	1.14	DO k=1,myNz
331			DO j=1,sNy
332			DO i=iMin,iMax
333	adcroft	1.1	iB = iB + 1
334	jmc	1.14	array(i,j,k,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
335	adcroft	1.1	ENDDO
336			ENDDO
337			ENDDO
338			ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
339	jmc	1.14	DO k=1,myNz
340			DO j=1,sNy
341	adcroft	1.1	iB = iB0
342	jmc	1.14	DO i=iMin,iMax
343	adcroft	1.1	iB = iB+1
344	jmc	1.14	array(i,j,k,bi,bj) = array(iB,j,k,biW,bjW)
345	adcroft	1.1	ENDDO
346			ENDDO
347			ENDDO
348			ENDIF
349			ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
350			iMin = 1
351			iMax = 1+exchWidthX-1
352			iB0 = sNx
353	jmc	1.14	IF ( westCommMode .EQ. COMM_PUT
354			& .OR. westCommMode .EQ. COMM_MSG ) THEN
355	adcroft	1.1	iB = 0
356	jmc	1.14	DO k=1,myNz
357			DO j=1,sNy
358			DO i=iMin,iMax
359	adcroft	1.1	iB = iB + 1
360	jmc	1.14	array(i,j,k,bi,bj) =
361			& array(i,j,k,bi,bj) + westRecvBuf_RX(iB,eBl,bi,bj)
362	adcroft	1.1	ENDDO
363			ENDDO
364			ENDDO
365			ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
366	jmc	1.14	DO k=1,myNz
367			DO j=1,sNy
368	adcroft	1.1	iB = iB0
369	jmc	1.14	DO i=iMin,iMax
370	adcroft	1.1	iB = iB+1
371	jmc	1.14	array(i,j,k,bi,bj) =
372			& array(i,j,k,bi,bj) + array(iB,j,k,biW,bjW)
373			array(iB,j,k,biW,bjW) = 0.0
374	adcroft	1.1	ENDDO
375			ENDDO
376			ENDDO
377			ENDIF
378			ENDIF
379
380			ENDDO
381			ENDDO
382
383			RETURN
384			END