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(
31fb0e0e6d Jean*0008      I        bi, bj, k, deepFacA,
                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: ===================================================
31fb0e0e6d Jean*0027 C  bi, bj               :: tile indices
71207ba845 Alis*0028 C  k                    :: vertical level
31fb0e0e6d Jean*0029 C  deepFacA             :: deep-model grid factor at level center
bd2e80b12f Jean*0030 C  uFld                 :: zonal    velocity
                0031 C  wFld                 :: vertical velocity
                0032 C  rTrans               :: vertical transport (above U point)
31fb0e0e6d Jean*0033 C  myThid               :: my Thread Id number
                0034       INTEGER bi, bj, k
                0035       _RL deepFacA(Nr)
aea29c8517 Alis*0036       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0037       _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
bd2e80b12f Jean*0038       _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0039       INTEGER myThid
                0040
71207ba845 Alis*0041 C !OUTPUT PARAMETERS: ==================================================
                0042 C  advectiveFluxWU      :: advective flux
                0043       _RL advectiveFluxWU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0044
                0045 C !LOCAL VARIABLES: ====================================================
31fb0e0e6d Jean*0046 C  i, j                 :: loop indices
                0047       INTEGER i, j
71207ba845 Alis*0048 CEOP
aea29c8517 Alis*0049
e0c3eb6fa1 Jean*0050       IF ( k.EQ.Nr+1 .AND.
9669509dca Jean*0051      &     useRealFreshWaterFlux .AND. usingPCoords ) THEN
31fb0e0e6d Jean*0052        DO j=1-OLy+1,sNy+OLy
                0053         DO i=1-OLx+1,sNx+OLx
eaba2fd266 Jean*0054          advectiveFluxWU(i,j) = rTrans(i,j)*uFld(i,j,k-1,bi,bj)
31fb0e0e6d Jean*0055      &                                     *deepFacA(k-1)
e0c3eb6fa1 Jean*0056         ENDDO
                0057        ENDDO
                0058
                0059       ELSEIF ( k.GT.Nr .OR. (k.EQ.1.AND.rigidLid) ) THEN
aea29c8517 Alis*0060 C     Advective flux = 0  at k=Nr+1 ; = 0 at k=1 if rigid-lid
                0061
31fb0e0e6d Jean*0062        DO j=1-OLy,sNy+OLy
                0063         DO i=1-OLx,sNx+OLx
                0064          advectiveFluxWU(i,j) = 0.
                0065         ENDDO
aea29c8517 Alis*0066        ENDDO
                0067
                0068       ELSEIF (k.EQ.1) THEN
                0069 C     (linear) Free-surface correction at k=1
                0070
31fb0e0e6d Jean*0071        DO j=1-OLy+1,sNy+OLy
                0072         DO i=1-OLx+1,sNx+OLx
                0073          advectiveFluxWU(i,j) = rTrans(i,j)*uFld(i,j,k,bi,bj)
                0074      &                                     *deepFacA(k)
                0075         ENDDO
aea29c8517 Alis*0076        ENDDO
                0077
                0078       ELSE
                0079
eaba2fd266 Jean*0080 C     Vertical advection - interior ; assume uFld & wFld are masked
31fb0e0e6d Jean*0081        DO j=1-OLy+1,sNy+OLy
                0082         DO i=1-OLx+1,sNx+OLx
                0083          advectiveFluxWU(i,j) = rTrans(i,j)*halfRL
229b6d70e7 Jean*0084 #ifdef MOM_BOUNDARY_CONSERVE
31fb0e0e6d Jean*0085      &    *( uFld(i,j, k ,bi,bj)*deepFacA( k )*_maskW(i,j,k-1,bi,bj)
                0086      &     + uFld(i,j,k-1,bi,bj)*deepFacA(k-1)*_maskW(i,j, k ,bi,bj) )
229b6d70e7 Jean*0087 #else
31fb0e0e6d Jean*0088      &    *( uFld(i,j, k ,bi,bj)*deepFacA( k )
                0089      &     + uFld(i,j,k-1,bi,bj)*deepFacA(k-1) )
229b6d70e7 Jean*0090 #endif
31fb0e0e6d Jean*0091         ENDDO
aea29c8517 Alis*0092        ENDDO
                0093
31fb0e0e6d Jean*0094        IF ( select_rStar.EQ.0 .AND. .NOT.rigidLid ) THEN
                0095 c    &                        .AND. usingPCoords ) THEN
aea29c8517 Alis*0096 C     (linear) Free-surface correction at k>1
31fb0e0e6d Jean*0097         DO j=1-OLy+1,sNy+OLy
                0098          DO i=1-OLx+1,sNx+OLx
aea29c8517 Alis*0099           advectiveFluxWU(i,j) = advectiveFluxWU(i,j)
31fb0e0e6d Jean*0100      &     +0.25 _d 0*(
                0101      &          wFld( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
                0102      &           *(maskC( i ,j,k,bi,bj)-maskC( i ,j,k-1,bi,bj))
                0103      &         +wFld(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
                0104      &           *(maskC(i-1,j,k,bi,bj)-maskC(i-1,j,k-1,bi,bj))
                0105      &                )*deepFac2F(k)*rhoFacF(k)
                0106      &                 *uFld(i,j,k,bi,bj)*deepFacA(k)
aea29c8517 Alis*0107          ENDDO
                0108         ENDDO
31fb0e0e6d Jean*0109 C- endif select_rStar=0 and NOT rigidLid
                0110        ENDIF
aea29c8517 Alis*0111
31fb0e0e6d Jean*0112 C- endif special k cases
aea29c8517 Alis*0113       ENDIF
                0114
                0115       RETURN
                0116       END