Warning, /eesupp/src/exch_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
2485739087 Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH_UV_DGRID_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH_UV_DGRID_3D_RX(
0009 U uPhi, vPhi,
0010 I withSigns, myNz, myThid )
0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH_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 (EXCH_UV_RX_cube) ignoring sign
0027 C then put back the right signs
0028 C
0029 C NOTES: 1) If using CubedSphereExchange, only works on ONE PROCESSOR!
0030 C*=====================================================================*
0031
0032 C !USES:
0033 IMPLICIT NONE
0034
0035 #include "SIZE.h"
0036 #include "EEPARAMS.h"
0037
0038 C !INPUT/OUTPUT PARAMETERS:
0039 C == Argument list variables ==
0040 INTEGER myNz
0041 _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0042 _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0043 LOGICAL withSigns
0044 INTEGER myThid
0045
0046 C !LOCAL VARIABLES:
0047 #ifndef ALLOW_EXCH2
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 myFace
0057 #endif
0058 CEOP
0059
0060 #ifdef ALLOW_EXCH2
0061 CALL EXCH2_UV_DGRID_3D_RX(
6979a1789e Jean*0062 U uPhi, vPhi,
2485739087 Jean*0063 I withSigns, myNz, myThid )
0064 #else /* ALLOW_EXCH2 */
0065 OLw = OLx
0066 OLe = OLx
0067 OLn = OLy
0068 OLs = OLy
0069 exchWidthX = OLx
0070 exchWidthY = OLy
0071 negOne = 1.
0072 IF (withSigns) negOne = -1.
0073
0074 IF ( useCubedSphereExchange ) THEN
0075 C--- using CubedSphereExchange:
0076
0077 C-- First call the exchanges for the two components, ignoring the Sign
0078 C note the order: vPhi,uPhi on D-grid are co-located with (u,v)_Cgrid
0079
45d7b5cc4e Jean*0080 c CALL EXCH1_UV_RX_CUBE( vPhi, uPhi, .FALSE.,
2485739087 Jean*0081 c I OLw, OLe, OLs, OLn, myNz,
0082 c I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0083 c I EXCH_UPDATE_CORNERS, myThid )
2485739087 Jean*0084
0085 C- note: can substitute the low-level S/R calls above with:
1d87abbb0d Jean*0086 CALL EXCH_UV_3D_RX(
2485739087 Jean*0087 U vPhi, uPhi,
0088 I .FALSE., myNz, myThid )
0089
0090 C-- Then we may need to switch the signs depending on which cube face
0091 C we are located.
0092
0093 C-- Loops on tile indices:
0094 DO bj = myByLo(myThid), myByHi(myThid)
0095 DO bi = myBxLo(myThid), myBxHi(myThid)
0096
0097 C- Now choose what to do at each edge of the halo based on which face
0098 C (we assume that bj is always=1)
0099 myFace = bi
0100
0101 C-- Loops on level index:
0102 DO k = 1,myNz
0103
0104 C- odd faces share disposition of all sections of the halo
0105 IF ( MOD(myFace,2).EQ.1 ) THEN
0106 C- North:
0107 c IF (exch2_isNedge(myTile).EQ.1) THEN
0108 DO j = 1,exchWidthY
0109 DO i = 1-OLx,sNx+OLx
0110 uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)*negOne
0111 c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
0112 ENDDO
0113 ENDDO
0114 c ENDIF
0115 C- South: (nothing to change)
0116 c IF (exch2_isSedge(myTile).EQ.1) THEN
0117 c DO j = 1,exchWidthY
0118 c DO i = 1-OLx,sNx+OLx
0119 c uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)
0120 c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
0121 c ENDDO
0122 c ENDDO
0123 c ENDIF
0124 C- East: (nothing to change)
0125 c IF (exch2_isEedge(myTile).EQ.1) THEN
0126 c DO j = 1-OLy,sNy+OLy
0127 c DO i = 1,exchWidthX
0128 c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
0129 c vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)
0130 c ENDDO
0131 c ENDDO
0132 c ENDIF
0133 C- West:
0134 c IF (exch2_isWedge(myTile).EQ.1) THEN
0135 DO j = 1-OLy,sNy+OLy
0136 DO i = 1,exchWidthX
0137 c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
0138 vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)*negOne
0139 ENDDO
0140 ENDDO
0141 c ENDIF
0142
0143 ELSE
0144 C- Now the even faces (share disposition of all sections of the halo)
0145
0146 C- East:
0147 c IF (exch2_isEedge(myTile).EQ.1) THEN
0148 DO j = 1-OLy,sNy+OLy
0149 DO i = 1,exchWidthX
0150 c uPhi(sNx+i,j,k,bi,bj) = uPhi(sNx+i,j,k,bi,bj)
0151 vPhi(sNx+i,j,k,bi,bj) = vPhi(sNx+i,j,k,bi,bj)*negOne
0152 ENDDO
0153 ENDDO
0154 c ENDIF
0155 C- West: (nothing to change)
0156 c IF (exch2_isWedge(myTile).EQ.1) THEN
0157 c DO j = 1-OLy,sNy+OLy
0158 c DO i = 1,exchWidthX
0159 c uPhi(1-i,j,k,bi,bj) = uPhi(1-i,j,k,bi,bj)
0160 c vPhi(1-i,j,k,bi,bj) = vPhi(1-i,j,k,bi,bj)
0161 c ENDDO
0162 c ENDDO
0163 c ENDIF
0164 C- North: (nothing to change)
0165 c IF (exch2_isNedge(myTile).EQ.1) THEN
0166 c DO j = 1,exchWidthY
0167 c DO i = 1-OLx,sNx+OLx
0168 c uPhi(i,sNy+j,k,bi,bj) = uPhi(i,sNy+j,k,bi,bj)
0169 c vPhi(i,sNy+j,k,bi,bj) = vPhi(i,sNy+j,k,bi,bj)
0170 c ENDDO
0171 c ENDDO
0172 c ENDIF
0173 C- South:
0174 c IF (exch2_isSedge(myTile).EQ.1) THEN
0175 DO j = 1,exchWidthY
0176 DO i = 1-OLx,sNx+OLx
0177 uPhi(i,1-j,k,bi,bj) = uPhi(i,1-j,k,bi,bj)*negOne
0178 c vPhi(i,1-j,k,bi,bj) = vPhi(i,1-j,k,bi,bj)
0179 ENDDO
0180 ENDDO
0181 c ENDIF
0182
0183 C end odd / even faces
0184 ENDIF
0185
0186 C-- end of Loops on tile and level indices (k,bi,bj).
0187 ENDDO
0188 ENDDO
0189 ENDDO
0190
0191 ELSE
0192 C--- not using CubedSphereExchange:
0193
6979a1789e Jean*0194 #ifdef DISCONNECTED_TILES
0195 CALL EXCH0_RX( uPhi,
0196 I OLw, OLe, OLs, OLn, myNz,
0197 I exchWidthX, exchWidthY,
0198 I EXCH_UPDATE_CORNERS, myThid )
0199 CALL EXCH0_RX( vPhi,
0200 I OLw, OLe, OLs, OLn, myNz,
0201 I exchWidthX, exchWidthY,
0202 I EXCH_UPDATE_CORNERS, myThid )
0203 #else /* DISCONNECTED_TILES */
45d7b5cc4e Jean*0204 CALL EXCH1_RX( uPhi,
2485739087 Jean*0205 I OLw, OLe, OLs, OLn, myNz,
0206 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0207 I EXCH_UPDATE_CORNERS, myThid )
0208 CALL EXCH1_RX( vPhi,
2485739087 Jean*0209 I OLw, OLe, OLs, OLn, myNz,
0210 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0211 I EXCH_UPDATE_CORNERS, myThid )
6979a1789e Jean*0212 #endif /* DISCONNECTED_TILES */
2485739087 Jean*0213
0214 C--- using or not using CubedSphereExchange: end
0215 ENDIF
0216
0217 #endif /* ALLOW_EXCH2 */
6979a1789e Jean*0218
0219 RETURN
2485739087 Jean*0220 END
0221
0222 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0223
0224 CEH3 ;;; Local Variables: ***
0225 CEH3 ;;; mode:fortran ***
0226 CEH3 ;;; End: ***
