Warning, /pkg/exch2/exch2_z_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
ec796d0ca4 Jean*0001 #include "CPP_EEOPTIONS.h"
8c27c9de99 Jean*0002 #include "W2_OPTIONS.h"
ec796d0ca4 Jean*0003
0004 CBOP
d4e639dc4c Jean*0005 C !ROUTINE: EXCH_Z_3D_RX
ec796d0ca4 Jean*0006
0007 C !INTERFACE:
d4e639dc4c Jean*0008 SUBROUTINE EXCH2_Z_3D_RX(
8c27c9de99 Jean*0009 U phi,
d4e639dc4c Jean*0010 I myNz, myThid )
ec796d0ca4 Jean*0011 IMPLICIT NONE
0012 C !DESCRIPTION:
0013 C *==========================================================*
d4e639dc4c Jean*0014 C | SUBROUTINE EXCH_Z_3D_RX
0015 C | o Handle exchanges for _RX three-dim zeta-point array.
ec796d0ca4 Jean*0016 C *==========================================================*
0017
0018 C !USES:
0019 C === Global data ===
0020 #include "SIZE.h"
0021 #include "EEPARAMS.h"
90219e5912 Jean*0022 #include "W2_EXCH2_SIZE.h"
ec796d0ca4 Jean*0023 #include "W2_EXCH2_TOPOLOGY.h"
d0ce7fc1dc Jean*0024 c#ifdef W2_FILL_NULL_REGIONS
0025 c#include "W2_EXCH2_PARAMS.h"
0026 c#endif
ec796d0ca4 Jean*0027
0028 C !INPUT/OUTPUT PARAMETERS:
0029 C === Routine arguments ===
0030 C phi :: Array with overlap regions are to be exchanged
d4e639dc4c Jean*0031 C myNz :: 3rd dimension of input array phi
0032 C myThid :: My Thread Id. number
0033 INTEGER myNz
0034 _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
ec796d0ca4 Jean*0035 INTEGER myThid
0036
0037 C !LOCAL VARIABLES:
0038 C == Local variables ==
0039 C OL[wens] :: Overlap extents in west, east, north, south.
0040 C exchWidth[XY] :: Extent of regions that will be exchanged.
0041 C mFace :: face number
d4e639dc4c Jean*0042 C local_maxDim :: upper limit of 3rd dimension value
ec796d0ca4 Jean*0043 C phiNW,phiSE :: temporary array to hold corner value (CS grid)
d6ea3164dc Jean*0044 C msgBuf :: Informational/error message buffer
d4e639dc4c Jean*0045 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0046 INTEGER bi, bj, myTile, i, j, k
ec796d0ca4 Jean*0047 INTEGER mFace
d4e639dc4c Jean*0048 INTEGER local_maxDim
0049 PARAMETER( local_maxDim = 8*Nr )
0050 _RX phiNW(local_maxDim,nSx,nSy)
0051 _RX phiSE(local_maxDim,nSx,nSy)
0052 CHARACTER*(MAX_LEN_MBUF) msgBuf
ec796d0ca4 Jean*0053 CEOP
8c27c9de99 Jean*0054
ec796d0ca4 Jean*0055
0056 OLw = OLx
0057 OLe = OLx
0058 OLn = OLy
0059 OLs = OLy
0060 exchWidthX = OLx
0061 exchWidthY = OLy
8c27c9de99 Jean*0062
ec796d0ca4 Jean*0063 IF (useCubedSphereExchange) THEN
d4e639dc4c Jean*0064 IF ( myNz.GT.local_maxDim ) THEN
0065 WRITE(msgBuf,'(2A,2(I4,A))') 'EXCH_Z_3D_RX :',
0066 & ' 3rd dimension=', myNz,
0067 & ' exceeds local_maxDim (=', local_maxDim, ' )'
0068 CALL PRINT_ERROR( msgBuf , myThid )
0069 WRITE(msgBuf,'(2A)') 'EXCH_Z_3D_RX :',
0070 & ' Increase "local_maxDim" and recompile'
0071 CALL PRINT_ERROR( msgBuf , myThid )
0072 STOP 'ABNORMAL END: S/R EXCH_Z_3D_RX'
0073 ENDIF
8c27c9de99 Jean*0074
ec796d0ca4 Jean*0075 C- save 2 corners value (in case we find 1 "missing corner")
0076 DO bj=myByLo(myThid),myByHi(myThid)
0077 DO bi=myBxLo(myThid),myBxHi(myThid)
d4e639dc4c Jean*0078 DO k=1,myNz
0079 phiNW(k,bi,bj) = phi(1,sNy+1,k,bi,bj)
0080 phiSE(k,bi,bj) = phi(sNx+1,1,k,bi,bj)
0081 ENDDO
ec796d0ca4 Jean*0082 ENDDO
0083 ENDDO
5df640d755 Jean*0084 ENDIF
8c27c9de99 Jean*0085
8bc539472e Jean*0086 CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
ec796d0ca4 Jean*0087 I OLw, OLe, OLs, OLn, myNz,
0088 I exchWidthX, exchWidthY,
1a3a8861a0 Jean*0089 I EXCH_IGNORE_CORNERS, myThid )
8bc539472e Jean*0090 CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
ec796d0ca4 Jean*0091 I OLw, OLe, OLs, OLn, myNz,
0092 I exchWidthX, exchWidthY,
8bc539472e Jean*0093 I EXCH_UPDATE_CORNERS, myThid )
8c27c9de99 Jean*0094
5df640d755 Jean*0095 IF (useCubedSphereExchange) THEN
0096
ec796d0ca4 Jean*0097 DO bj=myByLo(myThid),myByHi(myThid)
0098 DO bi=myBxLo(myThid),myBxHi(myThid)
5df640d755 Jean*0099 myTile = W2_myTileList(bi,bj)
ec796d0ca4 Jean*0100 mFace = exch2_myFace(myTile)
0101
0102 C--- Face 2,4,6:
0103 IF ( MOD(mFace,2).EQ.0 ) THEN
0104
0105 C-- East edge : shift j <- j-1
0106 IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0107 DO k=1,myNz
1a3a8861a0 Jean*0108 DO j=sNy+OLy,2-OLy,-1
d4e639dc4c Jean*0109 DO i=sNx+1,sNx+OLx
0110 phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
0111 ENDDO
ec796d0ca4 Jean*0112 ENDDO
0113 ENDDO
0114 C- North-East corner
0115 IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0116 DO k=1,myNz
0117 DO j=sNy+2,sNy+OLy
ec796d0ca4 Jean*0118 i=sNx-sNy+j
d4e639dc4c Jean*0119 phi(sNx+1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
0120 ENDDO
8c27c9de99 Jean*0121 #ifdef W2_FILL_NULL_REGIONS
d4e639dc4c Jean*0122 DO j=sNy+2,sNy+OLy
0123 DO i=sNx+2,sNx+OLx
0124 phi(i,j,k,bi,bj)=e2FillValue_RX
0125 ENDDO
ec796d0ca4 Jean*0126 ENDDO
8c27c9de99 Jean*0127 #endif
d4e639dc4c Jean*0128 ENDDO
ec796d0ca4 Jean*0129 ENDIF
0130 ENDIF
0131 C-- South edge : shift i <- i-1
0132 IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0133 DO k=1,myNz
0134 DO j=1-OLy,0
1a3a8861a0 Jean*0135 DO i=sNx+OLx,2-OLx,-1
d4e639dc4c Jean*0136 phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
0137 ENDDO
ec796d0ca4 Jean*0138 ENDDO
0139 ENDDO
0140 C- South-East corner
8c27c9de99 Jean*0141 IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0142 DO k=1,myNz
0143 phi(sNx+1,1,k,bi,bj)=phiSE(k,bi,bj)
ec796d0ca4 Jean*0144 DO i=sNx+2,sNx+OLx
d4e639dc4c Jean*0145 j=sNx+2-i
0146 phi(i,1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
0147 ENDDO
0148 #ifdef W2_FILL_NULL_REGIONS
0149 DO j=1-OLy,0
0150 DO i=sNx+2,sNx+OLx
0151 phi(i,j,k,bi,bj)=e2FillValue_RX
0152 ENDDO
ec796d0ca4 Jean*0153 ENDDO
8c27c9de99 Jean*0154 #endif
d4e639dc4c Jean*0155 ENDDO
ec796d0ca4 Jean*0156 ENDIF
0157 C- South-West corner
0158 IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0159 DO k=1,myNz
0160 DO j=1-OLy,0
0161 phi(1,j,k,bi,bj)=phi(j,1,k,bi,bj)
8c27c9de99 Jean*0162 #ifdef W2_FILL_NULL_REGIONS
d4e639dc4c Jean*0163 DO i=1-OLx,0
0164 phi(i,j,k,bi,bj)=e2FillValue_RX
0165 ENDDO
8c27c9de99 Jean*0166 #endif
d4e639dc4c Jean*0167 ENDDO
ec796d0ca4 Jean*0168 ENDDO
0169 ENDIF
0170 ENDIF
0171 C-- North-west corner
0172 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
0173 & exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0174 DO k=1,myNz
0175 DO i=2-OLx,0
0176 j=sNy+2-i
0177 phi(i,sNy+1,k,bi,bj)=phi(1,j,k,bi,bj)
0178 ENDDO
8c27c9de99 Jean*0179 #ifdef W2_FILL_NULL_REGIONS
d4e639dc4c Jean*0180 DO j=sNy+2,sNy+OLy
0181 DO i=1-OLx,0
0182 phi(i,j,k,bi,bj)=e2FillValue_RX
0183 ENDDO
ec796d0ca4 Jean*0184 ENDDO
1a3a8861a0 Jean*0185 phi(1-OLx,sNy+1,k,bi,bj)=e2FillValue_RX
8c27c9de99 Jean*0186 #endif
d4e639dc4c Jean*0187 ENDDO
ec796d0ca4 Jean*0188 ENDIF
0189
0190 ELSE
0191 C--- Face 1,3,5:
0192
0193 C-- North edge : shift i <- i-1
0194 IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0195 DO k=1,myNz
1a3a8861a0 Jean*0196 DO j=sNy+1,sNy+OLy
0197 DO i=sNx+OLx,2-OLx,-1
d4e639dc4c Jean*0198 phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
0199 ENDDO
ec796d0ca4 Jean*0200 ENDDO
0201 ENDDO
0202 C- North-East corner
0203 IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0204 DO k=1,myNz
ec796d0ca4 Jean*0205 DO i=sNx+2,sNx+OLx
d4e639dc4c Jean*0206 j=sNy-sNx+i
0207 phi(i,sNy+1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
0208 ENDDO
0209 #ifdef W2_FILL_NULL_REGIONS
0210 DO j=sNy+2,sNy+OLy
0211 DO i=sNx+2,sNx+OLx
0212 phi(i,j,k,bi,bj)=e2FillValue_RX
0213 ENDDO
ec796d0ca4 Jean*0214 ENDDO
8c27c9de99 Jean*0215 #endif
d4e639dc4c Jean*0216 ENDDO
ec796d0ca4 Jean*0217 ENDIF
0218 ENDIF
0219 C-- West edge : shift j <- j-1
0220 IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0221 DO k=1,myNz
1a3a8861a0 Jean*0222 DO j=sNy+OLy,2-OLy,-1
0223 DO i=1-OLx,0
d4e639dc4c Jean*0224 phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
0225 ENDDO
ec796d0ca4 Jean*0226 ENDDO
0227 ENDDO
0228 C- North-west corner
0229 IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0230 DO k=1,myNz
0231 phi(1,sNy+1,k,bi,bj)=phiNW(k,bi,bj)
0232 DO j=sNy+2,sNy+OLy
0233 i=sNy+2-j
0234 phi(1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
0235 ENDDO
8c27c9de99 Jean*0236 #ifdef W2_FILL_NULL_REGIONS
d4e639dc4c Jean*0237 DO j=sNy+2,sNy+OLy
0238 DO i=1-OLx,0
0239 phi(i,j,k,bi,bj)=e2FillValue_RX
0240 ENDDO
ec796d0ca4 Jean*0241 ENDDO
8c27c9de99 Jean*0242 #endif
d4e639dc4c Jean*0243 ENDDO
ec796d0ca4 Jean*0244 ENDIF
0245 C- South-West corner
0246 IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0247 DO k=1,myNz
ec796d0ca4 Jean*0248 DO i=1-OLx,0
d4e639dc4c Jean*0249 phi(i,1,k,bi,bj)=phi(1,i,k,bi,bj)
0250 ENDDO
0251 #ifdef W2_FILL_NULL_REGIONS
0252 DO j=1-OLy,0
0253 DO i=1-OLx,0
0254 phi(i,j,k,bi,bj)=e2FillValue_RX
0255 ENDDO
ec796d0ca4 Jean*0256 ENDDO
8c27c9de99 Jean*0257 #endif
d4e639dc4c Jean*0258 ENDDO
ec796d0ca4 Jean*0259 ENDIF
0260 ENDIF
0261 C- South-East corner
0262 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
0263 & exch2_isSedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0264 DO k=1,myNz
0265 DO j=2-OLy,0
0266 i=sNx+2-j
0267 phi(sNx+1,j,k,bi,bj)=phi(i,1,k,bi,bj)
0268 ENDDO
8c27c9de99 Jean*0269 #ifdef W2_FILL_NULL_REGIONS
d4e639dc4c Jean*0270 DO j=1-OLy,0
0271 DO i=sNx+2,sNx+OLx
0272 phi(i,j,k,bi,bj)=e2FillValue_RX
0273 ENDDO
ec796d0ca4 Jean*0274 ENDDO
1a3a8861a0 Jean*0275 phi(sNx+1,1-OLy,k,bi,bj)=e2FillValue_RX
8c27c9de99 Jean*0276 #endif
d4e639dc4c Jean*0277 ENDDO
ec796d0ca4 Jean*0278 ENDIF
0279
0280 C--- end odd / even face number
0281 ENDIF
0282
0283 ENDDO
0284 ENDDO
0285
5df640d755 Jean*0286 C--- using or not using CubedSphereExchange: end
ec796d0ca4 Jean*0287 ENDIF
0288
0289 RETURN
0290 END
0291
0292 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0293
0294 CEH3 ;;; Local Variables: ***
0295 CEH3 ;;; mode:fortran ***
0296 CEH3 ;;; End: ***
