pkg/mom_vecinv/mom_vi_v_vertshear.F

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