Warning, /pkg/exch2/exch2_uv_dgrid_3d_rx.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c7e6ea4849 Jean*0001 #include "CPP_EEOPTIONS.h"
0002 #include "W2_OPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH2_UV_DGRID_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_UV_DGRID_3D_RX(
0009 U uPhi, vPhi,
0010 I withSigns, myNz, myThid )
0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH2_UV_DGRID_3D_RX
0015 C handle exchanges for a 3D vector field on an D-grid.
0016 C
0017 C Input:
0018 C uPhi(lon,lat,levs,bi,bj) :: first component of vector
0019 C vPhi(lon,lat,levs,bi,bj) :: second component of vector
0020 C withSigns (logical) :: true to use sign of components
0021 C myNz :: 3rd dimension of input arrays uPhi,vPhi
0022 C myThid :: my Thread Id number
0023 C
0024 C Output: uPhi and vPhi are updated (halo regions filled)
0025 C
0026 C Calls: EXCH_RX (EXCH2_RX2_CUBE) ignoring sign
0027 C then put back the right signs
0028 C
0029 C*=====================================================================*
0030
0031 C !USES:
0032 IMPLICIT NONE
0033
0034 #include "SIZE.h"
0035 #include "EEPARAMS.h"
90219e5912 Jean*0036 #include "W2_EXCH2_SIZE.h"
c7e6ea4849 Jean*0037 #include "W2_EXCH2_TOPOLOGY.h"
0038
0039 C !INPUT/OUTPUT PARAMETERS:
0040 C == Argument list variables ==
0041 INTEGER myNz
0042 _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0043 _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0044 LOGICAL withSigns
0045 INTEGER myThid
0046
0047 C !LOCAL VARIABLES:
0048 C == Local variables ==
0049 C i,j,k,bi,bj :: loop indices.
0050 C OL[wens] :: Overlap extents in west, east, north, south.
0051 C exchWidth[XY] :: Extent of regions that will be exchanged.
0052
0053 INTEGER i,j,k,bi,bj
0054 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0055 _RX negOne
0056 INTEGER myTile, myFace
0057 CEOP
0058
0059 OLw = OLx
0060 OLe = OLx
0061 OLn = OLy
0062 OLs = OLy
0063 exchWidthX = OLx
0064 exchWidthY = OLy
0065 negOne = 1.
0066 IF (withSigns) negOne = -1.
0067
0068 C-- First call the exchanges for the two components, ignoring the Sign
0069 C note the order: vPhi,uPhi on D-grid are co-located with (u,v)_Cgrid
0070
8bc539472e Jean*0071 c CALL EXCH2_RX2_CUBE( vPhi, uPhi, .FALSE., 'Cg',
c7e6ea4849 Jean*0072 c I OLw, OLe, OLs, OLn, myNz,
0073 c I exchWidthX, exchWidthY,
8bc539472e Jean*0074 c I EXCH_UPDATE_CORNERS, myThid )
0075 c CALL EXCH2_RX2_CUBE( vPhi, uPhi, .FALSE., 'Cg',
c7e6ea4849 Jean*0076 c I OLw, OLe, OLs, OLn, myNz,
0077 c I exchWidthX, exchWidthY,
8bc539472e Jean*0078 c I EXCH_UPDATE_CORNERS, myThid )
c7e6ea4849 Jean*0079
0080 C- note: can substitute the low-level S/R calls above with:
0081 #ifdef W2_USE_R1_ONLY
0082 CALL EXCH2_UV_CGRID_3D_RX(
0083 U vPhi, uPhi,
0084 I .FALSE., myNz, myThid )
0085 #else
0086 CALL EXCH2_UV_3D_RX(
0087 U vPhi, uPhi,
0088 I .FALSE., myNz, myThid )
0089 #endif
0090
5df640d755 Jean*0091 IF ( useCubedSphereExchange ) THEN
0092 C--- using CubedSphereExchange:
0093
c7e6ea4849 Jean*0094 C-- Then we may need to switch the signs depending on which cube face
0095 C we are located.
0096
0097 C-- Loops on tile indices:
0098 DO bj = myByLo(myThid), myByHi(myThid)
0099 DO bi = myBxLo(myThid), myBxHi(myThid)
0100
8bc539472e Jean*0101 C- Choose what to do at each edge of the halo based on which face we are
5df640d755 Jean*0102 myTile = W2_myTileList(bi,bj)
c7e6ea4849 Jean*0103 myFace = exch2_myFace(myTile)
0104
0105 C-- Loops on level index:
0106 DO k = 1,myNz
0107
0108 C- odd faces share disposition of all sections of the halo
0109 IF ( MOD(myFace,2).EQ.1 ) THEN
0110 C- North:
0111 IF (exch2_isNedge(myTile).EQ.1) THEN
0112 DO j = 1,exchWidthY
0113 DO i = 1-OLx,sNx+OLx
0114 uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)*negOne
0115 c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
0116 ENDDO
0117 ENDDO
0118 ENDIF
0119 C- South: (nothing to change)
0120 c IF (exch2_isSedge(myTile).EQ.1) THEN
0121 c DO j = 1,exchWidthY
0122 c DO i = 1-OLx,sNx+OLx
0123 c uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)
0124 c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
0125 c ENDDO
0126 c ENDDO
0127 c ENDIF
0128 C- East: (nothing to change)
0129 c IF (exch2_isEedge(myTile).EQ.1) THEN
0130 c DO j = 1-OLy,sNy+OLy
0131 c DO i = 1,exchWidthX
0132 c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
0133 c vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)
0134 c ENDDO
0135 c ENDDO
0136 c ENDIF
0137 C- West:
0138 IF (exch2_isWedge(myTile).EQ.1) THEN
0139 DO j = 1-OLy,sNy+OLy
0140 DO i = 1,exchWidthX
0141 c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
0142 vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)*negOne
0143 ENDDO
0144 ENDDO
0145 ENDIF
0146
0147 ELSE
0148 C- Now the even faces (share disposition of all sections of the halo)
0149
0150 C- East:
0151 IF (exch2_isEedge(myTile).EQ.1) THEN
0152 DO j = 1-OLy,sNy+OLy
0153 DO i = 1,exchWidthX
0154 c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
0155 vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)*negOne
0156 ENDDO
0157 ENDDO
0158 ENDIF
0159 C- West: (nothing to change)
0160 c IF (exch2_isWedge(myTile).EQ.1) THEN
0161 c DO j = 1-OLy,sNy+OLy
0162 c DO i = 1,exchWidthX
0163 c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
0164 c vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)
0165 c ENDDO
0166 c ENDDO
0167 c ENDIF
0168 C- North: (nothing to change)
0169 c IF (exch2_isNedge(myTile).EQ.1) THEN
0170 c DO j = 1,exchWidthY
0171 c DO i = 1-OLx,sNx+OLx
0172 c uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)
0173 c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
0174 c ENDDO
0175 c ENDDO
0176 c ENDIF
0177 C- South:
0178 IF (exch2_isSedge(myTile).EQ.1) THEN
0179 DO j = 1,exchWidthY
0180 DO i = 1-OLx,sNx+OLx
0181 uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)*negOne
0182 c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
0183 ENDDO
0184 ENDDO
0185 ENDIF
0186
0187 C end odd / even faces
0188 ENDIF
0189
0190 C-- end of Loops on tile and level indices (k,bi,bj).
0191 ENDDO
0192 ENDDO
0193 ENDDO
0194
0195 C--- using or not using CubedSphereExchange: end
0196 ENDIF
0197
0198 RETURN
0199 END
0200
0201 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0202
0203 CEH3 ;;; Local Variables: ***
0204 CEH3 ;;; mode:fortran ***
0205 CEH3 ;;; End: ***
