Back to home page

MITgcm
 
 

    

File indexing completed on 2024-11-30 06:11:15 UTC

view on githubraw file Latest commit 7bb5a8a1 on 2024-11-29 14:30:55 UTC
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) )
396048594e Alis*0063           vD2 = (
616600b8d2 Patr*0064      &      _recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
396048594e Alis*0065      &                                           *cosFacV(j,bi,bj)
                0066      &                               +( Dij-Dim )*recip_DYC(i,j,bi,bj) )
90ef0f383b Mart*0067 
a340904e5a Ou W*0068           uDissip(i,j) = uD2*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0069           vDissip(i,j) = vD2*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
90ef0f383b Mart*0070 
                0071          ENDDO
                0072         ENDDO
                0073        ELSE
2f384c201c Jean*0074         DO j=2-OLy,sNy+OLy-1
                0075          DO i=2-OLx,sNx+OLx-1
90ef0f383b Mart*0076 
bbf2faef13 Patr*0077           Dim=hDiv( i ,j-1)
                0078           Dij=hDiv( i , j )
                0079           Dmj=hDiv(i-1, j )
                0080           Zip=hFacZ( i ,j+1)*vort3( i ,j+1)
                0081           Zij=hFacZ( i , j )*vort3( i , j )
                0082           Zpj=hFacZ(i+1, j )*vort3(i+1, j )
                0083 
86fd561884 Jean*0084           uD2 = viscAhD*
aea29c8517 Alis*0085      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
616600b8d2 Patr*0086      &        - viscAhZ*_recip_hFacW(i,j,k,bi,bj)*
86fd561884 Jean*0087      &                                ( Zip-Zij )*recip_DYG(i,j,bi,bj)
616600b8d2 Patr*0088           vD2 = viscAhZ*_recip_hFacS(i,j,k,bi,bj)*
86fd561884 Jean*0089      &               cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
                0090      &        + viscAhD*              ( Dij-Dim )*recip_DYC(i,j,bi,bj)
                0091 
a340904e5a Ou W*0092           uDissip(i,j) = uD2*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0093           vDissip(i,j) = vD2*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
86fd561884 Jean*0094 
90ef0f383b Mart*0095          ENDDO
86fd561884 Jean*0096         ENDDO
90ef0f383b Mart*0097        ENDIF
a340904e5a Ou W*0098 #ifdef ALLOW_DIAGNOSTICS
                0099        IF ( useDiagnostics ) THEN
                0100         CALL DIAGNOSTICS_FILL( uDissip,'Um_hDis2', k,1,2,bi,bj, myThid )
                0101         CALL DIAGNOSTICS_FILL( vDissip,'Vm_hDis2', k,1,2,bi,bj, myThid )
                0102        ENDIF
                0103 #endif /* ALLOW_DIAGNOSTICS */
86fd561884 Jean*0104       ELSE
2f384c201c Jean*0105        DO j=2-OLy,sNy+OLy-1
                0106         DO i=2-OLx,sNx+OLx-1
86fd561884 Jean*0107          uDissip(i,j) = 0.
                0108          vDissip(i,j) = 0.
                0109         ENDDO
                0110        ENDDO
                0111       ENDIF
                0112 
                0113 C     - Bi-harmonic terms
a340904e5a Ou W*0114       IF ( biharmonic ) THEN
                0115 C--   initialize local arrays
                0116        DO j=1-OLy,sNy+OLy
                0117         DO i=1-OLx,sNx+OLx
                0118          uD4(i,j) = 0. _d 0
                0119          vD4(i,j) = 0. _d 0
                0120         ENDDO
                0121        ENDDO
aea29c8517 Alis*0122 
90ef0f383b Mart*0123 C This bit scales the harmonic dissipation operator to be proportional
                0124 C to the grid-cell area over the time-step. viscAh is then non-dimensional
2f384c201c Jean*0125 C and should be less than 1/8, for example viscAh=0.01
a340904e5a Ou W*0126        IF ( useVariableViscosity ) THEN
2f384c201c Jean*0127         DO j=2-OLy,sNy+OLy-1
                0128          DO i=2-OLx,sNx+OLx-1
aea29c8517 Alis*0129 
90ef0f383b Mart*0130 #ifdef MOM_VI_ORIGINAL_VISCA4
                0131           Dim=dyF( i ,j-1,bi,bj)*dStar( i ,j-1)
                0132           Dij=dyF( i , j ,bi,bj)*dStar( i , j )
                0133           Dmj=dyF(i-1, j ,bi,bj)*dStar(i-1, j )
2f384c201c Jean*0134 
a340904e5a Ou W*0135           Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*zStar( i ,j+1)
                0136           Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*zStar( i , j )
                0137           Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*zStar(i+1, j )
fd0a408c49 Jean*0138 #else
90ef0f383b Mart*0139           Dim=dStar( i ,j-1)
                0140           Dij=dStar( i , j )
                0141           Dmj=dStar(i-1, j )
fd0a408c49 Jean*0142 
a340904e5a Ou W*0143           Zip=hFacZ( i ,j+1)*zStar( i ,j+1)
                0144           Zij=hFacZ( i , j )*zStar( i , j )
                0145           Zpj=hFacZ(i+1, j )*zStar(i+1, j )
fd0a408c49 Jean*0146 #endif
e46ec53fc5 Alis*0147           Dij=Dij*viscA4_D(i,j)
                0148           Dim=Dim*viscA4_D(i,j-1)
                0149           Dmj=Dmj*viscA4_D(i-1,j)
a340904e5a Ou W*0150           Zij=Zij*viscA4_Z(i,j)
                0151           Zip=Zip*viscA4_Z(i,j+1)
                0152           Zpj=Zpj*viscA4_Z(i+1,j)
fd0a408c49 Jean*0153 
                0154 #ifdef MOM_VI_ORIGINAL_VISCA4
a340904e5a Ou W*0155           uD4(i,j) = recip_rAw(i,j,bi,bj)*(
396048594e Alis*0156      &                             ( (Dij-Dmj)*cosFacU(j,bi,bj) )
2f384c201c Jean*0157      &  -_recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )
a340904e5a Ou W*0158      &                                    )
                0159           vD4(i,j) = recip_rAs(i,j,bi,bj)*(
616600b8d2 Patr*0160      &   _recip_hFacS(i,j,k,bi,bj)*( (Zpj-Zij)*cosFacV(j,bi,bj) )
2f384c201c Jean*0161      &   +                         ( Dij-Dim )
a340904e5a Ou W*0162      &                                    )
90ef0f383b Mart*0163 #else /* MOM_VI_ORIGINAL_VISCA4 */
a340904e5a Ou W*0164           uD4(i,j) = (
90ef0f383b Mart*0165      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
a340904e5a Ou W*0166      &     -_recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj)
                0167      &               )
                0168           vD4(i,j) = (
90ef0f383b Mart*0169      &      _recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
                0170      &                                           *cosFacV(j,bi,bj)
a340904e5a Ou W*0171      &                               +( Dij-Dim )*recip_DYC(i,j,bi,bj)
                0172      &               )
90ef0f383b Mart*0173 #endif  /* MOM_VI_ORIGINAL_VISCA4 */
                0174 
                0175          ENDDO
                0176         ENDDO
                0177        ELSE
2f384c201c Jean*0178         DO j=2-OLy,sNy+OLy-1
                0179          DO i=2-OLx,sNx+OLx-1
90ef0f383b Mart*0180 
                0181 #ifdef MOM_VI_ORIGINAL_VISCA4
                0182           Dim=dyF( i ,j-1,bi,bj)*dStar( i ,j-1)
                0183           Dij=dyF( i , j ,bi,bj)*dStar( i , j )
                0184           Dmj=dyF(i-1, j ,bi,bj)*dStar(i-1, j )
2f384c201c Jean*0185 
a340904e5a Ou W*0186           Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*zStar( i ,j+1)
                0187           Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*zStar( i , j )
                0188           Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*zStar(i+1, j )
90ef0f383b Mart*0189 #else
                0190           Dim=dStar( i ,j-1)
                0191           Dij=dStar( i , j )
                0192           Dmj=dStar(i-1, j )
                0193 
a340904e5a Ou W*0194           Zip=hFacZ( i ,j+1)*zStar( i ,j+1)
                0195           Zij=hFacZ( i , j )*zStar( i , j )
                0196           Zpj=hFacZ(i+1, j )*zStar(i+1, j )
90ef0f383b Mart*0197 #endif
                0198 
                0199 #ifdef MOM_VI_ORIGINAL_VISCA4
a340904e5a Ou W*0200           uD4(i,j) = recip_rAw(i,j,bi,bj)*(
2f384c201c Jean*0201      &                             viscA4D*( Dij-Dmj )*cosFacU(j,bi,bj)
                0202      &  -_recip_hFacW(i,j,k,bi,bj)*viscA4Z*( Zip-Zij )
a340904e5a Ou W*0203      &                                    )
                0204           vD4(i,j) = recip_rAs(i,j,bi,bj)*(
2f384c201c Jean*0205      &   _recip_hFacS(i,j,k,bi,bj)*viscA4Z*( Zpj-Zij )*cosFacV(j,bi,bj)
                0206      &   +                         viscA4D*( Dij-Dim )
a340904e5a Ou W*0207      &                                    )
fd0a408c49 Jean*0208 #else /* MOM_VI_ORIGINAL_VISCA4 */
a340904e5a Ou W*0209           uD4(i,j) = viscA4D*
fd0a408c49 Jean*0210      &               cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
a340904e5a Ou W*0211      &             - viscA4Z*_recip_hFacW(i,j,k,bi,bj)*
86fd561884 Jean*0212      &                                ( Zip-Zij )*recip_DYG(i,j,bi,bj)
a340904e5a Ou W*0213           vD4(i,j) = viscA4Z*_recip_hFacS(i,j,k,bi,bj)*
86fd561884 Jean*0214      &               cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
a340904e5a Ou W*0215      &             + viscA4D*         ( Dij-Dim )*recip_DYC(i,j,bi,bj)
fd0a408c49 Jean*0216 #endif /* MOM_VI_ORIGINAL_VISCA4 */
aea29c8517 Alis*0217 
90ef0f383b Mart*0218          ENDDO
86fd561884 Jean*0219         ENDDO
90ef0f383b Mart*0220        ENDIF
a340904e5a Ou W*0221        DO j=2-OLy,sNy+OLy-1
                0222         DO i=2-OLx,sNx+OLx-1
                0223           uD4(i,j) = -uD4(i,j)*maskW(i,j,k,bi,bj)*recip_deepFacC(k)
                0224           vD4(i,j) = -vD4(i,j)*maskS(i,j,k,bi,bj)*recip_deepFacC(k)
                0225           uDissip(i,j) = uDissip(i,j) + uD4(i,j)
                0226           vDissip(i,j) = vDissip(i,j) + vD4(i,j)
81e837e1e7 Jean*0227         ENDDO
                0228        ENDDO
a340904e5a Ou W*0229 #ifdef ALLOW_DIAGNOSTICS
                0230        IF ( useDiagnostics ) THEN
                0231         CALL DIAGNOSTICS_FILL( uD4, 'Um_hDis4', k,1,2,bi,bj, myThid )
                0232         CALL DIAGNOSTICS_FILL( vD4, 'Vm_hDis4', k,1,2,bi,bj, myThid )
                0233        ENDIF
                0234 #endif /* ALLOW_DIAGNOSTICS */
81e837e1e7 Jean*0235       ENDIF
                0236 
aea29c8517 Alis*0237       RETURN
                0238       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!