pkg/mom_vecinv/mom_vi_coriolis.F

cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
7843dde2de jm-c 0003 CBOP
                0004 C !ROUTINE: MOM_VI_CORIOLIS
                0005
                0006 C !INTERFACE: ==========================================================
5d7e0a8948 Jean*0007       SUBROUTINE MOM_VI_CORIOLIS(
7843dde2de jm-c 0008      I        bi, bj, k,
                0009      I        uFld, vFld, hFacZ, r_hFacZ,
                0010      O        uCoriolisTerm, vCoriolisTerm,
                0011      I        myThid )
aea29c8517 Alis*0012
7843dde2de jm-c 0013 C !DESCRIPTION:
                0014 C  Calculates the 2 horizontal components of Coriolis acceleration
                0015
                0016 C !USES: ===============================================================
                0017       IMPLICIT NONE
aea29c8517 Alis*0018 C     == Global variables ==
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "GRID.h"
                0022 #include "PARAMS.h"
                0023
7843dde2de jm-c 0024 C !INPUT PARAMETERS: ===================================================
                0025 C   bi, bj         :: current tile indices
                0026 C   k              :: current vertical level
                0027 C   uFld, vFld     :: local copy of horizontal velocity (u & v components)
                0028 C   hFacZ          :: hFac thickness factor at corner location
                0029 C   r_hFacZ        :: reciprocal hFac thickness factor at corner location
                0030 C   myThid         :: my Thread Id number
                0031       INTEGER bi,bj,k
                0032       _RL uFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0033       _RL vFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0034       _RS hFacZ  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0035       _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
7843dde2de jm-c 0036       INTEGER myThid
                0037
                0038 C !OUTPUT PARAMETERS: ==================================================
                0039 C   uCoriolisTerm  :: Coriolis tendency for u-component momentum
                0040 C   vCoriolisTerm  :: Coriolis tendency for v-component momentum
aea29c8517 Alis*0041       _RL uCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0042       _RL vCoriolisTerm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0043
7843dde2de jm-c 0044 C !LOCAL VARIABLES: ====================================================
                0045 C   i, j           :: loop indices
                0046 C   uBarXY, vBarXY :: averaged (in X & Y direction) of u & v velocity
                0047 C   uBarYm, uBarYp :: u velocity, Y direction averaged (at i and i+1)
                0048 C   vBarXm, vBarXp :: v velocity, X direction averaged (at j and j+1)
                0049 C   epsil          :: small number
                0050       INTEGER i,j
                0051       _RL uBarXY, vBarXY
                0052       _RL uBarYm, uBarYp, vBarXm, vBarXp
cab1a69b8a Jean*0053       _RS epsil
7843dde2de jm-c 0054 CEOP
                0055
cab1a69b8a Jean*0056       epsil = 1. _d -9
aea29c8517 Alis*0057
7843dde2de jm-c 0058       IF ( selectCoriScheme .EQ. 0 ) THEN
                0059 C- Simple average, no hFac :
                0060        DO j=1-OLy,sNy+OLy-1
                0061         DO i=2-OLx,sNx+OLx
                0062          vBarXY=0.25*(
                0063      &      (vFld( i , j )*dxG( i , j ,bi,bj)
                0064      &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj))
                0065      &     +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)
                0066      &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj))
                0067      &               )
                0068          uCoriolisTerm(i,j)=
                0069      &    +0.5*( fCoriG(i,j,bi,bj)+fCoriG(i,j+1,bi,bj)
                0070      &         )*vBarXY*recip_dxC(i,j,bi,bj)*_maskW(i,j,k,bi,bj)
                0071         ENDDO
                0072        ENDDO
                0073       ELSEIF ( selectCoriScheme .EQ. 1 ) THEN
cab1a69b8a Jean*0074 C- Partial-cell generalization of the Wet-point average method :
7843dde2de jm-c 0075 C     (formerly called: useJamartWetPoints)
                0076        DO j=1-OLy,sNy+OLy-1
                0077         DO i=2-OLx,sNx+OLx
cab1a69b8a Jean*0078          vBarXY=(
616600b8d2 Patr*0079      &      (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
                0080      &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj))
                0081      &     +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
                0082      &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj)))
                0083      &   / MAX( epsil,(_hFacS(i, j ,k,bi,bj)+_hFacS(i-1, j ,k,bi,bj))
                0084      &               +(_hFacS(i,j+1,k,bi,bj)+_hFacS(i-1,j+1,k,bi,bj)) )
aea29c8517 Alis*0085          uCoriolisTerm(i,j)=
cab1a69b8a Jean*0086      &    +0.5*( fCoriG(i,j,bi,bj)+fCoriG(i,j+1,bi,bj)
7843dde2de jm-c 0087      &         )*vBarXY*recip_dxC(i,j,bi,bj)*_maskW(i,j,k,bi,bj)
aea29c8517 Alis*0088         ENDDO
                0089        ENDDO
7843dde2de jm-c 0090       ELSEIF ( selectCoriScheme .EQ. 2 ) THEN
                0091 C- hFac weighted average :
                0092        DO j=1-OLy,sNy+OLy-1
                0093         DO i=2-OLx,sNx+OLx
cab1a69b8a Jean*0094          vBarXY=0.25*(
7843dde2de jm-c 0095      &      (vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
                0096      &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj))
                0097      &     +(vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
                0098      &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj))
5d7e0a8948 Jean*0099      &               )
cab1a69b8a Jean*0100          uCoriolisTerm(i,j)=
                0101      &    +0.5*( fCoriG(i,j,bi,bj)+fCoriG(i,j+1,bi,bj)
7843dde2de jm-c 0102      &         )*vBarXY*recip_dxC(i,j,bi,bj)*_recip_hFacW(i,j,k,bi,bj)
                0103         ENDDO
                0104        ENDDO
                0105       ELSEIF ( selectCoriScheme .EQ. 3 ) THEN
                0106 C- Energy-conserving discretisation with hFac weighted average :
                0107        DO j=1-OLy,sNy+OLy-1
                0108         DO i=2-OLx,sNx+OLx
                0109          vBarXm = halfRL *(
                0110      &       vFld( i , j )*dxG( i , j ,bi,bj)*_hFacS( i , j ,k,bi,bj)
                0111      &      +vFld(i-1, j )*dxG(i-1, j ,bi,bj)*_hFacS(i-1, j ,k,bi,bj) )
                0112          vBarXp = halfRL *(
                0113      &       vFld( i ,j+1)*dxG( i ,j+1,bi,bj)*_hFacS( i ,j+1,k,bi,bj)
                0114      &      +vFld(i-1,j+1)*dxG(i-1,j+1,bi,bj)*_hFacS(i-1,j+1,k,bi,bj) )
                0115          uCoriolisTerm(i,j) = +0.5 _d 0
                0116      &        *( vBarXm*fCoriG(i, j ,bi,bj)
                0117      &          +vBarXp*fCoriG(i,j+1,bi,bj)
                0118      &         )*recip_dxC(i,j,bi,bj)*_recip_hFacW(i,j,k,bi,bj)
cab1a69b8a Jean*0119         ENDDO
                0120        ENDDO
7843dde2de jm-c 0121       ELSE
                0122         STOP 'MOM_VI_CORIOLIS: invalid selectCoriScheme'
cab1a69b8a Jean*0123       ENDIF
aea29c8517 Alis*0124
7843dde2de jm-c 0125       IF ( selectCoriScheme .EQ. 0 ) THEN
                0126 C- Simple average, no hFac :
                0127        DO j=2-OLy,sNy+OLy
                0128         DO i=1-OLx,sNx+OLx-1
                0129          uBarXY=0.25*(
                0130      &      (uFld( i , j )*dyG( i , j ,bi,bj)
                0131      &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj))
                0132      &     +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)
                0133      &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj))
                0134      &               )
                0135          vCoriolisTerm(i,j)=
                0136      &    -0.5*( fCoriG(i,j,bi,bj)+fCoriG(i+1,j,bi,bj)
                0137      &         )*uBarXY*recip_dyC(i,j,bi,bj)*_maskS(i,j,k,bi,bj)
                0138         ENDDO
                0139        ENDDO
                0140       ELSEIF ( selectCoriScheme .EQ. 1 ) THEN
cab1a69b8a Jean*0141 C- Partial-cell generalization of the Wet-point average method :
7843dde2de jm-c 0142 C     (formerly called: useJamartWetPoints)
                0143        DO j=2-OLy,sNy+OLy
                0144         DO i=1-OLx,sNx+OLx-1
cab1a69b8a Jean*0145          uBarXY=(
616600b8d2 Patr*0146      &      (uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
                0147      &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj))
                0148      &     +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0149      &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj)))
                0150      &   / MAX( epsil,(_hFacW( i ,j,k,bi,bj)+_hFacW( i ,j-1,k,bi,bj))
                0151      &               +(_hFacW(i+1,j,k,bi,bj)+_hFacW(i+1,j-1,k,bi,bj)) )
aea29c8517 Alis*0152          vCoriolisTerm(i,j)=
cab1a69b8a Jean*0153      &    -0.5*( fCoriG(i,j,bi,bj)+fCoriG(i+1,j,bi,bj)
7843dde2de jm-c 0154      &         )*uBarXY*recip_dyC(i,j,bi,bj)*_maskS(i,j,k,bi,bj)
aea29c8517 Alis*0155         ENDDO
                0156        ENDDO
7843dde2de jm-c 0157       ELSEIF ( selectCoriScheme .EQ. 2 ) THEN
                0158 C- hFac weighted average :
                0159        DO j=2-OLy,sNy+OLy
                0160         DO i=1-OLx,sNx+OLx-1
cab1a69b8a Jean*0161          uBarXY=0.25*(
7843dde2de jm-c 0162      &      (uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
                0163      &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj))
                0164      &     +(uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0165      &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj))
5d7e0a8948 Jean*0166      &               )
cab1a69b8a Jean*0167          vCoriolisTerm(i,j)=
                0168      &    -0.5*( fCoriG(i,j,bi,bj)+fCoriG(i+1,j,bi,bj)
7843dde2de jm-c 0169      &         )*uBarXY*recip_dyC(i,j,bi,bj)*_recip_hFacS(i,j,k,bi,bj)
cab1a69b8a Jean*0170         ENDDO
                0171        ENDDO
7843dde2de jm-c 0172       ELSEIF ( selectCoriScheme .EQ. 3 ) THEN
                0173 C- Energy-conserving discretisation with hFac weighted average :
                0174        DO j=2-OLy,sNy+OLy
                0175         DO i=1-OLx,sNx+OLx-1
                0176          uBarYm = halfRL *(
                0177      &       uFld( i , j )*dyG( i , j ,bi,bj)*_hFacW( i , j ,k,bi,bj)
                0178      &      +uFld( i ,j-1)*dyG( i ,j-1,bi,bj)*_hFacW( i ,j-1,k,bi,bj) )
                0179          uBarYp = halfRL *(
                0180      &       uFld(i+1, j )*dyG(i+1, j ,bi,bj)*_hFacW(i+1, j ,k,bi,bj)
                0181      &      +uFld(i+1,j-1)*dyG(i+1,j-1,bi,bj)*_hFacW(i+1,j-1,k,bi,bj) )
                0182          vCoriolisTerm(i,j) = -0.5 _d 0
                0183      &        *( uBarYm*fCoriG( i ,j,bi,bj)
                0184      &          +uBarYp*fCoriG(i+1,j,bi,bj)
                0185      &         )*recip_dyC(i,j,bi,bj)*_recip_hFacS(i,j,k,bi,bj)
                0186         ENDDO
                0187        ENDDO
                0188       ELSE
                0189         STOP 'MOM_VI_CORIOLIS: invalid selectCoriScheme'
cab1a69b8a Jean*0190       ENDIF
aea29c8517 Alis*0191
                0192       RETURN
                0193       END