C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/exch2_uv_agrid_3d_rx.template,v 1.2 2006/11/18 01:09:00 heimbach Exp $ C $Name: $ #include "CPP_EEOPTIONS.h" #include "W2_OPTIONS.h" CBOP C !ROUTINE: EXCH2_UV_AGRID_3D_RX C !INTERFACE: SUBROUTINE EXCH2_UV_AGRID_3D_RX( U Uphi, Vphi, I withSigns, myNz, myThid ) C !DESCRIPTION: C*=====================================================================* C Purpose: SUBROUTINE EXCH2_UV_AGRID_3D_RX C handle exchanges for a 3D vector field on an A-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_RX (exch2_RX1_cube) - for each component C C*=====================================================================* C !USES: IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" #include "W2_EXCH2_TOPOLOGY.h" #include "W2_EXCH2_PARAMS.h" C !INPUT/OUTPUT PARAMETERS: C == Argument list variables == 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 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. C dummy[12] :: - copies of the vector components with haloes filled. INTEGER i,j,k,bi,bj INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RX negOne INTEGER mytile, myface CEOP 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 CALL EXCH2_RX1_CUBE( Uphi, 'T ', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) CALL EXCH2_RX1_CUBE( Uphi, 'T ', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) CALL EXCH2_RX1_CUBE( Vphi, 'T ', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) CALL EXCH2_RX1_CUBE( Vphi, 'T ', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) C- note: can substitute the low-level S/R calls above with: c CALL EXCH2_3D_RX( Uphi, myNz, myThid ) c CALL EXCH2_3D_RX( Vphi, myNz, myThid ) C Then if we are on the cube we may need to switch u and v components C and/or the signs depending on which cube face we are located. C-- Loops on tile and level indices: DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) DO k = 1,myNz C First we need to copy the component info into dummy arrays DO j = 1-OLy,sNy+OLy DO i = 1-OLx,sNx+OLx dummy1(i,j) = Uphi(i,j,k,bi,bj) dummy2(i,j) = Vphi(i,j,k,bi,bj) ENDDO ENDDO C Now choose what to do at each edge of the halo based on which face C (we assume that bj is always=1) mytile = W2_myTileList(bi) myface = exch2_myFace(mytile) C odd faces share disposition of all sections of the halo IF ( MOD(myface,2).EQ.1 ) THEN 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) = dummy1(sNx+i,j) c Vphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j) c ENDDO c ENDDO c ENDIF C west IF (exch2_isWedge(mytile).EQ.1) THEN DO j = 1-OLy,sNy+OLy DO i = 1,exchWidthX Uphi(1-i,j,k,bi,bj) = dummy2(1-i,j) Vphi(1-i,j,k,bi,bj) = dummy1(1-i,j)*negOne ENDDO ENDDO ENDIF C north IF (exch2_isNedge(mytile).EQ.1) THEN DO j = 1,exchWidthY DO i = 1-OLx,sNx+OLx Uphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)*negOne Vphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j) ENDDO ENDDO 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) = dummy1(i,1-j) c Vphi(i,1-j,k,bi,bj) = dummy2(i,1-j) c ENDDO c ENDDO c ENDIF ELSE C now the even faces (share disposition of all sections of the halo) C east IF (exch2_isEedge(mytile).EQ.1) THEN DO j = 1-OLy,sNy+OLy DO i = 1,exchWidthX Uphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j) Vphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)*negOne ENDDO ENDDO 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) = dummy1(1-i,j) c Vphi(1-i,j,k,bi,bj) = dummy2(1-i,j) 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) = dummy1(i,sNy+j) c Vphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j) c ENDDO c ENDDO c ENDIF C south IF (exch2_isSedge(mytile).EQ.1) THEN DO j = 1,exchWidthY DO i = 1-OLx,sNx+OLx Uphi(i,1-j,k,bi,bj) = dummy2(i,1-j)*negOne Vphi(i,1-j,k,bi,bj) = dummy1(i,1-j) ENDDO ENDDO 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: #ifndef AUTODIFF_EXCH2 CALL EXCH_RX( Uphi, I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) CALL EXCH_RX( Vphi, I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) #endif C--- using or not using CubedSphereExchange: end ENDIF RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CEH3 ;;; Local Variables: *** CEH3 ;;; mode:fortran *** CEH3 ;;; End: ***