pkg/mom_vecinv/mom_vi_v_vertshear.F

cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
31fb0e0e6d Jean*0003 CBOP
                0004 C     !ROUTINE: MOM_VI_V_VERTSHEAR
                0005
                0006 C     !INTERFACE:
cf9761f7d1 Jean*0007       SUBROUTINE MOM_VI_V_VERTSHEAR(
31fb0e0e6d Jean*0008      I        bi, bj, k, deepFacA,
                0009      I        vFld, wFld,
aea29c8517 Alis*0010      U        vShearTerm,
31fb0e0e6d Jean*0011      I        myThid )
                0012
                0013 C     !DESCRIPTION:
cf9761f7d1 Jean*0014 C     *==========================================================*
                0015 C     | S/R MOM_V_VERTSHEAR
                0016 C     *==========================================================*
aea29c8517 Alis*0017
31fb0e0e6d Jean*0018 C     !USES:
                0019       IMPLICIT NONE
aea29c8517 Alis*0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "GRID.h"
                0024 #include "PARAMS.h"
                0025
31fb0e0e6d Jean*0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C  deepFacA             :: deep-model grid factor at level center
                0028       INTEGER bi, bj, k
                0029       _RL deepFacA(Nr)
aea29c8517 Alis*0030       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0031       _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0032       _RL vShearTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0033       INTEGER myThid
                0034
31fb0e0e6d Jean*0035 C     !LOCAL VARIABLES:
                0036       INTEGER i, j, kp1, km1
                0037       _RL mask_Kp1, mask_Km1, wBarYm, wBarYp
                0038       _RL vZm, vZp, recip_drDeepRho
                0039       LOGICAL rAdvAreaWeight
3bb7e60d5f Jean*0040 c     _RL vmask_Kp1,vmask_K,vmask_Km1
aea29c8517 Alis*0041 c1    _RL wBarYZ,vZbarZ
31fb0e0e6d Jean*0042 CEOP
aea29c8517 Alis*0043
b8082fc644 Jean*0044       rAdvAreaWeight =.TRUE.
                0045 C-    Area-weighted average either in KE or in vert. advection:
                0046       IF ( selectKEscheme.EQ.1 .OR. selectKEscheme.EQ.3 )
                0047      &  rAdvAreaWeight =.FALSE.
                0048
31fb0e0e6d Jean*0049       kp1 = MIN(k+1,Nr)
                0050       mask_Kp1 = oneRL
                0051       IF (k.EQ.Nr) mask_Kp1 = zeroRL
                0052       km1 = MAX(k-1,1)
                0053       mask_Km1 = oneRL
                0054       IF (k.EQ.1) mask_Km1 = zeroRL
                0055
                0056       recip_drDeepRho = recip_drF(k)/deepFacA(k)
                0057      &                * recip_deepFac2C(k)*recip_rhoFacC(k)
aea29c8517 Alis*0058
31fb0e0e6d Jean*0059       DO j=2-OLy,sNy+OLy
                0060        DO i=1-OLx,sNx+OLx
aea29c8517 Alis*0061
627b8cb06f Jean*0062 c       vmask_K=_maskS(i,j,k,bi,bj)
aea29c8517 Alis*0063
                0064 C barZ( barY( W ) )
                0065 c       wBarYm=0.5*(wFld(I,J,K,bi,bj)+wFld(I,J-1,K,bi,bj))
                0066 c       wBarYp=0.5*(wFld(I,J,Kp1,bi,bj)+wFld(I,J-1,Kp1,bi,bj))
                0067 c    &              *mask_Kp1
                0068
cf9761f7d1 Jean*0069        IF ( rAdvAreaWeight ) THEN
31fb0e0e6d Jean*0070 C     Transport at interface k : Area weighted average
                0071         wBarYm = halfRL*(
                0072      &     wFld(i,j,k,bi,bj)*rA(i,j,bi,bj)*maskC(i,j,km1,bi,bj)
                0073      &   + wFld(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)*maskC(i,j-1,km1,bi,bj)
                0074      &                  )*mask_Km1*deepFac2F(k)*rhoFacF(k)
                0075      &                   *recip_rAs(i,j,bi,bj)
                0076
                0077 C     Transport at interface k+1 (here wFld is already masked)
                0078         wBarYp = halfRL*(
                0079      &     wFld(i,j,kp1,bi,bj)*rA(i,j,bi,bj)
                0080      &   + wFld(i,j-1,kp1,bi,bj)*rA(i,j-1,bi,bj)
                0081      &                  )*mask_Kp1*deepFac2F(kp1)*rhoFacF(kp1)
                0082      &                   *recip_rAs(i,j,bi,bj)
cf9761f7d1 Jean*0083        ELSE
31fb0e0e6d Jean*0084 C     Transport at interface k : simple average
                0085         wBarYm = halfRL*(
                0086      &     wFld(i,j,k,bi,bj)*maskC(i,j,km1,bi,bj)
                0087      &   + wFld(i,j-1,k,bi,bj)*maskC(i,j-1,km1,bi,bj)
                0088      &                  )*mask_Km1*deepFac2F(k)*rhoFacF(k)
                0089
                0090 C     Transport at interface k+1 (here wFld is already masked)
                0091         wBarYp = halfRL*(
                0092      &     wFld(i,j,kp1,bi,bj)
                0093      &   + wFld(i,j-1,kp1,bi,bj)
                0094      &                  )*mask_Kp1*deepFac2F(kp1)*rhoFacF(kp1)
cf9761f7d1 Jean*0095        ENDIF
aea29c8517 Alis*0096
31fb0e0e6d Jean*0097 C-    delta_Z( V*deepFac )  @ interface k
23571d7948 Jean*0098 c       vmask_Km1=mask_Km1*maskS(i,j,Km1,bi,bj)
31fb0e0e6d Jean*0099         vZm = ( vFld(i,j, k ,bi,bj)*deepFacA( k )
                0100      &        - vFld(i,j,km1,bi,bj)*deepFacA(km1)*mask_Km1 )*rkSign
aea29c8517 Alis*0101 c2   &      *recip_dRC(K)
23571d7948 Jean*0102 c       IF (freeslip1) vZm=vZm*vmask_Km1
                0103 c       IF (noslip1.AND.vmask_Km1.EQ.0.) vZm=vZm*2.
aea29c8517 Alis*0104
31fb0e0e6d Jean*0105 C-    delta_Z( V*deepFac )  @ interface k+1
23571d7948 Jean*0106 c       vmask_Kp1=mask_Kp1*maskS(i,j,Kp1,bi,bj)
31fb0e0e6d Jean*0107         vZp = ( vFld(i,j,kp1,bi,bj)*deepFacA(kp1)*mask_Kp1
                0108      &        - vFld(i,j, k ,bi,bj)*deepFacA( k ) )*rkSign
aea29c8517 Alis*0109 c2   &      *recip_dRC(Kp1)
23571d7948 Jean*0110 c       IF (freeslipK) vZp=vZp*vmask_Kp1
                0111 c       IF (noslipK.AND.vmask_Kp1.EQ.0.) vZp=vZp*2.
aea29c8517 Alis*0112
                0113 c1      IF (upwindShear) THEN
                0114 c1       wBarYZ=0.5*( wBarXm + wBarXp )
                0115 c1       IF (wBarYZ.GT.0.) THEN
                0116 c1        vZbarZ=vZp
                0117 c1       ELSE
                0118 c1        vZbarZ=vZm
                0119 c1       ENDIF
                0120 c1      ELSE
                0121 c1       vZbarZ=0.5*(vZm+vZp)
                0122 c1      ENDIF
                0123 c1      vShearTerm(I,J)=-wBarYZ*vZbarZ*_maskS(I,J,K,bi,bj)
                0124
                0125 c2      vShearTerm(I,J)=-0.5*(wBarYp*vZp+wBarYm*vZm)
                0126 c2   &                  *_maskS(I,J,K,bi,bj)
3bb7e60d5f Jean*0127         IF (upwindShear) THEN
31fb0e0e6d Jean*0128          vShearTerm(i,j) = -halfRL*
                0129      &                  (    (     wBarYp *vZp +     wBarYm *vZm )
                0130      &                     + ( ABS(wBarYp)*vZp - ABS(wBarYm)*vZm )
                0131      &                  )*_recip_hFacS(i,j,k,bi,bj)*recip_drDeepRho
3bb7e60d5f Jean*0132         ELSE
31fb0e0e6d Jean*0133          vShearTerm(i,j) = -halfRL*( wBarYp*vZp + wBarYm*vZm )
                0134      &                   *_recip_hFacS(i,j,k,bi,bj)*recip_drDeepRho
3bb7e60d5f Jean*0135         ENDIF
aea29c8517 Alis*0136        ENDDO
                0137       ENDDO
                0138
                0139       RETURN
                0140       END