Back to home page

MITgcm
 
 

    

File indexing completed on 2021-06-06 05:11:23 UTC

view on githubraw file Latest commit aa6b2555 on 2021-06-06 02:50:10 UTC
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
e1fb02e8f0 Jean*0033       INTEGER bi,bj
9313308f9b Jean*0034 #ifdef NONLIN_FRSURF
aa6b2555c8 Jean*0035       INTEGER i, j, ks
                0036 # ifdef ALLOW_AUTODIFF
                0037       INTEGER k
                0038 # endif
dff69a4ed4 Jean*0039       _RL hFacInfMOM, Rmin_tmp
e1fb02e8f0 Jean*0040 #else /* NONLIN_FRSURF */
                0041 # ifdef EXACT_CONSERV
                0042       INTEGER i, j
                0043 # endif
9313308f9b Jean*0044 #endif /* NONLIN_FRSURF */
cdc9f269ae Patr*0045 CEOP
                0046 
                0047 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0048 
c3689e90a0 Jean*0049 #ifdef ALLOW_DEBUG
                0050       IF (debugMode) CALL DEBUG_ENTER('INI_NLFS_VARS',myThid)
                0051 #endif
cdc9f269ae Patr*0052 
c3689e90a0 Jean*0053       DO bj=myByLo(myThid), myByHi(myThid)
                0054        DO bi=myBxLo(myThid), myBxHi(myThid)
                0055 C-    1rst bi,bj loop :
                0056 
9313308f9b Jean*0057 #ifdef EXACT_CONSERV
                0058 C-- Initialise arrays (defined within ifdef EXACT_CONSERV):
                0059 C   note: should be done elsewhere, outside ifdef NONLIN_FRSURF bloc
e1fb02e8f0 Jean*0060          DO j=1-OLy,sNy+OLy
                0061           DO i=1-OLx,sNx+OLx
9313308f9b Jean*0062             etaHnm1(i,j,bi,bj) = 0.
                0063             dEtaHdt(i,j,bi,bj) = 0.
                0064             PmEpR  (i,j,bi,bj) = 0.
                0065           ENDDO
                0066          ENDDO
                0067 #endif /* EXACT_CONSERV */
                0068 
                0069 #ifdef NONLIN_FRSURF
c3689e90a0 Jean*0070 C-- Initialise arrays (NLFS using r-coordinate):
e1fb02e8f0 Jean*0071          DO j=1-OLy,sNy+OLy
                0072           DO i=1-OLx,sNx+OLx
88f12b65e6 Gael*0073            hFac_surfC(i,j,bi,bj) = 0.
                0074            hFac_surfW(i,j,bi,bj) = 0.
                0075            hFac_surfS(i,j,bi,bj) = 0.
                0076            hFac_surfNm1C(i,j,bi,bj) = 0.
                0077            hFac_surfNm1W(i,j,bi,bj) = 0.
                0078            hFac_surfNm1S(i,j,bi,bj) = 0.
cdc9f269ae Patr*0079            Rmin_surf(i,j,bi,bj) = Ro_surf(i,j,bi,bj)
                0080           ENDDO
                0081          ENDDO
                0082 
c3689e90a0 Jean*0083 C-- Initialise arrays (NLFS using r* coordinate):
e1fb02e8f0 Jean*0084          DO j=1-OLy,sNy+OLy
                0085           DO i=1-OLx,sNx+OLx
c3689e90a0 Jean*0086             rStarFacC(i,j,bi,bj) = 1.
                0087             rStarFacW(i,j,bi,bj) = 1.
                0088             rStarFacS(i,j,bi,bj) = 1.
ccbf39d1a4 Jean*0089             pStarFacK(i,j,bi,bj) = 1.
72a058b866 Gael*0090             rStarFacNm1C(i,j,bi,bj) = 1.
                0091             rStarFacNm1W(i,j,bi,bj) = 1.
                0092             rStarFacNm1S(i,j,bi,bj) = 1.
c3689e90a0 Jean*0093             rStarExpC(i,j,bi,bj) = 1.
                0094             rStarExpW(i,j,bi,bj) = 1.
                0095             rStarExpS(i,j,bi,bj) = 1.
                0096             rStarDhCDt(i,j,bi,bj) = 0.
                0097             rStarDhWDt(i,j,bi,bj) = 0.
                0098             rStarDhSDt(i,j,bi,bj) = 0.
                0099           ENDDO
                0100          ENDDO
9313308f9b Jean*0101 
                0102 C-- Initialise arrays (NLFS using hybrid sigma-coordinate):
e1fb02e8f0 Jean*0103          DO j=1-OLy,sNy+OLy
                0104           DO i=1-OLx,sNx+OLx
9313308f9b Jean*0105             etaHw  (i,j,bi,bj) = 0.
                0106             etaHs  (i,j,bi,bj) = 0.
                0107             dEtaWdt(i,j,bi,bj) = 0.
                0108             dEtaSdt(i,j,bi,bj) = 0.
                0109           ENDDO
                0110          ENDDO
                0111 
cab62edf37 Ou W*0112 # ifdef ALLOW_AUTODIFF
065ea7c980 Jean*0113 C--  to make TAF happy: reset hFac to h0Fac (copied from hFac in ini_linear_phisurf)
c3689e90a0 Jean*0114          DO k=1,Nr
e1fb02e8f0 Jean*0115           DO j=1-OLy,sNy+OLy
                0116            DO i=1-OLx,sNx+OLx
eddedeb180 Patr*0117             hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
                0118             hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
                0119             hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
c3689e90a0 Jean*0120            ENDDO
                0121           ENDDO
                0122          ENDDO
cab62edf37 Ou W*0123          DO k=1,Nr
                0124           DO j=1-OLy,sNy+OLy
                0125            DO i=1-OLx,sNx+OLx
                0126 #  ifdef USE_MASK_AND_NO_IF
                0127             recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) /
                0128      &        ( _hFacC(i,j,k,bi,bj) + (oneRS - maskC(i,j,k,bi,bj)) )
                0129             recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) /
                0130      &        ( _hFacW(i,j,k,bi,bj) + (oneRS - maskW(i,j,k,bi,bj)) )
                0131             recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) /
                0132      &        ( _hFacS(i,j,k,bi,bj) + (oneRS - maskS(i,j,k,bi,bj)) )
                0133 #  else
                0134             IF ( maskC(i,j,k,bi,bj).NE.zeroRS )
                0135      &        recip_hFacC(i,j,k,bi,bj) = oneRS / _hFacC(i,j,k,bi,bj)
                0136             IF ( maskW(i,j,k,bi,bj).NE.zeroRS )
                0137      &        recip_hFacW(i,j,k,bi,bj) = oneRS / _hFacW(i,j,k,bi,bj)
                0138             IF ( maskS(i,j,k,bi,bj).NE.zeroRS )
                0139      &        recip_hFacS(i,j,k,bi,bj) = oneRS / _hFacS(i,j,k,bi,bj)
                0140 #  endif
                0141            ENDDO
                0142           ENDDO
                0143          ENDDO
                0144 # endif /* ALLOW_AUTODIFF */
9313308f9b Jean*0145 #endif /* NONLIN_FRSURF */
c3689e90a0 Jean*0146 
                0147 C-    end 1rst bi,bj loop.
                0148        ENDDO
                0149       ENDDO
                0150 
                0151 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9313308f9b Jean*0152 #ifdef NONLIN_FRSURF
                0153 
                0154       hFacInfMOM = hFacInf
c3689e90a0 Jean*0155 
                0156       DO bj=myByLo(myThid), myByHi(myThid)
                0157        DO bi=myBxLo(myThid), myBxHi(myThid)
                0158 
cdc9f269ae Patr*0159 C-- Compute the mimimum value of r_surf (used for computing hFac_surfC)
                0160          DO j=1,sNy
                0161           DO i=1,sNx
a2a20dcddc Jean*0162            ks = kSurfC(i,j,bi,bj)
cdc9f269ae Patr*0163            IF (ks.LE.Nr) THEN
                0164              Rmin_tmp = rF(ks+1)
a2a20dcddc Jean*0165              IF ( ks.EQ.kSurfW(i,j,bi,bj))
cdc9f269ae Patr*0166      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i-1,j,bi,bj))
a2a20dcddc Jean*0167              IF ( ks.EQ.kSurfW(i+1,j,bi,bj))
cdc9f269ae Patr*0168      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i+1,j,bi,bj))
a2a20dcddc Jean*0169              IF ( ks.EQ.kSurfS(i,j,bi,bj))
cdc9f269ae Patr*0170      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i,j-1,bi,bj))
a2a20dcddc Jean*0171              IF ( ks.EQ.kSurfS(i,j+1,bi,bj))
cdc9f269ae Patr*0172      &          Rmin_tmp = MAX(Rmin_tmp, R_low(i,j+1,bi,bj))
                0173 
                0174              Rmin_surf(i,j,bi,bj) =
dff69a4ed4 Jean*0175      &        MAX( MAX(rF(ks+1),R_low(i,j,bi,bj)) + hFacInf*drF(ks),
cdc9f269ae Patr*0176      &                                Rmin_tmp + hFacInfMOM*drF(ks)
                0177      &           )
                0178            ENDIF
                0179           ENDDO
                0180          ENDDO
                0181 
                0182 C-    end bi,bj loop.
                0183        ENDDO
c3689e90a0 Jean*0184       ENDDO
cdc9f269ae Patr*0185 
c3689e90a0 Jean*0186       CALL EXCH_XY_RL( Rmin_surf, myThid )
cdc9f269ae Patr*0187 
9313308f9b Jean*0188 #endif /* NONLIN_FRSURF */
cdc9f269ae Patr*0189 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c3689e90a0 Jean*0190 
                0191 #ifdef ALLOW_DEBUG
                0192       IF (debugMode) CALL DEBUG_LEAVE('INI_NLFS_VARS',myThid)
                0193 #endif
                0194 
cdc9f269ae Patr*0195       RETURN
                0196       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!