Warning, /pkg/exch2/exch2_uv_cgrid_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
fc624899fa Jean*0001 #include "CPP_EEOPTIONS.h"
0002 #include "W2_OPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH2_UV_CGRID_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_UV_CGRID_3D_RX(
0009 U uPhi, vPhi,
0010 I withSigns, myNz, myThid )
0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH2_UV_CGRID_3D_RX
0015 C handle exchanges for a 3D vector field on a C-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_RX1_cube) - for each component
0027 C
0028 C*=====================================================================*
0029
0030 C !USES:
0031 IMPLICIT NONE
0032
0033 #include "SIZE.h"
0034 #include "EEPARAMS.h"
90219e5912 Jean*0035 #include "W2_EXCH2_SIZE.h"
fc624899fa Jean*0036 #include "W2_EXCH2_TOPOLOGY.h"
d0ce7fc1dc Jean*0037 c#ifdef W2_FILL_NULL_REGIONS
0038 c#include "W2_EXCH2_PARAMS.h"
0039 c#endif
fc624899fa Jean*0040
0041 C !INPUT/OUTPUT PARAMETERS:
0042 C == Argument list variables ==
0043 INTEGER myNz
0044 _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0045 _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0046 LOGICAL withSigns
0047 INTEGER myThid
0048
0049 C !LOCAL VARIABLES:
0050 C == Local variables ==
0051 C i,j,k,bi,bj :: loop indices.
0052 C OL[wens] :: Overlap extents in west, east, north, south.
0053 C exchWidth[XY] :: Extent of regions that will be exchanged.
0054 C uLoc,vLoc :: local copy of the vector components with haloes filled.
0055
0056 INTEGER i,j,k,bi,bj
0057 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0058 _RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0059 _RX vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0060 _RX negOne
0061 INTEGER myTile, myFace
0062 CEOP
0063
0064 OLw = OLx
0065 OLe = OLx
0066 OLn = OLy
0067 OLs = OLy
0068 exchWidthX = OLx
0069 exchWidthY = OLy
0070 negOne = 1.
0071 IF (withSigns) negOne = -1.
0072
0073 C-- First call the exchanges for the two components
0074
8bc539472e Jean*0075 CALL EXCH2_RX1_CUBE( uPhi, .FALSE., 'T ',
fc624899fa Jean*0076 I OLw, OLe, OLs, OLn, myNz,
0077 I exchWidthX, exchWidthY,
1a3a8861a0 Jean*0078 I EXCH_IGNORE_CORNERS, myThid )
8bc539472e Jean*0079 CALL EXCH2_RX1_CUBE( uPhi, .FALSE., 'T ',
fc624899fa Jean*0080 I OLw, OLe, OLs, OLn, myNz,
0081 I exchWidthX, exchWidthY,
8bc539472e Jean*0082 I EXCH_UPDATE_CORNERS, myThid )
fc624899fa Jean*0083
8bc539472e Jean*0084 CALL EXCH2_RX1_CUBE( vPhi, .FALSE., 'T ',
fc624899fa Jean*0085 I OLw, OLe, OLs, OLn, myNz,
0086 I exchWidthX, exchWidthY,
1a3a8861a0 Jean*0087 I EXCH_IGNORE_CORNERS, myThid )
8bc539472e Jean*0088 CALL EXCH2_RX1_CUBE( vPhi, .FALSE., 'T ',
fc624899fa Jean*0089 I OLw, OLe, OLs, OLn, myNz,
0090 I exchWidthX, exchWidthY,
8bc539472e Jean*0091 I EXCH_UPDATE_CORNERS, myThid )
fc624899fa Jean*0092
0093 C- note: can substitute the low-level S/R calls above with:
0094 c CALL EXCH2_3D_RX( uPhi, myNz, myThid )
0095 c CALL EXCH2_3D_RX( vPhi, myNz, myThid )
0096
5df640d755 Jean*0097 IF ( useCubedSphereExchange ) THEN
0098
fc624899fa Jean*0099 C-- Then, depending on which tile we are, we may need
0100 C 1) to switch u and v components and also to switch the signs
0101 C 2) to shift the index along the face edge.
0102 C 3) ensure that near-corner halo regions is filled in the correct order
0103 C (i.e. with velocity component already available after 1 exch)
0104 C- note: because of index shift, the order really matter:
0105 C odd faces, do North 1rst and then West;
0106 C even faces, do East 1rst and then South.
0107
0108 C-- Loops on tile indices:
0109 DO bj = myByLo(myThid), myByHi(myThid)
0110 DO bi = myBxLo(myThid), myBxHi(myThid)
0111
8bc539472e Jean*0112 C- Choose what to do at each edge of the halo based on which face we are
5df640d755 Jean*0113 myTile = W2_myTileList(bi,bj)
fc624899fa Jean*0114 myFace = exch2_myFace(myTile)
0115
0116 C-- Loops on level index:
0117 DO k = 1,myNz
0118
0119 C- First we copy the 2 components info into local dummy arrays uLoc,vLoc
0120 DO j = 1-OLy,sNy+OLy
0121 DO i = 1-OLx,sNx+OLx
0122 uLoc(i,j) = uPhi(i,j,k,bi,bj)
0123 vLoc(i,j) = vPhi(i,j,k,bi,bj)
0124 ENDDO
0125 ENDDO
0126
0127 C- odd faces share disposition of all sections of the halo
0128 IF ( MOD(myFace,2).EQ.1 ) THEN
0129 C- North:
0130 IF (exch2_isNedge(myTile).EQ.1) THEN
0131 C switch u <- v , reverse the sign & shift i+1 <- i
0132 DO j = 1,exchWidthY
0133 DO i = 1-OLx,sNx+OLx-1
0134 uPhi(i+1,sNy+j,k,bi,bj) = vLoc(i,sNy+j)*negOne
0135 ENDDO
0136 ENDDO
0137 C switch v <- u , keep the sign
0138 DO j = 1,exchWidthY
0139 DO i = 1-OLx,sNx+OLx
0140 vPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
0141 ENDDO
0142 ENDDO
0143 ENDIF
0144 C- South (nothing to change)
0145 c IF (exch2_isSedge(myTile).EQ.1) THEN
0146 c DO j = 1,exchWidthY
0147 c DO i = 1-OLx,sNx+OLx
0148 c uPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
0149 c vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
0150 c ENDDO
0151 c ENDDO
0152 c ENDIF
0153 C- East (nothing to change)
0154 c IF (exch2_isEedge(myTile).EQ.1) THEN
0155 c DO j = 1-OLy,sNy+OLy
0156 c DO i = 1,exchWidthX
0157 c uPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)
0158 c vPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
0159 c ENDDO
0160 c ENDDO
0161 c ENDIF
0162 C- West:
0163 IF (exch2_isWedge(myTile).EQ.1) THEN
0164 C switch u <- v , keep the sign
0165 DO j = 1-OLy,sNy+OLy
0166 DO i = 1,exchWidthX
0167 uPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
0168 ENDDO
0169 ENDDO
0170 C switch v <- u , reverse the sign & shift j+1 <- j
0171 DO j = 1-OLy,sNy+OLy-1
0172 DO i = 1,exchWidthX
0173 vPhi(1-i,j+1,k,bi,bj) = uLoc(1-i,j)*negOne
0174 ENDDO
0175 ENDDO
0176 ENDIF
0177
0178 ELSE
0179 C- Now the even faces (share disposition of all sections of the halo)
0180
0181 C- East:
0182 IF (exch2_isEedge(myTile).EQ.1) THEN
0183 C switch u <- v , keep the sign
0184 DO j = 1-OLy,sNy+OLy
0185 DO i = 1,exchWidthX
0186 uPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
0187 ENDDO
0188 ENDDO
0189 C switch v <- u , reverse the sign & shift j+1 <- j
0190 DO j = 1-OLy,sNy+OLy-1
0191 DO i = 1,exchWidthX
0192 vPhi(sNx+i,j+1,k,bi,bj) = uLoc(sNx+i,j)*negOne
0193 ENDDO
0194 ENDDO
0195 ENDIF
0196 C- West (nothing to change)
0197 c IF (exch2_isWedge(myTile).EQ.1) THEN
0198 c DO j = 1-OLy,sNy+OLy
0199 c DO i = 1,exchWidthX
0200 c uPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)
0201 c vPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
0202 c ENDDO
0203 c ENDDO
0204 c ENDIF
0205 C- North (nothing to change)
0206 c IF (exch2_isNedge(myTile).EQ.1) THEN
0207 c DO j = 1,exchWidthY
0208 c DO i = 1-OLx,sNx+OLx
0209 c uPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
0210 c vPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)
0211 c ENDDO
0212 c ENDDO
0213 c ENDIF
0214 C- South:
0215 IF (exch2_isSedge(myTile).EQ.1) THEN
0216 C switch u <- v , reverse the sign & shift i+1 <- i
0217 DO j = 1,exchWidthY
0218 DO i = 1-OLx,sNx+OLx-1
0219 uPhi(i+1,1-j,k,bi,bj) = vLoc(i,1-j)*negOne
0220 ENDDO
0221 ENDDO
0222 C switch v <- u , keep the sign
0223 DO j = 1,exchWidthY
0224 DO i = 1-OLx,sNx+OLx
0225 vPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
0226 ENDDO
0227 ENDDO
0228 ENDIF
0229
0230 C- end odd / even faces
0231 ENDIF
0232
0233 C-- end of Loops on level index k.
0234 ENDDO
0235
0236 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0237 C-- Now fix edges near cube-corner
0238
0239 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0240 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0241 IF ( MOD(myFace,2).EQ.1 ) THEN
0242 DO k=1,myNz
0243 DO i=1,OLx
0244 vPhi(1-i,1,k,bi,bj) = uPhi(1,1-i,k,bi,bj)*negOne
0245 ENDDO
0246 ENDDO
0247 ELSE
0248 DO k=1,myNz
0249 DO i=1,OLx
0250 uPhi(1,1-i,k,bi,bj) = vPhi(1-i,1,k,bi,bj)*negOne
0251 ENDDO
0252 ENDDO
0253 ENDIF
0254 ENDIF
0255
0256 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0257 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0258 IF ( MOD(myFace,2).EQ.1 ) THEN
0259 DO k=1,myNz
0260 DO i=1,OLx
0261 uPhi(sNx+1,1-i,k,bi,bj) = vPhi(sNx+i,1,k,bi,bj)
0262 ENDDO
0263 ENDDO
0264 ELSE
0265 DO k=1,myNz
0266 DO i=1,OLx
0267 vPhi(sNx+i,1,k,bi,bj) = uPhi(sNx+1,1-i,k,bi,bj)
0268 ENDDO
0269 ENDDO
0270 ENDIF
0271 ENDIF
0272
0273 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0274 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0275 IF ( MOD(myFace,2).EQ.1 ) THEN
0276 DO k=1,myNz
0277 DO i=1,OLx
0278 vPhi(sNx+i,sNy+1,k,bi,bj)=uPhi(sNx+1,sNy+i,k,bi,bj)*negOne
0279 ENDDO
0280 ENDDO
0281 ELSE
0282 DO k=1,myNz
0283 DO i=1,OLx
0284 uPhi(sNx+1,sNy+i,k,bi,bj)=vPhi(sNx+i,sNy+1,k,bi,bj)*negOne
0285 ENDDO
0286 ENDDO
0287 ENDIF
0288 ENDIF
0289
0290 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0291 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0292 IF ( MOD(myFace,2).EQ.1 ) THEN
0293 DO k=1,myNz
0294 DO i=1,OLx
0295 uPhi(1,sNy+i,k,bi,bj) = vPhi(1-i,sNy+1,k,bi,bj)
0296 ENDDO
0297 ENDDO
0298 ELSE
0299 DO k=1,myNz
0300 DO i=1,OLx
0301 vPhi(1-i,sNy+1,k,bi,bj) = uPhi(1,sNy+i,k,bi,bj)
0302 ENDDO
0303 ENDDO
0304 ENDIF
0305 ENDIF
0306
0307 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0308
0309 C-- Now zero out the null areas that should not be used in the numerics
0310 C Also add one valid u,v value next to the corner, that allows
0311 C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
0312
0313 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0314 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0315 C Zero SW corner points
0316 DO k=1,myNz
0317 #ifdef W2_FILL_NULL_REGIONS
0318 DO j=1-OLy,0
0319 DO i=1-OLx,0
0320 uPhi(i,j,k,bi,bj)=e2FillValue_RX
0321 ENDDO
0322 ENDDO
0323 DO j=1-OLy,0
0324 DO i=1-OLx,0
0325 vPhi(i,j,k,bi,bj)=e2FillValue_RX
0326 ENDDO
0327 ENDDO
0328 #endif
0329 uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
0330 vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
0331 ENDDO
0332 ENDIF
0333
0334 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0335 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0336 C Zero NW corner points
0337 DO k=1,myNz
0338 #ifdef W2_FILL_NULL_REGIONS
0339 DO j=sNy+1,sNy+OLy
0340 DO i=1-OLx,0
0341 uPhi(i,j,k,bi,bj)=e2FillValue_RX
0342 ENDDO
0343 ENDDO
0344 DO j=sNy+2,sNy+OLy
0345 DO i=1-OLx,0
0346 vPhi(i,j,k,bi,bj)=e2FillValue_RX
0347 ENDDO
0348 ENDDO
0349 #endif
0350 uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)*negOne
0351 vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)*negOne
0352 ENDDO
0353 ENDIF
0354
0355 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0356 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0357 C Zero SE corner points
0358 DO k=1,myNz
0359 #ifdef W2_FILL_NULL_REGIONS
0360 DO j=1-OLy,0
0361 DO i=sNx+2,sNx+OLx
0362 uPhi(i,j,k,bi,bj)=e2FillValue_RX
0363 ENDDO
0364 ENDDO
0365 DO j=1-OLy,0
0366 DO i=sNx+1,sNx+OLx
0367 vPhi(i,j,k,bi,bj)=e2FillValue_RX
0368 ENDDO
0369 ENDDO
0370 #endif
0371 uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)*negOne
0372 vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)*negOne
0373 ENDDO
0374 ENDIF
0375
0376 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0377 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0378 C Zero NE corner points
0379 DO k=1,myNz
0380 #ifdef W2_FILL_NULL_REGIONS
0381 DO j=sNy+1,sNy+OLy
0382 DO i=sNx+2,sNx+OLx
0383 uPhi(i,j,k,bi,bj)=e2FillValue_RX
0384 ENDDO
0385 ENDDO
0386 DO j=sNy+2,sNy+OLy
0387 DO i=sNx+1,sNx+OLx
0388 vPhi(i,j,k,bi,bj)=e2FillValue_RX
0389 ENDDO
0390 ENDDO
0391 #endif
0392 uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
0393 vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
0394 ENDDO
0395 ENDIF
0396 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0397
0398 C-- end of Loops on tile indices (bi,bj).
0399 ENDDO
0400 ENDDO
0401
0402 C--- using or not using CubedSphereExchange: end
0403 ENDIF
0404
0405 RETURN
0406 END
0407
0408 CEH3 ;;; Local Variables: ***
0409 CEH3 ;;; mode:fortran ***
0410 CEH3 ;;; End: ***
