Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Wed, 15 Jul 2025 05:08:56 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/eesupp/src/exch_sm_3d_rx.template
449149bd7b Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
00030004 CBOP
0005 C !ROUTINE: EXCH_SM_3D_RX
00060007 C !INTERFACE:
0008 SUBROUTINE EXCH_SM_3D_RX(
0009 U phi,
0010 I withSigns, myNz, myThid )
00110012 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*=====================================================================*
00300031 C !USES:
0032 IMPLICIT NONE
00330034 #include "SIZE.h"
0035 #include "EEPARAMS.h"
00360037 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
00430044 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.
00510052 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*00570058 #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*00630064 OLw = OLx
0065 OLe = OLx
0066 OLn = OLy
0067 OLs = OLy
0068 exchWidthX = OLx
0069 exchWidthY = OLy
0070 negOne = 1.
0071b676deaff6 Jean*0072 IF (useCubedSphereExchange) THEN
0073 C--- using CubedSphereExchange:
449149bd7b Jean*00740075 C-- First call the exchanges
007645d7b5cc4e 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*0081b676deaff6 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*00870088 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
00920093 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:
00960097 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
01130114 ELSE
0115 C-- Face 2,4,6:
01160117 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
01330134 C-- End odd / even faces
0135 ENDIF
01360137 C-- end of Loops on tile and level indices (k,bi,bj).
0138 ENDDO
0139 ENDDO
b676deaff6 Jean*0140 ENDDO
01410142 C-- End withSigns
0143 ENDIF
449149bd7b Jean*01440145 ELSE
b676deaff6 Jean*0146 C--- not using CubedSphereExchange:
449149bd7b Jean*01476979a1789e 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*0159b676deaff6 Jean*0160 C--- using or not using CubedSphereExchange: end
449149bd7b Jean*0161 ENDIF
01623e943aa97a Jean*0163 #endif /* ALLOW_EXCH2 */
6979a1789e Jean*01640165 RETURN
449149bd7b Jean*0166 END
01670168 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
01690170 CEH3 ;;; Local Variables: ***
0171 CEH3 ;;; mode:fortran ***
0172 CEH3 ;;; End: ***
