model/src/ini_nlfs_vars.F

4c70dbac7f Jean*0001 #include "PACKAGES_CONFIG.h"
cdc9f269ae Patr*0002 #include "CPP_OPTIONS.h"
                0003
                0004 CBOP
c3689e90a0 Jean*0005 C     !ROUTINE: INI_NLFS_VARS
cdc9f269ae Patr*0006 C     !INTERFACE:
c3689e90a0 Jean*0007       SUBROUTINE INI_NLFS_VARS( myThid )
cdc9f269ae Patr*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
c3689e90a0 Jean*0010 C     | SUBROUTINE INI_NLFS_VARS
                0011 C     | o Initialise variables for Non-Linear Free-Surface
                0012 C     |   formulations (formerly INI_SURF_DR & INI_R_STAR)
cdc9f269ae Patr*0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     == Global variables
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "SURFACE.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     == Routine arguments ==
c3689e90a0 Jean*0027 C     myThid :: my Thread Id. number
cdc9f269ae Patr*0028       INTEGER myThid
                0029
                0030 C     !LOCAL VARIABLES:
                0031 C     Local variables
                0032 C     i,j,k,bi,bj  :: loop counter
c3be04357d Jean*0033       INTEGER i, j
                0034       INTEGER bi, bj
9313308f9b Jean*0035 #ifdef NONLIN_FRSURF
c3be04357d Jean*0036       INTEGER ks
aa6b2555c8 Jean*0037 # ifdef ALLOW_AUTODIFF
                0038       INTEGER k
                0039 # endif
dff69a4ed4 Jean*0040       _RL hFacInfMOM, Rmin_tmp
9313308f9b Jean*0041 #endif /* NONLIN_FRSURF */
cdc9f269ae Patr*0042 CEOP
                0043
                0044 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0045
c3689e90a0 Jean*0046 #ifdef ALLOW_DEBUG
                0047       IF (debugMode) CALL DEBUG_ENTER('INI_NLFS_VARS',myThid)
                0048 #endif
cdc9f269ae Patr*0049
c3689e90a0 Jean*0050       DO bj=myByLo(myThid), myByHi(myThid)
                0051        DO bi=myBxLo(myThid), myBxHi(myThid)
                0052 C-    1rst bi,bj loop :
                0053
c3be04357d Jean*0054 C-- Initialise arrays:
e1fb02e8f0 Jean*0055          DO j=1-OLy,sNy+OLy
                0056           DO i=1-OLx,sNx+OLx
9313308f9b Jean*0057             etaHnm1(i,j,bi,bj) = 0.
                0058             dEtaHdt(i,j,bi,bj) = 0.
                0059             PmEpR  (i,j,bi,bj) = 0.
                0060           ENDDO
                0061          ENDDO
                0062
                0063 #ifdef NONLIN_FRSURF
c3689e90a0 Jean*0064 C-- Initialise arrays (NLFS using r-coordinate):
e1fb02e8f0 Jean*0065          DO j=1-OLy,sNy+OLy
                0066           DO i=1-OLx,sNx+OLx
88f12b65e6 Gael*0067            hFac_surfC(i,j,bi,bj) = 0.
                0068            hFac_surfW(i,j,bi,bj) = 0.
                0069            hFac_surfS(i,j,bi,bj) = 0.
                0070            hFac_surfNm1C(i,j,bi,bj) = 0.
                0071            hFac_surfNm1W(i,j,bi,bj) = 0.
                0072            hFac_surfNm1S(i,j,bi,bj) = 0.
cdc9f269ae Patr*0073            Rmin_surf(i,j,bi,bj) = Ro_surf(i,j,bi,bj)
                0074           ENDDO
                0075          ENDDO
                0076
c3689e90a0 Jean*0077 C-- Initialise arrays (NLFS using r* coordinate):
e1fb02e8f0 Jean*0078          DO j=1-OLy,sNy+OLy
                0079           DO i=1-OLx,sNx+OLx
c3689e90a0 Jean*0080             rStarFacC(i,j,bi,bj) = 1.
                0081             rStarFacW(i,j,bi,bj) = 1.
                0082             rStarFacS(i,j,bi,bj) = 1.
ccbf39d1a4 Jean*0083             pStarFacK(i,j,bi,bj) = 1.
72a058b866 Gael*0084             rStarFacNm1C(i,j,bi,bj) = 1.
                0085             rStarFacNm1W(i,j,bi,bj) = 1.
                0086             rStarFacNm1S(i,j,bi,bj) = 1.
c3689e90a0 Jean*0087             rStarExpC(i,j,bi,bj) = 1.
                0088             rStarExpW(i,j,bi,bj) = 1.
                0089             rStarExpS(i,j,bi,bj) = 1.
                0090             rStarDhCDt(i,j,bi,bj) = 0.
                0091             rStarDhWDt(i,j,bi,bj) = 0.
                0092             rStarDhSDt(i,j,bi,bj) = 0.
                0093           ENDDO
                0094          ENDDO
9313308f9b Jean*0095
                0096 C-- Initialise arrays (NLFS using hybrid sigma-coordinate):
e1fb02e8f0 Jean*0097          DO j=1-OLy,sNy+OLy
                0098           DO i=1-OLx,sNx+OLx
9313308f9b Jean*0099             etaHw  (i,j,bi,bj) = 0.
                0100             etaHs  (i,j,bi,bj) = 0.
                0101             dEtaWdt(i,j,bi,bj) = 0.
                0102             dEtaSdt(i,j,bi,bj) = 0.
                0103           ENDDO
                0104          ENDDO
                0105
cab62edf37 Ou W*0106 # ifdef ALLOW_AUTODIFF
065ea7c980 Jean*0107 C--  to make TAF happy: reset hFac to h0Fac (copied from hFac in ini_linear_phisurf)
c3689e90a0 Jean*0108          DO k=1,Nr
e1fb02e8f0 Jean*0109           DO j=1-OLy,sNy+OLy
                0110            DO i=1-OLx,sNx+OLx
eddedeb180 Patr*0111             hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
                0112             hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
                0113             hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
c3689e90a0 Jean*0114            ENDDO
                0115           ENDDO
                0116          ENDDO
cab62edf37 Ou W*0117          DO k=1,Nr
                0118           DO j=1-OLy,sNy+OLy
                0119            DO i=1-OLx,sNx+OLx
                0120 #  ifdef USE_MASK_AND_NO_IF
                0121             recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) /
                0122      &        ( _hFacC(i,j,k,bi,bj) + (oneRS - maskC(i,j,k,bi,bj)) )
                0123             recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) /
                0124      &        ( _hFacW(i,j,k,bi,bj) + (oneRS - maskW(i,j,k,bi,bj)) )
                0125             recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) /
                0126      &        ( _hFacS(i,j,k,bi,bj) + (oneRS - maskS(i,j,k,bi,bj)) )
                0127 #  else
                0128             IF ( maskC(i,j,k,bi,bj).NE.zeroRS )
                0129      &        recip_hFacC(i,j,k,bi,bj) = oneRS / _hFacC(i,j,k,bi,bj)
                0130             IF ( maskW(i,j,k,bi,bj).NE.zeroRS )
                0131      &        recip_hFacW(i,j,k,bi,bj) = oneRS / _hFacW(i,j,k,bi,bj)
                0132             IF ( maskS(i,j,k,bi,bj).NE.zeroRS )
                0133      &        recip_hFacS(i,j,k,bi,bj) = oneRS / _hFacS(i,j,k,bi,bj)
                0134 #  endif
                0135            ENDDO
                0136           ENDDO
                0137          ENDDO
                0138 # endif /* ALLOW_AUTODIFF */
9313308f9b Jean*0139 #endif /* NONLIN_FRSURF */
c3689e90a0 Jean*0140
                0141 C-    end 1rst bi,bj loop.
                0142        ENDDO
                0143       ENDDO
                0144
                0145 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9313308f9b Jean*0146 #ifdef NONLIN_FRSURF
                0147
                0148       hFacInfMOM = hFacInf
c3689e90a0 Jean*0149
                0150       DO bj=myByLo(myThid), myByHi(myThid)
                0151        DO bi=myBxLo(myThid), myBxHi(myThid)
                0152
cdc9f269ae Patr*0153 C-- Compute the mimimum value of r_surf (used for computing hFac_surfC)
                0154          DO j=1,sNy
                0155           DO i=1,sNx
a2a20dcddc Jean*0156            ks = kSurfC(i,j,bi,bj)
cdc9f269ae Patr*0157            IF (ks.LE.Nr) THEN
                0158              Rmin_tmp = rF(ks+1)
a2a20dcddc Jean*0159              IF ( ks.EQ.kSurfW(i,j,bi,bj))
cdc9f269ae Patr*0160      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i-1,j,bi,bj))
a2a20dcddc Jean*0161              IF ( ks.EQ.kSurfW(i+1,j,bi,bj))
cdc9f269ae Patr*0162      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i+1,j,bi,bj))
a2a20dcddc Jean*0163              IF ( ks.EQ.kSurfS(i,j,bi,bj))
cdc9f269ae Patr*0164      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i,j-1,bi,bj))
a2a20dcddc Jean*0165              IF ( ks.EQ.kSurfS(i,j+1,bi,bj))
cdc9f269ae Patr*0166      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i,j+1,bi,bj))
                0167
                0168              Rmin_surf(i,j,bi,bj) =
dff69a4ed4 Jean*0169      &        MAX( MAX(rF(ks+1),R_low(i,j,bi,bj)) + hFacInf*drF(ks),
cdc9f269ae Patr*0170      &                                Rmin_tmp + hFacInfMOM*drF(ks)
                0171      &           )
                0172            ENDIF
                0173           ENDDO
                0174          ENDDO
                0175
                0176 C-    end bi,bj loop.
                0177        ENDDO
c3689e90a0 Jean*0178       ENDDO
cdc9f269ae Patr*0179
c3689e90a0 Jean*0180       CALL EXCH_XY_RL( Rmin_surf, myThid )
cdc9f269ae Patr*0181
9313308f9b Jean*0182 #endif /* NONLIN_FRSURF */
cdc9f269ae Patr*0183 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c3689e90a0 Jean*0184
                0185 #ifdef ALLOW_DEBUG
                0186       IF (debugMode) CALL DEBUG_LEAVE('INI_NLFS_VARS',myThid)
                0187 #endif
                0188
cdc9f269ae Patr*0189       RETURN
                0190       END