pkg/exch2/exch2_rx1_cube_ad.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_rx1_cube_ad.template,v 1.2 2008/07/29 20:25:23 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

#undef  Dbg

CBOP
C     !ROUTINE: EXCH_RX_CUBE_AD

C     !INTERFACE:
      SUBROUTINE EXCH2_RX1_CUBE_AD( 
     U            array, fieldCode,
     I            myOLw, myOLe, myOLn, myOLs, myNz,
     I            exchWidthX, exchWidthY,
     I            simulationMode, cornerMode, myThid )
      IMPLICIT NONE

C     !DESCRIPTION:

C     !USES:
C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "EXCH.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
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 regi exchanged in X.
C     exchWidthY :: Width of data region exchanged in Y.
C     myThid         :: Thread number of this instance of S/R EXCH...
      CHARACTER*2 fieldCode
      INTEGER myOLw
      INTEGER myOLe
      INTEGER myOLs
      INTEGER myOLn
      INTEGER myNz
      INTEGER exchWidthX
      INTEGER exchWidthY
      INTEGER simulationMode
      INTEGER cornerMode
      INTEGER myThid
      _RX array(1-myOLw:sNx+myOLe,
     &          1-myOLs:sNy+myOLn, 
     &          myNZ, nSx, nSy)

C     !LOCAL VARIABLES:
C     theSimulationMode :: Holds working copy of simulation mode
C     theCornerMode     :: Holds working copy of corner mode
C     I,J,K,bl,bt,bn,bs :: Loop and index counters
C     be,bw
      INTEGER theSimulationMode
      INTEGER theCornerMode
c     INTEGER I,J,K
c     INTEGER bl,bt,bn,bs,be,bw
      INTEGER I
C     Variables for working through W2 topology
      INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)
      INTEGER thisTile, farTile, N, nN, oN
      INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi
      INTEGER tIStride, tJStride, tKStride
      INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
      INTEGER bi1Lo, bi1Hi, bj1Lo, bj1Hi
C     == Statement function ==
C     tilemod - Permutes indices to return neighboring tile index on
C               six face cube.
c     INTEGER tilemod

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

      theSimulationMode = simulationMode
      theCornerMode     = cornerMode

C     For now tile<->tile exchanges are sequentialised through
C     thread 1. This is a temporary feature for preliminary testing until
C     general tile decomposistion is in place (CNH April 11, 2001)
      CALL BAR2( myThid )

C     Receive messages or extract buffer copies
      DO I=myBxLo(myThid), myBxHi(myThid)
       thisTile=W2_myTileList(I)
       nN=exch2_nNeighbours(thisTile)
       DO N=1,nN
        farTile=exch2_neighbourId(N,thisTile)
        tIlo =exch2_iLo(N,thisTile)
        tIhi =exch2_iHi(N,thisTile)
        tJlo =exch2_jLo(N,thisTile)
        tJhi =exch2_jHi(N,thisTile)
        CALL EXCH2_GET_RECV_BOUNDS(
     I       fieldCode, exchWidthX,
     O       tiStride, tjStride,
     U       tIlo, tiHi, tjLo, tjHi )
        tKLo=1
        tKHi=myNz
        tKStride=1
        i1Lo  = 1-myOLw
        i1Hi  = sNx+myOLe
        j1Lo  = 1-myOLs
        j1Hi  = sNy+myOLn
        k1Lo  = 1
        k1Hi  = myNz
        bi1Lo = I
        bi1Hi = I
        bj1Lo = 1
        bj1Hi = 1

C       Receive from neighbour N to fill my points 
C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
C       in "array". 
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
C               record.
        CALL EXCH2_RECV_RX1_AD(
     I       tIlo, tIhi, tiStride, 
     I       tJlo, tJhi, tjStride, 
     I       tKlo, tKhi, tkStride,
     I       thisTile, I, N,
     I       e2Bufr1_RX, e2BufrRecSize,
     I       MAX_NEIGHBOURS, nSx,
     I       array(1-myOLw,1-myOLs,1,I,1),
     I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     U       e2_msgHandles(1,N,I), 
     I       W2_myTileList,
     I       W2_myCommFlag(N,I),
     I       myThid )
       ENDDO
      ENDDO

C     without MPI: wait until all threads finish filling buffer
      CALL BAR2( myThid )

C     Post sends as messages or buffer copies
      DO I=myBxLo(myThid), myBxHi(myThid)
       thisTile=W2_myTileList(I)
       nN=exch2_nNeighbours(thisTile)
       DO N=1,nN
        farTile=exch2_neighbourId(N,thisTile)
        oN=exch2_opposingSend(N,thisTile)
        tIlo =exch2_iLo(oN,farTile)
        tIhi =exch2_iHi(oN,farTile)
        tJlo =exch2_jLo(oN,farTile)
        tJhi =exch2_jHi(oN,farTile)
        CALL EXCH2_GET_SEND_BOUNDS(
     I       fieldCode, exchWidthX,
     O       tiStride, tjStride,
     U       tIlo, tiHi, tjLo, tjHi )
        tKLo=1
        tKHi=myNz
        tKStride=1
        i1Lo  = 1-myOLw
        i1Hi  = sNx+myOLe
        j1Lo  = 1-myOLs
        j1Hi  = sNy+myOLn
        k1Lo  = 1
        k1Hi  = myNz
        bi1Lo = I
        bi1Hi = I
        bj1Lo = 1
        bj1Hi = 1
C       Send to neighbour N to fill neighbor points 
C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
C       in its copy of "array".
        CALL EXCH2_SEND_RX1_AD(
     I       tIlo, tIhi, tiStride, 
     I       tJlo, tJhi, tjStride, 
     I       tKlo, tKhi, tkStride,
     I       thisTile, N,
     I       e2Bufr1_RX(1,N,I,1), e2BufrRecSize,
     I       array(1-myOLw,1-myOLs,1,I,1),
     I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     O       e2_msgHandles(1,N,I), 
     I       W2_myCommFlag(N,I),
     I       myThid )
       ENDDO
      ENDDO

C     Clear message handles/locks
      DO I=1,nSx
       thisTile=W2_myTileList(I)
       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 is has consumed the buffer the sender filled here.
        farTile=exch2_neighbourId(N,thisTile)
        IF     ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN
#ifdef ALLOW_USE_MPI
         wHandle = e2_msgHandles(1,N,I)
         CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
#endif
        ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN
        ELSE
        ENDIF
       ENDDO
      ENDDO

      CALL BAR2(myThid)
  
      RETURN
      END

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

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	jahn	1.3	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_rx1_cube_ad.template,v 1.2 2008/07/29 20:25:23 jmc Exp $
2	heimbach	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			#undef Dbg
7
8			CBOP
9			C !ROUTINE: EXCH_RX_CUBE_AD
10
11			C !INTERFACE:
12			SUBROUTINE EXCH2_RX1_CUBE_AD(
13			U array, fieldCode,
14			I myOLw, myOLe, myOLn, myOLs, myNz,
15			I exchWidthX, exchWidthY,
16			I simulationMode, cornerMode, myThid )
17			IMPLICIT NONE
18
19			C !DESCRIPTION:
20
21			C !USES:
22			C == Global data ==
23			#include "SIZE.h"
24			#include "EEPARAMS.h"
25			#include "EESUPPORT.h"
26			#include "EXCH.h"
27			#include "W2_EXCH2_TOPOLOGY.h"
28			#include "W2_EXCH2_PARAMS.h"
29
30			C !INPUT/OUTPUT PARAMETERS:
31			C array :: Array with edges to exchange.
32			C myOLw :: West, East, North and South overlap region sizes.
33			C myOLe
34			C myOLn
35			C myOLs
36			C exchWidthX :: Width of data regi exchanged in X.
37			C exchWidthY :: Width of data region exchanged in Y.
38			C myThid :: Thread number of this instance of S/R EXCH...
39			CHARACTER*2 fieldCode
40			INTEGER myOLw
41			INTEGER myOLe
42			INTEGER myOLs
43			INTEGER myOLn
44			INTEGER myNz
45			INTEGER exchWidthX
46			INTEGER exchWidthY
47			INTEGER simulationMode
48			INTEGER cornerMode
49			INTEGER myThid
50			_RX array(1-myOLw:sNx+myOLe,
51			& 1-myOLs:sNy+myOLn,
52			& myNZ, nSx, nSy)
53
54			C !LOCAL VARIABLES:
55			C theSimulationMode :: Holds working copy of simulation mode
56			C theCornerMode :: Holds working copy of corner mode
57			C I,J,K,bl,bt,bn,bs :: Loop and index counters
58			C be,bw
59			INTEGER theSimulationMode
60			INTEGER theCornerMode
61			c INTEGER I,J,K
62			c INTEGER bl,bt,bn,bs,be,bw
63			INTEGER I
64			C Variables for working through W2 topology
65			INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)
66			INTEGER thisTile, farTile, N, nN, oN
67			INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi
68			INTEGER tIStride, tJStride, tKStride
69			INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
70			INTEGER bi1Lo, bi1Hi, bj1Lo, bj1Hi
71			C == Statement function ==
72			C tilemod - Permutes indices to return neighboring tile index on
73			C six face cube.
74			c INTEGER tilemod
75
76			C MPI stuff (should be in a routine call)
77			#ifdef ALLOW_USE_MPI
78			INTEGER mpiStatus(MPI_STATUS_SIZE)
79			INTEGER mpiRc
80			INTEGER wHandle
81			#endif
82			CEOP
83
84			theSimulationMode = simulationMode
85			theCornerMode = cornerMode
86
87			C For now tile<->tile exchanges are sequentialised through
88			C thread 1. This is a temporary feature for preliminary testing until
89			C general tile decomposistion is in place (CNH April 11, 2001)
90			CALL BAR2( myThid )
91
92			C Receive messages or extract buffer copies
93			DO I=myBxLo(myThid), myBxHi(myThid)
94			thisTile=W2_myTileList(I)
95			nN=exch2_nNeighbours(thisTile)
96			DO N=1,nN
97			farTile=exch2_neighbourId(N,thisTile)
98	jmc	1.2	tIlo =exch2_iLo(N,thisTile)
99			tIhi =exch2_iHi(N,thisTile)
100			tJlo =exch2_jLo(N,thisTile)
101			tJhi =exch2_jHi(N,thisTile)
102	heimbach	1.1	CALL EXCH2_GET_RECV_BOUNDS(
103			I fieldCode, exchWidthX,
104			O tiStride, tjStride,
105			U tIlo, tiHi, tjLo, tjHi )
106			tKLo=1
107			tKHi=myNz
108			tKStride=1
109			i1Lo = 1-myOLw
110			i1Hi = sNx+myOLe
111			j1Lo = 1-myOLs
112	jahn	1.3	j1Hi = sNy+myOLn
113	heimbach	1.1	k1Lo = 1
114			k1Hi = myNz
115			bi1Lo = I
116			bi1Hi = I
117			bj1Lo = 1
118			bj1Hi = 1
119
120			C Receive from neighbour N to fill my points
121			C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
122			C in "array".
123			C Note: when transferring data within a process:
124			C o e2Bufr entry to read is entry associated with opposing send record
125			C o e2_msgHandle entry to read is entry associated with opposing send
126			C record.
127			CALL EXCH2_RECV_RX1_AD(
128			I tIlo, tIhi, tiStride,
129			I tJlo, tJhi, tjStride,
130			I tKlo, tKhi, tkStride,
131			I thisTile, I, N,
132			I e2Bufr1_RX, e2BufrRecSize,
133			I MAX_NEIGHBOURS, nSx,
134			I array(1-myOLw,1-myOLs,1,I,1),
135			I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
136			U e2_msgHandles(1,N,I),
137			I W2_myTileList,
138			I W2_myCommFlag(N,I),
139			I myThid )
140			ENDDO
141			ENDDO
142
143			C without MPI: wait until all threads finish filling buffer
144			CALL BAR2( myThid )
145
146			C Post sends as messages or buffer copies
147			DO I=myBxLo(myThid), myBxHi(myThid)
148			thisTile=W2_myTileList(I)
149			nN=exch2_nNeighbours(thisTile)
150			DO N=1,nN
151			farTile=exch2_neighbourId(N,thisTile)
152	jmc	1.2	oN=exch2_opposingSend(N,thisTile)
153			tIlo =exch2_iLo(oN,farTile)
154			tIhi =exch2_iHi(oN,farTile)
155			tJlo =exch2_jLo(oN,farTile)
156			tJhi =exch2_jHi(oN,farTile)
157	heimbach	1.1	CALL EXCH2_GET_SEND_BOUNDS(
158			I fieldCode, exchWidthX,
159			O tiStride, tjStride,
160			U tIlo, tiHi, tjLo, tjHi )
161			tKLo=1
162			tKHi=myNz
163			tKStride=1
164			i1Lo = 1-myOLw
165			i1Hi = sNx+myOLe
166			j1Lo = 1-myOLs
167	jahn	1.3	j1Hi = sNy+myOLn
168	heimbach	1.1	k1Lo = 1
169			k1Hi = myNz
170			bi1Lo = I
171			bi1Hi = I
172			bj1Lo = 1
173			bj1Hi = 1
174			C Send to neighbour N to fill neighbor points
175			C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
176			C in its copy of "array".
177			CALL EXCH2_SEND_RX1_AD(
178			I tIlo, tIhi, tiStride,
179			I tJlo, tJhi, tjStride,
180			I tKlo, tKhi, tkStride,
181			I thisTile, N,
182			I e2Bufr1_RX(1,N,I,1), e2BufrRecSize,
183			I array(1-myOLw,1-myOLs,1,I,1),
184			I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
185			O e2_msgHandles(1,N,I),
186			I W2_myCommFlag(N,I),
187			I myThid )
188			ENDDO
189			ENDDO
190
191			C Clear message handles/locks
192			DO I=1,nSx
193			thisTile=W2_myTileList(I)
194			nN=exch2_nNeighbours(thisTile)
195			DO N=1,nN
196			C Note: In a between process tile-tile data transport using
197			C MPI the sender needs to clear an Isend wait handle here.
198			C In a within process tile-tile data transport using true
199			C shared address space/or direct transfer through commonly
200			C addressable memory blocks the receiver needs to assert
201			C that is has consumed the buffer the sender filled here.
202			farTile=exch2_neighbourId(N,thisTile)
203			IF ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN
204			#ifdef ALLOW_USE_MPI
205			wHandle = e2_msgHandles(1,N,I)
206			CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
207			#endif
208			ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN
209			ELSE
210			ENDIF
211			ENDDO
212			ENDDO
213
214			CALL BAR2(myThid)
215
216			RETURN
217			END
218
219			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
220
221			CEH3 ;;; Local Variables: ***
222			CEH3 ;;; mode:fortran ***
223			CEH3 ;;; End: ***