pkg/mom_vecinv/mom_vi_v_coriolis.F

cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
355718db32 Jean*0003 CBOP
                0004 C     !ROUTINE: MOM_VI_V_CORIOLIS
                0005 C     !INTERFACE:
5d7e0a8948 Jean*0006       SUBROUTINE MOM_VI_V_CORIOLIS(
355718db32 Jean*0007      I                     bi, bj, k,
3370e71df9 Mart*0008      I                     selectVortScheme, useJamartMomAdv,
355718db32 Jean*0009      I                     uFld, omega3, hFacZ, r_hFacZ,
                0010      O                     vCoriolisTerm,
                0011      I                     myThid )
                0012 C     !DESCRIPTION: \bv
cab1a69b8a Jean*0013 C     *==========================================================*
                0014 C     | S/R MOM_VI_V_CORIOLIS
355718db32 Jean*0015 C     |==========================================================*
                0016 C     | o Calculate flux (in X-dir.) of vorticity at V point
                0017 C     |   using 2nd order interpolation
cab1a69b8a Jean*0018 C     *==========================================================*
355718db32 Jean*0019 C     \ev
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
aea29c8517 Alis*0023
                0024 C     == Global variables ==
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "GRID.h"
                0028
355718db32 Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
aea29c8517 Alis*0030 C     == Routine arguments ==
355718db32 Jean*0031       INTEGER bi, bj, k
                0032       _RL     uFld     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0033       _RL     omega3   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0034       _RS     hFacZ    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0035       _RS     r_hFacZ  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0036       _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
3370e71df9 Mart*0037       INTEGER selectVortScheme
                0038       LOGICAL useJamartMomAdv
aea29c8517 Alis*0039       INTEGER myThid
355718db32 Jean*0040 CEOP
aea29c8517 Alis*0041
                0042 C     == Local variables ==
31fb0e0e6d Jean*0043 C     msgBuf :: Informational/error message buffer
355718db32 Jean*0044       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0045       INTEGER i, j
                0046       _RL     uBarXY, uBarYm, uBarYp
                0047       _RL     vort3v
4e5f84a272 Jean*0048       _RL     vort3im, vort3ij, vort3pm, vort3pj
                0049       _RL     oneThird, tmpFac
355718db32 Jean*0050       _RS     epsil
aea29c8517 Alis*0051
cab1a69b8a Jean*0052       epsil = 1. _d -9
4e5f84a272 Jean*0053       tmpFac = 1. _d 0
                0054 c     oneThird = 1. _d 0 / ( 1. _d 0 + 2.*tmpFac )
                0055       oneThird = 1. _d 0 / 3. _d 0
aea29c8517 Alis*0056
355718db32 Jean*0057       IF ( selectVortScheme.EQ.0 ) THEN
                0058 C--   using enstrophy conserving scheme (Shallow-Water Eq.) by Sadourny, JAS 75
                0059
31fb0e0e6d Jean*0060        DO j=2-OLy,sNy+OLy
                0061         DO i=1-OLx,sNx+OLx-1
                0062          uBarXY = 0.25 _d 0 *(
                0063      &      ( uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
                0064      &      + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
                0065      &     +( uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0066      &      + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
                0067      &                       )
                0068          vort3v = halfRL*( omega3(i,j)*r_hFacZ(i,j)
                0069      &                   + omega3(i+1,j)*r_hFacZ(i+1,j) )
                0070          vCoriolisTerm(i,j) = -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
                0071      &                               * _maskS(i,j,k,bi,bj)
355718db32 Jean*0072         ENDDO
                0073        ENDDO
                0074
                0075       ELSEIF ( selectVortScheme.EQ.1 ) THEN
                0076 C--   same as above, with different formulation (relatively to hFac)
                0077
31fb0e0e6d Jean*0078        DO j=2-OLy,sNy+OLy
                0079         DO i=1-OLx,sNx+OLx-1
                0080          uBarXY = halfRL*(
                0081      &      ( uFld( i , j )*dyG( i , j ,bi,bj)*hFacZ( i ,j)
                0082      &      + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*hFacZ( i ,j) )
                0083      &     +( uFld(i+1, j )*dyG(i+1, j ,bi,bj)*hFacZ(i+1,j)
                0084      &      + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*hFacZ(i+1,j) )
                0085      &                     )/MAX( epsil, hFacZ(i,j)+hFacZ(i+1,j) )
                0086          vort3v = halfRL*( omega3(i,j) + omega3(i+1,j) )
                0087          vCoriolisTerm(i,j) = -vort3v*uBarXY*recip_dyC(i,j,bi,bj)
                0088      &                               * _maskS(i,j,k,bi,bj)
355718db32 Jean*0089         ENDDO
                0090        ENDDO
                0091
                0092       ELSEIF ( selectVortScheme.EQ.2 ) THEN
                0093 C--   using energy conserving scheme (used by Sadourny in JAS 75 paper)
                0094
31fb0e0e6d Jean*0095        DO j=2-OLy,sNy+OLy
                0096         DO i=1-OLx,sNx+OLx-1
                0097          uBarYm = halfRL*(
355718db32 Jean*0098      &       uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
31fb0e0e6d Jean*0099      &     + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
                0100          uBarYp = halfRL*(
355718db32 Jean*0101      &       uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
31fb0e0e6d Jean*0102      &     + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
                0103          vort3v = ( uBarYm*r_hFacZ( i ,j)*omega3( i ,j)
                0104      &            + uBarYp*r_hFacZ(i+1,j)*omega3(i+1,j)
                0105      &            )*halfRL
                0106          vCoriolisTerm(i,j) = -vort3v*recip_dyC(i,j,bi,bj)
                0107      &                               * _maskS(i,j,k,bi,bj)
355718db32 Jean*0108         ENDDO
                0109        ENDDO
                0110
4e5f84a272 Jean*0111       ELSEIF ( selectVortScheme.EQ.3 ) THEN
                0112 C--   using energy & enstrophy conserving scheme
                0113 C     (from Sadourny, described by Burridge & Haseler, ECMWF Rep.4, 1977)
                0114
                0115 C     domain where vCoriolisTerm is valid :
                0116 C     [ 2-Olx : sNx+Olx-1 ] x [ 3-Oly : sNy+Oly-1 ]
                0117 C     (=> might need overlap of 3 if using CD-scheme)
31fb0e0e6d Jean*0118        DO j=2-OLy,sNy+OLy-1
                0119         DO i=1-OLx,sNx+OLx-1
                0120          vort3im = ( r_hFacZ(i, j )*omega3(i, j )
                0121      &             +(r_hFacZ(i+1,j)*omega3(i+1,j)
                0122      &              +r_hFacZ(i,j-1)*omega3(i,j-1)
                0123      &             ))*oneThird
                0124 c    &             )*tmpFac)*oneThird
4e5f84a272 Jean*0125      &      *uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj)
31fb0e0e6d Jean*0126          vort3ij = ( r_hFacZ(i, j )*omega3(i, j )
                0127      &             +(r_hFacZ(i+1,j)*omega3(i+1,j)
                0128      &              +r_hFacZ(i,j+1)*omega3(i,j+1)
                0129      &             ))*oneThird
                0130 c    &             )*tmpFac)*oneThird
4e5f84a272 Jean*0131      &      *uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
31fb0e0e6d Jean*0132          vort3pm = ( r_hFacZ(i+1,j)*omega3(i+1,j)
                0133      &             +(r_hFacZ(i, j )*omega3(i, j )
                0134      &              +r_hFacZ(i+1,j-1)*omega3(i+1,j-1)
                0135      &             ))*oneThird
                0136 c    &             )*tmpFac)*oneThird
4e5f84a272 Jean*0137      &      *uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj)
31fb0e0e6d Jean*0138          vort3pj = ( r_hFacZ(i+1,j)*omega3(i+1,j)
                0139      &             +(r_hFacZ(i, j )*omega3(i, j )
                0140      &              +r_hFacZ(i+1,j+1)*omega3(i+1,j+1)
                0141      &             ))*oneThird
                0142 c    &             )*tmpFac)*oneThird
4e5f84a272 Jean*0143      &      *uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0144 C---
31fb0e0e6d Jean*0145          vCoriolisTerm(i,j) = -( (vort3im+vort3ij)+(vort3pm+vort3pj) )
                0146      &                      *0.25 _d 0 *recip_dyC(i,j,bi,bj)
                0147      &                                 * _maskS(i,j,k,bi,bj)
                0148         ENDDO
                0149        ENDDO
                0150
                0151       ELSEIF ( selectVortScheme.EQ.4 ) THEN
                0152 C--   using energy conserving scheme without r_hFacZ factor
                0153
                0154        DO j=2-OLy,sNy+OLy
                0155         DO i=1-OLx,sNx+OLx-1
                0156          uBarYm = halfRL*(
                0157      &       uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
                0158      &     + uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
                0159          uBarYp = halfRL*(
                0160      &       uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0161      &     + uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
                0162          vort3v = ( uBarYm*omega3( i ,j)
                0163      &            + uBarYp*omega3(i+1,j)
                0164      &            )*halfRL
                0165          vCoriolisTerm(i,j) = -vort3v*recip_dyC(i,j,bi,bj)
                0166      &                               *recip_hFacS(i,j,k,bi,bj)
4e5f84a272 Jean*0167         ENDDO
                0168        ENDDO
                0169
355718db32 Jean*0170       ELSE
                0171         WRITE(msgBuf,'(A,I5,A)')
                0172      &   'MOM_VI_V_CORIOLIS: selectVortScheme=', selectVortScheme,
                0173      &   ' not implemented'
                0174         CALL PRINT_ERROR( msgBuf, myThid )
                0175         STOP 'ABNORMAL END: S/R MOM_VI_V_CORIOLIS'
                0176
                0177       ENDIF
                0178
                0179       IF ( useJamartMomAdv ) THEN
31fb0e0e6d Jean*0180        DO j=2-OLy,sNy+OLy-1
                0181         DO i=1-OLx,sNx+OLx-1
355718db32 Jean*0182          vCoriolisTerm(i,j) = vCoriolisTerm(i,j)
                0183      &           * 4. _d 0 * _hFacS(i,j,k,bi,bj)
                0184      &           / MAX( epsil,
                0185      &                  (_hFacW( i ,j,k,bi,bj)+_hFacW( i ,j-1,k,bi,bj))
                0186      &                 +(_hFacW(i+1,j,k,bi,bj)+_hFacW(i+1,j-1,k,bi,bj))
                0187      &                )
                0188         ENDDO
aea29c8517 Alis*0189        ENDDO
355718db32 Jean*0190       ENDIF
aea29c8517 Alis*0191
                0192       RETURN
                0193       END