Warning, /pkg/exch2/exch2_uv_3d_rx.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit aa6b2555 on 2021-06-06 02:50:10 UTC
046fd16d1c Andr*0001 #include "CPP_EEOPTIONS.h"
8c27c9de99 Jean*0002 #include "W2_OPTIONS.h"
1ec0ee365b Jean*0003 #undef DO_CORNER_COPY_V2U
046fd16d1c Andr*0004
0005 CBOP
d4e639dc4c Jean*0006 C !ROUTINE: EXCH2_UV_3D_RX
046fd16d1c Andr*0007
0008 C !INTERFACE:
d4e639dc4c Jean*0009 SUBROUTINE EXCH2_UV_3D_RX(
0010 U Uphi, Vphi,
0011 I withSigns, myNz, myThid )
0012
046fd16d1c Andr*0013 C !DESCRIPTION:
0014 C *==========================================================*
d4e639dc4c Jean*0015 C | SUBROUTINE EXCH2_UV_3D_RX
8c27c9de99 Jean*0016 C | o Handle exchanges for _RX, 3-dimensional vector arrays.
046fd16d1c Andr*0017 C *==========================================================*
d6ea3164dc Jean*0018 C | Vector arrays need to be rotated and interchanged for
046fd16d1c Andr*0019 C | exchange operations on some grids. This driver routine
0020 C | branches to support this.
0021 C *==========================================================*
0022
0023 C !USES:
d4e639dc4c Jean*0024 IMPLICIT NONE
046fd16d1c Andr*0025 C === Global data ===
0026 #include "SIZE.h"
0027 #include "EEPARAMS.h"
90219e5912 Jean*0028 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0029 #include "W2_EXCH2_TOPOLOGY.h"
d0ce7fc1dc Jean*0030 c#ifdef W2_FILL_NULL_REGIONS
0031 c#include "W2_EXCH2_PARAMS.h"
0032 c#endif
046fd16d1c Andr*0033
0034 C !INPUT/OUTPUT PARAMETERS:
0035 C === Routine arguments ===
0036 C phi :: Array with overlap regions are to be exchanged
0037 C Note - The interface to EXCH_RX assumes that
0038 C the standard Fortran 77 sequence association rules
0039 C apply.
d4e639dc4c Jean*0040 C myNz :: 3rd dimension of array to exchange
046fd16d1c Andr*0041 C myThid :: My thread id.
d4e639dc4c Jean*0042 INTEGER myNz
0043 _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0044 _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
046fd16d1c Andr*0045 LOGICAL withSigns
0046 INTEGER myThid
0047
0048 C !LOCAL VARIABLES:
0049 C == Local variables ==
0050 C OL[wens] :: Overlap extents in west, east, north, south.
0051 C exchWidth[XY] :: Extent of regions that will be exchanged.
d4e639dc4c Jean*0052 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
5df640d755 Jean*0053 INTEGER bi, bj, myTile, k
2cf110c259 Jean*0054 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0055 INTEGER i, j
0056 #else
0057 # ifdef DO_CORNER_COPY_V2U
0058 INTEGER j
0059 # endif
2cf110c259 Jean*0060 #endif
046fd16d1c Andr*0061 CEOP
0062
0063 OLw = OLx
0064 OLe = OLx
0065 OLn = OLy
0066 OLs = OLy
0067 exchWidthX = OLx
0068 exchWidthY = OLy
8c27c9de99 Jean*0069
bb99eee0de Jean*0070 CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
046fd16d1c Andr*0071 I OLw, OLe, OLs, OLn, myNz,
0072 I exchWidthX, exchWidthY,
1a3a8861a0 Jean*0073 I EXCH_IGNORE_CORNERS, myThid )
bb99eee0de Jean*0074 CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
7193a2041e Jean*0075 I OLw, OLe, OLs, OLn, myNz,
0076 I exchWidthX, exchWidthY,
8bc539472e Jean*0077 I EXCH_UPDATE_CORNERS, myThid )
8c27c9de99 Jean*0078
5df640d755 Jean*0079 IF (useCubedSphereExchange) THEN
0080 C--- using CubedSphereExchange:
046fd16d1c Andr*0081 DO bj=myByLo(myThid),myByHi(myThid)
0082 DO bi=myBxLo(myThid),myBxHi(myThid)
5df640d755 Jean*0083 myTile = W2_myTileList(bi,bj)
8c27c9de99 Jean*0084
bb99eee0de Jean*0085 #ifdef DO_CORNER_COPY_V2U
046fd16d1c Andr*0086 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0087 & exch2_isSedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0088 DO k=1,myNz
5df640d755 Jean*0089 C Uphi(sNx+1, 0,k,bi,bj)= vPhi(sNx+1, 1,k,bi,bj)
aa6b2555c8 Jean*0090 DO j=1-OLx,0
5df640d755 Jean*0091 Uphi(sNx+1, j,k,bi,bj)= vPhi(sNx+(1-j), 1,k,bi,bj)
41e70ac469 Chri*0092 ENDDO
046fd16d1c Andr*0093 ENDDO
0094 ENDIF
0095 IF ( withSigns ) THEN
0096 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0097 & exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0098 DO k=1,myNz
5df640d755 Jean*0099 C Uphi(sNx+1,sNy+1,k,bi,bj)=-vPhi(sNx+1,sNy+1,k,bi,bj)
aa6b2555c8 Jean*0100 DO j=1,OLx
5df640d755 Jean*0101 Uphi(sNx+1,sNy+j,k,bi,bj)=-vPhi(sNx+j,sNy+1,k,bi,bj)
41e70ac469 Chri*0102 ENDDO
046fd16d1c Andr*0103 ENDDO
0104 ENDIF
0105 ELSE
0106 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0107 & exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0108 DO k=1,myNz
5df640d755 Jean*0109 C Uphi(sNx+1,sNy+1,k,bi,bj)= vPhi(sNx+1,sNy+1,k,bi,bj)
aa6b2555c8 Jean*0110 DO j=1,OLx
5df640d755 Jean*0111 Uphi(sNx+1,sNy+j,k,bi,bj)= vPhi(sNx+j,sNy+1,k,bi,bj)
41e70ac469 Chri*0112 ENDDO
046fd16d1c Andr*0113 ENDDO
0114 ENDIF
0115 ENDIF
1ec0ee365b Jean*0116 #endif /* DO_CORNER_COPY_V2U */
1e450a3576 Jean*0117
8c27c9de99 Jean*0118 C-- Now zero out the null areas that should not be used in the numerics
0119 C Also add one valid u,v value next to the corner, that allows
1e450a3576 Jean*0120 C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
8c27c9de99 Jean*0121
41e70ac469 Chri*0122 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0123 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0124 C Zero SW corner points
5df640d755 Jean*0125 DO k=1,myNz
8c27c9de99 Jean*0126 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0127 DO j=1-OLx,0
0128 DO i=1-OLx,0
0129 uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0130 ENDDO
0131 ENDDO
5df640d755 Jean*0132 DO j=1-OLx,0
0133 DO i=1-OLx,0
0134 vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0135 ENDDO
0136 ENDDO
8c27c9de99 Jean*0137 #endif
aa6b2555c8 Jean*0138 IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
5df640d755 Jean*0139 uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
0140 vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
aa6b2555c8 Jean*0141 ENDIF
41e70ac469 Chri*0142 ENDDO
0143 ENDIF
8c27c9de99 Jean*0144
41e70ac469 Chri*0145 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0146 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0147 C Zero NW corner points
5df640d755 Jean*0148 DO k=1,myNz
8c27c9de99 Jean*0149 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0150 DO j=sNy+1,sNy+OLy
0151 DO i=1-OLx,0
0152 uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0153 ENDDO
0154 ENDDO
5df640d755 Jean*0155 DO j=sNy+2,sNy+OLy
0156 DO i=1-OLx,0
0157 vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0158 ENDDO
0159 ENDDO
8c27c9de99 Jean*0160 #endif
aa6b2555c8 Jean*0161 IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
0162 IF ( withSigns ) THEN
5df640d755 Jean*0163 uPhi(0,sNy+1,k,bi,bj)=-vPhi(1,sNy+2,k,bi,bj)
0164 vPhi(0,sNy+2,k,bi,bj)=-uPhi(0,sNy,k,bi,bj)
aa6b2555c8 Jean*0165 ELSE
5df640d755 Jean*0166 uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)
0167 vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)
aa6b2555c8 Jean*0168 ENDIF
1e450a3576 Jean*0169 ENDIF
41e70ac469 Chri*0170 ENDDO
0171 ENDIF
8c27c9de99 Jean*0172
41e70ac469 Chri*0173 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0174 & exch2_isSedge(myTile) .EQ. 1 ) THEN
0175 C Zero SE corner points
5df640d755 Jean*0176 DO k=1,myNz
8c27c9de99 Jean*0177 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0178 DO j=1-OLx,0
0179 DO i=sNx+2,sNx+OLx
0180 uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0181 ENDDO
0182 ENDDO
5df640d755 Jean*0183 DO j=1-OLx,0
0184 DO i=sNx+1,sNx+OLx
0185 vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0186 ENDDO
0187 ENDDO
8c27c9de99 Jean*0188 #endif
aa6b2555c8 Jean*0189 IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
0190 IF ( withSigns ) THEN
5df640d755 Jean*0191 uPhi(sNx+2,0,k,bi,bj)=-vPhi(sNx,0,k,bi,bj)
0192 vPhi(sNx+1,0,k,bi,bj)=-uPhi(sNx+2,1,k,bi,bj)
aa6b2555c8 Jean*0193 ELSE
5df640d755 Jean*0194 uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)
0195 vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)
aa6b2555c8 Jean*0196 ENDIF
1e450a3576 Jean*0197 ENDIF
41e70ac469 Chri*0198 ENDDO
0199 ENDIF
8c27c9de99 Jean*0200
41e70ac469 Chri*0201 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0202 & exch2_isNedge(myTile) .EQ. 1 ) THEN
0203 C Zero NE corner points
5df640d755 Jean*0204 DO k=1,myNz
8c27c9de99 Jean*0205 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0206 DO j=sNy+1,sNy+OLy
0207 DO i=sNx+2,sNx+OLx
0208 uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0209 ENDDO
0210 ENDDO
5df640d755 Jean*0211 DO j=sNy+2,sNy+OLy
0212 DO i=sNx+1,sNx+OLx
0213 vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0214 ENDDO
0215 ENDDO
8c27c9de99 Jean*0216 #endif
aa6b2555c8 Jean*0217 IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
5df640d755 Jean*0218 uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
0219 vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
aa6b2555c8 Jean*0220 ENDIF
41e70ac469 Chri*0221 ENDDO
0222 ENDIF
5df640d755 Jean*0223
046fd16d1c Andr*0224 ENDDO
0225 ENDDO
5df640d755 Jean*0226 C--- using or not using CubedSphereExchange: end
046fd16d1c Andr*0227 ENDIF
0228
0229 RETURN
0230 END
2ad152b417 Ed H*0231
0232 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0233
0234 CEH3 ;;; Local Variables: ***
0235 CEH3 ;;; mode:fortran ***
0236 CEH3 ;;; End: ***