9 use mom_cpu_clock,
only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
24 implicit none ;
private
26 #include <MOM_memory.h>
33 real,
dimension(:,:),
pointer :: equilibrium_value => null()
43 real :: meke_min_gamma
46 logical :: meke_geometric
48 real :: meke_geometric_alpha
50 logical :: meke_equilibrium_alt
56 logical :: rd_as_max_scale
58 logical :: use_old_lscale
59 logical :: use_min_lscale
69 real :: viscosity_coeff_ku
72 real :: viscosity_coeff_au
81 real :: meke_advection_factor
82 real :: meke_topographic_beta
84 real :: meke_restoring_rate
86 logical :: kh_flux_enabled
92 integer :: id_meke = -1, id_ue = -1, id_kh = -1, id_src = -1
93 integer :: id_ub = -1, id_ut = -1
94 integer :: id_gm_src = -1, id_mom_src = -1, id_gme_snk = -1, id_decay = -1
95 integer :: id_khmeke_u = -1, id_khmeke_v = -1, id_ku = -1, id_au = -1
96 integer :: id_le = -1, id_gamma_b = -1, id_gamma_t = -1
97 integer :: id_lrhines = -1, id_leady = -1
98 integer :: id_meke_equilibrium = -1
102 integer :: id_clock_pass
103 type(group_pass_type) :: pass_meke
104 type(group_pass_type) :: pass_kh
111 subroutine step_forward_meke(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, hv)
116 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
117 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: sn_u
118 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: sn_v
120 real,
intent(in) :: dt
122 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)),
intent(in) :: hu
123 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)),
intent(in) :: hv
126 real,
dimension(SZI_(G),SZJ_(G)) :: &
142 real,
dimension(SZIB_(G),SZJ_(G)) :: &
149 real,
dimension(SZI_(G),SZJB_(G)) :: &
167 logical :: use_drag_rate
168 integer :: i, j, k, is, ie, js, je, isq, ieq, jsq, jeq, nz
170 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
171 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
173 if (.not.
associated(cs))
call mom_error(fatal, &
174 "MOM_MEKE: Module must be initialized before it is used.")
175 if (.not.
associated(meke))
call mom_error(fatal, &
176 "MOM_MEKE: MEKE must be initialized before it is used.")
178 if ((cs%MEKE_damping > 0.0) .or. (cs%MEKE_Cd_scale > 0.0) .or. (cs%MEKE_Cb>0.) &
179 .or. cs%visc_drag)
then
180 use_drag_rate = .true.
182 use_drag_rate = .false.
186 if (.not.
associated(meke%MEKE))
then
192 if (
associated(meke%mom_src)) &
193 call hchksum(meke%mom_src,
'MEKE mom_src', g%HI, scale=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
194 if (
associated(meke%GME_snk)) &
195 call hchksum(meke%GME_snk,
'MEKE GME_snk', g%HI, scale=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
196 if (
associated(meke%GM_src)) &
197 call hchksum(meke%GM_src,
'MEKE GM_src', g%HI, scale=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
198 if (
associated(meke%MEKE))
call hchksum(meke%MEKE,
'MEKE MEKE', g%HI, scale=us%L_T_to_m_s**2)
199 call uvchksum(
"MEKE SN_[uv]", sn_u, sn_v, g%HI, scale=us%s_to_T)
200 call uvchksum(
"MEKE h[uv]", hu, hv, g%HI, haloshift=1, scale=gv%H_to_m*us%L_to_m**2)
203 sdt = dt*cs%MEKE_dtScale
205 mass_neglect = gv%H_to_RZ * gv%H_subroundoff
210 sdt_damp = sdt ;
if (cs%MEKE_KH >= 0.0 .or. cs%MEKE_K4 >= 0.) sdt_damp = 0.5*sdt
213 if (cs%MEKE_advection_factor>0.)
then
214 do j=js,je ;
do i=is-1,ie
218 do j=js,je ;
do i=is-1,ie
219 barohu(i,j) = hu(i,j,k) * gv%H_to_RZ
222 do j=js-1,je ;
do i=is,ie
226 do j=js-1,je ;
do i=is,ie
227 barohv(i,j) = hv(i,j,k) * gv%H_to_RZ
232 if (cs%MEKE_Cd_scale == 0.0 .and. .not. cs%visc_drag)
then
234 do j=js,je ;
do i=is,ie
235 drag_rate(i,j) = 0. ; drag_rate_j15(i,j) = 0.
240 if (cs%visc_drag)
then
242 do j=js,je ;
do i=is-1,ie
243 drag_vel_u(i,j) = 0.0
244 if ((g%mask2dCu(i,j) > 0.0) .and. (visc%bbl_thick_u(i,j) > 0.0)) &
245 drag_vel_u(i,j) = visc%Kv_bbl_u(i,j) / visc%bbl_thick_u(i,j)
248 do j=js-1,je ;
do i=is,ie
249 drag_vel_v(i,j) = 0.0
250 if ((g%mask2dCv(i,j) > 0.0) .and. (visc%bbl_thick_v(i,j) > 0.0)) &
251 drag_vel_v(i,j) = visc%Kv_bbl_v(i,j) / visc%bbl_thick_v(i,j)
255 do j=js,je ;
do i=is,ie
256 drag_rate_visc(i,j) = (0.25*g%IareaT(i,j) * us%Z_to_L * &
257 ((g%areaCu(i-1,j)*drag_vel_u(i-1,j) + &
258 g%areaCu(i,j)*drag_vel_u(i,j)) + &
259 (g%areaCv(i,j-1)*drag_vel_v(i,j-1) + &
260 g%areaCv(i,j)*drag_vel_v(i,j)) ) )
264 do j=js,je ;
do i=is,ie
265 drag_rate_visc(i,j) = 0.
271 do i=is-1,ie+1 ; mass(i,j) = 0.0 ;
enddo
272 do k=1,nz ;
do i=is-1,ie+1
273 mass(i,j) = mass(i,j) + g%mask2dT(i,j) * (gv%H_to_RZ * h(i,j,k))
277 if (mass(i,j) > 0.0) i_mass(i,j) = 1.0 / mass(i,j)
281 if (cs%initialize)
then
282 call meke_equilibrium(cs, meke, g, gv, us, sn_u, sn_v, drag_rate_visc, i_mass)
283 cs%initialize = .false.
287 call meke_lengthscales(cs, meke, g, gv, us, sn_u, sn_v, meke%MEKE, bottomfac2, barotrfac2, lmixscale)
289 call uvchksum(
"MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, g%HI, scale=us%Z_to_m*us%s_to_T)
290 call hchksum(mass,
'MEKE mass',g%HI,haloshift=1, scale=us%R_to_kg_m3*us%Z_to_m)
291 call hchksum(drag_rate_visc,
'MEKE drag_rate_visc', g%HI, scale=us%L_T_to_m_s)
292 call hchksum(bottomfac2,
'MEKE bottomFac2', g%HI)
293 call hchksum(barotrfac2,
'MEKE barotrFac2', g%HI)
294 call hchksum(lmixscale,
'MEKE LmixScale', g%HI,scale=us%L_to_m)
299 do j=js,je ;
do i=is,ie
300 src(i,j) = cs%MEKE_BGsrc
303 if (
associated(meke%mom_src))
then
305 do j=js,je ;
do i=is,ie
306 src(i,j) = src(i,j) - cs%MEKE_FrCoeff*i_mass(i,j)*meke%mom_src(i,j)
310 if (
associated(meke%GME_snk))
then
312 do j=js,je ;
do i=is,ie
313 src(i,j) = src(i,j) - cs%MEKE_GMECoeff*i_mass(i,j)*meke%GME_snk(i,j)
317 if (
associated(meke%GM_src))
then
318 if (cs%GM_src_alt)
then
320 do j=js,je ;
do i=is,ie
321 src(i,j) = src(i,j) - cs%MEKE_GMcoeff*meke%GM_src(i,j) / &
322 (gv%Rho0 * max(1.0*us%m_to_Z, g%bathyT(i,j)))
326 do j=js,je ;
do i=is,ie
327 src(i,j) = src(i,j) - cs%MEKE_GMcoeff*i_mass(i,j)*meke%GM_src(i,j)
332 if (cs%MEKE_equilibrium_restoring)
then
334 do j=js,je ;
do i=is,ie
335 src(i,j) = src(i,j) - cs%MEKE_restoring_rate*(meke%MEKE(i,j) - cs%equilibrium_value(i,j))
341 do j=js,je ;
do i=is,ie
342 meke%MEKE(i,j) = (meke%MEKE(i,j) + sdt*src(i,j))*g%mask2dT(i,j)
345 if (use_drag_rate)
then
348 do j=js,je ;
do i=is,ie
349 drag_rate(i,j) = (us%L_to_Z*rho0 * i_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
350 cdrag2 * ( max(0.0, 2.0*bottomfac2(i,j)*meke%MEKE(i,j)) + cs%MEKE_Uscale**2 ) )
356 do j=js,je ;
do i=is,ie
357 ldamping = cs%MEKE_damping + drag_rate(i,j) * bottomfac2(i,j)
358 if (meke%MEKE(i,j) < 0.) ldamping = 0.
361 meke%MEKE(i,j) = meke%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
362 meke_decay(i,j) = ldamping*g%mask2dT(i,j)
365 if (cs%kh_flux_enabled .or. cs%MEKE_K4 >= 0.0)
then
367 call cpu_clock_begin(cs%id_clock_pass)
369 call cpu_clock_end(cs%id_clock_pass)
372 if (cs%MEKE_K4 >= 0.0)
then
375 do j=js-1,je+1 ;
do i=is-2,ie+1
377 meke_uflux(i,j) = ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * g%mask2dCu(i,j)) * &
378 (meke%MEKE(i+1,j) - meke%MEKE(i,j))
385 do j=js-2,je+1 ;
do i=is-1,ie+1
387 meke_vflux(i,j) = ((g%dx_Cv(i,j)*g%IdyCv(i,j)) * g%mask2dCv(i,j)) * &
388 (meke%MEKE(i,j+1) - meke%MEKE(i,j))
396 do j=js-1,je+1 ;
do i=is-1,ie+1
397 del2meke(i,j) = g%IareaT(i,j) * &
398 ((meke_uflux(i,j) - meke_uflux(i-1,j)) + (meke_vflux(i,j) - meke_vflux(i,j-1)))
403 do j=js,je ;
do i=is-1,ie
406 inv_k4_max = 64.0 * sdt * ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * &
407 max(g%IareaT(i,j), g%IareaT(i+1,j)))**2
408 if (k4_here*inv_k4_max > 0.3) k4_here = 0.3 / inv_k4_max
411 meke_uflux(i,j) = ((k4_here * (g%dy_Cu(i,j)*g%IdxCu(i,j))) * &
412 ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * &
413 (del2meke(i+1,j) - del2meke(i,j))
416 do j=js-1,je ;
do i=is,ie
418 inv_k4_max = 64.0 * sdt * ((g%dx_Cv(i,j)*g%IdyCv(i,j)) * max(g%IareaT(i,j), g%IareaT(i,j+1)))**2
419 if (k4_here*inv_k4_max > 0.3) k4_here = 0.3 / inv_k4_max
422 meke_vflux(i,j) = ((k4_here * (g%dx_Cv(i,j)*g%IdyCv(i,j))) * &
423 ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * &
424 (del2meke(i,j+1) - del2meke(i,j))
428 do j=js,je ;
do i=is,ie
429 del4meke(i,j) = (sdt*(g%IareaT(i,j)*i_mass(i,j))) * &
430 ((meke_uflux(i-1,j) - meke_uflux(i,j)) + &
431 (meke_vflux(i,j-1) - meke_vflux(i,j)))
435 if (cs%kh_flux_enabled)
then
437 kh_here = max(0., cs%MEKE_Kh)
439 do j=js,je ;
do i=is-1,ie
441 if (
associated(meke%Kh)) &
442 kh_here = max(0., cs%MEKE_Kh) + &
443 cs%KhMEKE_Fac*0.5*(meke%Kh(i,j)+meke%Kh(i+1,j))
444 if (
associated(meke%Kh_diff)) &
445 kh_here = max(0.,cs%MEKE_Kh) + &
446 cs%KhMEKE_Fac*0.5*(meke%Kh_diff(i,j)+meke%Kh_diff(i+1,j))
447 inv_kh_max = 2.0*sdt * ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * &
448 max(g%IareaT(i,j),g%IareaT(i+1,j)))
449 if (kh_here*inv_kh_max > 0.25) kh_here = 0.25 / inv_kh_max
453 meke_uflux(i,j) = ((kh_here * (g%dy_Cu(i,j)*g%IdxCu(i,j))) * &
454 ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * &
455 (meke%MEKE(i,j) - meke%MEKE(i+1,j))
458 do j=js-1,je ;
do i=is,ie
459 if (
associated(meke%Kh)) &
460 kh_here = max(0.,cs%MEKE_Kh) + cs%KhMEKE_Fac * 0.5*(meke%Kh(i,j)+meke%Kh(i,j+1))
461 if (
associated(meke%Kh_diff)) &
462 kh_here = max(0.,cs%MEKE_Kh) + cs%KhMEKE_Fac * 0.5*(meke%Kh_diff(i,j)+meke%Kh_diff(i,j+1))
463 inv_kh_max = 2.0*sdt * ((g%dx_Cv(i,j)*g%IdyCv(i,j)) * max(g%IareaT(i,j),g%IareaT(i,j+1)))
464 if (kh_here*inv_kh_max > 0.25) kh_here = 0.25 / inv_kh_max
468 meke_vflux(i,j) = ((kh_here * (g%dx_Cv(i,j)*g%IdyCv(i,j))) * &
469 ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * &
470 (meke%MEKE(i,j) - meke%MEKE(i,j+1))
472 if (cs%MEKE_advection_factor>0.)
then
473 advfac = cs%MEKE_advection_factor / sdt
475 do j=js,je ;
do i=is-1,ie
477 if (barohu(i,j)>0.)
then
478 meke_uflux(i,j) = meke_uflux(i,j) + barohu(i,j)*meke%MEKE(i,j)*advfac
479 elseif (barohu(i,j)<0.)
then
480 meke_uflux(i,j) = meke_uflux(i,j) + barohu(i,j)*meke%MEKE(i+1,j)*advfac
484 do j=js-1,je ;
do i=is,ie
486 if (barohv(i,j)>0.)
then
487 meke_vflux(i,j) = meke_vflux(i,j) + barohv(i,j)*meke%MEKE(i,j)*advfac
488 elseif (barohv(i,j)<0.)
then
489 meke_vflux(i,j) = meke_vflux(i,j) + barohv(i,j)*meke%MEKE(i,j+1)*advfac
495 do j=js,je ;
do i=is,ie
496 meke%MEKE(i,j) = meke%MEKE(i,j) + (sdt*(g%IareaT(i,j)*i_mass(i,j))) * &
497 ((meke_uflux(i-1,j) - meke_uflux(i,j)) + &
498 (meke_vflux(i,j-1) - meke_vflux(i,j)))
503 if (cs%MEKE_K4 >= 0.0)
then
505 do j=js,je ;
do i=is,ie
506 meke%MEKE(i,j) = meke%MEKE(i,j) + del4meke(i,j)
511 if (cs%MEKE_KH >= 0.0 .or. cs%MEKE_K4 >= 0.0)
then
512 if (sdt>sdt_damp)
then
514 if (use_drag_rate)
then
516 do j=js,je ;
do i=is,ie
517 drag_rate(i,j) = (us%L_to_Z*rho0 * i_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
518 cdrag2 * ( max(0.0, 2.0*bottomfac2(i,j)*meke%MEKE(i,j)) + cs%MEKE_Uscale**2 ) )
521 do j=js,je ;
do i=is,ie
522 ldamping = cs%MEKE_damping + drag_rate(i,j) * bottomfac2(i,j)
523 if (meke%MEKE(i,j) < 0.) ldamping = 0.
526 meke%MEKE(i,j) = meke%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
527 meke_decay(i,j) = ldamping*g%mask2dT(i,j)
537 call cpu_clock_begin(cs%id_clock_pass)
539 call cpu_clock_end(cs%id_clock_pass)
542 if (cs%MEKE_KhCoeff>0.)
then
543 if (.not.cs%MEKE_GEOMETRIC)
then
544 if (cs%use_old_lscale)
then
545 if (cs%Rd_as_max_scale)
then
547 do j=js,je ;
do i=is,ie
548 meke%Kh(i,j) = (cs%MEKE_KhCoeff * &
549 sqrt(2.*max(0.,barotrfac2(i,j)*meke%MEKE(i,j))*g%areaT(i,j)) ) * &
550 min(meke%Rd_dx_h(i,j), 1.0)
554 do j=js,je ;
do i=is,ie
555 meke%Kh(i,j) = cs%MEKE_KhCoeff * &
556 sqrt(2.*max(0., barotrfac2(i,j)*meke%MEKE(i,j))*g%areaT(i,j))
561 do j=js,je ;
do i=is,ie
562 meke%Kh(i,j) = cs%MEKE_KhCoeff * &
563 sqrt(2.*max(0., barotrfac2(i,j)*meke%MEKE(i,j))) * lmixscale(i,j)
570 if (cs%viscosity_coeff_Ku /=0.)
then
571 do j=js,je ;
do i=is,ie
572 meke%Ku(i,j) = cs%viscosity_coeff_Ku * sqrt(2.*max(0.,meke%MEKE(i,j))) * lmixscale(i,j)
576 if (cs%viscosity_coeff_Au /=0.)
then
577 do j=js,je ;
do i=is,ie
578 meke%Au(i,j) = cs%viscosity_coeff_Au * sqrt(2.*max(0.,meke%MEKE(i,j))) * lmixscale(i,j)**3
582 if (
associated(meke%Kh) .or.
associated(meke%Ku) .or.
associated(meke%Au))
then
583 call cpu_clock_begin(cs%id_clock_pass)
585 call cpu_clock_end(cs%id_clock_pass)
589 if (any([cs%id_Ue, cs%id_Ub, cs%id_Ut] > 0)) &
591 if (cs%id_MEKE>0)
call post_data(cs%id_MEKE, meke%MEKE, cs%diag)
593 do j=js,je ;
do i=is,ie
594 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j)))
599 do j=js,je ;
do i=is,ie
600 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j) * bottomfac2(i,j)))
605 do j=js,je ;
do i=is,ie
606 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j) * barotrfac2(i,j)))
610 if (cs%id_Kh>0)
call post_data(cs%id_Kh, meke%Kh, cs%diag)
611 if (cs%id_Ku>0)
call post_data(cs%id_Ku, meke%Ku, cs%diag)
612 if (cs%id_Au>0)
call post_data(cs%id_Au, meke%Au, cs%diag)
613 if (cs%id_KhMEKE_u>0)
call post_data(cs%id_KhMEKE_u, kh_u, cs%diag)
614 if (cs%id_KhMEKE_v>0)
call post_data(cs%id_KhMEKE_v, kh_v, cs%diag)
615 if (cs%id_src>0)
call post_data(cs%id_src, src, cs%diag)
616 if (cs%id_decay>0)
call post_data(cs%id_decay, meke_decay, cs%diag)
617 if (cs%id_GM_src>0)
call post_data(cs%id_GM_src, meke%GM_src, cs%diag)
618 if (cs%id_mom_src>0)
call post_data(cs%id_mom_src, meke%mom_src, cs%diag)
619 if (cs%id_GME_snk>0)
call post_data(cs%id_GME_snk, meke%GME_snk, cs%diag)
620 if (cs%id_Le>0)
call post_data(cs%id_Le, lmixscale, cs%diag)
621 if (cs%id_gamma_b>0)
then
622 do j=js,je ;
do i=is,ie
623 bottomfac2(i,j) = sqrt(bottomfac2(i,j))
625 call post_data(cs%id_gamma_b, bottomfac2, cs%diag)
627 if (cs%id_gamma_t>0)
then
628 do j=js,je ;
do i=is,ie
629 barotrfac2(i,j) = sqrt(barotrfac2(i,j))
631 call post_data(cs%id_gamma_t, barotrfac2, cs%diag)
639 subroutine meke_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass)
645 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
646 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
647 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: drag_rate_visc
649 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: I_mass
653 real :: bottomFac2, barotrFac2
654 real :: LmixScale, LRhines, LEady
662 real :: EKE, EKEmin, EKEmax, EKEerr
663 real :: resid, ResMin, ResMax
665 real :: beta_topo_x, beta_topo_y
666 integer :: i, j, is, ie, js, je, n1, n2
668 logical :: useSecant, debugIteration
670 real :: Lgrid, Ldeform, Lfrict
672 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
674 debugiteration = .false.
675 khcoeff = cs%MEKE_KhCoeff
676 ubg2 = cs%MEKE_Uscale**2
678 tolerance = 1.0e-12*us%m_s_to_L_T**2
681 do j=js,je ;
do i=is,ie
684 sn = min(sn_u(i,j), sn_u(i-1,j), sn_v(i,j), sn_v(i,j-1))
686 if (cs%MEKE_equilibrium_alt)
then
687 meke%MEKE(i,j) = (cs%MEKE_GEOMETRIC_alpha * sn * us%Z_to_m*g%bathyT(i,j))**2 / cd2
689 fath = 0.25*((g%CoriolisBu(i,j) + g%CoriolisBu(i-1,j-1)) + &
690 (g%CoriolisBu(i-1,j) + g%CoriolisBu(i,j-1)))
693 if (cs%MEKE_topographic_beta == 0. .or. g%bathyT(i,j) == 0.)
then
694 beta_topo_x = 0. ; beta_topo_y = 0.
698 beta_topo_x = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
699 (g%bathyT(i+1,j)-g%bathyT(i,j)) * g%IdxCu(i,j) &
700 / max(g%bathyT(i+1,j),g%bathyT(i,j), gv%H_subroundoff) &
701 + (g%bathyT(i,j)-g%bathyT(i-1,j)) * g%IdxCu(i-1,j) &
702 / max(g%bathyT(i,j),g%bathyT(i-1,j), gv%H_subroundoff) )
703 beta_topo_y = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
704 (g%bathyT(i,j+1)-g%bathyT(i,j)) * g%IdyCv(i,j) &
705 / max(g%bathyT(i,j+1),g%bathyT(i,j), gv%H_subroundoff) + &
706 (g%bathyT(i,j)-g%bathyT(i,j-1)) * g%IdyCv(i,j-1) &
707 / max(g%bathyT(i,j),g%bathyT(i,j-1), gv%H_subroundoff) )
709 beta = sqrt((g%dF_dx(i,j) + beta_topo_x)**2 + &
710 (g%dF_dy(i,j) + beta_topo_y)**2 )
712 i_h = us%L_to_Z*gv%Rho0 * i_mass(i,j)
714 if (khcoeff*sn*i_h>0.)
then
718 ekemax = 0.01*us%m_s_to_L_T**2
722 resid = 1.0*us%m_to_L**2*us%T_to_s**3 ; n1 = 0
727 meke%Rd_dx_h(i,j), sn, eke, &
728 bottomfac2, barotrfac2, lmixscale, lrhines, leady)
730 kh = (khcoeff * sqrt(2.*barotrfac2*eke) * lmixscale)
732 drag_rate = i_h * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomfac2*eke + ubg2 ) )
733 ldamping = cs%MEKE_damping + drag_rate * bottomfac2
734 resid = src - ldamping * eke
745 if (resid<resmin) usesecant = .true.
747 if (ekemax > 2.e17*us%m_s_to_L_T**2)
then
748 if (debugiteration) stop
'Something has gone very wrong'
749 debugiteration = .true.
751 ekemin = 0. ; resmin = 0.
752 ekemax = 0.01*us%m_s_to_L_T**2
760 n2 = 0 ; ekeerr = ekemax - ekemin
761 do while (ekeerr > tolerance)
764 eke = ekemin + (ekemax - ekemin) * (resmin / (resmin - resmax))
766 eke = 0.5 * (ekemin + ekemax)
768 ekeerr = min( eke-ekemin, ekemax-eke )
770 kh = (khcoeff * sqrt(2.*barotrfac2*eke) * lmixscale)
772 drag_rate = i_h * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomfac2*eke + ubg2 ) )
773 ldamping = cs%MEKE_damping + drag_rate * bottomfac2
774 resid = src - ldamping * eke
775 if (usesecant .and. resid>resmin) usesecant = .false.
778 if (resid<resmin) usesecant = .true.
780 elseif (resid<0.)
then
786 if (n2>200) stop
'Failing to converge?'
805 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
806 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
809 integer :: i, j, is, ie, js, je
812 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
815 if (.not.
associated(cs%equilibrium_value))
allocate(cs%equilibrium_value(szi_(g),szj_(g)))
816 cs%equilibrium_value(:,:) = 0.0
819 do j=js,je ;
do i=is,ie
822 sn = min(sn_u(i,j), sn_u(i-1,j), sn_v(i,j), sn_v(i,j-1))
823 cs%equilibrium_value(i,j) = (cs%MEKE_GEOMETRIC_alpha * sn * us%Z_to_m*g%bathyT(i,j))**2 / cd2
826 if (cs%id_MEKE_equilibrium>0)
call post_data(cs%id_MEKE_equilibrium, cs%equilibrium_value, cs%diag)
834 EKE, bottomFac2, barotrFac2, LmixScale)
840 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
841 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
842 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: EKE
843 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: bottomFac2
844 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: barotrFac2
845 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: LmixScale
847 real,
dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady
851 real :: beta_topo_x, beta_topo_y
852 integer :: i, j, is, ie, js, je
854 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
857 do j=js,je ;
do i=is,ie
858 if (.not.cs%use_old_lscale)
then
859 if (cs%aEady > 0.)
then
860 sn = 0.25 * ( (sn_u(i,j) + sn_u(i-1,j)) + (sn_v(i,j) + sn_v(i,j-1)) )
864 fath = 0.25* ( ( g%CoriolisBu(i,j) + g%CoriolisBu(i-1,j-1) ) + &
865 ( g%CoriolisBu(i-1,j) + g%CoriolisBu(i,j-1) ) )
870 if (cs%MEKE_topographic_beta == 0. .or. g%bathyT(i,j) == 0.0)
then
871 beta_topo_x = 0. ; beta_topo_y = 0.
875 beta_topo_x = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
876 (g%bathyT(i+1,j)-g%bathyT(i,j)) * g%IdxCu(i,j) &
877 / max(g%bathyT(i+1,j),g%bathyT(i,j), gv%H_subroundoff) &
878 + (g%bathyT(i,j)-g%bathyT(i-1,j)) * g%IdxCu(i-1,j) &
879 / max(g%bathyT(i,j),g%bathyT(i-1,j), gv%H_subroundoff) )
880 beta_topo_y = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
881 (g%bathyT(i,j+1)-g%bathyT(i,j)) * g%IdyCv(i,j) &
882 / max(g%bathyT(i,j+1),g%bathyT(i,j), gv%H_subroundoff) + &
883 (g%bathyT(i,j)-g%bathyT(i,j-1)) * g%IdyCv(i,j-1) &
884 / max(g%bathyT(i,j),g%bathyT(i,j-1), gv%H_subroundoff) )
886 beta = sqrt((g%dF_dx(i,j) + beta_topo_x)**2 + &
887 (g%dF_dy(i,j) + beta_topo_y)**2 )
894 meke%Rd_dx_h(i,j), sn, meke%MEKE(i,j), &
895 bottomfac2(i,j), barotrfac2(i,j), lmixscale(i,j), &
896 lrhines(i,j), leady(i,j))
898 if (cs%id_Lrhines>0)
call post_data(cs%id_LRhines, lrhines, cs%diag)
899 if (cs%id_Leady>0)
call post_data(cs%id_LEady, leady, cs%diag)
907 bottomFac2, barotrFac2, LmixScale, Lrhines, Leady)
910 real,
intent(in) :: area
911 real,
intent(in) :: beta
912 real,
intent(in) :: depth
913 real,
intent(in) :: Rd_dx
914 real,
intent(in) :: SN
915 real,
intent(in) :: EKE
918 real,
intent(out) :: bottomFac2
919 real,
intent(out) :: barotrFac2
920 real,
intent(out) :: LmixScale
921 real,
intent(out) :: Lrhines
922 real,
intent(out) :: Leady
924 real :: Lgrid, Ldeform, Lfrict
929 ldeform = lgrid * rd_dx
930 lfrict = (us%Z_to_L * depth) / cs%cdrag
933 bottomfac2 = cs%MEKE_CD_SCALE**2
934 if (lfrict*cs%MEKE_Cb>0.) bottomfac2 = bottomfac2 + 1./( 1. + cs%MEKE_Cb*(ldeform/lfrict) )**0.8
935 bottomfac2 = max(bottomfac2, cs%MEKE_min_gamma)
939 if (lfrict*cs%MEKE_Ct>0.) barotrfac2 = 1. / ( 1. + cs%MEKE_Ct*(ldeform/lfrict) )**0.25
940 barotrfac2 = max(barotrfac2, cs%MEKE_min_gamma)
941 if (cs%use_old_lscale)
then
942 if (cs%Rd_as_max_scale)
then
943 lmixscale = min(ldeform, lgrid)
948 ue = sqrt( 2.0 * max( 0., barotrfac2*eke ) )
949 lrhines = sqrt( ue / max( beta, 1.e-30*us%T_to_s*us%L_to_m ) )
950 if (cs%aEady > 0.)
then
951 leady = ue / max( sn, 1.e-15*us%T_to_s )
955 if (cs%use_min_lscale)
then
957 if (cs%aDeform*ldeform > 0.) lmixscale = min(lmixscale,cs%aDeform*ldeform)
958 if (cs%aFrict *lfrict > 0.) lmixscale = min(lmixscale,cs%aFrict *lfrict)
959 if (cs%aRhines*lrhines > 0.) lmixscale = min(lmixscale,cs%aRhines*lrhines)
960 if (cs%aEady *leady > 0.) lmixscale = min(lmixscale,cs%aEady *leady)
961 if (cs%aGrid *lgrid > 0.) lmixscale = min(lmixscale,cs%aGrid *lgrid)
962 if (cs%Lfixed > 0.) lmixscale = min(lmixscale,cs%Lfixed)
965 if (cs%aDeform*ldeform > 0.) lmixscale = lmixscale + 1./(cs%aDeform*ldeform)
966 if (cs%aFrict *lfrict > 0.) lmixscale = lmixscale + 1./(cs%aFrict *lfrict)
967 if (cs%aRhines*lrhines > 0.) lmixscale = lmixscale + 1./(cs%aRhines*lrhines)
968 if (cs%aEady *leady > 0.) lmixscale = lmixscale + 1./(cs%aEady *leady)
969 if (cs%aGrid *lgrid > 0.) lmixscale = lmixscale + 1./(cs%aGrid *lgrid)
970 if (cs%Lfixed > 0.) lmixscale = lmixscale + 1./cs%Lfixed
971 if (lmixscale > 0.) lmixscale = 1. / lmixscale
979 logical function meke_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS)
980 type(time_type),
intent(in) :: time
984 type(
diag_ctrl),
target,
intent(inout) :: diag
994 real :: meke_restoring_timescale
996 integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
997 logical :: laplacian, biharmonic, usevarmix, coldstart
999 # include "version_variable.h"
1000 character(len=40) :: mdl =
"MOM_MEKE"
1002 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1003 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1008 "If true, turns on the MEKE scheme which calculates "// &
1009 "a sub-grid mesoscale eddy kinetic energy budget.", &
1013 if (.not.
associated(meke))
then
1015 call mom_error(warning,
"MEKE_init called with NO associated "// &
1016 "MEKE-type structure.")
1019 if (
associated(cs))
then
1021 "MEKE_init called with an associated control structure.")
1023 else ;
allocate(cs) ;
endif
1025 call mom_mesg(
"MEKE_init: reading parameters ", 5)
1028 call get_param(param_file, mdl,
"MEKE_DAMPING", cs%MEKE_damping, &
1029 "The local depth-independent MEKE dissipation rate.", &
1030 units=
"s-1", default=0.0, scale=us%T_to_s)
1031 call get_param(param_file, mdl,
"MEKE_CD_SCALE", cs%MEKE_Cd_scale, &
1032 "The ratio of the bottom eddy velocity to the column mean "//&
1033 "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//&
1034 "to account for the surface intensification of MEKE.", &
1035 units=
"nondim", default=0.)
1036 call get_param(param_file, mdl,
"MEKE_CB", cs%MEKE_Cb, &
1037 "A coefficient in the expression for the ratio of bottom projected "//&
1038 "eddy energy and mean column energy (see Jansen et al. 2015).",&
1039 units=
"nondim", default=25.)
1040 call get_param(param_file, mdl,
"MEKE_MIN_GAMMA2", cs%MEKE_min_gamma, &
1041 "The minimum allowed value of gamma_b^2.",&
1042 units=
"nondim", default=0.0001)
1043 call get_param(param_file, mdl,
"MEKE_CT", cs%MEKE_Ct, &
1044 "A coefficient in the expression for the ratio of barotropic "//&
1045 "eddy energy and mean column energy (see Jansen et al. 2015).",&
1046 units=
"nondim", default=50.)
1047 call get_param(param_file, mdl,
"MEKE_GMCOEFF", cs%MEKE_GMcoeff, &
1048 "The efficiency of the conversion of potential energy "//&
1049 "into MEKE by the thickness mixing parameterization. "//&
1050 "If MEKE_GMCOEFF is negative, this conversion is not "//&
1051 "used or calculated.", units=
"nondim", default=-1.0)
1052 call get_param(param_file, mdl,
"MEKE_GEOMETRIC", cs%MEKE_GEOMETRIC, &
1053 "If MEKE_GEOMETRIC is true, uses the GM coefficient formulation "//&
1054 "from the GEOMETRIC framework (Marshall et al., 2012).", default=.false.)
1055 call get_param(param_file, mdl,
"MEKE_GEOMETRIC_ALPHA", cs%MEKE_GEOMETRIC_alpha, &
1056 "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//&
1057 "thickness diffusion.", units=
"nondim", default=0.05)
1058 call get_param(param_file, mdl,
"MEKE_EQUILIBRIUM_ALT", cs%MEKE_equilibrium_alt, &
1059 "If true, use an alternative formula for computing the (equilibrium)"//&
1060 "initial value of MEKE.", default=.false.)
1061 call get_param(param_file, mdl,
"MEKE_EQUILIBRIUM_RESTORING", cs%MEKE_equilibrium_restoring, &
1062 "If true, restore MEKE back to its equilibrium value, which is calculated at"//&
1063 "each time step.", default=.false.)
1064 if (cs%MEKE_equilibrium_restoring)
then
1065 call get_param(param_file, mdl,
"MEKE_RESTORING_TIMESCALE", meke_restoring_timescale, &
1066 "The timescale used to nudge MEKE toward its equilibrium value.", units=
"s", &
1067 default=1e6, scale=us%T_to_s)
1068 cs%MEKE_restoring_rate = 1.0 / meke_restoring_timescale
1071 call get_param(param_file, mdl,
"MEKE_FRCOEFF", cs%MEKE_FrCoeff, &
1072 "The efficiency of the conversion of mean energy into "//&
1073 "MEKE. If MEKE_FRCOEFF is negative, this conversion "//&
1074 "is not used or calculated.", units=
"nondim", default=-1.0)
1075 call get_param(param_file, mdl,
"MEKE_GMECOEFF", cs%MEKE_GMECoeff, &
1076 "The efficiency of the conversion of MEKE into mean energy "//&
1077 "by GME. If MEKE_GMECOEFF is negative, this conversion "//&
1078 "is not used or calculated.", units=
"nondim", default=-1.0)
1079 call get_param(param_file, mdl,
"MEKE_BGSRC", cs%MEKE_BGsrc, &
1080 "A background energy source for MEKE.", units=
"W kg-1", &
1081 default=0.0, scale=us%m_to_L**2*us%T_to_s**3)
1082 call get_param(param_file, mdl,
"MEKE_KH", cs%MEKE_Kh, &
1083 "A background lateral diffusivity of MEKE. "//&
1084 "Use a negative value to not apply lateral diffusion to MEKE.", &
1085 units=
"m2 s-1", default=-1.0, scale=us%m_to_L**2*us%T_to_s)
1086 call get_param(param_file, mdl,
"MEKE_K4", cs%MEKE_K4, &
1087 "A lateral bi-harmonic diffusivity of MEKE. "//&
1088 "Use a negative value to not apply bi-harmonic diffusion to MEKE.", &
1089 units=
"m4 s-1", default=-1.0, scale=us%m_to_L**4*us%T_to_s)
1090 call get_param(param_file, mdl,
"MEKE_DTSCALE", cs%MEKE_dtScale, &
1091 "A scaling factor to accelerate the time evolution of MEKE.", &
1092 units=
"nondim", default=1.0)
1093 call get_param(param_file, mdl,
"MEKE_KHCOEFF", cs%MEKE_KhCoeff, &
1094 "A scaling factor in the expression for eddy diffusivity "//&
1095 "which is otherwise proportional to the MEKE velocity- "//&
1096 "scale times an eddy mixing-length. This factor "//&
1097 "must be >0 for MEKE to contribute to the thickness/ "//&
1098 "and tracer diffusivity in the rest of the model.", &
1099 units=
"nondim", default=1.0)
1100 call get_param(param_file, mdl,
"MEKE_USCALE", cs%MEKE_Uscale, &
1101 "The background velocity that is combined with MEKE to "//&
1102 "calculate the bottom drag.", units=
"m s-1", default=0.0, scale=us%m_s_to_L_T)
1103 call get_param(param_file, mdl,
"MEKE_GM_SRC_ALT", cs%GM_src_alt, &
1104 "If true, use the GM energy conversion form S^2*N^2*kappa rather "//&
1105 "than the streamfunction for the MEKE GM source term.", default=.false.)
1106 call get_param(param_file, mdl,
"MEKE_VISC_DRAG", cs%visc_drag, &
1107 "If true, use the vertvisc_type to calculate the bottom "//&
1108 "drag acting on MEKE.", default=.true.)
1109 call get_param(param_file, mdl,
"MEKE_KHTH_FAC", meke%KhTh_fac, &
1110 "A factor that maps MEKE%Kh to KhTh.", units=
"nondim", &
1112 call get_param(param_file, mdl,
"MEKE_KHTR_FAC", meke%KhTr_fac, &
1113 "A factor that maps MEKE%Kh to KhTr.", units=
"nondim", &
1115 call get_param(param_file, mdl,
"MEKE_KHMEKE_FAC", cs%KhMEKE_Fac, &
1116 "A factor that maps MEKE%Kh to Kh for MEKE itself.", &
1117 units=
"nondim", default=0.0)
1118 call get_param(param_file, mdl,
"MEKE_OLD_LSCALE", cs%use_old_lscale, &
1119 "If true, use the old formula for length scale which is "//&
1120 "a function of grid spacing and deformation radius.", &
1122 call get_param(param_file, mdl,
"MEKE_MIN_LSCALE", cs%use_min_lscale, &
1123 "If true, use a strict minimum of provided length scales "//&
1124 "rather than harmonic mean.", &
1126 call get_param(param_file, mdl,
"MEKE_RD_MAX_SCALE", cs%Rd_as_max_scale, &
1127 "If true, the length scale used by MEKE is the minimum of "//&
1128 "the deformation radius or grid-spacing. Only used if "//&
1129 "MEKE_OLD_LSCALE=True", units=
"nondim", default=.false.)
1130 call get_param(param_file, mdl,
"MEKE_VISCOSITY_COEFF_KU", cs%viscosity_coeff_Ku, &
1131 "If non-zero, is the scaling coefficient in the expression for"//&
1132 "viscosity used to parameterize harmonic lateral momentum mixing by"//&
1133 "unresolved eddies represented by MEKE. Can be negative to"//&
1134 "represent backscatter from the unresolved eddies.", &
1135 units=
"nondim", default=0.0)
1136 call get_param(param_file, mdl,
"MEKE_VISCOSITY_COEFF_AU", cs%viscosity_coeff_Au, &
1137 "If non-zero, is the scaling coefficient in the expression for"//&
1138 "viscosity used to parameterize biharmonic lateral momentum mixing by"//&
1139 "unresolved eddies represented by MEKE. Can be negative to"//&
1140 "represent backscatter from the unresolved eddies.", &
1141 units=
"nondim", default=0.0)
1142 call get_param(param_file, mdl,
"MEKE_FIXED_MIXING_LENGTH", cs%Lfixed, &
1143 "If positive, is a fixed length contribution to the expression "//&
1144 "for mixing length used in MEKE-derived diffusivity.", &
1145 units=
"m", default=0.0, scale=us%m_to_L)
1146 call get_param(param_file, mdl,
"MEKE_ALPHA_DEFORM", cs%aDeform, &
1147 "If positive, is a coefficient weighting the deformation scale "//&
1148 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1149 units=
"nondim", default=0.0)
1150 call get_param(param_file, mdl,
"MEKE_ALPHA_RHINES", cs%aRhines, &
1151 "If positive, is a coefficient weighting the Rhines scale "//&
1152 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1153 units=
"nondim", default=0.05)
1154 call get_param(param_file, mdl,
"MEKE_ALPHA_EADY", cs%aEady, &
1155 "If positive, is a coefficient weighting the Eady length scale "//&
1156 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1157 units=
"nondim", default=0.05)
1158 call get_param(param_file, mdl,
"MEKE_ALPHA_FRICT", cs%aFrict, &
1159 "If positive, is a coefficient weighting the frictional arrest scale "//&
1160 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1161 units=
"nondim", default=0.0)
1162 call get_param(param_file, mdl,
"MEKE_ALPHA_GRID", cs%aGrid, &
1163 "If positive, is a coefficient weighting the grid-spacing as a scale "//&
1164 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1165 units=
"nondim", default=0.0)
1166 call get_param(param_file, mdl,
"MEKE_COLD_START", coldstart, &
1167 "If true, initialize EKE to zero. Otherwise a local equilibrium solution "//&
1168 "is used as an initial condition for EKE.", default=.false.)
1169 call get_param(param_file, mdl,
"MEKE_BACKSCAT_RO_C", meke%backscatter_Ro_c, &
1170 "The coefficient in the Rossby number function for scaling the biharmonic "//&
1171 "frictional energy source. Setting to non-zero enables the Rossby number function.", &
1172 units=
"nondim", default=0.0)
1173 call get_param(param_file, mdl,
"MEKE_BACKSCAT_RO_POW", meke%backscatter_Ro_pow, &
1174 "The power in the Rossby number function for scaling the biharmonic "//&
1175 "frictional energy source.", units=
"nondim", default=0.0)
1176 call get_param(param_file, mdl,
"MEKE_ADVECTION_FACTOR", cs%MEKE_advection_factor, &
1177 "A scale factor in front of advection of eddy energy. Zero turns advection off. "//&
1178 "Using unity would be normal but other values could accommodate a mismatch "//&
1179 "between the advecting barotropic flow and the vertical structure of MEKE.", &
1180 units=
"nondim", default=0.0)
1181 call get_param(param_file, mdl,
"MEKE_TOPOGRAPHIC_BETA", cs%MEKE_topographic_beta, &
1182 "A scale factor to determine how much topographic beta is weighed in " //&
1183 "computing beta in the expression of Rhines scale. Use 1 if full "//&
1184 "topographic beta effect is considered; use 0 if it's completely ignored.", &
1185 units=
"nondim", default=0.0)
1188 call get_param(param_file, mdl,
"CDRAG", cdrag, &
1189 "CDRAG is the drag coefficient relating the magnitude of "//&
1190 "the velocity field to the bottom stress.", units=
"nondim", &
1192 call get_param(param_file, mdl,
"CDRAG_MEKE", cs%cdrag, &
1193 "CDRAG is the drag coefficient relating the magnitude of "//&
1194 "the velocity field to the bottom stress.", units=
"nondim", &
1196 call get_param(param_file, mdl,
"LAPLACIAN", laplacian, default=.false., do_not_log=.true.)
1197 call get_param(param_file, mdl,
"BIHARMONIC", biharmonic, default=.false., do_not_log=.true.)
1199 if (cs%viscosity_coeff_Ku/=0. .and. .not. laplacian)
call mom_error(fatal, &
1200 "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF_KU is true.")
1202 if (cs%viscosity_coeff_Au/=0. .and. .not. biharmonic)
call mom_error(fatal, &
1203 "BIHARMONIC must be true if MEKE_VISCOSITY_COEFF_AU is true.")
1205 call get_param(param_file, mdl,
"DEBUG", cs%debug, default=.false., do_not_log=.true.)
1208 cs%kh_flux_enabled = .false.
1209 if ((cs%MEKE_KH >= 0.0) .or. (cs%KhMEKE_FAC > 0.0) .or. (cs%MEKE_advection_factor > 0.0)) &
1210 cs%kh_flux_enabled = .true.
1214 cs%id_MEKE = register_diag_field(
'ocean_model',
'MEKE', diag%axesT1, time, &
1215 'Mesoscale Eddy Kinetic Energy',
'm2 s-2', conversion=us%L_T_to_m_s**2)
1216 if (.not.
associated(meke%MEKE)) cs%id_MEKE = -1
1217 cs%id_Kh = register_diag_field(
'ocean_model',
'MEKE_KH', diag%axesT1, time, &
1218 'MEKE derived diffusivity',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1219 if (.not.
associated(meke%Kh)) cs%id_Kh = -1
1220 cs%id_Ku = register_diag_field(
'ocean_model',
'MEKE_KU', diag%axesT1, time, &
1221 'MEKE derived lateral viscosity',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1222 if (.not.
associated(meke%Ku)) cs%id_Ku = -1
1223 cs%id_Au = register_diag_field(
'ocean_model',
'MEKE_AU', diag%axesT1, time, &
1224 'MEKE derived lateral biharmonic viscosity',
'm4 s-1', conversion=us%L_to_m**4*us%s_to_T)
1225 if (.not.
associated(meke%Au)) cs%id_Au = -1
1226 cs%id_Ue = register_diag_field(
'ocean_model',
'MEKE_Ue', diag%axesT1, time, &
1227 'MEKE derived eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1228 if (.not.
associated(meke%MEKE)) cs%id_Ue = -1
1229 cs%id_Ub = register_diag_field(
'ocean_model',
'MEKE_Ub', diag%axesT1, time, &
1230 'MEKE derived bottom eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1231 if (.not.
associated(meke%MEKE)) cs%id_Ub = -1
1232 cs%id_Ut = register_diag_field(
'ocean_model',
'MEKE_Ut', diag%axesT1, time, &
1233 'MEKE derived barotropic eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1234 if (.not.
associated(meke%MEKE)) cs%id_Ut = -1
1235 cs%id_src = register_diag_field(
'ocean_model',
'MEKE_src', diag%axesT1, time, &
1236 'MEKE energy source',
'm2 s-3', conversion=(us%L_T_to_m_s**2)*us%s_to_T)
1237 cs%id_decay = register_diag_field(
'ocean_model',
'MEKE_decay', diag%axesT1, time, &
1238 'MEKE decay rate',
's-1', conversion=us%s_to_T)
1239 cs%id_GM_src = register_diag_field(
'ocean_model',
'MEKE_GM_src', diag%axesT1, time, &
1240 'MEKE energy available from thickness mixing', &
1241 'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
1242 if (.not.
associated(meke%GM_src)) cs%id_GM_src = -1
1243 cs%id_mom_src = register_diag_field(
'ocean_model',
'MEKE_mom_src',diag%axesT1, time, &
1244 'MEKE energy available from momentum', &
1245 'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
1246 if (.not.
associated(meke%mom_src)) cs%id_mom_src = -1
1247 cs%id_GME_snk = register_diag_field(
'ocean_model',
'MEKE_GME_snk',diag%axesT1, time, &
1248 'MEKE energy lost to GME backscatter', &
1249 'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%L_to_m**2*us%s_to_T**3)
1250 if (.not.
associated(meke%GME_snk)) cs%id_GME_snk = -1
1251 cs%id_Le = register_diag_field(
'ocean_model',
'MEKE_Le', diag%axesT1, time, &
1252 'Eddy mixing length used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1253 cs%id_Lrhines = register_diag_field(
'ocean_model',
'MEKE_Lrhines', diag%axesT1, time, &
1254 'Rhines length scale used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1255 cs%id_Leady = register_diag_field(
'ocean_model',
'MEKE_Leady', diag%axesT1, time, &
1256 'Eady length scale used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1257 cs%id_gamma_b = register_diag_field(
'ocean_model',
'MEKE_gamma_b', diag%axesT1, time, &
1258 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity',
'nondim')
1259 cs%id_gamma_t = register_diag_field(
'ocean_model',
'MEKE_gamma_t', diag%axesT1, time, &
1260 'Ratio of barotropic eddy velocity to column-mean eddy velocity',
'nondim')
1262 if (cs%kh_flux_enabled)
then
1263 cs%id_KhMEKE_u = register_diag_field(
'ocean_model',
'KHMEKE_u', diag%axesCu1, time, &
1264 'Zonal diffusivity of MEKE',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1265 cs%id_KhMEKE_v = register_diag_field(
'ocean_model',
'KHMEKE_v', diag%axesCv1, time, &
1266 'Meridional diffusivity of MEKE',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1269 if (cs%MEKE_equilibrium_restoring)
then
1270 cs%id_MEKE_equilibrium = register_diag_field(
'ocean_model',
'MEKE_equilibrium', diag%axesT1, time, &
1271 'Equilibrated Mesoscale Eddy Kinetic Energy',
'm2 s-2', conversion=us%L_T_to_m_s**2)
1274 cs%id_clock_pass = cpu_clock_id(
'(Ocean continuity halo updates)', grain=clock_routine)
1280 if (coldstart) cs%initialize = .false.
1281 if (cs%initialize)
call mom_error(warning, &
1282 "MEKE_init: Initializing MEKE with a local equilibrium balance.")
1287 if ((us%s_to_T_restart /= 0.0) .and. (us%s_to_T_restart /= us%s_to_T)) &
1288 i_t_rescale = us%s_to_T_restart / us%s_to_T
1290 if ((us%m_to_L_restart /= 0.0) .and. (us%m_to_L_restart /= us%m_to_L)) &
1291 l_rescale = us%m_to_L / us%m_to_L_restart
1293 if (l_rescale*i_t_rescale /= 1.0)
then
1294 if (
associated(meke%MEKE))
then ;
if (
query_initialized(meke%MEKE,
"MEKE_MEKE", restart_cs))
then
1295 do j=js,je ;
do i=is,ie
1296 meke%MEKE(i,j) = l_rescale*i_t_rescale * meke%MEKE(i,j)
1300 if (l_rescale**2*i_t_rescale /= 1.0)
then
1301 if (
associated(meke%Kh))
then ;
if (
query_initialized(meke%Kh,
"MEKE_Kh", restart_cs))
then
1302 do j=js,je ;
do i=is,ie
1303 meke%Kh(i,j) = l_rescale**2*i_t_rescale * meke%Kh(i,j)
1306 if (
associated(meke%Ku))
then ;
if (
query_initialized(meke%Ku,
"MEKE_Ku", restart_cs))
then
1307 do j=js,je ;
do i=is,ie
1308 meke%Ku(i,j) = l_rescale**2*i_t_rescale * meke%Ku(i,j)
1311 if (
associated(meke%Kh_diff))
then ;
if (
query_initialized(meke%Kh,
"MEKE_Kh_diff", restart_cs))
then
1312 do j=js,je ;
do i=is,ie
1313 meke%Kh_diff(i,j) = l_rescale**2*i_t_rescale * meke%Kh_diff(i,j)
1317 if (l_rescale**4*i_t_rescale /= 1.0)
then
1318 if (
associated(meke%Au))
then ;
if (
query_initialized(meke%Au,
"MEKE_Au", restart_cs))
then
1319 do j=js,je ;
do i=is,ie
1320 meke%Au(i,j) = l_rescale**4*i_t_rescale * meke%Au(i,j)
1326 if (
associated(meke%MEKE))
then
1328 if (
associated(meke%Kh_diff))
call create_group_pass(cs%pass_MEKE, meke%Kh_diff, g%Domain)
1329 if (.not.cs%initialize)
call do_group_pass(cs%pass_MEKE, g%Domain)
1335 if (
associated(meke%Kh) .or.
associated(meke%Ku) .or.
associated(meke%Au)) &
1349 real :: meke_gmcoeff, meke_frcoeff, meke_gmecoeff, meke_khcoeff, meke_visccoeff_ku, meke_visccoeff_au
1350 logical :: use_kh_in_meke
1352 integer :: isd, ied, jsd, jed
1355 usemeke = .false.;
call read_param(param_file,
"USE_MEKE",usemeke)
1358 meke_gmcoeff =-1.;
call read_param(param_file,
"MEKE_GMCOEFF",meke_gmcoeff)
1359 meke_frcoeff =-1.;
call read_param(param_file,
"MEKE_FRCOEFF",meke_frcoeff)
1360 meke_gmecoeff =-1.;
call read_param(param_file,
"MEKE_GMECOEFF",meke_gmecoeff)
1361 meke_khcoeff =1.;
call read_param(param_file,
"MEKE_KHCOEFF",meke_khcoeff)
1362 meke_visccoeff_ku =0.;
call read_param(param_file,
"MEKE_VISCOSITY_COEFF_KU",meke_visccoeff_ku)
1363 meke_visccoeff_au =0.;
call read_param(param_file,
"MEKE_VISCOSITY_COEFF_AU",meke_visccoeff_au)
1364 use_kh_in_meke = .false.;
call read_param(param_file,
"USE_KH_IN_MEKE", use_kh_in_meke)
1366 if (
associated(meke))
then
1367 call mom_error(warning,
"MEKE_alloc_register_restart called with an associated "// &
1370 else;
allocate(meke);
endif
1372 if (.not. usemeke)
return
1375 call mom_mesg(
"MEKE_alloc_register_restart: allocating and registering", 5)
1376 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed
1377 allocate(meke%MEKE(isd:ied,jsd:jed)) ; meke%MEKE(:,:) = 0.0
1378 vd =
var_desc(
"MEKE",
"m2 s-2", hor_grid=
'h', z_grid=
'1', &
1379 longname=
"Mesoscale Eddy Kinetic Energy")
1381 if (meke_gmcoeff>=0.)
then
1382 allocate(meke%GM_src(isd:ied,jsd:jed)) ; meke%GM_src(:,:) = 0.0
1384 if (meke_frcoeff>=0. .or. meke_gmecoeff>=0.)
then
1385 allocate(meke%mom_src(isd:ied,jsd:jed)) ; meke%mom_src(:,:) = 0.0
1387 if (meke_gmecoeff>=0.)
then
1388 allocate(meke%GME_snk(isd:ied,jsd:jed)) ; meke%GME_snk(:,:) = 0.0
1390 if (meke_khcoeff>=0.)
then
1391 allocate(meke%Kh(isd:ied,jsd:jed)) ; meke%Kh(:,:) = 0.0
1392 vd =
var_desc(
"MEKE_Kh",
"m2 s-1", hor_grid=
'h', z_grid=
'1', &
1393 longname=
"Lateral diffusivity from Mesoscale Eddy Kinetic Energy")
1396 allocate(meke%Rd_dx_h(isd:ied,jsd:jed)) ; meke%Rd_dx_h(:,:) = 0.0
1397 if (meke_visccoeff_ku/=0.)
then
1398 allocate(meke%Ku(isd:ied,jsd:jed)) ; meke%Ku(:,:) = 0.0
1399 vd =
var_desc(
"MEKE_Ku",
"m2 s-1", hor_grid=
'h', z_grid=
'1', &
1400 longname=
"Lateral viscosity from Mesoscale Eddy Kinetic Energy")
1403 if (use_kh_in_meke)
then
1404 allocate(meke%Kh_diff(isd:ied,jsd:jed)) ; meke%Kh_diff(:,:) = 0.0
1405 vd =
var_desc(
"MEKE_Kh_diff",
"m2 s-1",hor_grid=
'h',z_grid=
'1', &
1406 longname=
"Copy of thickness diffusivity for diffusing MEKE")
1410 if (meke_visccoeff_au/=0.)
then
1411 allocate(meke%Au(isd:ied,jsd:jed)) ; meke%Au(:,:) = 0.0
1412 vd =
var_desc(
"MEKE_Au",
"m4 s-1", hor_grid=
'h', z_grid=
'1', &
1413 longname=
"Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy")
1425 if (
associated(cs))
deallocate(cs)
1427 if (.not.
associated(meke))
return
1429 if (
associated(meke%MEKE))
deallocate(meke%MEKE)
1430 if (
associated(meke%GM_src))
deallocate(meke%GM_src)
1431 if (
associated(meke%mom_src))
deallocate(meke%mom_src)
1432 if (
associated(meke%GME_snk))
deallocate(meke%GME_snk)
1433 if (
associated(meke%Kh))
deallocate(meke%Kh)
1434 if (
associated(meke%Kh_diff))
deallocate(meke%Kh_diff)
1435 if (
associated(meke%Ku))
deallocate(meke%Ku)
1436 if (
associated(meke%Au))
deallocate(meke%Au)