pkg/mom_vecinv/mom_vi_hdissip.F

cec2469d72 Alis*0001 #include "MOM_VECINV_OPTIONS.h"
aea29c8517 Alis*0002
                0003       SUBROUTINE MOM_VI_HDISSIP(
2f384c201c Jean*0004      I        bi, bj, k,
                0005      I        hDiv, vort3, dStar, zStar, hFacZ,
                0006      I        viscAh_Z, viscAh_D, viscA4_Z, viscA4_D,
                0007      I        harmonic, biharmonic, useVariableViscosity,
                0008      O        uDissip, vDissip,
                0009      I        myThid )
460dc72355 Patr*0010
aea29c8517 Alis*0011       IMPLICIT NONE
2f384c201c Jean*0012
aea29c8517 Alis*0013 C     Calculate horizontal dissipation terms
                0014 C     [del^2 - del^4] (u,v)
                0015
                0016 C     == Global variables ==
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
2f384c201c Jean*0020 #include "GRID.h"
aea29c8517 Alis*0021
                0022 C     == Routine arguments ==
2f384c201c Jean*0023       INTEGER bi, bj, k
                0024       _RL hDiv (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0025       _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0026       _RL dStar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0027       _RL zStar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
2f384c201c Jean*0028       _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d0d29b39da Jean*0029       _RL viscAh_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0030       _RL viscAh_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0031       _RL viscA4_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0032       _RL viscA4_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
b0c3bd7ab0 Bayl*0033       LOGICAL harmonic, biharmonic, useVariableViscosity
2f384c201c Jean*0034       _RL uDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0035       _RL vDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
998681995e Bayl*0036       INTEGER myThid
e46ec53fc5 Alis*0037
998681995e Bayl*0038 C     == Local variables ==
2f384c201c Jean*0039       INTEGER i, j
a340904e5a Ou W*0040       _RL Zip, Zij, Zpj, Dim, Dij, Dmj, uD2, vD2
                0041       _RL uD4(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0042       _RL vD4(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
aea29c8517 Alis*0043
86fd561884 Jean*0044 C     - Laplacian  terms
a340904e5a Ou W*0045       IF ( harmonic ) THEN
396048594e Alis*0046 C This bit scales the harmonic dissipation operator to be proportional
                0047 C to the grid-cell area over the time-step. viscAh is then non-dimensional
2f384c201c Jean*0048 C and should be less than 1/8, for example viscAh=0.01
a340904e5a Ou W*0049        IF ( useVariableViscosity ) THEN
2f384c201c Jean*0050         DO j=2-OLy,sNy+OLy-1
                0051          DO i=2-OLx,sNx+OLx-1
90ef0f383b Mart*0052
bbf2faef13 Patr*0053           Dij=hDiv( i , j )*viscAh_D(i,j)
                0054           Dim=hDiv( i ,j-1)*viscAh_D(i,j-1)
                0055           Dmj=hDiv(i-1, j )*viscAh_D(i-1,j)
                0056           Zij=hFacZ( i , j )*vort3( i , j )*viscAh_Z(i,j)
                0057           Zip=hFacZ( i ,j+1)*vort3( i ,j+1)*viscAh_Z(i,j+1)
                0058           Zpj=hFacZ(i+1, j )*vort3(i+1, j )*viscAh_Z(i+1,j)
                0059
396048594e Alis*0060           uD2 = (
                0061      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
616600b8d2 Patr*0062      &     -_recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj) )
58f454ab40 Mart*0063 #ifdef ISOTROPIC_COS_SCALING
                0064      &                                           *cosFacU(j,bi,bj)
                0065 #endif /* ISOTROPIC_COS_SCALING */
396048594e Alis*0066           vD2 = (
616600b8d2 Patr*0067      &      _recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
396048594e Alis*0068      &                                           *cosFacV(j,bi,bj)
                0069      &                               +( Dij-Dim )*recip_DYC(i,j,bi,bj) )
58f454ab40 Mart*0070 #ifdef ISOTROPIC_COS_SCALING
                0071      &                                           *cosFacV(j,bi,bj)
                0072 #endif /* ISOTROPIC_COS_SCALING */
90ef0f383b Mart*0073
a340904e5a Ou W*0074           uDissip(i,j) = uD2*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0075           vDissip(i,j) = vD2*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
90ef0f383b Mart*0076
                0077          ENDDO
                0078         ENDDO
                0079        ELSE
2f384c201c Jean*0080         DO j=2-OLy,sNy+OLy-1
                0081          DO i=2-OLx,sNx+OLx-1
90ef0f383b Mart*0082
bbf2faef13 Patr*0083           Dim=hDiv( i ,j-1)
                0084           Dij=hDiv( i , j )
                0085           Dmj=hDiv(i-1, j )
                0086           Zip=hFacZ( i ,j+1)*vort3( i ,j+1)
                0087           Zij=hFacZ( i , j )*vort3( i , j )
                0088           Zpj=hFacZ(i+1, j )*vort3(i+1, j )
                0089
86fd561884 Jean*0090           uD2 = viscAhD*
aea29c8517 Alis*0091      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
616600b8d2 Patr*0092      &        - viscAhZ*_recip_hFacW(i,j,k,bi,bj)*
86fd561884 Jean*0093      &                                ( Zip-Zij )*recip_DYG(i,j,bi,bj)
58f454ab40 Mart*0094 #ifdef ISOTROPIC_COS_SCALING
                0095      &                                           *cosFacU(j,bi,bj)
                0096 #endif /* ISOTROPIC_COS_SCALING */
616600b8d2 Patr*0097           vD2 = viscAhZ*_recip_hFacS(i,j,k,bi,bj)*
86fd561884 Jean*0098      &               cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
                0099      &        + viscAhD*              ( Dij-Dim )*recip_DYC(i,j,bi,bj)
58f454ab40 Mart*0100 #ifdef ISOTROPIC_COS_SCALING
                0101      &                                           *cosFacV(j,bi,bj)
                0102 #endif /* ISOTROPIC_COS_SCALING */
86fd561884 Jean*0103
a340904e5a Ou W*0104           uDissip(i,j) = uD2*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0105           vDissip(i,j) = vD2*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
86fd561884 Jean*0106
90ef0f383b Mart*0107          ENDDO
86fd561884 Jean*0108         ENDDO
90ef0f383b Mart*0109        ENDIF
a340904e5a Ou W*0110 #ifdef ALLOW_DIAGNOSTICS
                0111        IF ( useDiagnostics ) THEN
                0112         CALL DIAGNOSTICS_FILL( uDissip,'Um_hDis2', k,1,2,bi,bj, myThid )
                0113         CALL DIAGNOSTICS_FILL( vDissip,'Vm_hDis2', k,1,2,bi,bj, myThid )
                0114        ENDIF
                0115 #endif /* ALLOW_DIAGNOSTICS */
86fd561884 Jean*0116       ELSE
2f384c201c Jean*0117        DO j=2-OLy,sNy+OLy-1
                0118         DO i=2-OLx,sNx+OLx-1
86fd561884 Jean*0119          uDissip(i,j) = 0.
                0120          vDissip(i,j) = 0.
                0121         ENDDO
                0122        ENDDO
                0123       ENDIF
                0124
                0125 C     - Bi-harmonic terms
a340904e5a Ou W*0126       IF ( biharmonic ) THEN
                0127 C--   initialize local arrays
                0128        DO j=1-OLy,sNy+OLy
                0129         DO i=1-OLx,sNx+OLx
                0130          uD4(i,j) = 0. _d 0
                0131          vD4(i,j) = 0. _d 0
                0132         ENDDO
                0133        ENDDO
aea29c8517 Alis*0134
90ef0f383b Mart*0135 C This bit scales the harmonic dissipation operator to be proportional
                0136 C to the grid-cell area over the time-step. viscAh is then non-dimensional
2f384c201c Jean*0137 C and should be less than 1/8, for example viscAh=0.01
a340904e5a Ou W*0138        IF ( useVariableViscosity ) THEN
2f384c201c Jean*0139         DO j=2-OLy,sNy+OLy-1
                0140          DO i=2-OLx,sNx+OLx-1
aea29c8517 Alis*0141
90ef0f383b Mart*0142 #ifdef MOM_VI_ORIGINAL_VISCA4
                0143           Dim=dyF( i ,j-1,bi,bj)*dStar( i ,j-1)
                0144           Dij=dyF( i , j ,bi,bj)*dStar( i , j )
                0145           Dmj=dyF(i-1, j ,bi,bj)*dStar(i-1, j )
2f384c201c Jean*0146
a340904e5a Ou W*0147           Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*zStar( i ,j+1)
                0148           Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*zStar( i , j )
                0149           Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*zStar(i+1, j )
fd0a408c49 Jean*0150 #else
90ef0f383b Mart*0151           Dim=dStar( i ,j-1)
                0152           Dij=dStar( i , j )
                0153           Dmj=dStar(i-1, j )
fd0a408c49 Jean*0154
a340904e5a Ou W*0155           Zip=hFacZ( i ,j+1)*zStar( i ,j+1)
                0156           Zij=hFacZ( i , j )*zStar( i , j )
                0157           Zpj=hFacZ(i+1, j )*zStar(i+1, j )
fd0a408c49 Jean*0158 #endif
e46ec53fc5 Alis*0159           Dij=Dij*viscA4_D(i,j)
                0160           Dim=Dim*viscA4_D(i,j-1)
                0161           Dmj=Dmj*viscA4_D(i-1,j)
a340904e5a Ou W*0162           Zij=Zij*viscA4_Z(i,j)
                0163           Zip=Zip*viscA4_Z(i,j+1)
                0164           Zpj=Zpj*viscA4_Z(i+1,j)
fd0a408c49 Jean*0165
                0166 #ifdef MOM_VI_ORIGINAL_VISCA4
a340904e5a Ou W*0167           uD4(i,j) = recip_rAw(i,j,bi,bj)*(
396048594e Alis*0168      &                             ( (Dij-Dmj)*cosFacU(j,bi,bj) )
2f384c201c Jean*0169      &  -_recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )
f8798ebccf Patr*0170 # ifdef ISOTROPIC_COS_SCALING
58f454ab40 Mart*0171      &                                        *cosFacU(j,bi,bj)
f8798ebccf Patr*0172 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0173      &                                    )
                0174           vD4(i,j) = recip_rAs(i,j,bi,bj)*(
616600b8d2 Patr*0175      &   _recip_hFacS(i,j,k,bi,bj)*( (Zpj-Zij)*cosFacV(j,bi,bj) )
2f384c201c Jean*0176      &   +                         ( Dij-Dim )
f8798ebccf Patr*0177 # ifdef ISOTROPIC_COS_SCALING
58f454ab40 Mart*0178      &                                        *cosFacV(j,bi,bj)
f8798ebccf Patr*0179 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0180      &                                    )
90ef0f383b Mart*0181 #else /* MOM_VI_ORIGINAL_VISCA4 */
a340904e5a Ou W*0182           uD4(i,j) = (
90ef0f383b Mart*0183      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
a340904e5a Ou W*0184      &     -_recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj)
                0185      &               )
90ef0f383b Mart*0186 # ifdef ISOTROPIC_COS_SCALING
                0187      &                                           *cosFacU(j,bi,bj)
                0188 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0189           vD4(i,j) = (
90ef0f383b Mart*0190      &      _recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
                0191      &                                           *cosFacV(j,bi,bj)
a340904e5a Ou W*0192      &                               +( Dij-Dim )*recip_DYC(i,j,bi,bj)
                0193      &               )
90ef0f383b Mart*0194 # ifdef ISOTROPIC_COS_SCALING
                0195      &                                           *cosFacV(j,bi,bj)
                0196 # endif /* ISOTROPIC_COS_SCALING */
                0197 #endif  /* MOM_VI_ORIGINAL_VISCA4 */
                0198
                0199          ENDDO
                0200         ENDDO
                0201        ELSE
2f384c201c Jean*0202         DO j=2-OLy,sNy+OLy-1
                0203          DO i=2-OLx,sNx+OLx-1
90ef0f383b Mart*0204
                0205 #ifdef MOM_VI_ORIGINAL_VISCA4
                0206           Dim=dyF( i ,j-1,bi,bj)*dStar( i ,j-1)
                0207           Dij=dyF( i , j ,bi,bj)*dStar( i , j )
                0208           Dmj=dyF(i-1, j ,bi,bj)*dStar(i-1, j )
2f384c201c Jean*0209
a340904e5a Ou W*0210           Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*zStar( i ,j+1)
                0211           Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*zStar( i , j )
                0212           Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*zStar(i+1, j )
90ef0f383b Mart*0213 #else
                0214           Dim=dStar( i ,j-1)
                0215           Dij=dStar( i , j )
                0216           Dmj=dStar(i-1, j )
                0217
a340904e5a Ou W*0218           Zip=hFacZ( i ,j+1)*zStar( i ,j+1)
                0219           Zij=hFacZ( i , j )*zStar( i , j )
                0220           Zpj=hFacZ(i+1, j )*zStar(i+1, j )
90ef0f383b Mart*0221 #endif
                0222
                0223 #ifdef MOM_VI_ORIGINAL_VISCA4
a340904e5a Ou W*0224           uD4(i,j) = recip_rAw(i,j,bi,bj)*(
2f384c201c Jean*0225      &                             viscA4D*( Dij-Dmj )*cosFacU(j,bi,bj)
                0226      &  -_recip_hFacW(i,j,k,bi,bj)*viscA4Z*( Zip-Zij )
f8798ebccf Patr*0227 # ifdef ISOTROPIC_COS_SCALING
2f384c201c Jean*0228      &                                                *cosFacU(j,bi,bj)
f8798ebccf Patr*0229 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0230      &                                    )
                0231           vD4(i,j) = recip_rAs(i,j,bi,bj)*(
2f384c201c Jean*0232      &   _recip_hFacS(i,j,k,bi,bj)*viscA4Z*( Zpj-Zij )*cosFacV(j,bi,bj)
                0233      &   +                         viscA4D*( Dij-Dim )
f8798ebccf Patr*0234 # ifdef ISOTROPIC_COS_SCALING
2f384c201c Jean*0235      &                                                *cosFacV(j,bi,bj)
f8798ebccf Patr*0236 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0237      &                                    )
fd0a408c49 Jean*0238 #else /* MOM_VI_ORIGINAL_VISCA4 */
a340904e5a Ou W*0239           uD4(i,j) = viscA4D*
fd0a408c49 Jean*0240      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
a340904e5a Ou W*0241      &             - viscA4Z*_recip_hFacW(i,j,k,bi,bj)*
86fd561884 Jean*0242      &                                ( Zip-Zij )*recip_DYG(i,j,bi,bj)
f8798ebccf Patr*0243 # ifdef ISOTROPIC_COS_SCALING
58f454ab40 Mart*0244      &                                           *cosFacU(j,bi,bj)
f8798ebccf Patr*0245 # endif /* ISOTROPIC_COS_SCALING */
a340904e5a Ou W*0246           vD4(i,j) = viscA4Z*_recip_hFacS(i,j,k,bi,bj)*
86fd561884 Jean*0247      &               cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
a340904e5a Ou W*0248      &             + viscA4D*         ( Dij-Dim )*recip_DYC(i,j,bi,bj)
f8798ebccf Patr*0249 # ifdef ISOTROPIC_COS_SCALING
58f454ab40 Mart*0250      &                                           *cosFacV(j,bi,bj)
f8798ebccf Patr*0251 # endif /* ISOTROPIC_COS_SCALING */
fd0a408c49 Jean*0252 #endif /* MOM_VI_ORIGINAL_VISCA4 */
aea29c8517 Alis*0253
90ef0f383b Mart*0254          ENDDO
86fd561884 Jean*0255         ENDDO
90ef0f383b Mart*0256        ENDIF
a340904e5a Ou W*0257        DO j=2-OLy,sNy+OLy-1
                0258         DO i=2-OLx,sNx+OLx-1
                0259           uD4(i,j) = -uD4(i,j)*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0260           vD4(i,j) = -vD4(i,j)*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
                0261           uDissip(i,j) = uDissip(i,j) + uD4(i,j)
                0262           vDissip(i,j) = vDissip(i,j) + vD4(i,j)
81e837e1e7 Jean*0263         ENDDO
                0264        ENDDO
a340904e5a Ou W*0265 #ifdef ALLOW_DIAGNOSTICS
                0266        IF ( useDiagnostics ) THEN
                0267         CALL DIAGNOSTICS_FILL( uD4, 'Um_hDis4', k,1,2,bi,bj, myThid )
                0268         CALL DIAGNOSTICS_FILL( vD4, 'Vm_hDis4', k,1,2,bi,bj, myThid )
                0269        ENDIF
                0270 #endif /* ALLOW_DIAGNOSTICS */
81e837e1e7 Jean*0271       ENDIF
                0272
aea29c8517 Alis*0273       RETURN
                0274       END