Back to home page

MITgcm
 
 

    

File indexing completed on 2025-05-05 05:08:23 UTC

view on githubraw file Latest commit 31fb0e0e on 2025-05-05 02:15:14 UTC
1c99f96b44 Jean*0001 #include "MOM_COMMON_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: MOM_INIT_FIXED
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE MOM_INIT_FIXED( myThid )
                0009 
                0010 C     !DESCRIPTION:
b6f977b498 Jean*0011 C     Initialize fixed quantities
1c99f96b44 Jean*0012 C      for momentum (common to fluxform & vecinv) packages
                0013 
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
b6f977b498 Jean*0019 #include "GRID.h"
                0020 #include "SURFACE.h"
0c0d21fb5c Davi*0021 #include "MOM_VISC.h"
1c99f96b44 Jean*0022 
                0023 C     !INPUT PARAMETERS:
42b88cde36 Jean*0024 C     myThid               :: my thread Id number
1c99f96b44 Jean*0025       INTEGER myThid
                0026 CEOP
                0027 
b6f977b498 Jean*0028 C     !LOCAL VARIABLES:
9543c83638 Jean*0029 C     i,j,k,bi,bj  :: loop counter
845dcd8102 Jean*0030       INTEGER i,j,k,bi,bj
                0031       _RL recip_dt
af960ebfb4 Jean*0032       _RL twoThird
ab47de63dc Mart*0033 #ifdef ALLOW_BOTTOMDRAG_ROUGHNESS
                0034 C     msgBuf :: Informational/error message buffer
                0035       INTEGER kLow
                0036       _RL hLoc
                0037       _RL recip_zRoughBot
                0038       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0039 #endif
845dcd8102 Jean*0040 
af960ebfb4 Jean*0041       twoThird = 2. _d 0 / 3. _d 0
845dcd8102 Jean*0042       recip_dt = 1. _d 0
ab47de63dc Mart*0043       IF ( deltaTMom.NE.0. ) recip_dt = 1. _d 0/deltaTMom
b6f977b498 Jean*0044 
31fb0e0e6d Jean*0045       _BEGIN_MASTER(myThid)
                0046       DO k=1,Nr
                0047         deepFacAdv(k) = 1. _d 0
                0048       ENDDO
                0049 #ifndef MOM_USE_OLD_DEEP_VERT_ADV
                0050       IF ( useNHMTerms ) THEN
                0051        DO k=1,Nr
                0052         deepFacAdv(k) = deepFacC(k)
                0053        ENDDO
                0054       ENDIF
                0055 #endif
                0056       _END_MASTER(myThid)
                0057 
18ef5132e1 Gael*0058       DO bj=myByLo(myThid), myByHi(myThid)
                0059        DO bi=myBxLo(myThid), myBxHi(myThid)
845dcd8102 Jean*0060 
18ef5132e1 Gael*0061 #ifdef ALLOW_3D_VISCAH
845dcd8102 Jean*0062          DO k=1,Nr
                0063           DO j=1-OLy,sNy+OLy
                0064            DO i=1-OLx,sNx+OLx
                0065             viscAhDfld(i,j,k,bi,bj) = 0. _d 0
                0066             viscAhZfld(i,j,k,bi,bj) = 0. _d 0
                0067            ENDDO
                0068           ENDDO
                0069          ENDDO
18ef5132e1 Gael*0070 #endif
42b88cde36 Jean*0071 #ifdef ALLOW_3D_VISCA4
845dcd8102 Jean*0072          DO k=1,Nr
                0073           DO j=1-OLy,sNy+OLy
                0074            DO i=1-OLx,sNx+OLx
                0075             viscA4Dfld(i,j,k,bi,bj) = 0. _d 0
                0076             viscA4Zfld(i,j,k,bi,bj) = 0. _d 0
                0077            ENDDO
                0078           ENDDO
                0079          ENDDO
42b88cde36 Jean*0080 #endif
845dcd8102 Jean*0081 #ifdef ALLOW_NONHYDROSTATIC
                0082 C--   Set the horizontal viscosities to default value.
                0083          DO k=1,Nr
                0084           DO j=1-OLy,sNy+OLy
                0085            DO i=1-OLx,sNx+OLx
                0086             viscAh_W(i,j,k,bi,bj) = viscAhW
                0087             viscA4_W(i,j,k,bi,bj) = viscA4W
                0088            ENDDO
18ef5132e1 Gael*0089           ENDDO
                0090          ENDDO
845dcd8102 Jean*0091 #endif /* ALLOW_NONHYDROSTATIC */
0c0d21fb5c Davi*0092 
845dcd8102 Jean*0093 C--   Calculate length-scale factor (used in S/R MOM_CALC_VISC)
                0094          DO j=1-OLy,sNy+OLy
                0095           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0096             L2_D(i,j,bi,bj) = rA(i,j,bi,bj)
                0097           ENDDO
                0098          ENDDO
                0099          IF ( .NOT.useAreaViscLength ) THEN
845dcd8102 Jean*0100           DO j=1-OLy,sNy+OLy
                0101            DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0102             IF ( recip_dxF(i,j,bi,bj).NE.0. .OR.
                0103      &           recip_dyF(i,j,bi,bj).NE.0. ) THEN
                0104               L2_D(i,j,bi,bj) = 2. _d 0
                0105      &           /((recip_dxF(i,j,bi,bj)**2+recip_dyF(i,j,bi,bj)**2))
                0106             ENDIF
                0107            ENDDO
                0108           ENDDO
                0109          ENDIF
845dcd8102 Jean*0110          DO j=1-OLy,sNy+OLy
                0111           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0112             L3_D(i,j,bi,bj) = L2_D(i,j,bi,bj)**1.5
                0113             L4rdt_D(i,j,bi,bj) = 0.03125 _d 0*recip_dt
                0114      &                       *L2_D(i,j,bi,bj)**2
0c0d21fb5c Davi*0115           ENDDO
                0116          ENDDO
                0117 
845dcd8102 Jean*0118          DO j=1-OLy,sNy+OLy
                0119           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0120             L2_Z(i,j,bi,bj) = rAz(i,j,bi,bj)
                0121           ENDDO
                0122          ENDDO
                0123          IF ( .NOT.useAreaViscLength ) THEN
845dcd8102 Jean*0124           DO j=1-OLy,sNy+OLy
                0125            DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0126             IF ( recip_dxV(i,j,bi,bj).NE.0. .OR.
                0127      &           recip_dyU(i,j,bi,bj).NE.0. ) THEN
                0128               L2_Z(i,j,bi,bj) = 2. _d 0
                0129      &           /((recip_dxV(i,j,bi,bj)**2+recip_dyU(i,j,bi,bj)**2))
                0130             ENDIF
                0131            ENDDO
                0132           ENDDO
                0133          ENDIF
845dcd8102 Jean*0134          DO j=1-OLy,sNy+OLy
                0135           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0136             L3_Z(i,j,bi,bj) = L2_Z(i,j,bi,bj)**1.5
                0137             L4rdt_Z(i,j,bi,bj) = 0.03125 _d 0*recip_dt
                0138      &                       *L2_Z(i,j,bi,bj)**2
0c0d21fb5c Davi*0139           ENDDO
                0140          ENDDO
845dcd8102 Jean*0141 
af960ebfb4 Jean*0142 #ifdef ALLOW_SMAG_3D
                0143          DO j=1-OLy,sNy+OLy
                0144           DO i=1-OLx,sNx+OLx
                0145            smag3D_hLsC(i,j,bi,bj) = rA (i,j,bi,bj)**twoThird
                0146            smag3D_hLsW(i,j,bi,bj) = rAw(i,j,bi,bj)**twoThird
                0147            smag3D_hLsS(i,j,bi,bj) = rAs(i,j,bi,bj)**twoThird
                0148            smag3D_hLsZ(i,j,bi,bj) = rAz(i,j,bi,bj)**twoThird
                0149           ENDDO
                0150          ENDDO
                0151 #endif /* ALLOW_SMAG_3D */
                0152 
845dcd8102 Jean*0153 C-     end bi,bj loops
0c0d21fb5c Davi*0154        ENDDO
845dcd8102 Jean*0155       ENDDO
b6f977b498 Jean*0156 
d062b1342f Gael*0157 #ifdef ALLOW_3D_VISCAH
845dcd8102 Jean*0158       IF ( viscAhDfile .NE. ' ' ) THEN
                0159          CALL READ_FLD_XYZ_RL(viscAhDfile,' ',viscAhDfld,0,myThid)
                0160          CALL EXCH_3D_RL( viscAhDfld, Nr, myThid )
                0161       ENDIF
                0162       IF ( viscAhZfile .NE. ' ' ) THEN
                0163          CALL READ_FLD_XYZ_RL(viscAhZfile,' ',viscAhZfld,0,myThid)
                0164          CALL EXCH_Z_3D_RL( viscAhZfld, Nr, myThid )
                0165       ENDIF
42b88cde36 Jean*0166 #endif /* ALLOW_3D_VISCAH */
d062b1342f Gael*0167 #ifdef ALLOW_3D_VISCA4
845dcd8102 Jean*0168       IF ( viscA4Dfile .NE. ' ' ) THEN
                0169          CALL READ_FLD_XYZ_RL(viscA4Dfile,' ',viscA4Dfld,0,myThid)
                0170          CALL EXCH_3D_RL( viscA4Dfld, Nr, myThid )
                0171       ENDIF
                0172       IF ( viscA4Zfile .NE. ' ' ) THEN
                0173          CALL READ_FLD_XYZ_RL(viscA4Zfile,' ',viscA4Zfld,0,myThid)
                0174          CALL EXCH_Z_3D_RL( viscA4Zfld, Nr, myThid )
                0175       ENDIF
42b88cde36 Jean*0176 #endif /* ALLOW_3D_VISCA4 */
d062b1342f Gael*0177 
ab47de63dc Mart*0178 #ifdef ALLOW_BOTTOMDRAG_ROUGHNESS
                0179 C--   Compute bottom drag coefficents as a function of grid cell thickness
                0180 C     and roughness length, assuming von Karman constant = 0.4
                0181       DO bj=myByLo(myThid), myByHi(myThid)
                0182        DO bi=myBxLo(myThid), myBxHi(myThid)
                0183         DO j=1-OLy,sNy+OLy
                0184          DO i=1-OLx,sNx+OLx
                0185           bottomDragCoeffW(i,j,bi,bj) = bottomDragQuadratic
                0186           bottomDragCoeffS(i,j,bi,bj) = bottomDragQuadratic
                0187          ENDDO
                0188         ENDDO
                0189         IF ( zRoughBot .GT. 0. _d 0 .AND. usingZCoords ) THEN
                0190          recip_zRoughBot = 1. _d 0 / zRoughBot
                0191          DO j=1-OLy,sNy+OLy
                0192           DO i=1-OLx+1,sNx+OLx
                0193            kLow = MIN( kLowC(i-1,j,bi,bj), kLowC(i,j,bi,bj)  )
                0194            IF ( kLow .GE. 1 ) THEN
                0195             hLoc = ( oneRL +
                0196      &           0.5*drF(kLow)*hFacW(i,j,kLow,bi,bj)*recip_zRoughBot )
                0197             hLoc = 0.4 _d 0/LOG(hLoc)
                0198             bottomDragCoeffW(i,j,bi,bj) = hLoc*hLoc
                0199            ELSE
                0200             bottomDragCoeffW(i,j,bi,bj) = 0. _d 0
                0201            ENDIF
                0202           ENDDO
                0203          ENDDO
                0204          DO j=1-OLy+1,sNy+OLy
                0205           DO i=1-OLx,sNx+OLx
                0206            kLow = MIN( kLowC(i,j-1,bi,bj), kLowC(i,j,bi,bj)  )
                0207            IF ( kLow .GE. 1 ) THEN
                0208             hLoc = ( oneRL +
                0209      &           0.5*drF(kLow)*hFacS(i,j,kLow,bi,bj)*recip_zRoughBot )
                0210             hLoc = 0.4 _d 0/LOG(hLoc)
                0211             bottomDragCoeffS(i,j,bi,bj) = hLoc*hLoc
                0212            ELSE
                0213             bottomDragCoeffS(i,j,bi,bj) = 0. _d 0
                0214            ENDIF
                0215           ENDDO
                0216          ENDDO
                0217         ELSEIF ( zRoughBot .GT. 0. _d 0 ) THEN
                0218 C-    Roughness dependent drag not yet coded for P-Coordinates
                0219          WRITE(msgBuf,'(2A)') 'MOM_INIT_FIXED: zRoughBot > 0.',
                0220      &                ' not yet implemented for P-Coordinate'
                0221          CALL PRINT_ERROR( msgBuf, myThid )
                0222          STOP 'ABNORMAL END: S/R MOM_INIT_FIXED'
                0223         ENDIF
                0224        ENDDO
                0225       ENDDO
                0226 #endif /* ALLOW_BOTTOMDRAG_ROUGHNESS */
                0227 
1c99f96b44 Jean*0228 #ifdef ALLOW_DIAGNOSTICS
                0229       IF ( useDiagnostics ) THEN
                0230         CALL MOM_DIAGNOSTICS_INIT( myThid )
                0231       ENDIF
                0232 #endif /* ALLOW_DIAGNOSTICS */
                0233 
                0234       RETURN
                0235       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!