eesupp/src/fill_cs_corner_uv_rl.F

f1344853ff Mart*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_UV_RL
                0007
                0008 C     !INTERFACE:
                0009       SUBROUTINE FILL_CS_CORNER_UV_RL(
                0010      I     withSigns,
                0011      U     uFld, vFld,
                0012      I     bi,bj, myThid)
                0013       IMPLICIT NONE
                0014
                0015 C     !DESCRIPTION:
                0016 C     *==========================================================*
                0017 C     | SUBROUTINE FILL_CS_CORNER_UV_RL
                0018 C     | o Fill the corner-halo region of CS-grid,
                0019 C     |   for a 2 components, C-grid vector field
                0020 C     *==========================================================*
                0021 C     | o the corner halo region is filled with valid values
                0022 C     |   in order to extend in X and Y direction calculations
                0023 C     |   of fluxes, on a wide stencil.
                0024 C     *==========================================================*
                0025 C     | o this routine is a copy of S/R FILL_CS_CORNER_UV_RS
                0026 C     *==========================================================*
                0027
                0028 C     !USES:
                0029 C     == Global variables ==
                0030
                0031 #include "SIZE.h"
                0032 #include "EEPARAMS.h"
                0033 #ifdef ALLOW_EXCH2
                0034 #include "W2_EXCH2_SIZE.h"
                0035 #include "W2_EXCH2_TOPOLOGY.h"
                0036 #endif /* ALLOW_EXCH2 */
                0037
                0038 C     !INPUT/OUTPUT PARAMETERS:
                0039 C     == Routine arguments ==
                0040 C
                0041 C     withSigns :: uFld,vFld are vector components
                0042 C     uFld      :: u-component, at C-grid West  point location
                0043 C     vFld      :: v-component, at C-grid SOuth point location
                0044 C     bi,bj     :: tile indices
                0045 C     myThid    :: thread number
                0046       LOGICAL withSigns
                0047       _RL     uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0048       _RL     vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0049       INTEGER bi,bj
                0050       INTEGER myThid
                0051
                0052 C     !LOCAL VARIABLES:
                0053 C     == Local variables ==
                0054 C      i,j           :: loop indices
                0055 C      myTile        :: tile number
                0056       INTEGER i,j
                0057       LOGICAL southWestCorner
                0058       LOGICAL southEastCorner
                0059       LOGICAL northWestCorner
                0060       LOGICAL northEastCorner
                0061       _RL negOne
                0062 #ifdef ALLOW_EXCH2
                0063       INTEGER myTile
                0064 #endif
                0065 CEOP
                0066
                0067       IF (useCubedSphereExchange) THEN
                0068
                0069        negOne = 1. _d 0
                0070        IF (withSigns) negOne = -1. _d 0
                0071
                0072 #ifdef ALLOW_EXCH2
                0073        myTile = W2_myTileList(bi,bj)
                0074        southWestCorner = exch2_isWedge(myTile).EQ.1
                0075      &             .AND. exch2_isSedge(myTile).EQ.1
                0076        southEastCorner = exch2_isEedge(myTile).EQ.1
                0077      &             .AND. exch2_isSedge(myTile).EQ.1
                0078        northEastCorner = exch2_isEedge(myTile).EQ.1
                0079      &             .AND. exch2_isNedge(myTile).EQ.1
                0080        northWestCorner = exch2_isWedge(myTile).EQ.1
                0081      &             .AND. exch2_isNedge(myTile).EQ.1
                0082 #else
                0083        southWestCorner = .TRUE.
                0084        southEastCorner = .TRUE.
                0085        northWestCorner = .TRUE.
                0086        northEastCorner = .TRUE.
                0087 #endif
                0088
                0089 C--    To extend calculations in X direction, fill uFld array
                0090 C        with valid value in the corner.
                0091 C  e.g., NW corner: copy V(    0,sNy  ) into U(   -1,sNy+1)
                0092 C                   copy V(    0,sNy-1) into U(   -2,sNy+1)
                0093 C                   copy V(   -1,sNy  ) into U(   -1,sNy+2)
                0094 C                   copy V(   -1,sNy-1) into U(   -2,sNy+2)
                0095 C          |             |
                0096 C      U(-1,sNy+1)   U(1,sNy+1)   U(2,sNy+1)
                0097 C          | ^           |             |
                0098 C     -----|--\--------corner----------|
                0099 C          |   \         |             |
                0100 C          |    \        |
                0101 C          |     \       |
                0102 C     -----|---V(0,sNy)--|---------------
                0103 C          |             |
                0104 C
                0105 C--    to extend calculations in Y direction, fill vFld array
                0106 C        with valid value in the corner.
                0107 C  e.g., NW corner: copy U(    2,sNy+1) into V(   0,sNy+2)
                0108 C                   copy U(    3,sNy+1) into V(   0,sNy+3)
                0109 C                   copy U(    2,sNy+2) into V(  -1,sNy+2)
                0110 C                   copy U(    3,sNy+2) into V(  -1,sNy+3)
                0111 C          |              |              |
                0112 C     -----|--V(0,sNy+2)--|--------------|
                0113 C          |    ^====================\
                0114 C      U(-1,sNy+1)     U(1,sNy+1)     U(2,sNy+1)
                0115 C          |              |              |
                0116 C     -----|--V(0,sNy+1)--o--------------|
                0117 C          |              |\             |
                0118 C          |              | \=corner
                0119 C          |              |
                0120 C     -----|--V(0,sNy)----|--
                0121 C          |              |
                0122 C
                0123
                0124         IF ( southWestCorner ) THEN
                0125 C-        prepare for direction X:
                0126           DO j=1,OLy
                0127            DO i=1,OLx
                0128             uFld( 1-i , 1-j ) = negOne*vFld( 1-j , 1+i )
                0129            ENDDO
                0130           ENDDO
                0131 C-        prepare for direction Y:
                0132           DO j=1,OLy
                0133            DO i=1,OLx
                0134             vFld( 1-i , 1-j ) = negOne*uFld( 1+j , 1-i )
                0135            ENDDO
                0136           ENDDO
                0137         ENDIF
                0138
                0139         IF ( southEastCorner ) THEN
                0140 C-        prepare for direction X:
                0141           DO j=1,OLy
                0142            DO i=2,OLx
                0143             uFld(sNx+i, 1-j ) = vFld(sNx+j, i  )
                0144            ENDDO
                0145           ENDDO
                0146 C-        prepare for direction Y:
                0147           DO j=1,OLy
                0148            DO i=1,OLx
                0149             vFld(sNx+i, 1-j ) = uFld(sNx+1-j, 1-i  )
                0150            ENDDO
                0151           ENDDO
                0152         ENDIF
                0153
                0154         IF ( northWestCorner ) THEN
                0155 C-        prepare for direction X:
                0156           DO j=1,OLy
                0157            DO i=1,OLx
                0158             uFld( 1-i ,sNy+j) = vFld( 1-j , sNy+1-i )
                0159            ENDDO
                0160           ENDDO
                0161 C-        prepare for direction Y:
                0162           DO j=2,OLy
                0163            DO i=1,OLx
                0164             vFld( 1-i ,sNy+j) = uFld(  j  , sNy+i )
                0165            ENDDO
                0166           ENDDO
                0167         ENDIF
                0168
                0169         IF ( northEastCorner ) THEN
                0170 C-        prepare for direction X:
                0171           DO j=1,OLy
                0172            DO i=2,OLx
                0173             uFld(sNx+i,sNy+j) = negOne*vFld(sNx+j, sNy+2-i )
                0174            ENDDO
                0175           ENDDO
                0176 C-        prepare for direction Y:
                0177           DO j=2,OLy
                0178            DO i=1,OLx
                0179             vFld(sNx+i,sNy+j) = negOne*uFld(sNx+2-j, sNy+i )
                0180            ENDDO
                0181           ENDDO
                0182         ENDIF
                0183
                0184 C--   End useCubedSphereExchange
                0185       ENDIF
                0186
                0187       RETURN
                0188       END