Warning, /eesupp/src/exch_uv_agrid_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
ce7304455e Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH_UV_AGRID_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH_UV_AGRID_3D_RX(
6979a1789e Jean*0009 U uPhi, vPhi,
ce7304455e Jean*0010 I withSigns, myNz, myThid )
0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH_UV_AGRID_3D_RX
0015 C handle exchanges for a 3D vector field on an A-grid.
0016 C
0017 C Input:
6979a1789e Jean*0018 C uPhi(lon,lat,levs,bi,bj) :: first component of vector
0019 C vPhi(lon,lat,levs,bi,bj) :: second component of vector
ce7304455e Jean*0020 C withSigns (logical) :: true to use signs of components
6979a1789e Jean*0021 C myNz :: 3rd dimension of input arrays uPhi,vPhi
ce7304455e Jean*0022 C myThid :: my Thread Id number
0023 C
6979a1789e Jean*0024 C Output: uPhi and vPhi are updated (halo regions filled)
ce7304455e Jean*0025 C
0026 C Calls: exch (either exch_rx_cube or exch_rx) - twice, once
0027 C for the first-component, once for second.
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
6979a1789e Jean*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)
ce7304455e Jean*0043 LOGICAL withSigns
0044 INTEGER myThid
0045
0046 C !LOCAL VARIABLES:
3e943aa97a Jean*0047 #ifndef ALLOW_EXCH2
ce7304455e Jean*0048 C == Local variables ==
0049 C i,j,k,bi,bj :: are DO indices.
0050 C OL[wens] :: Overlap extents in west, east, north, south.
0051 C exchWidth[XY] :: Extent of regions that will be exchanged.
0052 C dummy[12] :: copies of the vector components with haloes filled.
0053
0054 INTEGER i,j,k,bi,bj
0055 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0056 _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0057 _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0058 _RX negOne
3e943aa97a Jean*0059 #endif
0060 CEOP
ce7304455e Jean*0061
0062 #ifdef ALLOW_EXCH2
0063 CALL EXCH2_UV_AGRID_3D_RX(
6979a1789e Jean*0064 U uPhi, vPhi,
6978feb812 Jean*0065 I withSigns, myNz, myThid )
3e943aa97a Jean*0066 #else /* ALLOW_EXCH2 */
ce7304455e Jean*0067
0068 OLw = OLx
0069 OLe = OLx
0070 OLn = OLy
0071 OLs = OLy
0072 exchWidthX = OLx
0073 exchWidthY = OLy
0074 negOne = 1.
0075 IF (withSigns) negOne = -1.
0076
0077 IF (useCubedSphereExchange) THEN
0078 C--- using CubedSphereExchange:
0079
0080 C First call the exchanges for the two components
0081
6979a1789e Jean*0082 CALL EXCH1_RX_CUBE( uPhi, .FALSE.,
ce7304455e Jean*0083 I OLw, OLe, OLs, OLn, myNz,
0084 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0085 I EXCH_UPDATE_CORNERS, myThid )
6979a1789e Jean*0086 CALL EXCH1_RX_CUBE( vPhi, .FALSE.,
ce7304455e Jean*0087 I OLw, OLe, OLs, OLn, myNz,
0088 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0089 I EXCH_UPDATE_CORNERS, myThid )
ce7304455e Jean*0090
0091 C Then if we are on the sphere we may need to switch u and v components
0092 C and/or the signs depending on which cube face we are located.
0093
0094 C-- Loops on tile and level indices:
0095 DO bj = myByLo(myThid), myByHi(myThid)
0096 DO bi = myBxLo(myThid), myBxHi(myThid)
6978feb812 Jean*0097 DO k = 1,myNz
ce7304455e Jean*0098
0099 C First we need to copy the component info into dummy arrays
0100 DO j = 1-OLy,sNy+OLy
0101 DO i = 1-OLx,sNx+OLx
6979a1789e Jean*0102 dummy1(i,j) = uPhi(i,j,k,bi,bj)
0103 dummy2(i,j) = vPhi(i,j,k,bi,bj)
ce7304455e Jean*0104 ENDDO
0105 ENDDO
0106
0107 C Now choose what to do at each edge of the halo based on which face
0108 C (we assume that bj is always=1)
0109
0110 C odd faces share disposition of all sections of the halo
0111 IF ( MOD(bi,2).EQ.1 ) THEN
0112 DO j = 1,sNy
0113 DO i = 1,exchWidthX
0114 C east (nothing to change)
6979a1789e Jean*0115 c uPhi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)
0116 c vPhi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
ce7304455e Jean*0117 C west
6979a1789e Jean*0118 uPhi(1-i,j,k,bi,bj) = dummy2(1-i,j)
0119 vPhi(1-i,j,k,bi,bj) = dummy1(1-i,j)*negOne
ce7304455e Jean*0120 ENDDO
0121 ENDDO
0122 DO j = 1,exchWidthY
0123 DO i = 1,sNx
0124 C north
6979a1789e Jean*0125 uPhi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)*negOne
0126 vPhi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
ce7304455e Jean*0127 C south (nothing to change)
6979a1789e Jean*0128 c uPhi(i,1-j,k,bi,bj) = dummy1(i,1-j)
0129 c vPhi(i,1-j,k,bi,bj) = dummy2(i,1-j)
ce7304455e Jean*0130 ENDDO
0131 ENDDO
0132
0133 ELSE
0134 C now the even faces (share disposition of all sections of the halo)
0135
0136 DO j = 1,sNy
0137 DO i = 1,exchWidthX
0138 C east
6979a1789e Jean*0139 uPhi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
0140 vPhi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)*negOne
ce7304455e Jean*0141 C west (nothing to change)
6979a1789e Jean*0142 c uPhi(1-i,j,k,bi,bj) = dummy1(1-i,j)
0143 c vPhi(1-i,j,k,bi,bj) = dummy2(1-i,j)
ce7304455e Jean*0144 ENDDO
0145 ENDDO
0146 DO j = 1,exchWidthY
0147 DO i = 1,sNx
0148 C north (nothing to change)
6979a1789e Jean*0149 c uPhi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
0150 c vPhi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)
ce7304455e Jean*0151 C south
6979a1789e Jean*0152 uPhi(i,1-j,k,bi,bj) = dummy2(i,1-j)*negOne
0153 vPhi(i,1-j,k,bi,bj) = dummy1(i,1-j)
ce7304455e Jean*0154
0155 ENDDO
0156 ENDDO
0157
0158 C end odd / even faces
0159 ENDIF
0160
0161 C-- end of Loops on tile and level indices (k,bi,bj).
0162 ENDDO
0163 ENDDO
0164 ENDDO
0165
0166 ELSE
0167 C--- not using CubedSphereExchange:
0168
6979a1789e Jean*0169 #ifdef DISCONNECTED_TILES
0170 CALL EXCH0_RX( uPhi,
0171 I OLw, OLe, OLs, OLn, myNz,
0172 I exchWidthX, exchWidthY,
0173 I EXCH_UPDATE_CORNERS, myThid )
0174 CALL EXCH0_RX( vPhi,
ce7304455e Jean*0175 I OLw, OLe, OLs, OLn, myNz,
0176 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0177 I EXCH_UPDATE_CORNERS, myThid )
6979a1789e Jean*0178 #else /* DISCONNECTED_TILES */
0179 CALL EXCH1_RX( uPhi,
ce7304455e Jean*0180 I OLw, OLe, OLs, OLn, myNz,
0181 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0182 I EXCH_UPDATE_CORNERS, myThid )
6979a1789e Jean*0183 CALL EXCH1_RX( vPhi,
0184 I OLw, OLe, OLs, OLn, myNz,
0185 I exchWidthX, exchWidthY,
0186 I EXCH_UPDATE_CORNERS, myThid )
0187 #endif /* DISCONNECTED_TILES */
ce7304455e Jean*0188
0189 C--- using or not using CubedSphereExchange: end
0190 ENDIF
0191
3e943aa97a Jean*0192 #endif /* ALLOW_EXCH2 */
6979a1789e Jean*0193
0194 RETURN
ce7304455e Jean*0195 END
0196
0197 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0198
0199 CEH3 ;;; Local Variables: ***
0200 CEH3 ;;; mode:fortran ***
0201 CEH3 ;;; End: ***
