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
0014
0015
0016
0017 #include "SIZE.h"
0018 #include "EEPARAMS.h"
0019 #include "PARAMS.h"
2f384c201c Jean*0020 #include "GRID.h"
aea29c8517 Alis*0021
0022
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
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
a340904e5a Ou W*0045 IF ( harmonic ) THEN
396048594e Alis*0046
0047
2f384c201c Jean*0048
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
a340904e5a Ou W*0114 IF ( biharmonic ) THEN
0115
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
0124
2f384c201c Jean*0125
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