C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/exch2_uv_3d_rx.template,v 1.4 2008/08/02 23:04:38 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#include "W2_OPTIONS.h"
#undef DO_CORNER_COPY_V2U

CBOP
C     !ROUTINE: EXCH2_UV_3D_RX

C     !INTERFACE:
      SUBROUTINE EXCH2_UV_3D_RX(
     U                           Uphi, Vphi,
     I                           withSigns, myNz, myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH2_UV_3D_RX
C     | o Handle exchanges for _RX, 3-dimensional vector arrays.
C     *==========================================================*
C     | Vector arrays need to be rotated and interchaged for
C     | exchange operations on some grids. This driver routine
C     | branches to support this.
C     *==========================================================*

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

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     phi    :: Array with overlap regions are to be exchanged
C               Note - The interface to EXCH_RX assumes that
C               the standard Fortran 77 sequence association rules
C               apply.
C     myNz   :: 3rd dimension of array to exchange
C     myThid :: My thread id.
      INTEGER myNz
      _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      LOGICAL withSigns
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     OL[wens]       :: Overlap extents in west, east, north, south.
C     exchWidth[XY]  :: Extent of regions that will be exchanged.
      INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
      INTEGER bi, bj, myTile, k, j
#ifdef W2_FILL_NULL_REGIONS
      INTEGER i
#endif
CEOP

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
C     ** NOTE ** The exchange routine we use here does not
C                require the preceeding and following barriers.
C                However, the slow, simple exchange interface
C                that is calling it here is meant to ensure
C                that threads are synchronised before exchanges
C                begine.

      IF (useCubedSphereExchange) THEN

       CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
c      CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
c    I            OLw, OLe, OLs, OLn, myNz,
c    I            exchWidthX, exchWidthY,
c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
        myTile = W2_myTileList(bi)

#ifdef DO_CORNER_COPY_V2U
        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
         DO k=1,myNz
C         Uphi(snx+1,    0,k,bi,bj)= vPhi(snx+1,    1,k,bi,bj)
          DO j=1-olx,0
           Uphi(snx+1,    j,k,bi,bj)= vPhi(snx+(1-j),    1,k,bi,bj)
          ENDDO
         ENDDO
        ENDIF
        IF ( withSigns ) THEN
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO k=1,myNz
C          Uphi(snx+1,sny+1,k,bi,bj)=-vPhi(snx+1,sny+1,k,bi,bj)
           DO j=1,olx
            Uphi(snx+1,sny+j,k,bi,bj)=-vPhi(snx+j,sny+1,k,bi,bj)
           ENDDO
          ENDDO
         ENDIF
        ELSE
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO k=1,myNz
C          Uphi(snx+1,sny+1,k,bi,bj)= vPhi(snx+1,sny+1,k,bi,bj)
           DO j=1,olx
            Uphi(snx+1,sny+j,k,bi,bj)= vPhi(snx+j,sny+1,k,bi,bj)
           ENDDO
          ENDDO
         ENDIF
        ENDIF
#endif /* DO_CORNER_COPY_V2U */

C--     Now zero out the null areas that should not be used in the numerics
C       Also add one valid u,v value next to the corner, that allows
C        to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))

        IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
C        Zero SW corner points
         DO K=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO J=1-OLx,0
           DO I=1-OLx,0
            uPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO J=1-OLx,0
           DO I=1-OLx,0
            vPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
            uPhi(0,0,K,bi,bj)=vPhi(1,0,K,bi,bj)
            vPhi(0,0,K,bi,bj)=uPhi(0,1,K,bi,bj)
         ENDDO
        ENDIF

        IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &       exch2_isNedge(myTile) .EQ. 1 ) THEN
C        Zero NW corner points
         DO K=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO J=sNy+1,sNy+OLy
           DO I=1-OLx,0
            uPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO J=sNy+2,sNy+OLy
           DO I=1-OLx,0
            vPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
          IF ( withSigns ) THEN
            uPhi(0,sNy+1,K,bi,bj)=-vPhi(1,sNy+2,K,bi,bj)
            vPhi(0,sNy+2,K,bi,bj)=-uPhi(0,sNy,K,bi,bj)
          ELSE
            uPhi(0,sNy+1,K,bi,bj)= vPhi(1,sNy+2,K,bi,bj)
            vPhi(0,sNy+2,K,bi,bj)= uPhi(0,sNy,K,bi,bj)
          ENDIF
         ENDDO
        ENDIF

        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
C        Zero SE corner points
         DO K=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO J=1-OLx,0
           DO I=sNx+2,sNx+OLx
            uPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO J=1-OLx,0
           DO I=sNx+1,sNx+OLx
            vPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
          IF ( withSigns ) THEN
            uPhi(sNx+2,0,K,bi,bj)=-vPhi(sNx,0,K,bi,bj)
            vPhi(sNx+1,0,K,bi,bj)=-uPhi(sNx+2,1,K,bi,bj)
          ELSE
            uPhi(sNx+2,0,K,bi,bj)= vPhi(sNx,0,K,bi,bj)
            vPhi(sNx+1,0,K,bi,bj)= uPhi(sNx+2,1,K,bi,bj)
          ENDIF
         ENDDO
        ENDIF

        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isNedge(myTile) .EQ. 1 ) THEN
C        Zero NE corner points
         DO K=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO J=sNy+1,sNy+OLy
           DO I=sNx+2,sNx+OLx
            uPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO J=sNy+2,sNy+OLy
           DO I=sNx+1,sNx+OLx
            vPhi(I,J,K,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
            uPhi(sNx+2,sNy+1,K,bi,bj)=vPhi(sNx,sNy+2,K,bi,bj)
            vPhi(sNx+1,sNy+2,K,bi,bj)=uPhi(sNx+2,sNy,K,bi,bj)
         ENDDO
        ENDIF
       ENDDO
      ENDDO

      ELSE

c      CALL EXCH_RX( Uphi,
c    I            OLw, OLe, OLs, OLn, myNz,
c    I            exchWidthX, exchWidthY,
c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
c      CALL EXCH_RX( Vphi,
c    I            OLw, OLe, OLs, OLn, myNz,
c    I            exchWidthX, exchWidthY,
c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
c_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
       _EXCH_XYZ_RX( Uphi, myThid )
       _EXCH_XYZ_RX( Vphi, myThid )

      ENDIF

      RETURN
      END

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

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