pkg/mom_fluxform/mom_u_adv_wu.F

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