pkg/mom_common/mom_v_coriolis_nh.F

1a741329d2 Jean*0001 #include "MOM_COMMON_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: MOM_V_CORIOLIS_NH
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE MOM_V_CORIOLIS_NH(
31fb0e0e6d Jean*0008      I               bi, bj, k, wFld,
1a741329d2 Jean*0009      O               vCoriolisTerm,
                0010      I               myThid )
                0011
                0012 C !DESCRIPTION:
                0013 C Calculates the 3.D Coriolis term in the meridional momentum equation:
                0014 C \begin{equation*}
3daafce20b Jean*0015 C - \overline{ f_prime \overline{w}^{k} }^{i}
1a741329d2 Jean*0016 C \end{equation*}
                0017 C consistent with Non-Hydrostatic (or quasi-hydrostatic) formulation
                0018
                0019 C !USES: ===============================================================
                0020       IMPLICIT NONE
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
                0025
                0026 C !INPUT PARAMETERS: ===================================================
31fb0e0e6d Jean*0027 C  bi, bj               :: tile indices
1a741329d2 Jean*0028 C  k                    :: vertical level
                0029 C  wFld                 :: vertical flow
                0030 C  myThid               :: thread number
31fb0e0e6d Jean*0031       INTEGER bi, bj, k
1a741329d2 Jean*0032       _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0033       INTEGER myThid
                0034
                0035 C !OUTPUT PARAMETERS: ==================================================
                0036 C  vCoriolisTerm        :: Coriolis term
                0037       _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0038
                0039 C !LOCAL VARIABLES: ====================================================
31fb0e0e6d Jean*0040 C  i, j                 :: loop indices
                0041       INTEGER i, j, kp1
1a741329d2 Jean*0042       _RL wMsk
                0043 CEOP
                0044
31fb0e0e6d Jean*0045       kp1 = MIN(k+1,Nr)
                0046       wMsk = 1.
                0047       IF (k.EQ.Nr) wMsk = 0.
1a741329d2 Jean*0048
31fb0e0e6d Jean*0049       IF ( select3dCoriScheme.EQ.1 ) THEN
                0050 C-    Original discretization of 2*Omega*cos(phi)*w
                0051 C     documented as Energy conserving
                0052        DO j=2-OLy,sNy+OLy
                0053         DO i=1-OLx,sNx+OLx
                0054          vCoriolisTerm(i,j) = -gravitySign*halfRL
                0055      &       *( fCoriCos(i, j ,bi,bj)*angleSinC(i, j ,bi,bj)*halfRL
                0056      &           *( wFld(i, j , k ,bi,bj)*rVel2wUnit( k )
                0057      &            + wFld(i, j ,kp1,bi,bj)*rVel2wUnit(kp1)*wMsk )
                0058      &        + fCoriCos(i,j-1,bi,bj)*angleSinC(i,j-1,bi,bj)*halfRL
                0059      &           *( wFld(i,j-1, k ,bi,bj)*rVel2wUnit( k )
                0060      &            + wFld(i,j-1,kp1,bi,bj)*rVel2wUnit(kp1)*wMsk )
                0061      &        )
                0062         ENDDO
                0063        ENDDO
                0064       ELSE
                0065 C-    Using averaged transport:
                0066        DO j=2-OLy,sNy+OLy
                0067         DO i=1-OLx,sNx+OLx
                0068          vCoriolisTerm(i,j) = -gravitySign*halfRL
                0069      &    *( fCoriCos(i, j ,bi,bj)*angleSinC(i, j ,bi,bj)
                0070      &      *( wFld(i, j , k ,bi,bj)*rVel2wUnit( k )*deepFac2F( k )
                0071      &       + wFld(i, j ,kp1,bi,bj)*rVel2wUnit(kp1)*deepFac2F(kp1)*wMsk
                0072      &         )*rA(i, j ,bi,bj)*halfRL
                0073      &     + fCoriCos(i,j-1,bi,bj)*angleSinC(i,j-1,bi,bj)
                0074      &      *( wFld(i,j-1, k ,bi,bj)*rVel2wUnit( k )*deepFac2F( k )
                0075      &       + wFld(i,j-1,kp1,bi,bj)*rVel2wUnit(kp1)*deepFac2F(kp1)*wMsk
                0076      &         )*rA(i,j-1,bi,bj)*halfRL
                0077      &     )*recip_rAs(i,j,bi,bj)*recip_deepFac2C(k)
                0078      &      *recip_hFacS(i,j,k,bi,bj)
                0079         ENDDO
1a741329d2 Jean*0080        ENDDO
31fb0e0e6d Jean*0081       ENDIF
1a741329d2 Jean*0082
                0083       RETURN
                0084       END