C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/exch3/ex3_xy_rx.template,v 1.1 2006/04/06 20:36:26 edhill Exp $
C $Name:  $

#include "EX3_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: EX3_XY_RX

C     !INTERFACE:
      SUBROUTINE EX3_XY_RX(
     I     gtype,
     B     phi,
     I     myThid )

C     !DESCRIPTION:
C     Perform an exchange for 2D scalars located at either Arakawa mass
C     [M|T] or vorticity [Z|V] points.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "EX3_SIZE.h"
#include "EX3_PARAMS.h"
#include "EX3_TOPOLOGY.h"

C     !INPUT PARAMETERS:
C     gtype  :: grid type: [M|T]=mass point, [Z|V]=vorticity point
C     phi    :: Array with overlap regions to be exchanged
C     myThid :: My thread id.
      CHARACTER*(*) gtype
      _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
      INTEGER iloc,in,nN
      CHARACTER*(MAX_LEN_MBUF) msgbuf
C
      INTEGER
     I     bufftag, sendProc, recvProc,
     I     il,ih,is,  jl,jh,js,  kl,kh,ks,
     I     io1,jo1,ko1,
     I     idl1,idh1, jdl1,jdh1, kdl1,kdh1
      INTEGER
     I     i_sendtile, i_recvtile
      LOGICAL along_i
      CHARACTER*(1) commType
      INTEGER msgID(nSx*nSy)
C
#ifdef ALLOW_USE_MPI
      INTEGER mpiStatus(MPI_STATUS_SIZE)
      INTEGER mpiRc
      INTEGER wHandle
#endif

      idl1 = 1-OLx
      idh1 = sNx+OLx
      jdl1 = 1-OLy
      jdh1 = sNy+OLy
      kdl1 = 1
      kdh1 = 1
      kl = 1
      kh = 1
      ks = 1

      commType(1:1) = 'P'
#ifdef ALLOW_USE_MPI
      commType(1:1) = 'M'
#endif

C     As with EXCH2, tile<->tile communication is synchronized through
C     thread 1.
      CALL BAR2(myThid)

      IF (gtype(1:1) .EQ. 'M' .OR. gtype(1:1) .EQ. 'T') THEN

C       phi is a scalar located at Arakawa mass (cell-center) points

C       First send
        DO iloc = myBxLo(myThid), myBxHi(myThid)
          i_sendtile = ex3_p_itile(iloc)
          nN = ex3_e_n(i_sendtile)
          DO in = 1,nN
            i_recvtile = ex3_e_iopt(in,i_sendtile)
            CALL EX3_GET_BUFFTAG(
     I           i_sendtile, i_recvtile, in,
     O           bufftag,
     I           myThid )
            recvProc   = ex3_t_iproc(i_recvtile)

C           =====  I direction  =====
            il = ex3_e_dat(2,1,in,i_sendtile)
            IF ( ex3_e_dat(1,1,in,i_sendtile) .EQ. 0 ) THEN
              along_i  = .FALSE.
              ih = ex3_e_dat(3,1,in,i_sendtile)
            ELSE
C             Here, "along" means the i dimension is perpendicular to
C             the "seam" between the two tiles
              along_i  = .TRUE.
              IF (IABS(ex3_e_dat(1,1,in,i_sendtile)) .EQ. 1) THEN
                ih = il + ex3_e_dat(1,1,in,i_sendtile) * OLx
              ELSE
                ih = il + ex3_e_dat(3,1,in,i_sendtile)
              ENDIF
            ENDIF
            is = 1
            IF (il .GT. ih) is = -1

C           =====  J direction  =====
            jl = ex3_e_dat(2,2,in,i_sendtile)
            IF ( ex3_e_dat(1,2,in,i_sendtile) .EQ. 0 ) THEN
              jh = ex3_e_dat(3,2,in,i_sendtile)
            ELSE
              IF (IABS(ex3_e_dat(1,2,in,i_sendtile)) .EQ. 1) THEN
                jh = jl + ex3_e_dat(1,2,in,i_sendtile) * OLy
              ELSE
                jh = jl + ex3_e_dat(3,2,in,i_sendtile)
              ENDIF
            ENDIF
            js = 1
            IF (jl .GT. jh) js = -1

            io1 = 0
            jo1 = 0
            ko1 = 0
            CALL EX3_SEND_RX1(
     I           bufftag, recvProc,
     I           along_i,
     I           il,ih,is,  jl,jh,js,  kl,kh,ks,
     I           io1,jo1,ko1,
     I           idl1,idh1, jdl1,jdh1, kdl1,kdh1,
     I           phi,
C    B           buff, n_buff, msgID,
     B           EX3_B_RX(1,in,iloc), EX3_MAX_BL, msgID(iloc),
     I           commType,
     I           myThid )
          ENDDO
        ENDDO

C       Then receive
        DO iloc = myBxLo(myThid), myBxHi(myThid)
          i_recvtile = ex3_p_itile(iloc)
          nN = ex3_e_n(i_recvtile)
          DO in = 1,nN
            i_sendtile = ex3_e_iopt(in,i_sendtile)
            CALL EX3_GET_BUFFTAG(
     I           i_sendtile, i_recvtile, in,
     O           bufftag,
     I           myThid )
            sendProc = ex3_t_iproc(i_sendtile)

C           =====  I direction  =====
            il = ex3_e_dat(2,1,in,i_sendtile)
            IF ( ex3_e_dat(1,1,in,i_sendtile) .EQ. 0 ) THEN
              along_i  = .FALSE.
              ih = ex3_e_dat(3,1,in,i_sendtile)
            ELSE
C             Here, "along" means the i dimension is perpendicular to
C             the "seam" between the two tiles
              along_i  = .TRUE.
              IF (IABS(ex3_e_dat(1,1,in,i_sendtile)) .EQ. 1) THEN
                ih = il + ex3_e_dat(1,1,in,i_sendtile) * OLx
              ELSE
                ih = il + ex3_e_dat(3,1,in,i_sendtile)
              ENDIF
            ENDIF
            is = 1
            IF (il .GT. ih) is = -1

C           =====  J direction  =====
            jl = ex3_e_dat(2,2,in,i_sendtile)
            IF ( ex3_e_dat(1,2,in,i_sendtile) .EQ. 0 ) THEN
              jh = ex3_e_dat(3,2,in,i_sendtile)
            ELSE
              IF (IABS(ex3_e_dat(1,2,in,i_sendtile)) .EQ. 1) THEN
                jh = jl + ex3_e_dat(1,2,in,i_sendtile) * OLy
              ELSE
                jh = jl + ex3_e_dat(3,2,in,i_sendtile)
              ENDIF
            ENDIF
            js = 1
            IF (jl .GT. jh) js = -1

            CALL EX3_RECV_RX1(
     I           bufftag, sendProc,
     I           along_i,
     I           il,ih,is,  jl,jh,js,  kl,kh,ks,
     I           idl1,idh1, jdl1,jdh1, kdl1,kdh1,
     I           phi,
C    B           buff, n_buff,
     B           EX3_B_RX(1,in,iloc), EX3_MAX_BL,
     I           commType,
     I           myThid )
          ENDDO
        ENDDO

      ELSEIF (gtype(1:1) .EQ. 'Z' .OR. gtype(1:1) .EQ. 'V') THEN

C       phi is a scalar located at Arakawa vorticity (cell-corner)
C       points

      ELSE
        WRITE(msgbuf,'(3a)')
     &       'EX3_XY_RX ERROR: grid type ''', gtype(1:1), 
     &       ''' is invalid -- please use one of [MTZV]'
        CALL print_error(msgbuf, mythid)
        STOP 'ABNORMAL END: S/R EX3_XY_RX'
      ENDIF

      CALL BAR2(myThid)

      RETURN
      END

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

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***