/[MITgcm]/MITgcm/pkg/kpp/kpp_calc.F
ViewVC logotype

Contents of /MITgcm/pkg/kpp/kpp_calc.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.16 - (show annotations) (download)
Fri Mar 21 23:18:28 2003 UTC (21 years, 2 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint50b_pre, checkpoint50a_post, checkpoint50b_post
Changes since 1.15: +23 -10 lines
Bug fix for merging between c50 and KPP.
ikey was passed from thermodynamics to kpp_calc via
common block rather than being recomputed in kpp_calc,
in contradiction with new key itdkey.
New key ikppkey created, and tamc.h headers updated.

1 C $Header: /u/gcmpack/MITgcm/pkg/kpp/kpp_calc.F,v 1.9.6.6 2003/03/21 22:56:06 heimbach Exp $
2 C $Name: $
3
4 #include "KPP_OPTIONS.h"
5
6 subroutine KPP_CALC(
7 I bi, bj, myTime, myThid )
8 C /==========================================================\
9 C | SUBROUTINE KPP_CALC |
10 C | o Compute all KPP fields defined in KPP.h |
11 C |==========================================================|
12 C | This subroutine serves as an interface between MITGCMUV |
13 C | code and NCOM 1-D routines in kpp_routines.F |
14 C \==========================================================/
15 IMPLICIT NONE
16
17 c=======================================================================
18 c
19 c written by : jan morzel, august 11, 1994
20 c modified by : jan morzel, january 25, 1995 : "dVsq" and 1d code
21 c detlef stammer, august, 1997 : for MIT GCM Classic
22 c d. menemenlis, july, 1998 : for MIT GCM UV
23 c
24 c compute vertical mixing coefficients based on the k-profile
25 c and oceanic planetary boundary layer scheme by large & mcwilliams.
26 c
27 c summary:
28 c - compute interior mixing everywhere:
29 c interior mixing gets computed at all interfaces due to constant
30 c internal wave background activity ("fkpm" and "fkph"), which
31 c is enhanced in places of static instability (local richardson
32 c number < 0).
33 c Additionally, mixing can be enhanced by adding contribution due
34 c to shear instability which is a function of the local richardson
35 c number
36 c - double diffusivity:
37 c interior mixing can be enhanced by double diffusion due to salt
38 c fingering and diffusive convection (ifdef "kmixdd").
39 c - kpp scheme in the boundary layer:
40 c
41 c a.boundary layer depth:
42 c at every gridpoint the depth of the oceanic boundary layer
43 c ("hbl") gets computed by evaluating bulk richardson numbers.
44 c b.boundary layer mixing:
45 c within the boundary layer, above hbl, vertical mixing is
46 c determined by turbulent surface fluxes, and interior mixing at
47 c the lower boundary, i.e. at hbl.
48 c
49 c this subroutine provides the interface between the MIT GCM UV and the
50 c subroutine "kppmix", where boundary layer depth, vertical
51 c viscosity, vertical diffusivity, and counter gradient term (ghat)
52 c are computed slabwise.
53 c note: subroutine "kppmix" uses m-k-s units.
54 c
55 c time level:
56 c input tracer and velocity profiles are evaluated at time level
57 c tau, surface fluxes come from tau or tau-1.
58 c
59 c grid option:
60 c in this "1-grid" implementation, diffusivity and viscosity
61 c profiles are computed on the "t-grid" (by using velocity shear
62 c profiles averaged from the "u,v-grid" onto the "t-grid"; note, that
63 c the averaging includes zero values on coastal and seafloor grid
64 c points). viscosity on the "u,v-grid" is computed by averaging the
65 c "t-grid" viscosity values onto the "u,v-grid".
66 c
67 c vertical grid:
68 c mixing coefficients get evaluated at the bottom of the lowest
69 c layer, i.e., at depth zw(Nr). these values are only useful when
70 c the model ocean domain does not include the entire ocean down to
71 c the seafloor ("upperocean" setup) and allows flux through the
72 c bottom of the domain. for full-depth runs, these mixing
73 c coefficients are being zeroed out before leaving this subroutine.
74 c
75 c-------------------------------------------------------------------------
76
77 c global parameters updated by kpp_calc
78 c KPPviscAz - KPP eddy viscosity coefficient (m^2/s)
79 c KPPdiffKzT - KPP diffusion coefficient for temperature (m^2/s)
80 c KPPdiffKzS - KPP diffusion coefficient for salt and tracers (m^2/s)
81 c KPPghat - Nonlocal transport coefficient (s/m^2)
82 c KPPhbl - Boundary layer depth on "t-grid" (m)
83 c KPPfrac - Fraction of short-wave flux penetrating mixing layer
84
85 c-- KPP_CALC computes vertical viscosity and diffusivity for region
86 c (-2:sNx+3,-2:sNy+3) as required by CALC_DIFFUSIVITY and requires
87 c values of uVel, vVel, SurfaceTendencyU, SurfaceTendencyV in the
88 c region (-2:sNx+4,-2:sNy+4).
89 c Hence overlap region needs to be set OLx=4, OLy=4.
90 c When option FRUGAL_KPP is used, computation in overlap regions
91 c is replaced with exchange calls hence reducing overlap requirements
92 c to OLx=1, OLy=1.
93
94 #include "SIZE.h"
95 #include "EEPARAMS.h"
96 #include "PARAMS.h"
97 #include "DYNVARS.h"
98 #include "KPP.h"
99 #include "KPP_PARAMS.h"
100 #include "FFIELDS.h"
101 #include "GRID.h"
102
103 #ifdef ALLOW_SEAICE
104 #include "SEAICE_EXTERNAL.h"
105 #endif ALLOW_SEAICE
106
107 #ifdef ALLOW_AUTODIFF_TAMC
108 #include "tamc.h"
109 #include "tamc_keys.h"
110 #else /* ALLOW_AUTODIFF_TAMC */
111 integer ikppkey
112 #endif /* ALLOW_AUTODIFF_TAMC */
113
114 EXTERNAL DIFFERENT_MULTIPLE
115 LOGICAL DIFFERENT_MULTIPLE
116
117 c Routine arguments
118 c bi, bj - array indices on which to apply calculations
119 c myTime - Current time in simulation
120
121 INTEGER bi, bj
122 INTEGER myThid
123 _RL myTime
124
125 #ifdef ALLOW_KPP
126
127 c Local constants
128 c minusone, p0, p5, p25, p125, p0625
129 c imin, imax, jmin, jmax - array computation indices
130
131 _RL minusone
132 parameter( minusone=-1.0)
133 _KPP_RL p0 , p5 , p25 , p125 , p0625
134 parameter( p0=0.0, p5=0.5, p25=0.25, p125=0.125, p0625=0.0625 )
135 integer imin , imax , jmin , jmax
136 #ifdef FRUGAL_KPP
137 parameter( imin=1 , imax=sNx , jmin=1 , jmax=sNy )
138 #else
139 parameter(imin=2-OLx,imax=sNx+OLx-1,jmin=2-OLy,jmax=sNy+OLy-1)
140 #endif
141
142 c Local arrays and variables
143 c work? (nx,ny) - horizontal working arrays
144 c ustar (nx,ny) - surface friction velocity (m/s)
145 c bo (nx,ny) - surface turbulent buoyancy forcing (m^2/s^3)
146 c bosol (nx,ny) - surface radiative buoyancy forcing (m^2/s^3)
147 c shsq (nx,ny,Nr) - local velocity shear squared
148 c at interfaces for ri_iwmix (m^2/s^2)
149 c dVsq (nx,ny,Nr) - velocity shear re surface squared
150 c at grid levels for bldepth (m^2/s^2)
151 c dbloc (nx,ny,Nr) - local delta buoyancy at interfaces
152 c for ri_iwmix and bldepth (m/s^2)
153 c Ritop (nx,ny,Nr) - numerator of bulk richardson number
154 c at grid levels for bldepth
155 c vddiff (nx,ny,Nrp2,1)- vertical viscosity on "t-grid" (m^2/s)
156 c vddiff (nx,ny,Nrp2,2)- vert. diff. on next row for temperature (m^2/s)
157 c vddiff (nx,ny,Nrp2,3)- vert. diff. on next row for salt&tracers (m^2/s)
158 c ghat (nx,ny,Nr) - nonlocal transport coefficient (s/m^2)
159 c hbl (nx,ny) - mixing layer depth (m)
160 c kmtj (nx,ny) - maximum number of wet levels in each column
161 c z0 (nx,ny) - Roughness length (m)
162 c zRef (nx,ny) - Reference depth: Hmix * epsilon (m)
163 c uRef (nx,ny) - Reference zonal velocity (m/s)
164 c vRef (nx,ny) - Reference meridional velocity (m/s)
165
166 _RL worka ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
167 integer work1 ( ibot:itop , jbot:jtop )
168 _KPP_RL work2 ( ibot:itop , jbot:jtop )
169 _KPP_RL work3 ( ibot:itop , jbot:jtop )
170 _KPP_RL ustar ( ibot:itop , jbot:jtop )
171 _KPP_RL bo ( ibot:itop , jbot:jtop )
172 _KPP_RL bosol ( ibot:itop , jbot:jtop )
173 _KPP_RL shsq ( ibot:itop , jbot:jtop , Nr )
174 _KPP_RL dVsq ( ibot:itop , jbot:jtop , Nr )
175 _KPP_RL dbloc ( ibot:itop , jbot:jtop , Nr )
176 _KPP_RL Ritop ( ibot:itop , jbot:jtop , Nr )
177 _KPP_RL vddiff( ibot:itop , jbot:jtop , 0:Nrp1, mdiff )
178 _KPP_RL ghat ( ibot:itop , jbot:jtop , Nr )
179 _KPP_RL hbl ( ibot:itop , jbot:jtop )
180 #ifdef KPP_ESTIMATE_UREF
181 _KPP_RL z0 ( ibot:itop , jbot:jtop )
182 _KPP_RL zRef ( ibot:itop , jbot:jtop )
183 _KPP_RL uRef ( ibot:itop , jbot:jtop )
184 _KPP_RL vRef ( ibot:itop , jbot:jtop )
185 #endif /* KPP_ESTIMATE_UREF */
186
187 _KPP_RL tempvar2
188 integer i, j, k, kp1, im1, ip1, jm1, jp1
189
190 #ifdef KPP_ESTIMATE_UREF
191 _KPP_RL tempvar1, dBdz1, dBdz2, ustarX, ustarY
192 #endif
193
194 #ifdef ALLOW_AUTODIFF_TAMC
195 act1 = bi - myBxLo(myThid)
196 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
197 act2 = bj - myByLo(myThid)
198 max2 = myByHi(myThid) - myByLo(myThid) + 1
199 act3 = myThid - 1
200 max3 = nTx*nTy
201 act4 = ikey_dynamics - 1
202 ikppkey = (act1 + 1) + act2*max1
203 & + act3*max1*max2
204 & + act4*max1*max2*max3
205 #endif /* ALLOW_AUTODIFF_TAMC */
206
207 c Check to see if new vertical mixing coefficient should be computed now?
208 IF ( DIFFERENT_MULTIPLE(kpp_freq,myTime,myTime-deltaTClock) .OR.
209 1 myTime .EQ. startTime ) THEN
210
211 c-----------------------------------------------------------------------
212 c prepare input arrays for subroutine "kppmix" to compute
213 c viscosity and diffusivity and ghat.
214 c All input arrays need to be in m-k-s units.
215 c
216 c note: for the computation of the bulk richardson number in the
217 c "bldepth" subroutine, gradients of velocity and buoyancy are
218 c required at every depth. in the case of very fine vertical grids
219 c (thickness of top layer < 2m), the surface reference depth must
220 c be set to zref=epsilon/2*zgrid(k), and the reference value
221 c of velocity and buoyancy must be computed as vertical average
222 c between the surface and 2*zref. in the case of coarse vertical
223 c grids zref is zgrid(1)/2., and the surface reference value is
224 c simply the surface value at zgrid(1).
225 c-----------------------------------------------------------------------
226
227 c------------------------------------------------------------------------
228 c density related quantities
229 c --------------------------
230 c
231 c work2 - density of surface layer (kg/m^3)
232 c dbloc - local buoyancy gradient at Nr interfaces
233 c g/rho{k+1,k+1} * [ drho{k,k+1}-drho{k+1,k+1} ] (m/s^2)
234 c dbsfc (stored in Ritop to conserve stack memory)
235 c - buoyancy difference with respect to the surface
236 c g * [ drho{1,k}/rho{1,k} - drho{k,k}/rho{k,k} ] (m/s^2)
237 c ttalpha (stored in vddiff(:,:,:,1) to conserve stack memory)
238 c - thermal expansion coefficient without 1/rho factor
239 c d(rho{k,k})/d(T(k)) (kg/m^3/C)
240 c ssbeta (stored in vddiff(:,:,:,2) to conserve stack memory)
241 c - salt expansion coefficient without 1/rho factor
242 c d(rho{k,k})/d(S(k)) (kg/m^3/PSU)
243 c------------------------------------------------------------------------
244
245 CALL TIMER_START('STATEKPP [KPP_CALC]', myThid)
246 CALL STATEKPP(
247 I bi, bj, myThid
248 O , work2, dbloc, Ritop
249 O , vddiff(ibot,jbot,1,1), vddiff(ibot,jbot,1,2)
250 & )
251 CALL TIMER_STOP ('STATEKPP [KPP_CALC]', myThid)
252
253 DO k = 1, Nr
254 DO j = jbot, jtop
255 DO i = ibot, itop
256 ghat(i,j,k) = dbloc(i,j,k)
257 ENDDO
258 ENDDO
259 ENDDO
260
261 #ifdef KPP_SMOOTH_DBLOC
262 c horizontally smooth dbloc with a 121 filter
263 c smooth dbloc stored in ghat to save space
264 c dbloc(k) is buoyancy gradientnote between k and k+1
265 c levels therefore k+1 mask must be used
266
267 DO k = 1, Nr-1
268 CALL KPP_SMOOTH_HORIZ (
269 I k+1, bi, bj,
270 U ghat (ibot,jbot,k) )
271 ENDDO
272
273 #endif /* KPP_SMOOTH_DBLOC */
274
275 #ifdef KPP_SMOOTH_DENS
276 c horizontally smooth density related quantities with 121 filters
277 CALL KPP_SMOOTH_HORIZ (
278 I 1, bi, bj,
279 U work2 )
280 DO k = 1, Nr
281 CALL KPP_SMOOTH_HORIZ (
282 I k+1, bi, bj,
283 U dbloc (ibot,jbot,k) )
284 CALL KPP_SMOOTH_HORIZ (
285 I k, bi, bj,
286 U Ritop (ibot,jbot,k) )
287 CALL KPP_SMOOTH_HORIZ (
288 I k, bi, bj,
289 U vddiff(ibot,jbot,k,1) )
290 CALL KPP_SMOOTH_HORIZ (
291 I k, bi, bj,
292 U vddiff(ibot,jbot,k,2) )
293 ENDDO
294 #endif /* KPP_SMOOTH_DENS */
295
296 DO k = 1, Nr
297 DO j = jbot, jtop
298 DO i = ibot, itop
299
300 c zero out dbloc over land points (so that the convective
301 c part of the interior mixing can be diagnosed)
302 dbloc(i,j,k) = dbloc(i,j,k) * pMask(i,j,k,bi,bj)
303 ghat(i,j,k) = ghat(i,j,k) * pMask(i,j,k,bi,bj)
304 Ritop(i,j,k) = Ritop(i,j,k) * pMask(i,j,k,bi,bj)
305 if(k.eq.nzmax(i,j,bi,bj)) then
306 dbloc(i,j,k) = p0
307 ghat(i,j,k) = p0
308 Ritop(i,j,k) = p0
309 endif
310
311 c numerator of bulk richardson number on grid levels
312 c note: land and ocean bottom values need to be set to zero
313 c so that the subroutine "bldepth" works correctly
314 Ritop(i,j,k) = (zgrid(1)-zgrid(k)) * Ritop(i,j,k)
315
316 END DO
317 END DO
318 END DO
319
320 cph(
321 cph this avoids a single or double recomp./call of statekpp
322 CADJ store work2 = comlev1_kpp, key = ikppkey
323 #ifdef ALLOW_AUTODIFF_KPP_EXTENSIVE_STORE
324 CADJ store dbloc, Ritop, ghat = comlev1_kpp, key = ikppkey
325 CADJ store vddiff = comlev1_kpp, key = ikppkey
326 #endif
327 cph)
328
329 c------------------------------------------------------------------------
330 c friction velocity, turbulent and radiative surface buoyancy forcing
331 c -------------------------------------------------------------------
332 c taux / rho = SurfaceTendencyU * drF(1) (N/m^2)
333 c tauy / rho = SurfaceTendencyV * drF(1) (N/m^2)
334 c ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho ) (m/s)
335 c bo = - g * ( alpha*SurfaceTendencyT +
336 c beta *SurfaceTendencyS ) * drF(1) / rho (m^2/s^3)
337 c bosol = - g * alpha * Qsw * drF(1) / rho (m^2/s^3)
338 c------------------------------------------------------------------------
339
340 c initialize arrays to zero
341 DO j = jbot, jtop
342 DO i = ibot, itop
343 ustar(i,j) = p0
344 bo (I,J) = p0
345 bosol(I,J) = p0
346 END DO
347 END DO
348
349 DO j = jmin, jmax
350 jp1 = j + 1
351 DO i = imin, imax
352 ip1 = i+1
353 work3(i,j) =
354 & (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) *
355 & (SurfaceTendencyU(i,j,bi,bj) + SurfaceTendencyU(ip1,j,bi,bj)) +
356 & (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj)) *
357 & (SurfaceTendencyV(i,j,bi,bj) + SurfaceTendencyV(i,jp1,bi,bj))
358 END DO
359 END DO
360 cph(
361 CADJ store work3 = comlev1_kpp, key = ikppkey
362 cph)
363 DO j = jmin, jmax
364 jp1 = j + 1
365 DO i = imin, imax
366 ip1 = i+1
367
368 if ( work3(i,j) .lt. (phepsi*phepsi) ) then
369 ustar(i,j) = SQRT( phepsi * p5 * drF(1) )
370 else
371 tempVar2 = SQRT( work3(i,j) ) * p5 * drF(1)
372 ustar(i,j) = SQRT( tempVar2 )
373 endif
374
375 if ( .NOT. useSEAICE )
376 & bo(I,J) = - gravity *
377 & ( vddiff(I,J,1,1) * SurfaceTendencyT(i,j,bi,bj) +
378 & vddiff(I,J,1,2) * SurfaceTendencyS(i,j,bi,bj)
379 & ) *
380 & drF(1) / work2(I,J)
381
382 #ifdef ALLOW_SEAICE
383 if ( useSEAICE )
384 & bo(I,J) = - gravity *
385 & ( vddiff(I,J,1,1) * (SurfaceTendencyT(i,j,bi,bj)+
386 & SurfaceTendencyTice(i,j,bi,bj)) +
387 & vddiff(I,J,1,2) * SurfaceTendencyS(i,j,bi,bj)
388 & ) *
389 & drF(1) / work2(I,J)
390 #endif ALLOW_SEAICE
391
392 bosol(I,J) = gravity * vddiff(I,J,1,1) * Qsw(i,j,bi,bj) *
393 & recip_Cp*recip_rhoConst*recip_dRf(1) *
394 & drF(1) / work2(I,J)
395
396 END DO
397 END DO
398
399 cph(
400 CADJ store ustar = comlev1_kpp, key = ikppkey
401 cph)
402
403 c------------------------------------------------------------------------
404 c velocity shear
405 c --------------
406 c Get velocity shear squared, averaged from "u,v-grid"
407 c onto "t-grid" (in (m/s)**2):
408 c dVsq(k)=(Uref-U(k))**2+(Vref-V(k))**2 at grid levels
409 c shsq(k)=(U(k)-U(k+1))**2+(V(k)-V(k+1))**2 at interfaces
410 c------------------------------------------------------------------------
411
412 c initialize arrays to zero
413 DO k = 1, Nr
414 DO j = jbot, jtop
415 DO i = ibot, itop
416 shsq(i,j,k) = p0
417 dVsq(i,j,k) = p0
418 END DO
419 END DO
420 END DO
421
422 c dVsq computation
423
424 #ifdef KPP_ESTIMATE_UREF
425
426 c Get rid of vertical resolution dependence of dVsq term by
427 c estimating a surface velocity that is independent of first level
428 c thickness in the model. First determine mixed layer depth hMix.
429 c Second zRef = espilon * hMix. Third determine roughness length
430 c scale z0. Third estimate reference velocity.
431
432 DO j = jmin, jmax
433 jp1 = j + 1
434 DO i = imin, imax
435 ip1 = i + 1
436
437 c Determine mixed layer depth hMix as the shallowest depth at which
438 c dB/dz exceeds 5.2e-5 s^-2.
439 work1(i,j) = nzmax(i,j,bi,bj)
440 DO k = 1, Nr
441 IF ( k .LT. nzmax(i,j,bi,bj) .AND.
442 & dbloc(i,j,k) / drC(k+1) .GT. dB_dz )
443 & work1(i,j) = k
444 END DO
445
446 c Linearly interpolate to find hMix.
447 k = work1(i,j)
448 IF ( k .EQ. 0 .OR. nzmax(i,j,bi,bj) .EQ. 1 ) THEN
449 zRef(i,j) = p0
450 ELSEIF ( k .EQ. 1) THEN
451 dBdz2 = dbloc(i,j,1) / drC(2)
452 zRef(i,j) = drF(1) * dB_dz / dBdz2
453 ELSEIF ( k .LT. nzmax(i,j,bi,bj) ) THEN
454 dBdz1 = dbloc(i,j,k-1) / drC(k )
455 dBdz2 = dbloc(i,j,k ) / drC(k+1)
456 zRef(i,j) = rF(k) + drF(k) * (dB_dz - dBdz1) /
457 & MAX ( phepsi, dBdz2 - dBdz1 )
458 ELSE
459 zRef(i,j) = rF(k+1)
460 ENDIF
461
462 c Compute roughness length scale z0 subject to 0 < z0
463 tempVar1 = p5 * (
464 & (uVel(i, j, 1,bi,bj)-uVel(i, j, 2,bi,bj)) *
465 & (uVel(i, j, 1,bi,bj)-uVel(i, j, 2,bi,bj)) +
466 & (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, 2,bi,bj)) *
467 & (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, 2,bi,bj)) +
468 & (vVel(i, j, 1,bi,bj)-vVel(i, j, 2,bi,bj)) *
469 & (vVel(i, j, 1,bi,bj)-vVel(i, j, 2,bi,bj)) +
470 & (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,2,bi,bj)) *
471 & (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,2,bi,bj)) )
472 if ( tempVar1 .lt. (epsln*epsln) ) then
473 tempVar2 = epsln
474 else
475 tempVar2 = SQRT ( tempVar1 )
476 endif
477 z0(i,j) = rF(2) *
478 & ( rF(3) * LOG ( rF(3) / rF(2) ) /
479 & ( rF(3) - rF(2) ) -
480 & tempVar2 * vonK /
481 & MAX ( ustar(i,j), phepsi ) )
482 z0(i,j) = MAX ( z0(i,j), phepsi )
483
484 c zRef is set to 0.1 * hMix subject to z0 <= zRef <= drF(1)
485 zRef(i,j) = MAX ( epsilon * zRef(i,j), z0(i,j) )
486 zRef(i,j) = MIN ( zRef(i,j), drF(1) )
487
488 c Estimate reference velocity uRef and vRef.
489 uRef(i,j) = p5 *
490 & ( uVel(i,j,1,bi,bj) + uVel(ip1,j,1,bi,bj) )
491 vRef(i,j) = p5 *
492 & ( vVel(i,j,1,bi,bj) + vVel(i,jp1,1,bi,bj) )
493 IF ( zRef(i,j) .LT. drF(1) ) THEN
494 ustarX = ( SurfaceTendencyU(i, j,bi,bj) +
495 & SurfaceTendencyU(ip1,j,bi,bj) ) * p5
496 ustarY = ( SurfaceTendencyV(i,j, bi,bj) +
497 & SurfaceTendencyU(i,jp1,bi,bj) ) * p5
498 tempVar1 = ustarX * ustarX + ustarY * ustarY
499 if ( tempVar1 .lt. (epsln*epsln) ) then
500 tempVar2 = epsln
501 else
502 tempVar2 = SQRT ( tempVar1 )
503 endif
504 tempVar2 = ustar(i,j) *
505 & ( LOG ( zRef(i,j) / rF(2) ) +
506 & z0(i,j) / zRef(i,j) - z0(i,j) / rF(2) ) /
507 & vonK / tempVar2
508 uRef(i,j) = uRef(i,j) + ustarX * tempVar2
509 vRef(i,j) = vRef(i,j) + ustarY * tempVar2
510 ENDIF
511
512 END DO
513 END DO
514
515 DO k = 1, Nr
516 DO j = jmin, jmax
517 jm1 = j - 1
518 jp1 = j + 1
519 DO i = imin, imax
520 im1 = i - 1
521 ip1 = i + 1
522 dVsq(i,j,k) = p5 * (
523 $ (uRef(i,j) - uVel(i, j, k,bi,bj)) *
524 $ (uRef(i,j) - uVel(i, j, k,bi,bj)) +
525 $ (uRef(i,j) - uVel(ip1,j, k,bi,bj)) *
526 $ (uRef(i,j) - uVel(ip1,j, k,bi,bj)) +
527 $ (vRef(i,j) - vVel(i, j, k,bi,bj)) *
528 $ (vRef(i,j) - vVel(i, j, k,bi,bj)) +
529 $ (vRef(i,j) - vVel(i, jp1,k,bi,bj)) *
530 $ (vRef(i,j) - vVel(i, jp1,k,bi,bj)) )
531 #ifdef KPP_SMOOTH_DVSQ
532 dVsq(i,j,k) = p5 * dVsq(i,j,k) + p125 * (
533 $ (uRef(i,j) - uVel(i, jm1,k,bi,bj)) *
534 $ (uRef(i,j) - uVel(i, jm1,k,bi,bj)) +
535 $ (uRef(i,j) - uVel(ip1,jm1,k,bi,bj)) *
536 $ (uRef(i,j) - uVel(ip1,jm1,k,bi,bj)) +
537 $ (uRef(i,j) - uVel(i, jp1,k,bi,bj)) *
538 $ (uRef(i,j) - uVel(i, jp1,k,bi,bj)) +
539 $ (uRef(i,j) - uVel(ip1,jp1,k,bi,bj)) *
540 $ (uRef(i,j) - uVel(ip1,jp1,k,bi,bj)) +
541 $ (vRef(i,j) - vVel(im1,j, k,bi,bj)) *
542 $ (vRef(i,j) - vVel(im1,j, k,bi,bj)) +
543 $ (vRef(i,j) - vVel(im1,jp1,k,bi,bj)) *
544 $ (vRef(i,j) - vVel(im1,jp1,k,bi,bj)) +
545 $ (vRef(i,j) - vVel(ip1,j, k,bi,bj)) *
546 $ (vRef(i,j) - vVel(ip1,j, k,bi,bj)) +
547 $ (vRef(i,j) - vVel(ip1,jp1,k,bi,bj)) *
548 $ (vRef(i,j) - vVel(ip1,jp1,k,bi,bj)) )
549 #endif /* KPP_SMOOTH_DVSQ */
550 END DO
551 END DO
552 END DO
553
554 #else /* KPP_ESTIMATE_UREF */
555
556 DO k = 1, Nr
557 DO j = jmin, jmax
558 jm1 = j - 1
559 jp1 = j + 1
560 DO i = imin, imax
561 im1 = i - 1
562 ip1 = i + 1
563 dVsq(i,j,k) = p5 * (
564 $ (uVel(i, j, 1,bi,bj)-uVel(i, j, k,bi,bj)) *
565 $ (uVel(i, j, 1,bi,bj)-uVel(i, j, k,bi,bj)) +
566 $ (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, k,bi,bj)) *
567 $ (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, k,bi,bj)) +
568 $ (vVel(i, j, 1,bi,bj)-vVel(i, j, k,bi,bj)) *
569 $ (vVel(i, j, 1,bi,bj)-vVel(i, j, k,bi,bj)) +
570 $ (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,k,bi,bj)) *
571 $ (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,k,bi,bj)) )
572 #ifdef KPP_SMOOTH_DVSQ
573 dVsq(i,j,k) = p5 * dVsq(i,j,k) + p125 * (
574 $ (uVel(i, jm1,1,bi,bj)-uVel(i, jm1,k,bi,bj)) *
575 $ (uVel(i, jm1,1,bi,bj)-uVel(i, jm1,k,bi,bj)) +
576 $ (uVel(ip1,jm1,1,bi,bj)-uVel(ip1,jm1,k,bi,bj)) *
577 $ (uVel(ip1,jm1,1,bi,bj)-uVel(ip1,jm1,k,bi,bj)) +
578 $ (uVel(i, jp1,1,bi,bj)-uVel(i, jp1,k,bi,bj)) *
579 $ (uVel(i, jp1,1,bi,bj)-uVel(i, jp1,k,bi,bj)) +
580 $ (uVel(ip1,jp1,1,bi,bj)-uVel(ip1,jp1,k,bi,bj)) *
581 $ (uVel(ip1,jp1,1,bi,bj)-uVel(ip1,jp1,k,bi,bj)) +
582 $ (vVel(im1,j, 1,bi,bj)-vVel(im1,j, k,bi,bj)) *
583 $ (vVel(im1,j, 1,bi,bj)-vVel(im1,j, k,bi,bj)) +
584 $ (vVel(im1,jp1,1,bi,bj)-vVel(im1,jp1,k,bi,bj)) *
585 $ (vVel(im1,jp1,1,bi,bj)-vVel(im1,jp1,k,bi,bj)) +
586 $ (vVel(ip1,j, 1,bi,bj)-vVel(ip1,j, k,bi,bj)) *
587 $ (vVel(ip1,j, 1,bi,bj)-vVel(ip1,j, k,bi,bj)) +
588 $ (vVel(ip1,jp1,1,bi,bj)-vVel(ip1,jp1,k,bi,bj)) *
589 $ (vVel(ip1,jp1,1,bi,bj)-vVel(ip1,jp1,k,bi,bj)) )
590 #endif /* KPP_SMOOTH_DVSQ */
591 END DO
592 END DO
593 END DO
594
595 #endif /* KPP_ESTIMATE_UREF */
596
597 c shsq computation
598 DO k = 1, Nrm1
599 kp1 = k + 1
600 DO j = jmin, jmax
601 jm1 = j - 1
602 jp1 = j + 1
603 DO i = imin, imax
604 im1 = i - 1
605 ip1 = i + 1
606 shsq(i,j,k) = p5 * (
607 $ (uVel(i, j, k,bi,bj)-uVel(i, j, kp1,bi,bj)) *
608 $ (uVel(i, j, k,bi,bj)-uVel(i, j, kp1,bi,bj)) +
609 $ (uVel(ip1,j, k,bi,bj)-uVel(ip1,j, kp1,bi,bj)) *
610 $ (uVel(ip1,j, k,bi,bj)-uVel(ip1,j, kp1,bi,bj)) +
611 $ (vVel(i, j, k,bi,bj)-vVel(i, j, kp1,bi,bj)) *
612 $ (vVel(i, j, k,bi,bj)-vVel(i, j, kp1,bi,bj)) +
613 $ (vVel(i, jp1,k,bi,bj)-vVel(i, jp1,kp1,bi,bj)) *
614 $ (vVel(i, jp1,k,bi,bj)-vVel(i, jp1,kp1,bi,bj)) )
615 #ifdef KPP_SMOOTH_SHSQ
616 shsq(i,j,k) = p5 * shsq(i,j,k) + p125 * (
617 $ (uVel(i, jm1,k,bi,bj)-uVel(i, jm1,kp1,bi,bj)) *
618 $ (uVel(i, jm1,k,bi,bj)-uVel(i, jm1,kp1,bi,bj)) +
619 $ (uVel(ip1,jm1,k,bi,bj)-uVel(ip1,jm1,kp1,bi,bj)) *
620 $ (uVel(ip1,jm1,k,bi,bj)-uVel(ip1,jm1,kp1,bi,bj)) +
621 $ (uVel(i, jp1,k,bi,bj)-uVel(i, jp1,kp1,bi,bj)) *
622 $ (uVel(i, jp1,k,bi,bj)-uVel(i, jp1,kp1,bi,bj)) +
623 $ (uVel(ip1,jp1,k,bi,bj)-uVel(ip1,jp1,kp1,bi,bj)) *
624 $ (uVel(ip1,jp1,k,bi,bj)-uVel(ip1,jp1,kp1,bi,bj)) +
625 $ (vVel(im1,j, k,bi,bj)-vVel(im1,j, kp1,bi,bj)) *
626 $ (vVel(im1,j, k,bi,bj)-vVel(im1,j, kp1,bi,bj)) +
627 $ (vVel(im1,jp1,k,bi,bj)-vVel(im1,jp1,kp1,bi,bj)) *
628 $ (vVel(im1,jp1,k,bi,bj)-vVel(im1,jp1,kp1,bi,bj)) +
629 $ (vVel(ip1,j, k,bi,bj)-vVel(ip1,j, kp1,bi,bj)) *
630 $ (vVel(ip1,j, k,bi,bj)-vVel(ip1,j, kp1,bi,bj)) +
631 $ (vVel(ip1,jp1,k,bi,bj)-vVel(ip1,jp1,kp1,bi,bj)) *
632 $ (vVel(ip1,jp1,k,bi,bj)-vVel(ip1,jp1,kp1,bi,bj)) )
633 #endif
634 END DO
635 END DO
636 END DO
637
638 cph(
639 #ifdef ALLOW_AUTODIFF_KPP_EXTENSIVE_STORE
640 CADJ store dvsq, shsq = comlev1_kpp, key = ikppkey
641 #endif
642 cph)
643
644 c-----------------------------------------------------------------------
645 c solve for viscosity, diffusivity, ghat, and hbl on "t-grid"
646 c-----------------------------------------------------------------------
647
648 DO j = jbot, jtop
649 DO i = ibot, itop
650 work1(i,j) = nzmax(i,j,bi,bj)
651 work2(i,j) = Fcori(i,j,bi,bj)
652 END DO
653 END DO
654 CALL TIMER_START('KPPMIX [KPP_CALC]', myThid)
655 CALL KPPMIX (
656 I mytime, mythid
657 I , work1, shsq, dVsq, ustar
658 I , bo, bosol, dbloc, Ritop, work2
659 I , ikppkey
660 O , vddiff
661 U , ghat
662 O , hbl )
663
664 CALL TIMER_STOP ('KPPMIX [KPP_CALC]', myThid)
665
666 c-----------------------------------------------------------------------
667 c zero out land values and transfer to global variables
668 c-----------------------------------------------------------------------
669
670 DO j = jmin, jmax
671 DO i = imin, imax
672 DO k = 1, Nr
673 KPPviscAz(i,j,k,bi,bj) = vddiff(i,j,k-1,1) * pMask(i,j,k,bi,bj)
674 KPPdiffKzS(i,j,k,bi,bj)= vddiff(i,j,k-1,2) * pMask(i,j,k,bi,bj)
675 KPPdiffKzT(i,j,k,bi,bj)= vddiff(i,j,k-1,3) * pMask(i,j,k,bi,bj)
676 KPPghat(i,j,k,bi,bj) = ghat(i,j,k) * pMask(i,j,k,bi,bj)
677 END DO
678 KPPhbl(i,j,bi,bj) = hbl(i,j) * pMask(i,j,1,bi,bj)
679 END DO
680 END DO
681 #ifdef FRUGAL_KPP
682 _EXCH_XYZ_R8(KPPviscAz , myThid )
683 _EXCH_XYZ_R8(KPPdiffKzS , myThid )
684 _EXCH_XYZ_R8(KPPdiffKzT , myThid )
685 _EXCH_XYZ_R8(KPPghat , myThid )
686 _EXCH_XY_R8 (KPPhbl , myThid )
687 #endif
688
689 #ifdef KPP_SMOOTH_VISC
690 c horizontal smoothing of vertical viscosity
691 DO k = 1, Nr
692 CALL SMOOTH_HORIZ (
693 I k, bi, bj,
694 U KPPviscAz(1-OLx,1-OLy,k,bi,bj) )
695 END DO
696 _EXCH_XYZ_R8(KPPviscAz , myThid )
697 #endif /* KPP_SMOOTH_VISC */
698
699 #ifdef KPP_SMOOTH_DIFF
700 c horizontal smoothing of vertical diffusivity
701 DO k = 1, Nr
702 CALL SMOOTH_HORIZ (
703 I k, bi, bj,
704 U KPPdiffKzS(1-OLx,1-OLy,k,bi,bj) )
705 CALL SMOOTH_HORIZ (
706 I k, bi, bj,
707 U KPPdiffKzT(1-OLx,1-OLy,k,bi,bj) )
708 END DO
709 _EXCH_XYZ_R8(KPPdiffKzS , myThid )
710 _EXCH_XYZ_R8(KPPdiffKzT , myThid )
711 #endif /* KPP_SMOOTH_DIFF */
712
713 cph(
714 cph crucial: this avoids full recomp./call of kppmix
715 CADJ store KPPhbl = comlev1_kpp, key = ikppkey
716 cph)
717
718 C Compute fraction of solar short-wave flux penetrating to
719 C the bottom of the mixing layer.
720 DO j=1-OLy,sNy+OLy
721 DO i=1-OLx,sNx+OLx
722 worka(i,j) = KPPhbl(i,j,bi,bj)
723 ENDDO
724 ENDDO
725 CALL SWFRAC(
726 I (sNx+2*OLx)*(sNy+2*OLy), minusone,
727 I mytime, mythid,
728 U worka )
729 DO j=1-OLy,sNy+OLy
730 DO i=1-OLx,sNx+OLx
731 KPPfrac(i,j,bi,bj) = worka(i,j)
732 ENDDO
733 ENDDO
734
735 ENDIF
736
737 #endif /* ALLOW_KPP */
738
739 RETURN
740 END
741
742 subroutine KPP_CALC_DUMMY(
743 I bi, bj, myTime, myThid )
744 C /==========================================================\
745 C | SUBROUTINE KPP_CALC_DUMMY |
746 C | o Compute all KPP fields defined in KPP.h |
747 C | o Dummy routine for TAMC
748 C |==========================================================|
749 C | This subroutine serves as an interface between MITGCMUV |
750 C | code and NCOM 1-D routines in kpp_routines.F |
751 C \==========================================================/
752 IMPLICIT NONE
753
754 #include "SIZE.h"
755 #include "EEPARAMS.h"
756 #include "PARAMS.h"
757 #include "KPP.h"
758 #include "KPP_PARAMS.h"
759 #include "GRID.h"
760
761 c Routine arguments
762 c bi, bj - array indices on which to apply calculations
763 c myTime - Current time in simulation
764
765 INTEGER bi, bj
766 INTEGER myThid
767 _RL myTime
768
769 #ifdef ALLOW_KPP
770
771 c Local constants
772 integer i, j, k
773
774 DO j=1-OLy,sNy+OLy
775 DO i=1-OLx,sNx+OLx
776 KPPhbl (i,j,bi,bj) = 1.0
777 KPPfrac(i,j,bi,bj) = 0.0
778 DO k = 1,Nr
779 KPPghat (i,j,k,bi,bj) = 0.0
780 KPPviscAz (i,j,k,bi,bj) = viscAz
781 KPPdiffKzT(i,j,k,bi,bj) = diffKzT
782 KPPdiffKzS(i,j,k,bi,bj) = diffKzS
783 ENDDO
784 ENDDO
785 ENDDO
786
787 #endif
788 RETURN
789 END

  ViewVC Help
Powered by ViewVC 1.1.22