Warning, /eesupp/src/exch_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
449149bd7b Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: EXCH_SM_3D_RX
0006
0007 C !INTERFACE:
0008 SUBROUTINE EXCH_SM_3D_RX(
0009 U phi,
0010 I withSigns, myNz, myThid )
0011
0012 C !DESCRIPTION:
0013 C*=====================================================================*
0014 C Purpose: SUBROUTINE EXCH_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 signs of X & Y orientation
0021 C myNz :: 3rd dimension of input arrays phi
0022 C myThid :: my Thread Id number
0023 C
0024 C Output: phi is updated (halo regions filled)
0025 C
0026 C Calls: exch (either exch_rx_cube or exch_rx)
0027 C
0028 C NOTES: 1) If using CubedSphereExchange, only works on ONE PROCESSOR!
0029 C*=====================================================================*
0030
0031 C !USES:
0032 IMPLICIT NONE
0033
0034 #include "SIZE.h"
0035 #include "EEPARAMS.h"
0036
0037 C !INPUT/OUTPUT PARAMETERS:
0038 C == Argument list variables ==
0039 INTEGER myNz
0040 _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
0041 LOGICAL withSigns
0042 INTEGER myThid
0043
0044 C !LOCAL VARIABLES:
3e943aa97a Jean*0045 #ifndef ALLOW_EXCH2
449149bd7b Jean*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 C dummy[12] :: copies of the vector components with haloes filled.
0051
0052 INTEGER i,j,k,bi,bj
0053 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
0054 _RX negOne
3e943aa97a Jean*0055 #endif
0056 CEOP
449149bd7b Jean*0057
0058 #ifdef ALLOW_EXCH2
0059 CALL EXCH2_SM_3D_RX(
45d7b5cc4e Jean*0060 U phi,
0061 I withSigns, myNz, myThid )
3e943aa97a Jean*0062 #else /* ALLOW_EXCH2 */
449149bd7b Jean*0063
0064 OLw = OLx
0065 OLe = OLx
0066 OLn = OLy
0067 OLs = OLy
0068 exchWidthX = OLx
0069 exchWidthY = OLy
0070 negOne = 1.
0071
b676deaff6 Jean*0072 IF (useCubedSphereExchange) THEN
0073 C--- using CubedSphereExchange:
449149bd7b Jean*0074
0075 C-- First call the exchanges
0076
45d7b5cc4e Jean*0077 CALL EXCH1_RX_CUBE( phi, .FALSE.,
449149bd7b Jean*0078 I OLw, OLe, OLs, OLn, myNz,
0079 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0080 I EXCH_UPDATE_CORNERS, myThid )
449149bd7b Jean*0081
b676deaff6 Jean*0082 IF (withSigns) THEN
449149bd7b Jean*0083 C-- Then we may need to switch the signs depending on which cube face
0084 C we are located (we assume that bj is always=1).
0085 C Choose what to do at each edge of the halo based on which face
b676deaff6 Jean*0086 negOne = -1.
449149bd7b Jean*0087
0088 C-- Loops on tile and level indices:
b676deaff6 Jean*0089 DO bj = myByLo(myThid), myByHi(myThid)
449149bd7b Jean*0090 DO bi = myBxLo(myThid), myBxHi(myThid)
0091 DO k = 1,myNz
0092
0093 C- odd (or even) faces share disposition of all sections of the halo
0094 IF ( MOD(bi,2).EQ.1 ) THEN
0095 C-- Face 1,3,5:
0096
0097 DO j = 1,exchWidthY
0098 DO i = 1,sNx
0099 C- North:
0100 phi(i,sNy+j,k,bi,bj) = phi(i,sNy+j,k,bi,bj)*negOne
0101 C- South: (nothing to change)
0102 c phi(i,1-j,k,bi,bj) = phi(i,1-j,k,bi,bj)
0103 ENDDO
0104 ENDDO
0105 DO j = 1,sNy
0106 DO i = 1,exchWidthX
0107 C- East: (nothing to change)
0108 c phi(sNx+i,j,k,bi,bj) = phi(sNx+i,j,k,bi,bj)
0109 C- West:
0110 phi(1-i,j,k,bi,bj) = phi(1-i,j,k,bi,bj)*negOne
0111 ENDDO
0112 ENDDO
0113
0114 ELSE
0115 C-- Face 2,4,6:
0116
0117 DO j = 1,sNy
0118 DO i = 1,exchWidthX
0119 C- East:
0120 phi(sNx+i,j,k,bi,bj) = phi(sNx+i,j,k,bi,bj)*negOne
0121 C- West: (nothing to change)
0122 c phi(1-i,j,k,bi,bj) = phi(1-i,j,k,bi,bj)
0123 ENDDO
0124 ENDDO
0125 DO j = 1,exchWidthY
0126 DO i = 1,sNx
0127 C- North: (nothing to change)
0128 c phi(i,sNy+j,k,bi,bj) = phi(i,sNy+j,k,bi,bj)
0129 C- South:
0130 phi(i,1-j,k,bi,bj) = phi(i,1-j,k,bi,bj)*negOne
0131 ENDDO
0132 ENDDO
0133
0134 C-- End odd / even faces
0135 ENDIF
0136
0137 C-- end of Loops on tile and level indices (k,bi,bj).
0138 ENDDO
0139 ENDDO
b676deaff6 Jean*0140 ENDDO
0141
0142 C-- End withSigns
0143 ENDIF
449149bd7b Jean*0144
0145 ELSE
b676deaff6 Jean*0146 C--- not using CubedSphereExchange:
449149bd7b Jean*0147
6979a1789e Jean*0148 #ifdef DISCONNECTED_TILES
0149 CALL EXCH0_RX( phi,
0150 I OLw, OLe, OLs, OLn, myNz,
0151 I exchWidthX, exchWidthY,
0152 I EXCH_UPDATE_CORNERS, myThid )
0153 #else /* DISCONNECTED_TILES */
45d7b5cc4e Jean*0154 CALL EXCH1_RX( phi,
449149bd7b Jean*0155 I OLw, OLe, OLs, OLn, myNz,
0156 I exchWidthX, exchWidthY,
45d7b5cc4e Jean*0157 I EXCH_UPDATE_CORNERS, myThid )
6979a1789e Jean*0158 #endif /* DISCONNECTED_TILES */
449149bd7b Jean*0159
b676deaff6 Jean*0160 C--- using or not using CubedSphereExchange: end
449149bd7b Jean*0161 ENDIF
0162
3e943aa97a Jean*0163 #endif /* ALLOW_EXCH2 */
6979a1789e Jean*0164
0165 RETURN
449149bd7b Jean*0166 END
0167
0168 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0169
0170 CEH3 ;;; Local Variables: ***
0171 CEH3 ;;; mode:fortran ***
0172 CEH3 ;;; End: ***
