Back to home page

MITgcm

 
 

    


Warning, /pkg/exch2/exch2_uv_3d_rx.template is written in an unsupported language. File is not indexed.

view on githubraw file Latest commit aa6b2555 on 2021-06-06 02:50:10 UTC
046fd16d1c Andr*0001 #include "CPP_EEOPTIONS.h"
8c27c9de99 Jean*0002 #include "W2_OPTIONS.h"
1ec0ee365b Jean*0003 #undef DO_CORNER_COPY_V2U
046fd16d1c Andr*0004 
                0005 CBOP
d4e639dc4c Jean*0006 C     !ROUTINE: EXCH2_UV_3D_RX
046fd16d1c Andr*0007 
                0008 C     !INTERFACE:
d4e639dc4c Jean*0009       SUBROUTINE EXCH2_UV_3D_RX(
                0010      U                           Uphi, Vphi,
                0011      I                           withSigns, myNz, myThid )
                0012 
046fd16d1c Andr*0013 C     !DESCRIPTION:
                0014 C     *==========================================================*
d4e639dc4c Jean*0015 C     | SUBROUTINE EXCH2_UV_3D_RX
8c27c9de99 Jean*0016 C     | o Handle exchanges for _RX, 3-dimensional vector arrays.
046fd16d1c Andr*0017 C     *==========================================================*
d6ea3164dc Jean*0018 C     | Vector arrays need to be rotated and interchanged for
046fd16d1c Andr*0019 C     | exchange operations on some grids. This driver routine
                0020 C     | branches to support this.
                0021 C     *==========================================================*
                0022 
                0023 C     !USES:
d4e639dc4c Jean*0024       IMPLICIT NONE
046fd16d1c Andr*0025 C     === Global data ===
                0026 #include "SIZE.h"
                0027 #include "EEPARAMS.h"
90219e5912 Jean*0028 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0029 #include "W2_EXCH2_TOPOLOGY.h"
d0ce7fc1dc Jean*0030 c#ifdef W2_FILL_NULL_REGIONS
                0031 c#include "W2_EXCH2_PARAMS.h"
                0032 c#endif
046fd16d1c Andr*0033 
                0034 C     !INPUT/OUTPUT PARAMETERS:
                0035 C     === Routine arguments ===
                0036 C     phi    :: Array with overlap regions are to be exchanged
                0037 C               Note - The interface to EXCH_RX assumes that
                0038 C               the standard Fortran 77 sequence association rules
                0039 C               apply.
d4e639dc4c Jean*0040 C     myNz   :: 3rd dimension of array to exchange
046fd16d1c Andr*0041 C     myThid :: My thread id.
d4e639dc4c Jean*0042       INTEGER myNz
                0043       _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
                0044       _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
046fd16d1c Andr*0045       LOGICAL withSigns
                0046       INTEGER myThid
                0047 
                0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
                0050 C     OL[wens]       :: Overlap extents in west, east, north, south.
                0051 C     exchWidth[XY]  :: Extent of regions that will be exchanged.
d4e639dc4c Jean*0052       INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
5df640d755 Jean*0053       INTEGER bi, bj, myTile, k
2cf110c259 Jean*0054 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0055       INTEGER i, j
                0056 #else
                0057 # ifdef DO_CORNER_COPY_V2U
                0058       INTEGER j
                0059 # endif
2cf110c259 Jean*0060 #endif
046fd16d1c Andr*0061 CEOP
                0062 
                0063       OLw        = OLx
                0064       OLe        = OLx
                0065       OLn        = OLy
                0066       OLs        = OLy
                0067       exchWidthX = OLx
                0068       exchWidthY = OLy
8c27c9de99 Jean*0069 
bb99eee0de Jean*0070        CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
046fd16d1c Andr*0071      I            OLw, OLe, OLs, OLn, myNz,
                0072      I            exchWidthX, exchWidthY,
1a3a8861a0 Jean*0073      I            EXCH_IGNORE_CORNERS, myThid )
bb99eee0de Jean*0074        CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
7193a2041e Jean*0075      I            OLw, OLe, OLs, OLn, myNz,
                0076      I            exchWidthX, exchWidthY,
8bc539472e Jean*0077      I            EXCH_UPDATE_CORNERS, myThid )
8c27c9de99 Jean*0078 
5df640d755 Jean*0079       IF (useCubedSphereExchange) THEN
                0080 C---  using CubedSphereExchange:
046fd16d1c Andr*0081       DO bj=myByLo(myThid),myByHi(myThid)
                0082        DO bi=myBxLo(myThid),myBxHi(myThid)
5df640d755 Jean*0083         myTile = W2_myTileList(bi,bj)
8c27c9de99 Jean*0084 
bb99eee0de Jean*0085 #ifdef DO_CORNER_COPY_V2U
046fd16d1c Andr*0086         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
                0087      &       exch2_isSedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0088          DO k=1,myNz
5df640d755 Jean*0089 C         Uphi(sNx+1,    0,k,bi,bj)= vPhi(sNx+1,    1,k,bi,bj)
aa6b2555c8 Jean*0090           DO j=1-OLx,0
5df640d755 Jean*0091            Uphi(sNx+1,    j,k,bi,bj)= vPhi(sNx+(1-j),    1,k,bi,bj)
41e70ac469 Chri*0092           ENDDO
046fd16d1c Andr*0093          ENDDO
                0094         ENDIF
                0095         IF ( withSigns ) THEN
                0096          IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
                0097      &        exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0098           DO k=1,myNz
5df640d755 Jean*0099 C          Uphi(sNx+1,sNy+1,k,bi,bj)=-vPhi(sNx+1,sNy+1,k,bi,bj)
aa6b2555c8 Jean*0100            DO j=1,OLx
5df640d755 Jean*0101             Uphi(sNx+1,sNy+j,k,bi,bj)=-vPhi(sNx+j,sNy+1,k,bi,bj)
41e70ac469 Chri*0102            ENDDO
046fd16d1c Andr*0103           ENDDO
                0104          ENDIF
                0105         ELSE
                0106          IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
                0107      &        exch2_isNedge(myTile) .EQ. 1 ) THEN
d4e639dc4c Jean*0108           DO k=1,myNz
5df640d755 Jean*0109 C          Uphi(sNx+1,sNy+1,k,bi,bj)= vPhi(sNx+1,sNy+1,k,bi,bj)
aa6b2555c8 Jean*0110            DO j=1,OLx
5df640d755 Jean*0111             Uphi(sNx+1,sNy+j,k,bi,bj)= vPhi(sNx+j,sNy+1,k,bi,bj)
41e70ac469 Chri*0112            ENDDO
046fd16d1c Andr*0113           ENDDO
                0114          ENDIF
                0115         ENDIF
1ec0ee365b Jean*0116 #endif /* DO_CORNER_COPY_V2U */
1e450a3576 Jean*0117 
8c27c9de99 Jean*0118 C--     Now zero out the null areas that should not be used in the numerics
                0119 C       Also add one valid u,v value next to the corner, that allows
1e450a3576 Jean*0120 C        to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
8c27c9de99 Jean*0121 
41e70ac469 Chri*0122         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
                0123      &       exch2_isSedge(myTile) .EQ. 1 ) THEN
                0124 C        Zero SW corner points
5df640d755 Jean*0125          DO k=1,myNz
8c27c9de99 Jean*0126 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0127           DO j=1-OLx,0
                0128            DO i=1-OLx,0
                0129             uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0130            ENDDO
                0131           ENDDO
5df640d755 Jean*0132           DO j=1-OLx,0
                0133            DO i=1-OLx,0
                0134             vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0135            ENDDO
                0136           ENDDO
8c27c9de99 Jean*0137 #endif
aa6b2555c8 Jean*0138           IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
5df640d755 Jean*0139             uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
                0140             vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
aa6b2555c8 Jean*0141           ENDIF
41e70ac469 Chri*0142          ENDDO
                0143         ENDIF
8c27c9de99 Jean*0144 
41e70ac469 Chri*0145         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
                0146      &       exch2_isNedge(myTile) .EQ. 1 ) THEN
                0147 C        Zero NW corner points
5df640d755 Jean*0148          DO k=1,myNz
8c27c9de99 Jean*0149 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0150           DO j=sNy+1,sNy+OLy
                0151            DO i=1-OLx,0
                0152             uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0153            ENDDO
                0154           ENDDO
5df640d755 Jean*0155           DO j=sNy+2,sNy+OLy
                0156            DO i=1-OLx,0
                0157             vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0158            ENDDO
                0159           ENDDO
8c27c9de99 Jean*0160 #endif
aa6b2555c8 Jean*0161           IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
                0162            IF ( withSigns ) THEN
5df640d755 Jean*0163             uPhi(0,sNy+1,k,bi,bj)=-vPhi(1,sNy+2,k,bi,bj)
                0164             vPhi(0,sNy+2,k,bi,bj)=-uPhi(0,sNy,k,bi,bj)
aa6b2555c8 Jean*0165            ELSE
5df640d755 Jean*0166             uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)
                0167             vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)
aa6b2555c8 Jean*0168            ENDIF
1e450a3576 Jean*0169           ENDIF
41e70ac469 Chri*0170          ENDDO
                0171         ENDIF
8c27c9de99 Jean*0172 
41e70ac469 Chri*0173         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
                0174      &       exch2_isSedge(myTile) .EQ. 1 ) THEN
                0175 C        Zero SE corner points
5df640d755 Jean*0176          DO k=1,myNz
8c27c9de99 Jean*0177 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0178           DO j=1-OLx,0
                0179            DO i=sNx+2,sNx+OLx
                0180             uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0181            ENDDO
                0182           ENDDO
5df640d755 Jean*0183           DO j=1-OLx,0
                0184            DO i=sNx+1,sNx+OLx
                0185             vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0186            ENDDO
                0187           ENDDO
8c27c9de99 Jean*0188 #endif
aa6b2555c8 Jean*0189           IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
                0190            IF ( withSigns ) THEN
5df640d755 Jean*0191             uPhi(sNx+2,0,k,bi,bj)=-vPhi(sNx,0,k,bi,bj)
                0192             vPhi(sNx+1,0,k,bi,bj)=-uPhi(sNx+2,1,k,bi,bj)
aa6b2555c8 Jean*0193            ELSE
5df640d755 Jean*0194             uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)
                0195             vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)
aa6b2555c8 Jean*0196            ENDIF
1e450a3576 Jean*0197           ENDIF
41e70ac469 Chri*0198          ENDDO
                0199         ENDIF
8c27c9de99 Jean*0200 
41e70ac469 Chri*0201         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
                0202      &       exch2_isNedge(myTile) .EQ. 1 ) THEN
                0203 C        Zero NE corner points
5df640d755 Jean*0204          DO k=1,myNz
8c27c9de99 Jean*0205 #ifdef W2_FILL_NULL_REGIONS
5df640d755 Jean*0206           DO j=sNy+1,sNy+OLy
                0207            DO i=sNx+2,sNx+OLx
                0208             uPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0209            ENDDO
                0210           ENDDO
5df640d755 Jean*0211           DO j=sNy+2,sNy+OLy
                0212            DO i=sNx+1,sNx+OLx
                0213             vPhi(i,j,k,bi,bj)=e2FillValue_RX
41e70ac469 Chri*0214            ENDDO
                0215           ENDDO
8c27c9de99 Jean*0216 #endif
aa6b2555c8 Jean*0217           IF ( OLx.GE.2 .AND. OLy.GE.2 ) THEN
5df640d755 Jean*0218             uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
                0219             vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
aa6b2555c8 Jean*0220           ENDIF
41e70ac469 Chri*0221          ENDDO
                0222         ENDIF
5df640d755 Jean*0223 
046fd16d1c Andr*0224        ENDDO
                0225       ENDDO
5df640d755 Jean*0226 C---  using or not using CubedSphereExchange: end
046fd16d1c Andr*0227       ENDIF
                0228 
                0229       RETURN
                0230       END
2ad152b417 Ed H*0231 
                0232 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0233 
                0234 CEH3 ;;; Local Variables: ***
                0235 CEH3 ;;; mode:fortran ***
                0236 CEH3 ;;; End: ***