pkg/mom_fluxform/mom_v_adv_wv.F

6d54cf9ca1 Ed H*0001 #include "MOM_FLUXFORM_OPTIONS.h"
bd2e80b12f Jean*0002 #undef OLD_MOM_ADV_W
aea29c8517 Alis*0003
71207ba845 Alis*0004 CBOP
                0005 C !ROUTINE: MOM_V_ADV_WV
                0006
                0007 C !INTERFACE: ==========================================================
aea29c8517 Alis*0008       SUBROUTINE MOM_V_ADV_WV(
                0009      I        bi,bj,k,
bd2e80b12f Jean*0010      I        vFld,wFld,rTrans,
aea29c8517 Alis*0011      O        advectiveFluxWV,
                0012      I        myThid)
                0013
71207ba845 Alis*0014 C !DESCRIPTION:
                0015 C Calculates the vertical advective flux of meridional momentum:
                0016 C \begin{equation*}
                0017 C F^r = \overline{W}^j \overline{v}^{k}
                0018 C \end{equation*}
                0019
                0020 C !USES: ===============================================================
                0021       IMPLICIT NONE
aea29c8517 Alis*0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GRID.h"
                0026
71207ba845 Alis*0027 C !INPUT PARAMETERS: ===================================================
                0028 C  bi,bj                :: tile indices
                0029 C  k                    :: vertical level
bd2e80b12f Jean*0030 C  vFld                 :: meridional velocity
                0031 C  wFld                 :: vertical velocity
                0032 C  rTrans               :: vertical transport (above V point)
71207ba845 Alis*0033 C  myThid               :: thread number
aea29c8517 Alis*0034       INTEGER bi,bj,k
                0035       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0036       _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
bd2e80b12f Jean*0037       _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0038       INTEGER myThid
                0039
71207ba845 Alis*0040 C !OUTPUT PARAMETERS: ==================================================
                0041 C  advectiveFluxWV      :: advective flux
                0042       _RL advectiveFluxWV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0043
                0044 C !LOCAL VARIABLES: ====================================================
                0045 C  i,j                  :: loop indices
229b6d70e7 Jean*0046       INTEGER i,j
71207ba845 Alis*0047 CEOP
aea29c8517 Alis*0048
e0c3eb6fa1 Jean*0049       IF ( k.EQ.Nr+1 .AND.
9669509dca Jean*0050      &     useRealFreshWaterFlux .AND. usingPCoords ) THEN
e0c3eb6fa1 Jean*0051        DO j=1-Oly+1,sNy+Oly
bd2e80b12f Jean*0052         DO i=1-Olx+1,sNx+Olx
                0053          advectiveFluxWV(i,j) = rTrans(i,j)*vFld(i,j,k-1,bi,bj)
e0c3eb6fa1 Jean*0054         ENDDO
                0055        ENDDO
                0056
                0057       ELSEIF ( k.GT.Nr .OR. (k.EQ.1.AND.rigidLid) ) THEN
aea29c8517 Alis*0058 C     Advective flux = 0  at k=Nr+1 ; = 0 at k=1 if rigid-lid
                0059
                0060       DO j=1-Oly,sNy+Oly
                0061        DO i=1-Olx,sNx+Olx
                0062         advectiveFluxWV(i,j) = 0.
                0063        ENDDO
                0064       ENDDO
                0065
                0066       ELSEIF (k.EQ.1) THEN
                0067 C     (linear) Free-surface correction at k=1
                0068
                0069       DO j=1-Oly+1,sNy+Oly
bd2e80b12f Jean*0070        DO i=1-Olx+1,sNx+Olx
                0071         advectiveFluxWV(i,j) = rTrans(i,j)*vFld(i,j,k,bi,bj)
aea29c8517 Alis*0072        ENDDO
                0073       ENDDO
                0074
                0075       ELSE
                0076
eaba2fd266 Jean*0077 C     Vertical advection - interior ; assume vFld & wFld are masked
aea29c8517 Alis*0078       DO j=1-Oly+1,sNy+Oly
bd2e80b12f Jean*0079        DO i=1-Olx+1,sNx+Olx
                0080         advectiveFluxWV(i,j) = rTrans(i,j)*
229b6d70e7 Jean*0081 #ifdef MOM_BOUNDARY_CONSERVE
                0082      &   0.5 _d 0*( vFld(i,j,k,bi,bj)*_maskS(i,j,k-1,bi,bj)
                0083      &             +vFld(i,j,k-1,bi,bj)*_maskS(i,j,k,bi,bj) )
                0084 #else
eaba2fd266 Jean*0085      &   0.5 _d 0*( vFld(i,j,k,bi,bj)+vFld(i,j,k-1,bi,bj) )
229b6d70e7 Jean*0086 #endif
aea29c8517 Alis*0087        ENDDO
                0088       ENDDO
                0089
bd2e80b12f Jean*0090       IF ( select_rStar.EQ.0 .AND. .NOT.rigidLid ) THEN
eaba2fd266 Jean*0091 c    &                       .AND. usingPCoords ) THEN
aea29c8517 Alis*0092 C     (linear) Free-surface correction at k>1
                0093         DO j=1-Oly+1,sNy+Oly
bd2e80b12f Jean*0094          DO i=1-Olx+1,sNx+Olx
aea29c8517 Alis*0095           advectiveFluxWV(i,j) = advectiveFluxWV(i,j)
                0096      &     +0.25*(
                0097      &          wFld(i, j ,k,bi,bj)*rA(i, j ,bi,bj)*
eaba2fd266 Jean*0098      &          (maskC(i, j ,k,bi,bj)-maskC(i, j ,k-1,bi,bj))
aea29c8517 Alis*0099      &         +wFld(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)*
                0100      &          (maskC(i,j-1,k,bi,bj)-maskC(i,j-1,k-1,bi,bj))
eaba2fd266 Jean*0101      &           )*deepFac2F(k)*rhoFacF(k)
                0102      &            *vFld(i,j,k,bi,bj)
aea29c8517 Alis*0103          ENDDO
                0104         ENDDO
                0105 C- endif NOT rigidLid
                0106       ENDIF
                0107
                0108       ENDIF
                0109
                0110       RETURN
                0111       END