Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:36:08 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
44027b6abc Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_EEOPTIONS.h"
                0003 
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C     !ROUTINE: FILL_CS_CORNER_TR_RL
                0007 
                0008 C     !INTERFACE:
                0009       SUBROUTINE FILL_CS_CORNER_TR_RL(
dc7d71076a Jean*0010      I     fill4dir, withSigns,
44027b6abc Jean*0011      U     trFld,
                0012      I     bi,bj, myThid)
                0013 
                0014 C     !DESCRIPTION:
                0015 C     *==========================================================*
                0016 C     | SUBROUTINE FILL_CS_CORNER_TR_RL
6f72547be3 Jean*0017 C     | o Fill the corner-halo region of CS-grid,
44027b6abc Jean*0018 C     |   for a tracer variable (center of grid cell)
                0019 C     *==========================================================*
                0020 C     | o the corner halo region is filled with valid values
                0021 C     |   in order to compute (later on) gradient in X or Y
dc7d71076a Jean*0022 C     |   direction on a wide stencil.
44027b6abc Jean*0023 C     *==========================================================*
                0024 
                0025 C     !USES:
6f72547be3 Jean*0026       IMPLICIT NONE
44027b6abc Jean*0027 
6f72547be3 Jean*0028 C     == Global variables ==
44027b6abc Jean*0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #ifdef ALLOW_EXCH2
1cc6effca6 Jean*0032 #include "W2_EXCH2_SIZE.h"
44027b6abc Jean*0033 #include "W2_EXCH2_TOPOLOGY.h"
                0034 #endif /* ALLOW_EXCH2 */
                0035 
                0036 C     !INPUT/OUTPUT PARAMETERS:
                0037 C     == Routine arguments ==
6f72547be3 Jean*0038 C
dc7d71076a Jean*0039 C     fill4dir  :: = 0 fill corner with zeros
                0040 C                  = 1 copy to prepare for X direction calculations
                0041 C                  = 2 copy to prepare for Y direction calculations
                0042 C                  = 3 fill corner with averaged value
6f72547be3 Jean*0043 C     withSigns :: True = account for sign of X & Y directions
44027b6abc Jean*0044 C     trFld     :: tracer field array with empty corners to fill
                0045 C     bi,bj     :: tile indices
                0046 C     myThid    :: thread number
dc7d71076a Jean*0047       INTEGER fill4dir
6f72547be3 Jean*0048       LOGICAL withSigns
44027b6abc Jean*0049       _RL trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       INTEGER bi,bj
                0051       INTEGER myThid
                0052 
                0053 C     !LOCAL VARIABLES:
                0054 C     == Local variables ==
                0055 C      i,j           :: loop indices
                0056 C      myTile        :: tile number
                0057       INTEGER i,j
                0058       LOGICAL southWestCorner
                0059       LOGICAL southEastCorner
                0060       LOGICAL northWestCorner
                0061       LOGICAL northEastCorner
6f72547be3 Jean*0062       _RL     negOne
89b34fe90d Jean*0063 #ifdef ALLOW_EXCH2
                0064       INTEGER myTile
                0065 #endif
44027b6abc Jean*0066 CEOP
                0067 
6f72547be3 Jean*0068       negOne = 1.
                0069       IF (withSigns) negOne = -1.
                0070 
44027b6abc Jean*0071       IF (useCubedSphereExchange) THEN
                0072 
                0073 #ifdef ALLOW_EXCH2
6e33c64afb Jean*0074        myTile = W2_myTileList(bi,bj)
44027b6abc Jean*0075        southWestCorner = exch2_isWedge(myTile).EQ.1
                0076      &             .AND. exch2_isSedge(myTile).EQ.1
                0077        southEastCorner = exch2_isEedge(myTile).EQ.1
                0078      &             .AND. exch2_isSedge(myTile).EQ.1
                0079        northEastCorner = exch2_isEedge(myTile).EQ.1
                0080      &             .AND. exch2_isNedge(myTile).EQ.1
                0081        northWestCorner = exch2_isWedge(myTile).EQ.1
                0082      &             .AND. exch2_isNedge(myTile).EQ.1
                0083 #else
                0084        southWestCorner = .TRUE.
                0085        southEastCorner = .TRUE.
                0086        northWestCorner = .TRUE.
                0087        northEastCorner = .TRUE.
                0088 #endif
                0089 
dc7d71076a Jean*0090        IF ( fill4dir .EQ. 0 ) THEN
                0091 C--    Just fill corner with zero (e.g., used for 6 tracer points average)
                0092 
                0093          IF ( southWestCorner ) THEN
                0094           DO j=1,OLy
                0095            DO i=1,OLx
                0096             trFld( 1-i , 1-j ) = 0. _d 0
                0097            ENDDO
                0098           ENDDO
                0099          ENDIF
                0100          IF ( southEastCorner ) THEN
                0101           DO j=1,OLy
                0102            DO i=1,OLx
                0103             trFld(sNx+i, 1-j ) = 0. _d 0
                0104            ENDDO
                0105           ENDDO
                0106          ENDIF
                0107          IF ( northWestCorner ) THEN
                0108           DO j=1,OLy
                0109            DO i=1,OLx
                0110             trFld( 1-i ,sNy+j) = 0. _d 0
                0111            ENDDO
                0112           ENDDO
                0113          ENDIF
                0114          IF ( northEastCorner ) THEN
                0115           DO j=1,OLy
                0116            DO i=1,OLx
                0117             trFld(sNx+i,sNy+j) = 0. _d 0
                0118            ENDDO
                0119           ENDDO
                0120          ENDIF
                0121 
                0122        ELSEIF ( fill4dir .EQ. 1 ) THEN
44027b6abc Jean*0123 C--    Internal exchange for calculations in X
                0124 
                0125 C-     For cube face corners we need to duplicate the
                0126 C-     i-1 and i+1 values into the null space as follows:
                0127 C
                0128 C
                0129 C      o NW corner: copy T(    0,sNy  ) into T(    0,sNy+1) e.g.
                0130 C                      |
                0131 C         x T(0,sNy+1) |
                0132 C        /\            |
                0133 C      --||------------|-----------
                0134 C        ||            |
                0135 C         x T(0,sNy)   |   x T(1,sNy)
                0136 C                      |
                0137 C
                0138 C      o SW corner: copy T(0,1) into T(0,0) e.g.
                0139 C                      |
                0140 C         x T(0,1)     |  x T(1,1)
                0141 C        ||            |
                0142 C      --||------------|-----------
                0143 C        \/            |
                0144 C         x T(0,0)     |
                0145 C                      |
                0146 C
                0147 C      o NE corner: copy T(sNx+1,sNy  ) into T(sNx+1,sNy+1) e.g.
                0148 C                      |
                0149 C                      |   x T(sNx+1,sNy+1)
                0150 C                      |  /\
                0151 C      ----------------|--||-------
                0152 C                      |  ||
                0153 C         x T(sNx,sNy) |   x T(sNx+1,sNy  )
                0154 C                      |
                0155 C      o SE corner: copy T(sNx+1,1    ) into T(sNx+1,0    ) e.g.
                0156 C                      |
6f72547be3 Jean*0157 C         x T(sNx,1)   |   x T(sNx+1,    1)
44027b6abc Jean*0158 C                      |  ||
                0159 C      ----------------|--||-------
                0160 C                      |  \/
                0161 C                      |   x T(sNx+1,    0)
                0162          IF ( southWestCorner ) THEN
                0163           DO j=1,OLy
                0164            DO i=1,OLx
6f72547be3 Jean*0165             trFld( 1-i , 1-j ) = negOne*trFld( 1-j , i  )
44027b6abc Jean*0166            ENDDO
                0167           ENDDO
                0168          ENDIF
                0169          IF ( southEastCorner ) THEN
                0170           DO j=1,OLy
                0171            DO i=1,OLx
6f72547be3 Jean*0172             trFld(sNx+i, 1-j ) = negOne*trFld(sNx+j, i  )
44027b6abc Jean*0173            ENDDO
                0174           ENDDO
                0175          ENDIF
                0176          IF ( northWestCorner ) THEN
                0177           DO j=1,OLy
                0178            DO i=1,OLx
6f72547be3 Jean*0179             trFld( 1-i ,sNy+j) = negOne*trFld( 1-j , sNy+1-i )
44027b6abc Jean*0180            ENDDO
                0181           ENDDO
                0182          ENDIF
                0183          IF ( northEastCorner ) THEN
                0184           DO j=1,OLy
                0185            DO i=1,OLx
6f72547be3 Jean*0186             trFld(sNx+i,sNy+j) = negOne*trFld(sNx+j, sNy+1-i )
44027b6abc Jean*0187            ENDDO
                0188           ENDDO
                0189          ENDIF
                0190 
                0191 C--   End of X direction ; start Y direction case.
                0192 
dc7d71076a Jean*0193        ELSEIF ( fill4dir .EQ. 2 ) THEN
44027b6abc Jean*0194 C--    Internal exchange for calculations in Y
                0195 
                0196 C-     For cube face corners we need to duplicate the
                0197 C-     j-1 and j+1 values into the null space as follows:
                0198 C
                0199 C      o SW corner: copy T(0,1) into T(0,0) e.g.
                0200 C                      |
                0201 C                      |  x T(1,1)
                0202 C                      |
                0203 C      ----------------|-----------
                0204 C                      |
                0205 C         x T(0,0)<====== x T(1,0)
                0206 C                      |
                0207 C
                0208 C      o NW corner: copy T(    0,sNy  ) into T(    0,sNy+1) e.g.
                0209 C                      |
                0210 C         x T(0,sNy+1)<=== x T(1,sNy+1)
                0211 C                      |
                0212 C      ----------------|-----------
                0213 C                      |
                0214 C                      |   x T(1,sNy)
                0215 C                      |
                0216 C
                0217 C      o NE corner: copy T(sNx+1,sNy  ) into T(sNx+1,sNy+1) e.g.
                0218 C                      |
                0219 C      x T(sNx,sNy+1)=====>x T(sNx+1,sNy+1)
6f72547be3 Jean*0220 C                      |
44027b6abc Jean*0221 C      ----------------|-----------
6f72547be3 Jean*0222 C                      |
                0223 C      x T(sNx,sNy)    |
44027b6abc Jean*0224 C                      |
                0225 C      o SE corner: copy T(sNx+1,1    ) into T(sNx+1,0    ) e.g.
                0226 C                      |
6f72547be3 Jean*0227 C         x T(sNx,1)   |
                0228 C                      |
44027b6abc Jean*0229 C      ----------------|-----------
6f72547be3 Jean*0230 C                      |
44027b6abc Jean*0231 C         x T(sNx,0) =====>x T(sNx+1,    0)
                0232          IF ( southWestCorner ) THEN
                0233           DO j=1,Oly
                0234            DO i=1,Olx
6f72547be3 Jean*0235             trFld( 1-i , 1-j ) = negOne*trFld(   j   , 1-i )
44027b6abc Jean*0236            ENDDO
                0237           ENDDO
                0238          ENDIF
                0239          IF ( southEastCorner ) THEN
                0240           DO j=1,Oly
                0241            DO i=1,Olx
6f72547be3 Jean*0242             trFld(sNx+i, 1-j ) = negOne*trFld(sNx+1-j, 1-i )
44027b6abc Jean*0243            ENDDO
                0244           ENDDO
                0245          ENDIF
                0246          IF ( northWestCorner ) THEN
                0247           DO j=1,Oly
                0248            DO i=1,Olx
6f72547be3 Jean*0249             trFld( 1-i ,sNy+j) = negOne*trFld(   j   ,sNy+i)
44027b6abc Jean*0250            ENDDO
                0251           ENDDO
                0252          ENDIF
                0253          IF ( northEastCorner ) THEN
                0254           DO j=1,Oly
                0255            DO i=1,Olx
6f72547be3 Jean*0256             trFld(sNx+i,sNy+j) = negOne*trFld(sNx+1-j,sNy+i)
44027b6abc Jean*0257            ENDDO
                0258           ENDDO
                0259          ENDIF
                0260 
                0261 C-     End of Y direction case.
dc7d71076a Jean*0262        ELSE
                0263          STOP 'FILL_CS_CORNER_TR_RL: fill4dir has illegal value'
44027b6abc Jean*0264        ENDIF
                0265 
                0266 C--   End useCubedSphereExchange
                0267       ENDIF
                0268 
                0269       RETURN
                0270       END