pkg/mom_common/mom_w_coriolis_nh.F

6780674bfd Jean*0001 #include "MOM_COMMON_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: MOM_W_CORIOLIS_NH
                0005
                0006 C !INTERFACE: ==========================================================
8ecb2a8ef1 Jean*0007       SUBROUTINE MOM_W_CORIOLIS_NH(
31fb0e0e6d Jean*0008      I               bi, bj, k,
                0009      I               uFld, vFld, recip_rThickC,
6780674bfd Jean*0010      U               wCoriolisTerm,
8ecb2a8ef1 Jean*0011      I               myThid )
6780674bfd Jean*0012
                0013 C !DESCRIPTION:
                0014 C Calculates the Coriolis term in the vertical momentum equation:
                0015 C \begin{equation*}
3daafce20b Jean*0016 C + f_prime \overline{u}^{ik}
6780674bfd Jean*0017 C \end{equation*}
                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
6780674bfd Jean*0028 C  k                    :: vertical level
                0029 C  uFld                 :: horizontal flow, u component
                0030 C  vFld                 :: horizontal flow, v component
31fb0e0e6d Jean*0031 C  recip_rThickC        :: reciprocal of W-cell thickness
6780674bfd Jean*0032 C  myThid               :: my Thread Id number
31fb0e0e6d Jean*0033       INTEGER bi, bj, k
6780674bfd Jean*0034       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0035       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
31fb0e0e6d Jean*0036       _RL recip_rThickC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
6780674bfd Jean*0037       INTEGER myThid
                0038
                0039 C !OUTPUT PARAMETERS: ==================================================
                0040 C  uCoriolisTerm        :: Coriolis term
                0041       _RL wCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0042
                0043 #ifdef ALLOW_NONHYDROSTATIC
                0044 C !LOCAL VARIABLES: ====================================================
31fb0e0e6d Jean*0045 C  i, j                 :: loop indices
6780674bfd Jean*0046       INTEGER i,j
                0047 CEOP
                0048
                0049       IF ( k.GT.1 .AND. k.LE.Nr ) THEN
31fb0e0e6d Jean*0050
                0051        IF ( select3dCoriScheme.EQ.1 ) THEN
                0052 C-    Original discretization of 2*Omega*cos(phi)*u_eastward
                0053 C     documented as Energy conserving
                0054         DO j=1-OLy,sNy+OLy-1
                0055          DO i=1-OLx,sNx+OLx-1
8ecb2a8ef1 Jean*0056            wCoriolisTerm(i,j) =
6780674bfd Jean*0057      &      -gravitySign*fCoriCos(i,j,bi,bj)*
                0058      &       ( angleCosC(i,j,bi,bj)*(
                0059      &                (uFld(i,j,k-1,bi,bj)+uFld(i+1,j,k-1,bi,bj))
                0060      &              + (uFld(i,j, k ,bi,bj)+uFld(i+1,j, k ,bi,bj))
                0061      &                              )*0.25 _d 0
                0062      &        -angleSinC(i,j,bi,bj)*(
                0063      &                (vFld(i,j,k-1,bi,bj)+vFld(i,j+1,k-1,bi,bj))
                0064      &              + (vFld(i,j, k ,bi,bj)+vFld(i,j+1, k ,bi,bj))
                0065      &                              )*0.25 _d 0
8ecb2a8ef1 Jean*0066      &       )*wUnit2rVel(k)
6780674bfd Jean*0067          ENDDO
                0068         ENDDO
31fb0e0e6d Jean*0069        ELSEIF ( select3dCoriScheme.EQ.2 ) THEN
                0070 C-    Using thickness-averaged transport (but without hFac):
                0071         DO j=1-OLy,sNy+OLy-1
                0072          DO i=1-OLx,sNx+OLx-1
                0073            wCoriolisTerm(i,j) = -gravitySign
                0074      &      *fCoriCos(i,j,bi,bj)
                0075      &      *( angleCosC(i,j,bi,bj)
                0076      &         *( ( uFld(i,j,k-1,bi,bj) + uFld(i+1,j,k-1,bi,bj) )
                0077      &            *drF(k-1)
                0078      &          + ( uFld(i,j, k ,bi,bj) + uFld(i+1,j, k ,bi,bj) )
                0079      &            *drF( k )
                0080      &          )*0.25 _d 0
                0081      &        -angleSinC(i,j,bi,bj)
                0082      &         *( ( vFld(i,j,k-1,bi,bj) + vFld(i,j+1,k-1,bi,bj) )
                0083      &            *drF(k-1)
                0084      &          + ( vFld(i,j, k ,bi,bj) + vFld(i,j+1, k ,bi,bj) )
                0085      &            *drF( k )
                0086      &          )*0.25 _d 0
                0087      &       )*recip_drC(k)*wUnit2rVel(k)
                0088          ENDDO
                0089         ENDDO
                0090        ELSE
                0091 C-    Using thickness-averaged transport:
                0092 C     for now, without dyG*deepFacC weight and without recip_hFacI factor:
                0093         DO j=1-OLy,sNy+OLy-1
                0094          DO i=1-OLx,sNx+OLx-1
                0095            wCoriolisTerm(i,j) = -gravitySign
                0096      &      *fCoriCos(i,j,bi,bj)
                0097      &      *( angleCosC(i,j,bi,bj)
                0098      &        *( ( uFld( i ,j,k-1,bi,bj)*hFacW( i ,j,k-1,bi,bj)
                0099      &           + uFld(i+1,j,k-1,bi,bj)*hFacW(i+1,j,k-1,bi,bj)
                0100      &           )*drF(k-1)
                0101 c    &            *deepFacC(k-1)
                0102      &         + ( uFld( i ,j, k ,bi,bj)*hFacW( i ,j, k ,bi,bj)
                0103      &           + uFld(i+1,j, k ,bi,bj)*hFacW(i+1,j, k ,bi,bj)
                0104      &           )*drF( k )
                0105 c    &            *deepFacC( k )
                0106      &         )*0.25 _d 0
                0107      &        -angleSinC(i,j,bi,bj)
                0108      &        *( ( vFld(i, j ,k-1,bi,bj)*hFacS(i, j ,k-1,bi,bj)
                0109      &           + vFld(i,j+1,k-1,bi,bj)*hFacS(i,j+1,k-1,bi,bj)
                0110      &           )*drF(k-1)
                0111 c    &            *deepFacC(k-1)
                0112      &         + ( vFld(i, j , k ,bi,bj)*hFacS(i, j , k ,bi,bj)
                0113      &           + vFld(i,j+1, k ,bi,bj)*hFacS(i,j+1, k ,bi,bj)
                0114      &           )*drF( k )
                0115 c    &            *deepFacC( k )
                0116      &         )*0.25 _d 0
                0117      &       )*recip_rThickC(i,j)*wUnit2rVel(k)
                0118 c    &       )*recip_rThickC(i,j)*recip_deepFacF(k)*wUnit2rVel(k)
                0119          ENDDO
                0120         ENDDO
                0121        ENDIF
                0122
6780674bfd Jean*0123       ELSE
31fb0e0e6d Jean*0124         DO j=1-OLy,sNy+OLy-1
                0125          DO i=1-OLx,sNx+OLx-1
6780674bfd Jean*0126            wCoriolisTerm(i,j) = 0. _d 0
                0127          ENDDO
                0128         ENDDO
                0129       ENDIF
                0130
                0131 #endif /* ALLOW_NONHYDROSTATIC */
                0132
                0133       RETURN
                0134       END