Warning, /pkg/exch2/exch2_sm_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
34bc6c70b8 Jean*0001 #include "CPP_EEOPTIONS.h"
0002 #include "W2_OPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH2_SM_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH2_SM_3D_RX(
8bc539472e Jean*0009 U phi,
0010 I withSigns, myNz, myThid )
34bc6c70b8 Jean*0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH2_SM_3D_RX
0015 C handle exchanges for Second Moment (Sxy) 3D field
0016 C (for quantity which Sign depend on X & Y orientation), at Mass point
0017 C
0018 C Input:
0019 C phi(lon,lat,levs,bi,bj) :: array with overlap regions are to be exchanged
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: phi is updated (halo regions filled)
0025 C
0026 C Calls: exch_RX (exch2_RX1_cube)
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"
34bc6c70b8 Jean*0036 #include "W2_EXCH2_TOPOLOGY.h"
0037
0038 C !INPUT/OUTPUT PARAMETERS:
0039 C == Argument list variables ==
0040 INTEGER myNz
0041 _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0042 LOGICAL withSigns
0043 INTEGER myThid
0044
0045 C !LOCAL VARIABLES:
0046 C == Local variables ==
0047 C i,j,k,bi,bj :: loop indices.
0048 C OL[wens] :: Overlap extents in west, east, north, south.
0049 C exchWidth[XY] :: Extent of regions that will be exchanged.
0050
0051 INTEGER i,j,k,bi,bj
0052 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0053 _RX negOne
0054 INTEGER myTile, myFace
0055 CEOP
0056
0057 OLw = OLx
0058 OLe = OLx
0059 OLn = OLy
0060 OLs = OLy
0061 exchWidthX = OLx
0062 exchWidthY = OLy
0063 negOne = 1.
0064 IF (withSigns) negOne = -1.
0065
0066 C-- First call the exchanges
0067
8bc539472e Jean*0068 CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
34bc6c70b8 Jean*0069 I OLw, OLe, OLs, OLn, myNz,
0070 I exchWidthX, exchWidthY,
1a3a8861a0 Jean*0071 I EXCH_IGNORE_CORNERS, myThid )
8bc539472e Jean*0072 CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
34bc6c70b8 Jean*0073 I OLw, OLe, OLs, OLn, myNz,
0074 I exchWidthX, exchWidthY,
8bc539472e Jean*0075 I EXCH_UPDATE_CORNERS, myThid )
34bc6c70b8 Jean*0076
0077 C- note: can substitute the low-level S/R call above with:
0078 c CALL EXCH2_3D_RX( phi, myNz, myThid )
0079
6bdd4f0881 Jean*0080 IF ( useCubedSphereExchange .AND. withSigns ) THEN
0081 C--- using CubedSphereExchange with Signs:
5df640d755 Jean*0082
8bc539472e Jean*0083 C-- Then we may need to switch the signs depending on which cube face
0084 C we are located.
34bc6c70b8 Jean*0085
0086 C-- Loops on tile indices:
0087 DO bj = myByLo(myThid), myByHi(myThid)
0088 DO bi = myBxLo(myThid), myBxHi(myThid)
0089
8bc539472e Jean*0090 C Choose what to do at each edge of the halo based on which face we are
5df640d755 Jean*0091 myTile = W2_myTileList(bi,bj)
34bc6c70b8 Jean*0092 myFace = exch2_myFace(myTile)
0093
0094 C-- Loops on level index:
0095 DO k = 1,myNz
0096
0097 C- odd (or even) faces share disposition of all sections of the halo
0098 IF ( MOD(myFace,2).EQ.1 ) THEN
0099 C-- Face 1,3,5:
0100
0101 C- North:
0102 IF (exch2_isNedge(myTile).EQ.1) THEN
0103 DO j = 1,exchWidthY
0104 DO i = 1-OLx,sNx+OLx
0105 phi(i,sNy+j,k,bi,bj) = phi(i,sNy+j,k,bi,bj)*negOne
0106 ENDDO
0107 ENDDO
0108 ENDIF
0109 C- South: (nothing to change)
0110 c IF (exch2_isSedge(myTile).EQ.1) THEN
0111 c DO j = 1,exchWidthY
0112 c DO i = 1-OLx,sNx+OLx
0113 c phi(i,1-j,k,bi,bj) = phi(i,1-j,k,bi,bj)
0114 c ENDDO
0115 c ENDDO
0116 c ENDIF
0117 C- East: (nothing to change)
0118 c IF (exch2_isEedge(myTile).EQ.1) THEN
0119 c DO j = 1-OLy,sNy+OLy
0120 c DO i = 1,exchWidthX
0121 c phi(sNx+i,j,k,bi,bj) = phi(sNx+i,j,k,bi,bj)
0122 c ENDDO
0123 c ENDDO
0124 c ENDIF
0125 C- West:
0126 IF (exch2_isWedge(myTile).EQ.1) THEN
0127 DO j = 1-OLy,sNy+OLy
0128 DO i = 1,exchWidthX
0129 phi(1-i,j,k,bi,bj) = phi(1-i,j,k,bi,bj)*negOne
0130 ENDDO
0131 ENDDO
0132 ENDIF
0133
0134 ELSE
0135 C-- Face 2,4,6:
0136
0137 C- East:
0138 IF (exch2_isEedge(myTile).EQ.1) THEN
0139 DO j = 1-OLy,sNy+OLy
0140 DO i = 1,exchWidthX
0141 phi(sNx+i,j,k,bi,bj) = phi(sNx+i,j,k,bi,bj)*negOne
0142 ENDDO
0143 ENDDO
0144 ENDIF
0145 C- West: (nothing to change)
0146 c IF (exch2_isWedge(myTile).EQ.1) THEN
0147 c DO j = 1-OLy,sNy+OLy
0148 c DO i = 1,exchWidthX
0149 c phi(1-i,j,k,bi,bj) = phi(1-i,j,k,bi,bj)
0150 c ENDDO
0151 c ENDDO
0152 c ENDIF
0153 C- North: (nothing to change)
0154 c IF (exch2_isNedge(myTile).EQ.1) THEN
0155 c DO j = 1,exchWidthY
0156 c DO i = 1-OLx,sNx+OLx
0157 c phi(i,sNy+j,k,bi,bj) = phi(i,sNy+j,k,bi,bj)
0158 c ENDDO
0159 c ENDDO
0160 c ENDIF
0161 C- South:
0162 IF (exch2_isSedge(myTile).EQ.1) THEN
0163 DO j = 1,exchWidthY
0164 DO i = 1-OLx,sNx+OLx
0165 phi(i,1-j,k,bi,bj) = phi(i,1-j,k,bi,bj)*negOne
0166 ENDDO
0167 ENDDO
0168 ENDIF
0169
0170 C-- End odd / even faces
0171 ENDIF
0172
0173 C-- end of Loops on tile and level indices (k,bi,bj).
0174 ENDDO
0175 ENDDO
0176 ENDDO
0177
6bdd4f0881 Jean*0178 C--- using or not using CubedSphereExchange with Signs: end
34bc6c70b8 Jean*0179 ENDIF
0180
0181 RETURN
0182 END
0183
0184 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0185
0186 CEH3 ;;; Local Variables: ***
0187 CEH3 ;;; mode:fortran ***
0188 CEH3 ;;; End: ***
