C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/exch2/Attic/exch2_uv_xy_rx.template,v 1.3 2004/04/05 15:27:06 edhill Exp $ C $Name: $ #include "CPP_EEOPTIONS.h" CBOP C !ROUTINE: EXCH_UV_XY_RX C !INTERFACE: SUBROUTINE EXCH2_UV_XY_RX( U Uphi, Vphi, withSigns, I myThid ) IMPLICIT NONE C !DESCRIPTION: C *==========================================================* C | SUBROUTINE EXCH_UV_XY_RX C | o Handle exchanges for _RX, two-dimensional arrays. C *==========================================================* C | Driver exchange routine which branches to cube sphere or C | global, simple cartesian index grid. Exchange routine is C | called with two arrays that are components of a vector. C | These components are rotated and interchanged on the C | rotated grid during cube exchanges. C *==========================================================* C !USES: C === Global data === #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" #include "W2_EXCH2_TOPOLOGY.h" #include "W2_EXCH2_PARAMS.h" C !INPUT/OUTPUT PARAMETERS: C === Routine arguments === C Uphi :: Arrays with overlap regions are to be exchanged C Vphi Note - The interface to EXCH_ assumes that C the standard Fortran 77 sequence association rules C apply. C myThid :: My thread id. C withSigns :: Flag controlling whether vector is signed. _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,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, myNz INTEGER bi, bj, myTile, i, j CEOP OLw = OLx OLe = OLx OLn = OLy OLs = OLy exchWidthX = OLx exchWidthY = OLy myNz = 1 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, 'UV', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV', I OLw, OLe, OLs, OLn, myNz, I exchWidthX, exchWidthY, I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid ) DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) myTile = W2_myTileList(bi) IF ( exch2_isEedge(myTile) .EQ. 1 .AND. & exch2_isSedge(myTile) .EQ. 1 ) THEN C Uphi(snx+1, 0,bi,bj)= vPhi(snx+1, 1,bi,bj) DO j=1-olx,0 Uphi(snx+1, j,bi,bj)= vPhi(snx+(1-j), 1,bi,bj) ENDDO ENDIF IF ( withSigns ) THEN IF ( exch2_isEedge(myTile) .EQ. 1 .AND. & exch2_isNedge(myTile) .EQ. 1 ) THEN C Uphi(snx+1,sny+1,bi,bj)=-vPhi(snx+1,sny+1,bi,bj) DO j=1,olx Uphi(snx+1,sny+j,bi,bj)=-vPhi(snx+j,sny+1,bi,bj) ENDDO ENDIF ELSE IF ( exch2_isEedge(myTile) .EQ. 1 .AND. & exch2_isNedge(myTile) .EQ. 1 ) THEN C Uphi(snx+1,sny+1,bi,bj)= vPhi(snx+1,sny+1,bi,bj) DO j=1,olx Uphi(snx+1,sny+j,bi,bj)= vPhi(snx+j,sny+1,bi,bj) ENDDO ENDIF ENDIF C Now zero out the null areas that should not be used in the numerics IF ( exch2_isWedge(myTile) .EQ. 1 .AND. & exch2_isSedge(myTile) .EQ. 1 ) THEN C Zero SW corner points DO J=1-OLx,0 DO I=1-OLx,0 uPhi(I,J,bi,bj)=0. ENDDO ENDDO DO J=1-OLx,0 DO I=1-OLx,0 vPhi(I,J,bi,bj)=0. ENDDO ENDDO ENDIF IF ( exch2_isWedge(myTile) .EQ. 1 .AND. & exch2_isNedge(myTile) .EQ. 1 ) THEN C Zero NW corner points DO J=sNy+1,sNy+OLy DO I=1-OLx,0 uPhi(I,J,bi,bj)=0. ENDDO ENDDO DO J=sNy+2,sNy+OLy DO I=1-OLx,0 vPhi(I,J,bi,bj)=0. ENDDO ENDDO ENDIF IF ( exch2_isEedge(myTile) .EQ. 1 .AND. & exch2_isSedge(myTile) .EQ. 1 ) THEN C Zero SE corner points DO J=1-OLx,0 DO I=sNx+2,sNx+OLx uPhi(I,J,bi,bj)=0. ENDDO ENDDO DO J=1-OLx,0 DO I=sNx+1,sNx+OLx vPhi(I,J,bi,bj)=0. ENDDO ENDDO ENDIF IF ( exch2_isEedge(myTile) .EQ. 1 .AND. & exch2_isNedge(myTile) .EQ. 1 ) THEN C Zero NE corner points DO J=sNy+1,sNy+OLy DO I=sNx+2,sNx+OLx uPhi(I,J,bi,bj)=0. ENDDO ENDDO DO J=sNy+2,sNy+OLy DO I=sNx+1,sNx+OLx vPhi(I,J,bi,bj)=0. ENDDO 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_XY_RX( Uphi, myThid ) _EXCH_XY_RX( Vphi, myThid ) ENDIF RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CEH3 ;;; Local Variables: *** CEH3 ;;; mode:fortran *** CEH3 ;;; End: ***