model/src/add_walls2masks.F

f88bbe67c4 Jean*0001 c#include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
                0005 C     !ROUTINE: ADD_WALLS2MASKS
                0006 C     !INTERFACE:
dff94812d5 Jean*0007       SUBROUTINE ADD_WALLS2MASKS( rEmpty, myThid )
f88bbe67c4 Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE ADD_WALLS2MASKS
                0011 C     | o Apply additional closing of Western and Southern edges
                0012 C     |   grid-cell open-water factor
                0013 C     *==========================================================*
                0014 C     | Reset to zero hFacW and/or hFacS grid factors at some
                0015 C     | specific locations. In particular, allow to prevent fluid
                0016 C     | transport (at any detph) between 2 adjacent vertical
                0017 C     | column by adding a "thin wall" between the 2.
dff94812d5 Jean*0018 C     | Location of "thin-wall" is reccorded as kSurfW/S = Nr+2
f88bbe67c4 Jean*0019 C     *==========================================================*
                0020 C     \ev
                0021
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 C     === Global variables ===
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "GRID.h"
                0029 c#include "SURFACE.h"
                0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     == Routine arguments ==
dff94812d5 Jean*0033 C     rEmpty  :: empty column r-position
f88bbe67c4 Jean*0034 C     myThid  :: my Thread Id number
dff94812d5 Jean*0035       _RS rEmpty
f88bbe67c4 Jean*0036       INTEGER myThid
                0037
                0038 C     !LOCAL VARIABLES:
                0039 C     == Local variables ==
                0040 C     bi,bj   :: tile indices
                0041 C     i,j,k   :: Loop counters
dff94812d5 Jean*0042 C     tmpFldW :: Temporary array used to load file in
                0043 C     tmpFldS :: Temporary array used to load file in
f88bbe67c4 Jean*0044       _RS tmpFldW(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0045       _RS tmpFldS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0046       INTEGER bi, bj
                0047       INTEGER i, j, k
                0048 CEOP
                0049
                0050 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0051
                0052       IF ( addWwallFile.NE.' ' .OR. addSwallFile.NE.' ' ) THEN
                0053
                0054 C--   Load files "addWwallFile" and/or "addSwallFile":
                0055         DO bj=myByLo(myThid), myByHi(myThid)
                0056          DO bi=myBxLo(myThid), myBxHi(myThid)
                0057            DO j=1-OLy,sNy+OLy
                0058             DO i=1-OLx,sNx+OLx
                0059              tmpFldW(i,j,bi,bj) = zeroRS
                0060              tmpFldS(i,j,bi,bj) = zeroRS
                0061             ENDDO
                0062            ENDDO
                0063          ENDDO
                0064         ENDDO
                0065         IF ( addWwallFile.NE.' ' ) THEN
                0066           CALL READ_FLD_XY_RS( addWwallFile, ' ', tmpFldW, 0, myThid )
                0067         ENDIF
                0068         IF ( addSwallFile.NE.' ' ) THEN
                0069           CALL READ_FLD_XY_RS( addSwallFile, ' ', tmpFldS, 0, myThid )
                0070         ENDIF
                0071         CALL EXCH_UV_XY_RS( tmpFldW, tmpFldS, .FALSE., myThid )
                0072
                0073       ENDIF
                0074
dff94812d5 Jean*0075 c     IF ( selectSigmaCoord.EQ.0 ) THEN
f88bbe67c4 Jean*0076 C---  r-coordinate with partial-cell or full cell mask
                0077
                0078 C--   The following block allows thin walls representation of non-periodic
                0079 C     boundaries such as happen on the lat-lon grid at the N/S poles.
                0080 C     We should really supply a flag for doing this.
                0081 c      IF ( closedBoundaryAtPoles ) THEN
                0082         DO bj=myByLo(myThid), myByHi(myThid)
                0083          DO bi=myBxLo(myThid), myBxHi(myThid)
                0084            DO j=1-OLy,sNy+OLy
                0085             DO i=1-OLx,sNx+OLx
                0086               IF ( dyG(i,j,bi,bj).EQ.zeroRS ) THEN
                0087                 DO k=1,Nr
                0088                  hFacW(i,j,k,bi,bj) = zeroRS
                0089                 ENDDO
dff94812d5 Jean*0090                 rLowW (i,j,bi,bj) = rEmpty
                0091                 rSurfW(i,j,bi,bj) = rEmpty
                0092                 kSurfW(i,j,bi,bj) = Nr+2
                0093                 maskInW(i,j,bi,bj)= zeroRS
f88bbe67c4 Jean*0094               ENDIF
                0095               IF ( dxG(i,j,bi,bj).EQ.zeroRS ) THEN
                0096                 DO k=1,Nr
                0097                  hFacS(i,j,k,bi,bj) = zeroRS
                0098                 ENDDO
dff94812d5 Jean*0099                 rLowS (i,j,bi,bj) = rEmpty
                0100                 rSurfS(i,j,bi,bj) = rEmpty
                0101                 kSurfS(i,j,bi,bj) = Nr+2
                0102                 maskInS(i,j,bi,bj)= zeroRS
f88bbe67c4 Jean*0103               ENDIF
                0104             ENDDO
                0105            ENDDO
                0106          ENDDO
                0107         ENDDO
                0108 c      ENDIF
                0109
                0110 C--   Addtional closing of Western and Southern grid-cell edges
                0111 C      as provided in files: "addWwallFile" or "addSwallFile"
                0112        IF ( addWwallFile.NE.' ' .OR. addSwallFile.NE.' ' ) THEN
                0113         DO bj=myByLo(myThid), myByHi(myThid)
                0114          DO bi=myBxLo(myThid), myBxHi(myThid)
                0115            DO j=1-OLy,sNy+OLy
                0116             DO i=1-OLx,sNx+OLx
                0117               IF ( tmpFldW(i,j,bi,bj).EQ.oneRS ) THEN
                0118                 DO k=1,Nr
                0119                  hFacW(i,j,k,bi,bj) = zeroRS
                0120                 ENDDO
dff94812d5 Jean*0121                 rLowW (i,j,bi,bj) = rEmpty
                0122                 rSurfW(i,j,bi,bj) = rEmpty
                0123                 kSurfW(i,j,bi,bj) = Nr+2
                0124                 maskInW(i,j,bi,bj)= zeroRS
f88bbe67c4 Jean*0125               ENDIF
                0126               IF ( tmpFldS(i,j,bi,bj).EQ.oneRS ) THEN
                0127                 DO k=1,Nr
                0128                  hFacS(i,j,k,bi,bj) = zeroRS
                0129                 ENDDO
dff94812d5 Jean*0130                 rLowS (i,j,bi,bj) = rEmpty
                0131                 rSurfS(i,j,bi,bj) = rEmpty
                0132                 kSurfS(i,j,bi,bj) = Nr+2
                0133                 maskInS(i,j,bi,bj)= zeroRS
f88bbe67c4 Jean*0134               ENDIF
                0135             ENDDO
                0136            ENDDO
                0137          ENDDO
                0138         ENDDO
                0139        ENDIF
                0140
dff94812d5 Jean*0141 c     ELSE
f88bbe67c4 Jean*0142 C---  Sigma and Hybrid-Sigma set-up:
dff94812d5 Jean*0143 c     ENDIF
f88bbe67c4 Jean*0144
                0145       RETURN
                0146       END