File indexing completed on 2023-02-23 06:09:53 UTC
view on githubraw file Latest commit 28038c27 on 2023-02-22 22:45:14 UTC
d8d1486ca1 Jean*0001 #include "KL10_OPTIONS.h"
0002
0003
0004
0005
0006
26b1a7a333 Jean*0007 SUBROUTINE KL10_CALC(
0008 I bi, bj, sigmaR, myTime, myIter, myThid )
d8d1486ca1 Jean*0009
0010
26b1a7a333 Jean*0011
d8d1486ca1 Jean*0012
0013
26b1a7a333 Jean*0014
d8d1486ca1 Jean*0015
26b1a7a333 Jean*0016
0017
0018
d8d1486ca1 Jean*0019
0020
0021
0022
26b1a7a333 Jean*0023
0024
d8d1486ca1 Jean*0025
0026
26b1a7a333 Jean*0027 IMPLICIT NONE
d8d1486ca1 Jean*0028 #include "SIZE.h"
0029 #include "EEPARAMS.h"
0030 #include "PARAMS.h"
0031 #include "EOS.h"
dc4a6ae782 Jean*0032 #include "GRID.h"
d8d1486ca1 Jean*0033 #include "DYNVARS.h"
0034 #include "FFIELDS.h"
dc4a6ae782 Jean*0035 #include "KL10.h"
d5a47d279f Jean*0036
0037
0038
d8d1486ca1 Jean*0039
0040
0041
26b1a7a333 Jean*0042
0043
0044
0045
0046
0047 INTEGER bi, bj
0048 _RL sigmaR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0049 _RL myTime
0050 INTEGER myIter
0051 INTEGER myThid
d8d1486ca1 Jean*0052
0053 #ifdef ALLOW_KL10
0054
0055
26b1a7a333 Jean*0056
d8d1486ca1 Jean*0057 INTEGER I, J, K, Km1, JJ
0058 INTEGER iMin ,iMax ,jMin ,jMax,di
28038c27d5 Lois*0059 _RL KLviscTmp, tempu
d8d1486ca1 Jean*0060 _RL b0, buoyFreqf, buoyFreqc, KLviscold,zsum,zsums
28038c27d5 Lois*0061
0062
0063 _RL rhoS(0:Nr), RS(1:Nr)
d5a47d279f Jean*0064 _RL dzp,ec,ep,es,epss(-1:0),epsw(-1:0),dz,KTemp
26b1a7a333 Jean*0065
0066
d8d1486ca1 Jean*0067
26b1a7a333 Jean*0068
d5a47d279f Jean*0069
d8d1486ca1 Jean*0070
26b1a7a333 Jean*0071
d8d1486ca1 Jean*0072 iMin = 2-OLx
0073 iMax = sNx+OLx-1
0074 jMin = 2-OLy
0075 jMax = sNy+OLy-1
0076
0077 DO J=jMin,jMax
0078 DO I=iMin,iMax
0079 K=1
28038c27d5 Lois*0080 rhoS(1)=rhoInSitu(I,J,K,bi,bj)
d8d1486ca1 Jean*0081 RS(1)=rC(1)
0082
0083 KLeps(I-1,J-1,1,bi,bj)=0.0
26b1a7a333 Jean*0084
d8d1486ca1 Jean*0085 ep = 0.0
0086 dzp = 0.0
0087
0088 KLviscAr(I,J,1,bi,bj) = viscArNr(1)
0089 KLviscold = KLviscAr(I,J,1,bi,bj)
28038c27d5 Lois*0090
0091
0092 DO K=2,Nr
0093 rhoS(K)= rhoS(K-1) + rkSign*drC(K)*SigmaR(I,J,K)
0094 RS(K)=rC(K)
0095 ENDDO
d8d1486ca1 Jean*0096
0097
0098 DO K=2,Nr
26b1a7a333 Jean*0099
d5a47d279f Jean*0100
0101
0102
d8d1486ca1 Jean*0103 IF ( (rhoS(K).LT.rhoS(K-1)).AND.(maskC(I,J,K,bi
0104 & ,bj).GT.0)) THEN
0105 JJ=K-1
0106 DO WHILE ( (JJ.GT.0).AND.(rhoS(K).LT.rhoS(JJ)) )
26b1a7a333 Jean*0107
d8d1486ca1 Jean*0108 JJ=JJ-1
0109 ENDDO
0110 rhoS(JJ+1:K)=cshift(rhoS(JJ+1:K),-1)
0111 RS(JJ+1:K)=cshift(RS(JJ+1:K),-1)
0112 ENDIF
0113 ENDDO
0114
0115
0116
0117
78524d1402 Jean*0118
d8d1486ca1 Jean*0119
0120 KLdiffKr(I,J,1,bi,bj) = MAX(KLviscAr(I,J,1,bi,bj),
dc4a6ae782 Jean*0121 #ifdef ALLOW_3D_DIFFKR
0122 & diffKr(I,J,1,bi,bj) )
0123 #else
78524d1402 Jean*0124 & diffKrNrS(1) )
dc4a6ae782 Jean*0125 #endif
d8d1486ca1 Jean*0126
0127 b0 = MAX(-gravity*mass2rUnit*
0128 & (rhoS(1) - rhoS(2))*recip_drC(2),0. _d 0)
26b1a7a333 Jean*0129
d8d1486ca1 Jean*0130 DO di=-1,0
0131 epss(di)=0.0
0132 epsw(di)=0.0
0133 ENDDO
0134
0135 DO K=1,Nr
0136 IF (K.LT.Nr) THEN
0137 buoyFreqf = -gravity*mass2rUnit*
0138 & (rhoS(K) - rhoS(K+1))*recip_drC(K+1)
0139 ELSE
0140
0141 buoyFreqf = -gravity*mass2rUnit*
0142 & (rhoS(K-1) - rhoS(K))*recip_drC(K)
0143
0144 ENDIF
0145 buoyFreqf = MAX(buoyFreqf,0. _d 0)
0146 buoyFreqc = (buoyFreqf + b0)*0.5
0147
0148
0149
0150
0151
0152 KLviscTmp = MAX( viscArNr(K), 0.2*(RS(K)-rC(K))*
0153 & (RS(K)-rC(K))*sqrt(buoyFreqc))
0154
0155 IF (K.GT.1) THEN
0156 Km1=K-1
0157
0158
0159 KTemp = 0.5*(KLviscTmp+KLviscold)
0160
0161
0162 KTemp = MIN(KLviscMax,KTemp)
0163 KLviscAr(I,J,K,bi,bj) = MAX(KTemp,viscArNr(K))
dc4a6ae782 Jean*0164 KLdiffKr(I,J,K,bi,bj) = MAX(KTemp,
0165 #ifdef ALLOW_3D_DIFFKR
0166 & diffKr(I,J,K,bi,bj) )
0167 #else
78524d1402 Jean*0168 & diffKrNrS(K) )
dc4a6ae782 Jean*0169 #endif
d8d1486ca1 Jean*0170
0171
0172
0173
0174
0175
0176
0177
0178
0179
0180 zsum=0.
0181 ec=0.0
0182 zsums=0.
0183 es=0.
0184 DO di=-1,0
0185 IF (hfacW(I+di,J-1,K,bi,bj).GT.0.000001) THEN
0186 dz = 0.5*(drF(K)*hfacW(I+di,J-1,K,bi,bj)
d5a47d279f Jean*0187 & +drF(Km1)*hfacW(I+di,J-1,Km1,bi,bj))
d8d1486ca1 Jean*0188 IF (dz.GT.0.00001) THEN
0189 tempu = (uVel(I+di,J-1,Km1,bi,bj)-uVel(I+di,J
d5a47d279f Jean*0190 & -1,K,bi,bj))/dz
d8d1486ca1 Jean*0191 epsw(di)=tempu*tempu*KLviscAr(I+di,J-1,K,bi
d5a47d279f Jean*0192 & ,bj)
d8d1486ca1 Jean*0193 ec=ec+epsw(di)*dz
0194 zsum = zsum+dz
0195 ENDIF
0196 ELSE
0197
0198
0199 dz=0.5*(drF(Km1)*hfacW(I+di,J-1,Km1,bi ,bj))
0200 ec=ec+epsw(di)*dz
0201 zsum = zsum+dz
0202 ENDIF
0203
0204 IF (hfacS(I-1,J+di,K,bi,bj).GT.0.000001) THEN
0205 dz = 0.5*(drF(K)*hfacS(I-1,J+di,K,bi,bj)
d5a47d279f Jean*0206 & +drF(Km1)*hfacS(I-1,J+di,Km1,bi,bj))
d8d1486ca1 Jean*0207 IF (dz.GT.0.00001) THEN
0208 tempu = (vVel(I-1,J+di,Km1,bi,bj)-vVel(I-1,J
d5a47d279f Jean*0209 & +di,K,bi,bj))/dz
d8d1486ca1 Jean*0210 epss(di)=tempu*tempu*KLviscAr(I-1,J+di,K,bi
d5a47d279f Jean*0211 & ,bj)
d8d1486ca1 Jean*0212 es = es+epss(di)*dz
0213 zsums = zsums+dz
0214 ENDIF
0215 ELSE
0216
0217
0218 dz=+0.5*(drF(Km1)*hfacS(I-1,J+di,Km1 ,bi,bj))
0219 es = es+epss(di)*dz
0220 zsums = zsums+dz
0221 ENDIF
0222 ENDDO
0223
0224 IF (zsum.GT.0.00001) THEN
0225 ec=ec/zsum
0226 ENDIF
0227
0228 IF (zsums.GT.0.00001) THEN
0229 es=es/zsums
0230 ENDIF
0231
0232 ec=es+ec
0233
0234
0235
0236
26b1a7a333 Jean*0237
0238
d8d1486ca1 Jean*0239
0240 KLeps(I-1,J-1,Km1,bi,bj) = 0.5*(ep+ec)
0241 IF (Km1.EQ.1) THEN
0242 KLeps(I-1,J-1,Km1,bi,bj) = ec
0243 ENDIF
0244 ep=ec
0245 ENDIF
0246
d5a47d279f Jean*0247
0248
0249
0250
d8d1486ca1 Jean*0251
0252 b0 = buoyFreqf
0253 KLviscold = KLviscTmp
0254 ENDDO
0255
0256
0257 KLeps(I-1,J-1,Nr,bi,bj) =ep
0258
0259 ENDDO
0260
0261 ENDDO
0262
0263
0264 #endif /* ALLOW_KL10 */
0265
0266 RETURN
0267 END