C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/exch2_rx2_cube.template,v 1.2 2004/04/05 15:27:06 edhill Exp $
C $Name: checkpoint56a_post $

#include "CPP_EEOPTIONS.h"

#undef  Dbg

CBOP
C     !ROUTINE: EXCH_RX2_CUBE

C     !INTERFACE:
      SUBROUTINE EXCH2_RX2_CUBE( 
     U            array1, array2, signOption, 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 region exchanged in X.
C     exchWidthY :: Width of data region exchanged in Y.
C     myThid         :: Thread number of this instance of S/R EXCH...
      LOGICAL     signOption
      CHARACTER*2 fieldCode
      INTEGER myOLw
      INTEGER myOLe
      INTEGER myOLs
      INTEGER myOLn
      INTEGER myNz
      INTEGER exchWidthX
      INTEGER exchWidthY
      INTEGER simulationMode
      INTEGER cornerMode
      INTEGER myThid
      _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)

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
      INTEGER I,J,K
      INTEGER bl,bt,bn,bs,be,bw
C     Variables for working through W2 topology
      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 i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
C     == Statement function ==
C     tilemod - Permutes indices to return neighboring tile index on
C               six face cube.
      INTEGER tilemod

C     MPI stuff (should be in a routine call)
#ifdef ALLOW_USE_MPI
      INTEGER mpiStatus(MPI_STATUS_SIZE)
#endif
      INTEGER mpiRc
      INTEGER wHandle
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     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)
        tIlo =exch2_itlo_c(N,thisTile)
        tIhi =exch2_ithi_c(N,thisTile)
        tJlo =exch2_jtlo_c(N,thisTile)
        tJhi =exch2_jthi_c(N,thisTile)
        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+myOLs
        k1Lo  = 1
        k1Hi  = myNz
        i2Lo  = 1-myOLw
        i2Hi  = sNx+myOLe
        j2Lo  = 1-myOLs
        j2Hi  = sNy+myOLs
        k2Lo  = 1
        k2Hi  = myNz
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_RX2(
     I       tIlo, tIhi, tiStride, 
     I       tJlo, tJhi, tjStride, 
     I       tKlo, tKhi, tkStride,
     I       thisTile, N,
     I       e2Bufr1_RX(1,N,I,1), e2BufrRecSize,
     I       e2Bufr2_RX(1,N,I,1),
     I       array1(1-myOLw,1-myOLs,1,I,1),
     I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     I       array2(1-myOLw,1-myOLs,1,I,1),
     I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
     O       e2_msgHandles(1,N,I), 
     O       e2_msgHandles(2,N,I), 
     I       W2_myCommFlag(N,I), signOption,
     I       myThid )
       ENDDO
      ENDDO

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)
        oN=exch2_opposingSend_Record(N,thisTile)
        tIlo =exch2_itlo_c(oN,farTile)
        tIhi =exch2_ithi_c(oN,farTile)
        tJlo =exch2_jtlo_c(oN,farTile)
        tJhi =exch2_jthi_c(oN,farTile)
        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+myOLs
        k1Lo  = 1
        k1Hi  = myNz
        i2Lo  = 1-myOLw
        i2Hi  = sNx+myOLe
        j2Lo  = 1-myOLs
        j2Hi  = sNy+myOLs
        k2Lo  = 1
        k2Hi  = myNz
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_RX2(
     I       tIlo, tIhi, tiStride, 
     I       tJlo, tJhi, tjStride, 
     I       tKlo, tKhi, tkStride,
     I       thisTile, I, N,
     I       e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize,
     I       MAX_NEIGHBOURS, nSx,
     I       array1(1-myOLw,1-myOLs,1,I,1),
     I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
     I       array2(1-myOLw,1-myOLs,1,I,1),
     I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
     U       e2_msgHandles, 
     I       W2_myTileList,
     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 )
         wHandle = e2_msgHandles(2,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: ***