Back to home page

MITgcm
 
 

    

File indexing completed on 2023-04-05 05:10:00 UTC

view on githubraw file Latest commit ab47de63 on 2023-04-04 20:10:37 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 
                0041       k = 1
af960ebfb4 Jean*0042       twoThird = 2. _d 0 / 3. _d 0
845dcd8102 Jean*0043       recip_dt = 1. _d 0
ab47de63dc Mart*0044       IF ( deltaTMom.NE.0. ) recip_dt = 1. _d 0/deltaTMom
b6f977b498 Jean*0045 
18ef5132e1 Gael*0046       DO bj=myByLo(myThid), myByHi(myThid)
                0047        DO bi=myBxLo(myThid), myBxHi(myThid)
845dcd8102 Jean*0048 
18ef5132e1 Gael*0049 #ifdef ALLOW_3D_VISCAH
845dcd8102 Jean*0050          DO k=1,Nr
                0051           DO j=1-OLy,sNy+OLy
                0052            DO i=1-OLx,sNx+OLx
                0053             viscAhDfld(i,j,k,bi,bj) = 0. _d 0
                0054             viscAhZfld(i,j,k,bi,bj) = 0. _d 0
                0055            ENDDO
                0056           ENDDO
                0057          ENDDO
18ef5132e1 Gael*0058 #endif
42b88cde36 Jean*0059 #ifdef ALLOW_3D_VISCA4
845dcd8102 Jean*0060          DO k=1,Nr
                0061           DO j=1-OLy,sNy+OLy
                0062            DO i=1-OLx,sNx+OLx
                0063             viscA4Dfld(i,j,k,bi,bj) = 0. _d 0
                0064             viscA4Zfld(i,j,k,bi,bj) = 0. _d 0
                0065            ENDDO
                0066           ENDDO
                0067          ENDDO
42b88cde36 Jean*0068 #endif
845dcd8102 Jean*0069 #ifdef ALLOW_NONHYDROSTATIC
                0070 C--   Set the horizontal viscosities to default value.
                0071          DO k=1,Nr
                0072           DO j=1-OLy,sNy+OLy
                0073            DO i=1-OLx,sNx+OLx
                0074             viscAh_W(i,j,k,bi,bj) = viscAhW
                0075             viscA4_W(i,j,k,bi,bj) = viscA4W
                0076            ENDDO
18ef5132e1 Gael*0077           ENDDO
                0078          ENDDO
845dcd8102 Jean*0079 #endif /* ALLOW_NONHYDROSTATIC */
0c0d21fb5c Davi*0080 
845dcd8102 Jean*0081 C--   Calculate length-scale factor (used in S/R MOM_CALC_VISC)
                0082          DO j=1-OLy,sNy+OLy
                0083           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0084             L2_D(i,j,bi,bj) = rA(i,j,bi,bj)
                0085           ENDDO
                0086          ENDDO
                0087          IF ( .NOT.useAreaViscLength ) THEN
845dcd8102 Jean*0088           DO j=1-OLy,sNy+OLy
                0089            DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0090             IF ( recip_dxF(i,j,bi,bj).NE.0. .OR.
                0091      &           recip_dyF(i,j,bi,bj).NE.0. ) THEN
                0092               L2_D(i,j,bi,bj) = 2. _d 0
                0093      &           /((recip_dxF(i,j,bi,bj)**2+recip_dyF(i,j,bi,bj)**2))
                0094             ENDIF
                0095            ENDDO
                0096           ENDDO
                0097          ENDIF
845dcd8102 Jean*0098          DO j=1-OLy,sNy+OLy
                0099           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0100             L3_D(i,j,bi,bj) = L2_D(i,j,bi,bj)**1.5
                0101             L4rdt_D(i,j,bi,bj) = 0.03125 _d 0*recip_dt
                0102      &                       *L2_D(i,j,bi,bj)**2
0c0d21fb5c Davi*0103           ENDDO
                0104          ENDDO
                0105 
845dcd8102 Jean*0106          DO j=1-OLy,sNy+OLy
                0107           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0108             L2_Z(i,j,bi,bj) = rAz(i,j,bi,bj)
                0109           ENDDO
                0110          ENDDO
                0111          IF ( .NOT.useAreaViscLength ) THEN
845dcd8102 Jean*0112           DO j=1-OLy,sNy+OLy
                0113            DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0114             IF ( recip_dxV(i,j,bi,bj).NE.0. .OR.
                0115      &           recip_dyU(i,j,bi,bj).NE.0. ) THEN
                0116               L2_Z(i,j,bi,bj) = 2. _d 0
                0117      &           /((recip_dxV(i,j,bi,bj)**2+recip_dyU(i,j,bi,bj)**2))
                0118             ENDIF
                0119            ENDDO
                0120           ENDDO
                0121          ENDIF
845dcd8102 Jean*0122          DO j=1-OLy,sNy+OLy
                0123           DO i=1-OLx,sNx+OLx
a57a19e4e4 Jean*0124             L3_Z(i,j,bi,bj) = L2_Z(i,j,bi,bj)**1.5
                0125             L4rdt_Z(i,j,bi,bj) = 0.03125 _d 0*recip_dt
                0126      &                       *L2_Z(i,j,bi,bj)**2
0c0d21fb5c Davi*0127           ENDDO
                0128          ENDDO
845dcd8102 Jean*0129 
af960ebfb4 Jean*0130 #ifdef ALLOW_SMAG_3D
                0131          DO j=1-OLy,sNy+OLy
                0132           DO i=1-OLx,sNx+OLx
                0133            smag3D_hLsC(i,j,bi,bj) = rA (i,j,bi,bj)**twoThird
                0134            smag3D_hLsW(i,j,bi,bj) = rAw(i,j,bi,bj)**twoThird
                0135            smag3D_hLsS(i,j,bi,bj) = rAs(i,j,bi,bj)**twoThird
                0136            smag3D_hLsZ(i,j,bi,bj) = rAz(i,j,bi,bj)**twoThird
                0137           ENDDO
                0138          ENDDO
                0139 #endif /* ALLOW_SMAG_3D */
                0140 
845dcd8102 Jean*0141 C-     end bi,bj loops
0c0d21fb5c Davi*0142        ENDDO
845dcd8102 Jean*0143       ENDDO
b6f977b498 Jean*0144 
d062b1342f Gael*0145 #ifdef ALLOW_3D_VISCAH
845dcd8102 Jean*0146       IF ( viscAhDfile .NE. ' ' ) THEN
                0147          CALL READ_FLD_XYZ_RL(viscAhDfile,' ',viscAhDfld,0,myThid)
                0148          CALL EXCH_3D_RL( viscAhDfld, Nr, myThid )
                0149       ENDIF
                0150       IF ( viscAhZfile .NE. ' ' ) THEN
                0151          CALL READ_FLD_XYZ_RL(viscAhZfile,' ',viscAhZfld,0,myThid)
                0152          CALL EXCH_Z_3D_RL( viscAhZfld, Nr, myThid )
                0153       ENDIF
42b88cde36 Jean*0154 #endif /* ALLOW_3D_VISCAH */
d062b1342f Gael*0155 #ifdef ALLOW_3D_VISCA4
845dcd8102 Jean*0156       IF ( viscA4Dfile .NE. ' ' ) THEN
                0157          CALL READ_FLD_XYZ_RL(viscA4Dfile,' ',viscA4Dfld,0,myThid)
                0158          CALL EXCH_3D_RL( viscA4Dfld, Nr, myThid )
                0159       ENDIF
                0160       IF ( viscA4Zfile .NE. ' ' ) THEN
                0161          CALL READ_FLD_XYZ_RL(viscA4Zfile,' ',viscA4Zfld,0,myThid)
                0162          CALL EXCH_Z_3D_RL( viscA4Zfld, Nr, myThid )
                0163       ENDIF
42b88cde36 Jean*0164 #endif /* ALLOW_3D_VISCA4 */
d062b1342f Gael*0165 
ab47de63dc Mart*0166 #ifdef ALLOW_BOTTOMDRAG_ROUGHNESS
                0167 C--   Compute bottom drag coefficents as a function of grid cell thickness
                0168 C     and roughness length, assuming von Karman constant = 0.4
                0169       DO bj=myByLo(myThid), myByHi(myThid)
                0170        DO bi=myBxLo(myThid), myBxHi(myThid)
                0171         DO j=1-OLy,sNy+OLy
                0172          DO i=1-OLx,sNx+OLx
                0173           bottomDragCoeffW(i,j,bi,bj) = bottomDragQuadratic
                0174           bottomDragCoeffS(i,j,bi,bj) = bottomDragQuadratic
                0175          ENDDO
                0176         ENDDO
                0177         IF ( zRoughBot .GT. 0. _d 0 .AND. usingZCoords ) THEN
                0178          recip_zRoughBot = 1. _d 0 / zRoughBot
                0179          DO j=1-OLy,sNy+OLy
                0180           DO i=1-OLx+1,sNx+OLx
                0181            kLow = MIN( kLowC(i-1,j,bi,bj), kLowC(i,j,bi,bj)  )
                0182            IF ( kLow .GE. 1 ) THEN
                0183             hLoc = ( oneRL +
                0184      &           0.5*drF(kLow)*hFacW(i,j,kLow,bi,bj)*recip_zRoughBot )
                0185             hLoc = 0.4 _d 0/LOG(hLoc)
                0186             bottomDragCoeffW(i,j,bi,bj) = hLoc*hLoc
                0187            ELSE
                0188             bottomDragCoeffW(i,j,bi,bj) = 0. _d 0
                0189            ENDIF
                0190           ENDDO
                0191          ENDDO
                0192          DO j=1-OLy+1,sNy+OLy
                0193           DO i=1-OLx,sNx+OLx
                0194            kLow = MIN( kLowC(i,j-1,bi,bj), kLowC(i,j,bi,bj)  )
                0195            IF ( kLow .GE. 1 ) THEN
                0196             hLoc = ( oneRL +
                0197      &           0.5*drF(kLow)*hFacS(i,j,kLow,bi,bj)*recip_zRoughBot )
                0198             hLoc = 0.4 _d 0/LOG(hLoc)
                0199             bottomDragCoeffS(i,j,bi,bj) = hLoc*hLoc
                0200            ELSE
                0201             bottomDragCoeffS(i,j,bi,bj) = 0. _d 0
                0202            ENDIF
                0203           ENDDO
                0204          ENDDO
                0205         ELSEIF ( zRoughBot .GT. 0. _d 0 ) THEN
                0206 C-    Roughness dependent drag not yet coded for P-Coordinates
                0207          WRITE(msgBuf,'(2A)') 'MOM_INIT_FIXED: zRoughBot > 0.',
                0208      &                ' not yet implemented for P-Coordinate'
                0209          CALL PRINT_ERROR( msgBuf, myThid )
                0210          STOP 'ABNORMAL END: S/R MOM_INIT_FIXED'
                0211         ENDIF
                0212        ENDDO
                0213       ENDDO
                0214 #endif /* ALLOW_BOTTOMDRAG_ROUGHNESS */
                0215 
1c99f96b44 Jean*0216 #ifdef ALLOW_DIAGNOSTICS
                0217       IF ( useDiagnostics ) THEN
                0218         CALL MOM_DIAGNOSTICS_INIT( myThid )
                0219       ENDIF
                0220 #endif /* ALLOW_DIAGNOSTICS */
                0221 
                0222       RETURN
                0223       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!