pkg/exch2/exch2_get_rx2.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_get_rx2.template,v 1.2 2009/06/28 01:00:23 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#include "W2_OPTIONS.h"

CBOP 0
C !ROUTINE: EXCH2_GET_RX2

C !INTERFACE:
      SUBROUTINE EXCH2_GET_RX2 (
     I       tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
     I       tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
     I       tKlo, tKhi, tkStride,
     I       thisTile, nN, bi, bj,
     I       e2BufrRecSize, sizeNb, sizeBi, sizeBj,
     I       e2Bufr1_RX, e2Bufr2_RX,
     U       array1,
     U       array2,
     I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
     U       e2_msgHandles,
     I       commSetting, myThid )

C !DESCRIPTION:
C     Two components vector field Exchange:
C     Get from buffer exchanged data to fill in this tile-egde overlap region.

C !USES:
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"

C !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     tIlo1, tIhi1  :: index range in I that will be filled in target "array1"
C     tIlo2, tIhi2  :: index range in I that will be filled in target "array2"
C     tIstride      :: index step  in I that will be filled in target arrays
C     tJlo1, tJhi1  :: index range in J that will be filled in target "array1"
C     tJlo2, tJhi2  :: index range in J that will be filled in target "array2"
C     tJstride      :: index step  in J that will be filled in target arrays
C     tKlo, tKhi    :: index range in K that will be filled in target arrays
C     tKstride      :: index step  in K that will be filled in target arrays
C     oIs1, oJs1    :: I,J index offset in target "array1" to source connection
C     oIs2, oJs2    :: I,J index offset in target "array2" to source connection
C     thisTile      :: receiving tile Id. number
C     nN            :: Neighbour entry that we are processing
C     bi,bj         :: Indices of the receiving tile within this process
C                   ::  (used to select buffer slots that are allowed).
C     e2BufrRecSize :: Number of elements in each entry of e2Bufr[1,2]_RX
C     sizeNb        :: Second dimension of e2Bufr1_RX & e2Bufr2_RX
C     sizeBi        :: Third  dimension of e2Bufr1_RX & e2Bufr2_RX
C     sizeBj        :: Fourth dimension of e2Bufr1_RX & e2Bufr2_RX
C     e2Bufr1_RX    :: Data transport buffer array. This array is used in one of
C     e2Bufr2_RX    :: two ways. For PUT communication the entry in the buffer
C                   :: associated with the source for this receive (determined
C                   :: from the opposing_send index) is read.
C                   :: For MSG communication the entry in the buffer associated
C                   :: with this neighbor of this tile is used as a receive
C                   :: location for loading a linear stream of bytes.
C     array1        :: 1rst Component target array that this receive writes to.
C     array2        :: 2nd  Component target array that this receive writes to.
C     i1Lo, i1Hi    :: I coordinate bounds of target array1
C     j1Lo, j1Hi    :: J coordinate bounds of target array1
C     k1Lo, k1Hi    :: K coordinate bounds of target array1
C     i2Lo, i2Hi    :: I coordinate bounds of target array2
C     j2Lo, j2Hi    :: J coordinate bounds of target array2
C     k2Lo, k2Hi    :: K coordinate bounds of target array2
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     commSetting   :: Mode of communication used to exchange with this neighbor
C     withSigns     :: Flag controlling whether vector field is signed.
C     myThid        :: my Thread Id. number

      INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
      INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
      INTEGER tKlo, tKhi, tkStride
      INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
      INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
      INTEGER thisTile, nN, bi, bj
      INTEGER e2BufrRecSize, sizeNb, sizeBi, sizeBj
      _RX     e2Bufr1_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
      _RX     e2Bufr2_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
      _RX     array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
      _RX     array2(i2Lo:i2Hi,j2Lo:j2Hi,k2Lo:k2Hi)
      INTEGER e2_msgHandles( 2, sizeNb, sizeBi, sizeBj )
      CHARACTER commSetting
      INTEGER myThid
CEOP

C !LOCAL VARIABLES:
C     == Local variables ==
C     itl,jtl,ktl :: Loop counters (this tile)
C     soT    :: Source tile Id number
C     oNb    :: Opposing send record number
C     iBufr1 :: number of buffer-1 elements to transfer
C     iBufr2 :: number of buffer-2 elements to transfer
C     sNb    :: buffer(source) Neighbour index to get data from
C     sBi    :: buffer(source) local(to this Proc) Tile index to get data from
C     sBj    :: buffer(source) local(to this Proc) Tile index to get data from
C     sLv    :: buffer(source) level index to get data from
C     i,j    :: Loop counters

      INTEGER itl, jtl, ktl
      INTEGER soT
      INTEGER oNb
      INTEGER iBufr1, iBufr2
      INTEGER sNb, sBi, sBj, sLv
      INTEGER i,j
c     CHARACTER*(MAX_LEN_MBUF) msgBuf

      soT = exch2_neighbourId( nN, thisTile )
      oNb = exch2_opposingSend(nN, thisTile )

C     Handle receive end data transport according to communication mechanism between
C     source and target tile
      IF     ( commSetting .EQ. 'P' ) THEN

C      1 Need to check and spin on data ready assertion for multithreaded mode,
C        for now, ensure global sync using barrier.
C      2 get directly data from 1rst level buffer (sLv=1);

C     find the tile indices (local to this Proc) corresponding to
C      this source tile Id "soT"
       sLv = 1
       sNb = oNb
       DO j=1,sizeBj
        DO i=1,sizeBi
         IF ( W2_myTileList(i,j).EQ.soT ) THEN
           sBi = i
           sBj = j
         ENDIF
        ENDDO
       ENDDO
#ifdef ALLOW_USE_MPI
      ELSEIF ( commSetting .EQ. 'M' ) THEN
       sLv = 2
       sBi = bi
       sBj = bj
       sNb = nN
#endif /* ALLOW_USE_MPI */
      ELSE
       STOP 'EXCH2_GET_RX2:: commSetting VALUE IS INVALID'
      ENDIF

      iBufr1=0
      DO ktl=tKlo,tKhi,tkStride
       DO jtl=tJLo1, tJHi1, tjStride
        DO itl=tILo1, tIHi1, tiStride
C     Read from e2Bufr1_RX(iBufr,sNb,sBi,sBj,sLv)
         iBufr1 = iBufr1+1
         array1(itl,jtl,ktl) = e2Bufr1_RX(iBufr1,sNb,sBi,sBj,sLv)
        ENDDO
       ENDDO
      ENDDO

      iBufr2=0
      DO ktl=tKlo,tKhi,tkStride
       DO jtl=tJLo2, tJHi2, tjStride
        DO itl=tILo2, tIHi2, tiStride
C     Read from e2Bufr2_RX(iBufr,sNb,sBi,sBj,sLv)
         iBufr2 = iBufr2+1
         array2(itl,jtl,ktl) = e2Bufr2_RX(iBufr2,sNb,sBi,sBj,sLv)
        ENDDO
       ENDDO
      ENDDO

      RETURN
      END

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

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_get_rx2.template,v 1.2 2009/06/28 01:00:23 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5			#include "W2_OPTIONS.h"
6
7			CBOP 0
8			C !ROUTINE: EXCH2_GET_RX2
9
10			C !INTERFACE:
11			SUBROUTINE EXCH2_GET_RX2 (
12			I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
13			I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
14			I tKlo, tKhi, tkStride,
15			I thisTile, nN, bi, bj,
16			I e2BufrRecSize, sizeNb, sizeBi, sizeBj,
17			I e2Bufr1_RX, e2Bufr2_RX,
18			U array1,
19			U array2,
20			I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
21			I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
22			U e2_msgHandles,
23			I commSetting, myThid )
24
25			C !DESCRIPTION:
26			C Two components vector field Exchange:
27			C Get from buffer exchanged data to fill in this tile-egde overlap region.
28
29			C !USES:
30			IMPLICIT NONE
31
32			#include "SIZE.h"
33			#include "EEPARAMS.h"
34			#include "W2_EXCH2_SIZE.h"
35			#include "W2_EXCH2_TOPOLOGY.h"
36
37			C !INPUT/OUTPUT PARAMETERS:
38			C === Routine arguments ===
39			C tIlo1, tIhi1 :: index range in I that will be filled in target "array1"
40			C tIlo2, tIhi2 :: index range in I that will be filled in target "array2"
41			C tIstride :: index step in I that will be filled in target arrays
42			C tJlo1, tJhi1 :: index range in J that will be filled in target "array1"
43			C tJlo2, tJhi2 :: index range in J that will be filled in target "array2"
44			C tJstride :: index step in J that will be filled in target arrays
45			C tKlo, tKhi :: index range in K that will be filled in target arrays
46			C tKstride :: index step in K that will be filled in target arrays
47			C oIs1, oJs1 :: I,J index offset in target "array1" to source connection
48			C oIs2, oJs2 :: I,J index offset in target "array2" to source connection
49	jmc	1.3	C thisTile :: receiving tile Id. number
50	jmc	1.1	C nN :: Neighbour entry that we are processing
51			C bi,bj :: Indices of the receiving tile within this process
52			C :: (used to select buffer slots that are allowed).
53			C e2BufrRecSize :: Number of elements in each entry of e2Bufr[1,2]_RX
54			C sizeNb :: Second dimension of e2Bufr1_RX & e2Bufr2_RX
55			C sizeBi :: Third dimension of e2Bufr1_RX & e2Bufr2_RX
56			C sizeBj :: Fourth dimension of e2Bufr1_RX & e2Bufr2_RX
57			C e2Bufr1_RX :: Data transport buffer array. This array is used in one of
58			C e2Bufr2_RX :: two ways. For PUT communication the entry in the buffer
59			C :: associated with the source for this receive (determined
60			C :: from the opposing_send index) is read.
61			C :: For MSG communication the entry in the buffer associated
62			C :: with this neighbor of this tile is used as a receive
63			C :: location for loading a linear stream of bytes.
64			C array1 :: 1rst Component target array that this receive writes to.
65			C array2 :: 2nd Component target array that this receive writes to.
66			C i1Lo, i1Hi :: I coordinate bounds of target array1
67			C j1Lo, j1Hi :: J coordinate bounds of target array1
68			C k1Lo, k1Hi :: K coordinate bounds of target array1
69			C i2Lo, i2Hi :: I coordinate bounds of target array2
70			C j2Lo, j2Hi :: J coordinate bounds of target array2
71			C k2Lo, k2Hi :: K coordinate bounds of target array2
72			C e2_msgHandles :: Synchronization and coordination data structure used to
73			C :: coordinate access to e2Bufr1_RX or to regulate message
74			C :: buffering. In PUT communication sender will increment
75			C :: handle entry once data is ready in buffer. Receiver will
76			C :: decrement handle once data is consumed from buffer.
77	jmc	1.3	C :: For MPI MSG communication MPI_Wait uses handle to check
78	jmc	1.1	C :: Isend has cleared. This is done in routine after receives.
79			C commSetting :: Mode of communication used to exchange with this neighbor
80			C withSigns :: Flag controlling whether vector field is signed.
81			C myThid :: my Thread Id. number
82
83			INTEGER tIlo1, tIhi1, tIlo2, tIhi2, tiStride
84			INTEGER tJlo1, tJhi1, tJlo2, tJhi2, tjStride
85			INTEGER tKlo, tKhi, tkStride
86			INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
87			INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
88			INTEGER thisTile, nN, bi, bj
89			INTEGER e2BufrRecSize, sizeNb, sizeBi, sizeBj
90			_RX e2Bufr1_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
91			_RX e2Bufr2_RX( e2BufrRecSize, sizeNb, sizeBi, sizeBj, 2 )
92			_RX array1(i1Lo:i1Hi,j1Lo:j1Hi,k1Lo:k1Hi)
93			_RX array2(i2Lo:i2Hi,j2Lo:j2Hi,k2Lo:k2Hi)
94			INTEGER e2_msgHandles( 2, sizeNb, sizeBi, sizeBj )
95			CHARACTER commSetting
96			INTEGER myThid
97			CEOP
98
99			C !LOCAL VARIABLES:
100			C == Local variables ==
101			C itl,jtl,ktl :: Loop counters (this tile)
102			C soT :: Source tile Id number
103			C oNb :: Opposing send record number
104	jmc	1.3	C iBufr1 :: number of buffer-1 elements to transfer
105			C iBufr2 :: number of buffer-2 elements to transfer
106			C sNb :: buffer(source) Neighbour index to get data from
107	jmc	1.1	C sBi :: buffer(source) local(to this Proc) Tile index to get data from
108			C sBj :: buffer(source) local(to this Proc) Tile index to get data from
109			C sLv :: buffer(source) level index to get data from
110			C i,j :: Loop counters
111
112			INTEGER itl, jtl, ktl
113			INTEGER soT
114			INTEGER oNb
115			INTEGER iBufr1, iBufr2
116			INTEGER sNb, sBi, sBj, sLv
117			INTEGER i,j
118			c CHARACTER*(MAX_LEN_MBUF) msgBuf
119
120			soT = exch2_neighbourId( nN, thisTile )
121			oNb = exch2_opposingSend(nN, thisTile )
122
123			C Handle receive end data transport according to communication mechanism between
124			C source and target tile
125			IF ( commSetting .EQ. 'P' ) THEN
126
127			C 1 Need to check and spin on data ready assertion for multithreaded mode,
128			C for now, ensure global sync using barrier.
129			C 2 get directly data from 1rst level buffer (sLv=1);
130
131			C find the tile indices (local to this Proc) corresponding to
132			C this source tile Id "soT"
133			sLv = 1
134			sNb = oNb
135			DO j=1,sizeBj
136			DO i=1,sizeBi
137	jmc	1.2	IF ( W2_myTileList(i,j).EQ.soT ) THEN
138	jmc	1.1	sBi = i
139			sBj = j
140			ENDIF
141			ENDDO
142			ENDDO
143			#ifdef ALLOW_USE_MPI
144			ELSEIF ( commSetting .EQ. 'M' ) THEN
145			sLv = 2
146			sBi = bi
147			sBj = bj
148			sNb = nN
149			#endif /* ALLOW_USE_MPI */
150			ELSE
151			STOP 'EXCH2_GET_RX2:: commSetting VALUE IS INVALID'
152			ENDIF
153
154			iBufr1=0
155			DO ktl=tKlo,tKhi,tkStride
156			DO jtl=tJLo1, tJHi1, tjStride
157			DO itl=tILo1, tIHi1, tiStride
158			C Read from e2Bufr1_RX(iBufr,sNb,sBi,sBj,sLv)
159			iBufr1 = iBufr1+1
160			array1(itl,jtl,ktl) = e2Bufr1_RX(iBufr1,sNb,sBi,sBj,sLv)
161			ENDDO
162			ENDDO
163			ENDDO
164
165			iBufr2=0
166			DO ktl=tKlo,tKhi,tkStride
167			DO jtl=tJLo2, tJHi2, tjStride
168			DO itl=tILo2, tIHi2, tiStride
169			C Read from e2Bufr2_RX(iBufr,sNb,sBi,sBj,sLv)
170			iBufr2 = iBufr2+1
171			array2(itl,jtl,ktl) = e2Bufr2_RX(iBufr2,sNb,sBi,sBj,sLv)
172			ENDDO
173			ENDDO
174			ENDDO
175
176			RETURN
177			END
178
179			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
180
181			CEH3 ;;; Local Variables: ***
182			CEH3 ;;; mode:fortran ***
183			CEH3 ;;; End: ***