pkg/exch2/exch2_rx2_cube_ad.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_rx2_cube_ad.template,v 1.12 2012/03/26 19:13:15 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP
C     !ROUTINE: EXCH_RX2_CUBE_AD

C     !INTERFACE:
      SUBROUTINE EXCH2_RX2_CUBE_AD(
     U            array1, array2,
     I            signOption, fieldCode,
     I            myOLw, myOLe, myOLs, myOLn, myNz,
     I            exchWidthX, exchWidthY,
     I            cornerMode, myThid )

C     !DESCRIPTION:
C     Two components vector field AD-Exchange:
C     Tile-edge overlap-region of a 2 component vector field is added to
C     corresponding near-edge interior data point and then zero out.

C     !USES:
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_BUFFER.h"

C     !INPUT/OUTPUT PARAMETERS:
C     array1      :: 1rst component array with edges to exchange.
C     array2      :: 2nd  component array with edges to exchange.
C     signOption  :: Flag controlling whether vector is signed.
C     fieldCode   :: field code (position on staggered grid)
C     myOLw,myOLe :: West and East overlap region sizes.
C     myOLs,myOLn :: South and North overlap region sizes.
C     exchWidthX  :: Width of data region exchanged in X.
C     exchWidthY  :: Width of data region exchanged in Y.
C     cornerMode  :: halo-corner-region treatment: update/ignore corner region
C     myThid      :: Thread number of this instance of S/R EXCH...

      INTEGER myOLw, myOLe, myOLs, myOLn, myNz
      _RX array1(1-myOLw:sNx+myOLe,
     &           1-myOLs:sNy+myOLn,
     &           myNz, nSx, nSy)
      _RX array2(1-myOLw:sNx+myOLe,
     &           1-myOLs:sNy+myOLn,
     &           myNz, nSx, nSy)
      LOGICAL signOption
      CHARACTER*2 fieldCode
      INTEGER exchWidthX
      INTEGER exchWidthY
      INTEGER cornerMode
      INTEGER myThid

C     !LOCAL VARIABLES:
C     e2_msgHandles :: Synchronization and coordination data structure used to
C                   :: coordinate access to e2Bufr1_RX or to regulate message
C                   :: buffering. In PUT communication sender will increment
C                   :: handle entry once data is ready in buffer. Receiver will
C                   :: decrement handle once data is consumed from buffer.
C                   :: For MPI MSG communication MPI_Wait uses handle to check
C                   :: Isend has cleared. This is done in routine after receives.
C     note: a) current implementation does not use e2_msgHandles for communication
C              between threads: all-threads barriers are used (see CNH note below).
C              For a 2-threads synchro communication (future version),
C              e2_msgHandles should be shared (in common block, moved to BUFFER.h)
      INTEGER bi, bj
C     Variables for working through W2 topology
      INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
      INTEGER thisTile, farTile, N, nN, oN
      INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
      INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
      INTEGER tIStride, tJStride
      INTEGER tKlo, tKhi, tKStride
      INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
      INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
      LOGICAL updateCorners

#ifdef ALLOW_USE_MPI
      INTEGER iBufr1, iBufr2, nri, nrj
C     MPI stuff (should be in a routine call)
      INTEGER mpiStatus(MPI_STATUS_SIZE)
      INTEGER mpiRc
      INTEGER wHandle
#endif
CEOP

      updateCorners = cornerMode .EQ. EXCH_UPDATE_CORNERS
C-    Tile size of arrays to exchange:
      i1Lo  = 1-myOLw
      i1Hi  = sNx+myOLe
      j1Lo  = 1-myOLs
      j1Hi  = sNy+myOLn
      k1Lo  = 1
      k1Hi  = myNz
      i2Lo  = 1-myOLw
      i2Hi  = sNx+myOLe
      j2Lo  = 1-myOLs
      j2Hi  = sNy+myOLn
      k2Lo  = 1
      k2Hi  = myNz

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

C     Prevent anyone to access shared buffer while an other thread modifies it
      CALL BAR2( myThid )

C--   Extract from buffer (either from level 1 if local exch,
C                     or level 2 if coming from an other Proc)
C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
C  AD:   on local (to this Proc) or remote Proc tile destination
      DO bj=myByLo(myThid), myByHi(myThid)
       DO bi=myBxLo(myThid), myBxHi(myThid)
        thisTile=W2_myTileList(bi,bj)
        nN=exch2_nNeighbours(thisTile)
        DO N=1,nN
          CALL EXCH2_GET_UV_BOUNDS(
     I               fieldCode, exchWidthX, updateCorners,
     I               thisTile, N,
     O               tIlo1, tIhi1, tJlo1, tJhi1,
     O               tIlo2, tIhi2, tJlo2, tJhi2,
     O               tiStride, tjStride,
     O               oIs1, oJs1, oIs2, oJs2,
     I               myThid )
          tKLo=1
          tKHi=myNz
          tKStride=1

C     From buffer, get my points
C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
C     Note: when transferring data within a process:
C      o e2Bufr entry to read is entry associated with opposing send record
C      o e2_msgHandle entry to read is entry associated with opposing send record.
          CALL EXCH2_AD_GET_RX2(
     I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
     I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
     I               tKlo, tKhi, tkStride,
     I               thisTile, N, bi, bj,
     I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
     O               iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
     O               e2Bufr1_RX, e2Bufr2_RX,
     U               array1(1-myOLw,1-myOLs,1,bi,bj),
     U               array2(1-myOLw,1-myOLs,1,bi,bj),
     I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
     U               e2_msgHandles,
     I               W2_myCommFlag(N,bi,bj), myThid )
        ENDDO
       ENDDO
      ENDDO

C     Wait until all threads finish filling buffer
      CALL BAR2( myThid )

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

#ifdef ALLOW_USE_MPI
      IF ( usingMPI ) THEN
C  AD: all MPI part is acting on buffer and is identical to forward code,
C  AD: except a) the buffer level: send from lev.2, receive into lev.1
C  AD:        b) the length of transferred buffer (<- match the ad_put/ad_get)

      _BEGIN_MASTER( myThid )

C--   Send my data (in buffer, level 1) to target Process
      DO bj=1,nSy
       DO bi=1,nSx
        thisTile=W2_myTileList(bi,bj)
        nN=exch2_nNeighbours(thisTile)
        DO N=1,nN
C-    Skip the call if this is an internal exchange
         IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
          CALL EXCH2_SEND_RX2(
     I               thisTile, N,
     I               e2BufrRecSize,
     I               iBuf1Filled(N,bi,bj),    iBuf2Filled(N,bi,bj),
     I               e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
     O               e2_msgHandles(1,N,bi,bj),
     I               W2_myCommFlag(N,bi,bj), myThid )
         ENDIF
        ENDDO
       ENDDO
      ENDDO

C--   Receive data (in buffer, level 1) from source Process
      DO bj=1,nSy
       DO bi=1,nSx
        thisTile=W2_myTileList(bi,bj)
        nN=exch2_nNeighbours(thisTile)
        DO N=1,nN
C-    Skip the call if this is an internal exchange
         IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
          farTile=exch2_neighbourId(N,thisTile)
          oN = exch2_opposingSend(N,thisTile)
          CALL EXCH2_GET_UV_BOUNDS(
     I               fieldCode, exchWidthX, updateCorners,
     I               farTile, oN,
     O               tIlo1, tIhi1, tJlo1, tJhi1,
     O               tIlo2, tIhi2, tJlo2, tJhi2,
     O               tiStride, tjStride,
     O               oIs1, oJs1, oIs2, oJs2,
     I               myThid )
          nri = 1 + (tIhi1-tIlo1)/tiStride
          nrj = 1 + (tJhi1-tJlo1)/tjStride
          iBufr1 = nri*nrj*myNz
          nri = 1 + (tIhi2-tIlo2)/tiStride
          nrj = 1 + (tJhi2-tJlo2)/tjStride
          iBufr2 = nri*nrj*myNz
C       Receive from neighbour N to fill buffer and later on the array
          CALL EXCH2_RECV_RX2(
     I               thisTile, N,
     I               e2BufrRecSize,
     I               iBufr1, iBufr2,
     I               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
     I               W2_myCommFlag(N,bi,bj), myThid )
         ENDIF
        ENDDO
       ENDDO
      ENDDO

C--   Clear message handles/locks
      DO bj=1,nSy
       DO bi=1,nSx
        thisTile=W2_myTileList(bi,bj)
        nN=exch2_nNeighbours(thisTile)
        DO N=1,nN
C     Note: In a between process tile-tile data transport using
C           MPI the sender needs to clear an Isend wait handle here.
C           In a within process tile-tile data transport using true
C           shared address space/or direct transfer through commonly
C           addressable memory blocks the receiver needs to assert
C           that he has consumed the buffer the sender filled here.
         farTile=exch2_neighbourId(N,thisTile)
         IF     ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
          wHandle = e2_msgHandles(1,N,bi,bj)
          CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
          wHandle = e2_msgHandles(2,N,bi,bj)
          CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
         ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
         ELSE
         ENDIF
        ENDDO
       ENDDO
      ENDDO

      _END_MASTER( myThid )
C     Everyone waits until master-thread finishes receiving
      CALL BAR2( myThid )

      ENDIF
#endif /* ALLOW_USE_MPI */

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

C--   Post sends into buffer (buffer level 1):
      DO bj=myByLo(myThid), myByHi(myThid)
       DO bi=myBxLo(myThid), myBxHi(myThid)
        thisTile=W2_myTileList(bi,bj)
        nN=exch2_nNeighbours(thisTile)
        DO N=1,nN
          farTile=exch2_neighbourId(N,thisTile)
          oN = exch2_opposingSend(N,thisTile)
          CALL EXCH2_GET_UV_BOUNDS(
     I               fieldCode, exchWidthX, updateCorners,
     I               farTile, oN,
     O               tIlo1, tIhi1, tJlo1, tJhi1,
     O               tIlo2, tIhi2, tJlo2, tJhi2,
     O               tiStride, tjStride,
     O               oIs1, oJs1, oIs2, oJs2,
     I               myThid )
          tKLo=1
          tKHi=myNz
          tKStride=1
C-    Put my points in buffer for neighbour N to fill points
C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
C     in its copy of "array1" & "array2".
          CALL EXCH2_AD_PUT_RX2(
     I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
     I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
     I               tKlo, tKhi, tkStride,
     I               oIs1, oJs1, oIs2, oJs2,
     I               thisTile, N,
     I               e2BufrRecSize,
     O               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
     I               array1(1-myOLw,1-myOLs,1,bi,bj),
     I               array2(1-myOLw,1-myOLs,1,bi,bj),
     I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
     O               e2_msgHandles(1,N,bi,bj),
     I               W2_myCommFlag(N,bi,bj), signOption, myThid )
        ENDDO
       ENDDO
      ENDDO

      RETURN
      END

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

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	jmc	1.13	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_rx2_cube_ad.template,v 1.12 2012/03/26 19:13:15 jmc Exp $
2	heimbach	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			CBOP
7	jmc	1.6	C !ROUTINE: EXCH_RX2_CUBE_AD
8	heimbach	1.1
9			C !INTERFACE:
10	jmc	1.3	SUBROUTINE EXCH2_RX2_CUBE_AD(
11	jmc	1.6	U array1, array2,
12			I signOption, fieldCode,
13	jmc	1.11	I myOLw, myOLe, myOLs, myOLn, myNz,
14	heimbach	1.1	I exchWidthX, exchWidthY,
15	jmc	1.10	I cornerMode, myThid )
16	heimbach	1.1
17			C !DESCRIPTION:
18	jmc	1.6	C Two components vector field AD-Exchange:
19			C Tile-edge overlap-region of a 2 component vector field is added to
20			C corresponding near-edge interior data point and then zero out.
21	heimbach	1.1
22			C !USES:
23	jmc	1.6	IMPLICIT NONE
24
25	heimbach	1.1	C == Global data ==
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "EESUPPORT.h"
29	jmc	1.5	#include "W2_EXCH2_SIZE.h"
30	heimbach	1.1	#include "W2_EXCH2_TOPOLOGY.h"
31	jmc	1.5	#include "W2_EXCH2_BUFFER.h"
32	heimbach	1.1
33			C !INPUT/OUTPUT PARAMETERS:
34	jmc	1.6	C array1 :: 1rst component array with edges to exchange.
35			C array2 :: 2nd component array with edges to exchange.
36			C signOption :: Flag controlling whether vector is signed.
37			C fieldCode :: field code (position on staggered grid)
38			C myOLw,myOLe :: West and East overlap region sizes.
39	jmc	1.11	C myOLs,myOLn :: South and North overlap region sizes.
40	jmc	1.6	C exchWidthX :: Width of data region exchanged in X.
41			C exchWidthY :: Width of data region exchanged in Y.
42			C cornerMode :: halo-corner-region treatment: update/ignore corner region
43			C myThid :: Thread number of this instance of S/R EXCH...
44
45	jmc	1.11	INTEGER myOLw, myOLe, myOLs, myOLn, myNz
46	jmc	1.6	_RX array1(1-myOLw:sNx+myOLe,
47			& 1-myOLs:sNy+myOLn,
48			& myNz, nSx, nSy)
49			_RX array2(1-myOLw:sNx+myOLe,
50			& 1-myOLs:sNy+myOLn,
51			& myNz, nSx, nSy)
52			LOGICAL signOption
53	heimbach	1.1	CHARACTER*2 fieldCode
54			INTEGER exchWidthX
55			INTEGER exchWidthY
56			INTEGER cornerMode
57			INTEGER myThid
58
59			C !LOCAL VARIABLES:
60	jmc	1.6	C e2_msgHandles :: Synchronization and coordination data structure used to
61			C :: coordinate access to e2Bufr1_RX or to regulate message
62			C :: buffering. In PUT communication sender will increment
63			C :: handle entry once data is ready in buffer. Receiver will
64			C :: decrement handle once data is consumed from buffer.
65	jmc	1.9	C :: For MPI MSG communication MPI_Wait uses handle to check
66	jmc	1.6	C :: Isend has cleared. This is done in routine after receives.
67			C note: a) current implementation does not use e2_msgHandles for communication
68			C between threads: all-threads barriers are used (see CNH note below).
69			C For a 2-threads synchro communication (future version),
70			C e2_msgHandles should be shared (in common block, moved to BUFFER.h)
71			INTEGER bi, bj
72	heimbach	1.1	C Variables for working through W2 topology
73	jmc	1.6	INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
74	heimbach	1.1	INTEGER thisTile, farTile, N, nN, oN
75	jmc	1.3	INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
76			INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
77			INTEGER tIStride, tJStride
78			INTEGER tKlo, tKhi, tKStride
79	heimbach	1.1	INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
80			INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
81	jmc	1.12	LOGICAL updateCorners
82	heimbach	1.1
83	jmc	1.6	#ifdef ALLOW_USE_MPI
84			INTEGER iBufr1, iBufr2, nri, nrj
85	heimbach	1.1	C MPI stuff (should be in a routine call)
86			INTEGER mpiStatus(MPI_STATUS_SIZE)
87			INTEGER mpiRc
88			INTEGER wHandle
89			#endif
90			CEOP
91
92	jmc	1.12	updateCorners = cornerMode .EQ. EXCH_UPDATE_CORNERS
93	jmc	1.6	C- Tile size of arrays to exchange:
94			i1Lo = 1-myOLw
95			i1Hi = sNx+myOLe
96			j1Lo = 1-myOLs
97			j1Hi = sNy+myOLn
98			k1Lo = 1
99			k1Hi = myNz
100			i2Lo = 1-myOLw
101			i2Hi = sNx+myOLe
102			j2Lo = 1-myOLs
103			j2Hi = sNy+myOLn
104			k2Lo = 1
105			k2Hi = myNz
106	heimbach	1.1
107	jmc	1.8	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
108
109			C Prevent anyone to access shared buffer while an other thread modifies it
110	heimbach	1.1	CALL BAR2( myThid )
111
112	jmc	1.6	C-- Extract from buffer (either from level 1 if local exch,
113			C or level 2 if coming from an other Proc)
114			C AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
115			C AD: on local (to this Proc) or remote Proc tile destination
116			DO bj=myByLo(myThid), myByHi(myThid)
117			DO bi=myBxLo(myThid), myBxHi(myThid)
118	jmc	1.7	thisTile=W2_myTileList(bi,bj)
119	jmc	1.6	nN=exch2_nNeighbours(thisTile)
120			DO N=1,nN
121			CALL EXCH2_GET_UV_BOUNDS(
122	jmc	1.12	I fieldCode, exchWidthX, updateCorners,
123	jmc	1.6	I thisTile, N,
124			O tIlo1, tIhi1, tJlo1, tJhi1,
125			O tIlo2, tIhi2, tJlo2, tJhi2,
126			O tiStride, tjStride,
127			O oIs1, oJs1, oIs2, oJs2,
128			I myThid )
129			tKLo=1
130			tKHi=myNz
131			tKStride=1
132
133			C From buffer, get my points
134			C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
135			C Note: when transferring data within a process:
136			C o e2Bufr entry to read is entry associated with opposing send record
137			C o e2_msgHandle entry to read is entry associated with opposing send record.
138			CALL EXCH2_AD_GET_RX2(
139			I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
140			I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
141			I tKlo, tKhi, tkStride,
142			I thisTile, N, bi, bj,
143			I e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
144	jmc	1.7	O iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
145	jmc	1.6	O e2Bufr1_RX, e2Bufr2_RX,
146			U array1(1-myOLw,1-myOLs,1,bi,bj),
147			U array2(1-myOLw,1-myOLs,1,bi,bj),
148			I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
149			I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
150			U e2_msgHandles,
151	jmc	1.7	I W2_myCommFlag(N,bi,bj), myThid )
152	jmc	1.6	ENDDO
153	heimbach	1.1	ENDDO
154			ENDDO
155
156	jmc	1.8	C Wait until all threads finish filling buffer
157			CALL BAR2( myThid )
158
159	jmc	1.6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
160
161			#ifdef ALLOW_USE_MPI
162	jmc	1.13	IF ( usingMPI ) THEN
163	jmc	1.6	C AD: all MPI part is acting on buffer and is identical to forward code,
164			C AD: except a) the buffer level: send from lev.2, receive into lev.1
165	jmc	1.9	C AD: b) the length of transferred buffer (<- match the ad_put/ad_get)
166	jmc	1.6
167			_BEGIN_MASTER( myThid )
168
169			C-- Send my data (in buffer, level 1) to target Process
170			DO bj=1,nSy
171			DO bi=1,nSx
172	jmc	1.7	thisTile=W2_myTileList(bi,bj)
173	jmc	1.6	nN=exch2_nNeighbours(thisTile)
174			DO N=1,nN
175			C- Skip the call if this is an internal exchange
176	jmc	1.7	IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
177	jmc	1.6	CALL EXCH2_SEND_RX2(
178			I thisTile, N,
179			I e2BufrRecSize,
180	jmc	1.7	I iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
181			I e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
182	jmc	1.6	O e2_msgHandles(1,N,bi,bj),
183	jmc	1.7	I W2_myCommFlag(N,bi,bj), myThid )
184	jmc	1.6	ENDIF
185			ENDDO
186			ENDDO
187			ENDDO
188
189			C-- Receive data (in buffer, level 1) from source Process
190			DO bj=1,nSy
191			DO bi=1,nSx
192	jmc	1.7	thisTile=W2_myTileList(bi,bj)
193	jmc	1.6	nN=exch2_nNeighbours(thisTile)
194			DO N=1,nN
195			C- Skip the call if this is an internal exchange
196	jmc	1.7	IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
197	jmc	1.6	farTile=exch2_neighbourId(N,thisTile)
198			oN = exch2_opposingSend(N,thisTile)
199			CALL EXCH2_GET_UV_BOUNDS(
200	jmc	1.12	I fieldCode, exchWidthX, updateCorners,
201	jmc	1.6	I farTile, oN,
202			O tIlo1, tIhi1, tJlo1, tJhi1,
203			O tIlo2, tIhi2, tJlo2, tJhi2,
204			O tiStride, tjStride,
205			O oIs1, oJs1, oIs2, oJs2,
206			I myThid )
207			nri = 1 + (tIhi1-tIlo1)/tiStride
208			nrj = 1 + (tJhi1-tJlo1)/tjStride
209			iBufr1 = nrinrjmyNz
210			nri = 1 + (tIhi2-tIlo2)/tiStride
211			nrj = 1 + (tJhi2-tJlo2)/tjStride
212			iBufr2 = nrinrjmyNz
213			C Receive from neighbour N to fill buffer and later on the array
214			CALL EXCH2_RECV_RX2(
215			I thisTile, N,
216			I e2BufrRecSize,
217			I iBufr1, iBufr2,
218	jmc	1.7	I e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
219			I W2_myCommFlag(N,bi,bj), myThid )
220	jmc	1.6	ENDIF
221			ENDDO
222			ENDDO
223			ENDDO
224	heimbach	1.1
225	jmc	1.6	C-- Clear message handles/locks
226			DO bj=1,nSy
227			DO bi=1,nSx
228	jmc	1.7	thisTile=W2_myTileList(bi,bj)
229	jmc	1.6	nN=exch2_nNeighbours(thisTile)
230			DO N=1,nN
231			C Note: In a between process tile-tile data transport using
232			C MPI the sender needs to clear an Isend wait handle here.
233			C In a within process tile-tile data transport using true
234			C shared address space/or direct transfer through commonly
235			C addressable memory blocks the receiver needs to assert
236			C that he has consumed the buffer the sender filled here.
237			farTile=exch2_neighbourId(N,thisTile)
238	jmc	1.7	IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
239	jmc	1.6	wHandle = e2_msgHandles(1,N,bi,bj)
240			CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
241			wHandle = e2_msgHandles(2,N,bi,bj)
242			CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
243	jmc	1.7	ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
244	jmc	1.6	ELSE
245			ENDIF
246			ENDDO
247	heimbach	1.1	ENDDO
248			ENDDO
249
250	jmc	1.6	_END_MASTER( myThid )
251	jmc	1.8	C Everyone waits until master-thread finishes receiving
252			CALL BAR2( myThid )
253
254	jmc	1.13	ENDIF
255	jmc	1.6	#endif /* ALLOW_USE_MPI */
256
257			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
258
259			C-- Post sends into buffer (buffer level 1):
260			DO bj=myByLo(myThid), myByHi(myThid)
261			DO bi=myBxLo(myThid), myBxHi(myThid)
262	jmc	1.7	thisTile=W2_myTileList(bi,bj)
263	jmc	1.6	nN=exch2_nNeighbours(thisTile)
264			DO N=1,nN
265			farTile=exch2_neighbourId(N,thisTile)
266			oN = exch2_opposingSend(N,thisTile)
267			CALL EXCH2_GET_UV_BOUNDS(
268	jmc	1.12	I fieldCode, exchWidthX, updateCorners,
269	jmc	1.6	I farTile, oN,
270			O tIlo1, tIhi1, tJlo1, tJhi1,
271			O tIlo2, tIhi2, tJlo2, tJhi2,
272			O tiStride, tjStride,
273			O oIs1, oJs1, oIs2, oJs2,
274			I myThid )
275			tKLo=1
276			tKHi=myNz
277			tKStride=1
278			C- Put my points in buffer for neighbour N to fill points
279			C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
280			C in its copy of "array1" & "array2".
281			CALL EXCH2_AD_PUT_RX2(
282			I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
283			I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
284			I tKlo, tKhi, tkStride,
285			I oIs1, oJs1, oIs2, oJs2,
286			I thisTile, N,
287			I e2BufrRecSize,
288	jmc	1.7	O e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
289	jmc	1.6	I array1(1-myOLw,1-myOLs,1,bi,bj),
290			I array2(1-myOLw,1-myOLs,1,bi,bj),
291			I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
292			I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
293			O e2_msgHandles(1,N,bi,bj),
294	jmc	1.7	I W2_myCommFlag(N,bi,bj), signOption, myThid )
295	jmc	1.6	ENDDO
296	heimbach	1.1	ENDDO
297			ENDDO
298
299			RETURN
300			END
301
302			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
303
304			CEH3 ;;; Local Variables: ***
305			CEH3 ;;; mode:fortran ***
306			CEH3 ;;; End: ***