C $Header: /u/gcmpack/MITgcm/eesupp/src/exch_uv_dgrid_3d_rx.template,v 1.4 2012/05/14 13:15:05 jmc Exp $
C $Name: $
#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"
CBOP
C !ROUTINE: EXCH_UV_DGRID_3D_RS
C !INTERFACE:
SUBROUTINE EXCH_UV_DGRID_3D_RS(
U uPhi, vPhi,
I withSigns, myNz, myThid )
C !DESCRIPTION:
C*=====================================================================*
C Purpose: SUBROUTINE EXCH_UV_DGRID_3D_RS
C handle exchanges for a 3D vector field on an D-grid.
C
C Input:
C uPhi(lon,lat,levs,bi,bj) :: first component of vector
C vPhi(lon,lat,levs,bi,bj) :: second component of vector
C withSigns (logical) :: true to use sign of components
C myNz :: 3rd dimension of input arrays uPhi,vPhi
C myThid :: my Thread Id number
C
C Output: uPhi and vPhi are updated (halo regions filled)
C
C Calls: EXCH_RS (EXCH_UV_RS_cube) ignoring sign
C then put back the right signs
C
C NOTES: 1) If using CubedSphereExchange, only works on ONE PROCESSOR!
C*=====================================================================*
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
C !INPUT/OUTPUT PARAMETERS:
C == Argument list variables ==
INTEGER myNz
_RS uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
_RS vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
LOGICAL withSigns
INTEGER myThid
C !LOCAL VARIABLES:
#ifndef ALLOW_EXCH2
C == Local variables ==
C i,j,k,bi,bj :: loop indices.
C OL[wens] :: Overlap extents in west, east, north, south.
C exchWidth[XY] :: Extent of regions that will be exchanged.
INTEGER i,j,k,bi,bj
INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
_RS negOne
INTEGER myFace
#endif
CEOP
#ifdef ALLOW_EXCH2
CALL EXCH2_UV_DGRID_3D_RS(
U uPhi, vPhi,
I withSigns, myNz, myThid )
#else /* ALLOW_EXCH2 */
OLw = OLx
OLe = OLx
OLn = OLy
OLs = OLy
exchWidthX = OLx
exchWidthY = OLy
negOne = 1.
IF (withSigns) negOne = -1.
IF ( useCubedSphereExchange ) THEN
C--- using CubedSphereExchange:
C-- First call the exchanges for the two components, ignoring the Sign
C note the order: vPhi,uPhi on D-grid are co-located with (u,v)_Cgrid
c CALL EXCH1_UV_RS_CUBE( vPhi, uPhi, .FALSE.,
c I OLw, OLe, OLs, OLn, myNz,
c I exchWidthX, exchWidthY,
c I EXCH_UPDATE_CORNERS, myThid )
C- note: can substitute the low-level S/R calls above with:
CALL EXCH_UV_3D_RS(
U vPhi, uPhi,
I .FALSE., myNz, myThid )
C-- Then we may need to switch the signs depending on which cube face
C we are located.
C-- Loops on tile indices:
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
C- Now choose what to do at each edge of the halo based on which face
C (we assume that bj is always=1)
myFace = bi
C-- Loops on level index:
DO k = 1,myNz
C- odd faces share disposition of all sections of the halo
IF ( MOD(myFace,2).EQ.1 ) THEN
C- North:
c IF (exch2_isNedge(myTile).EQ.1) THEN
DO j = 1,exchWidthY
DO i = 1-OLx,sNx+OLx
uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)*negOne
c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
ENDDO
ENDDO
c ENDIF
C- South: (nothing to change)
c IF (exch2_isSedge(myTile).EQ.1) THEN
c DO j = 1,exchWidthY
c DO i = 1-OLx,sNx+OLx
c uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)
c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
c ENDDO
c ENDDO
c ENDIF
C- East: (nothing to change)
c IF (exch2_isEedge(myTile).EQ.1) THEN
c DO j = 1-OLy,sNy+OLy
c DO i = 1,exchWidthX
c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
c vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)
c ENDDO
c ENDDO
c ENDIF
C- West:
c IF (exch2_isWedge(myTile).EQ.1) THEN
DO j = 1-OLy,sNy+OLy
DO i = 1,exchWidthX
c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)*negOne
ENDDO
ENDDO
c ENDIF
ELSE
C- Now the even faces (share disposition of all sections of the halo)
C- East:
c IF (exch2_isEedge(myTile).EQ.1) THEN
DO j = 1-OLy,sNy+OLy
DO i = 1,exchWidthX
c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)*negOne
ENDDO
ENDDO
c ENDIF
C- West: (nothing to change)
c IF (exch2_isWedge(myTile).EQ.1) THEN
c DO j = 1-OLy,sNy+OLy
c DO i = 1,exchWidthX
c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
c vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)
c ENDDO
c ENDDO
c ENDIF
C- North: (nothing to change)
c IF (exch2_isNedge(myTile).EQ.1) THEN
c DO j = 1,exchWidthY
c DO i = 1-OLx,sNx+OLx
c uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)
c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
c ENDDO
c ENDDO
c ENDIF
C- South:
c IF (exch2_isSedge(myTile).EQ.1) THEN
DO j = 1,exchWidthY
DO i = 1-OLx,sNx+OLx
uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)*negOne
c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
ENDDO
ENDDO
c ENDIF
C end odd / even faces
ENDIF
C-- end of Loops on tile and level indices (k,bi,bj).
ENDDO
ENDDO
ENDDO
ELSE
C--- not using CubedSphereExchange:
#ifdef DISCONNECTED_TILES
CALL EXCH0_RS( uPhi,
I OLw, OLe, OLs, OLn, myNz,
I exchWidthX, exchWidthY,
I EXCH_UPDATE_CORNERS, myThid )
CALL EXCH0_RS( vPhi,
I OLw, OLe, OLs, OLn, myNz,
I exchWidthX, exchWidthY,
I EXCH_UPDATE_CORNERS, myThid )
#else /* DISCONNECTED_TILES */
CALL EXCH1_RS( uPhi,
I OLw, OLe, OLs, OLn, myNz,
I exchWidthX, exchWidthY,
I EXCH_UPDATE_CORNERS, myThid )
CALL EXCH1_RS( vPhi,
I OLw, OLe, OLs, OLn, myNz,
I exchWidthX, exchWidthY,
I EXCH_UPDATE_CORNERS, myThid )
#endif /* DISCONNECTED_TILES */
C--- using or not using CubedSphereExchange: end
ENDIF
#endif /* ALLOW_EXCH2 */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***