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>
28 public step_forward_meke, meke_init, meke_alloc_register_restart, meke_end
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
52 logical :: meke_equilibrium_restoring
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%RZ3_T3_to_W_m2*us%L_to_Z**2)
194 if (
associated(meke%GME_snk)) &
195 call hchksum(meke%GME_snk,
'MEKE GME_snk', g%HI, scale=us%RZ3_T3_to_W_m2*us%L_to_Z**2)
196 if (
associated(meke%GM_src)) &
197 call hchksum(meke%GM_src,
'MEKE GM_src', g%HI, scale=us%RZ3_T3_to_W_m2*us%L_to_Z**2)
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, &
201 call uvchksum(
"MEKE h[uv]", hu, hv, g%HI, haloshift=1, &
202 scale=gv%H_to_m*(us%L_to_m**2))
205 sdt = dt*cs%MEKE_dtScale
207 mass_neglect = gv%H_to_RZ * gv%H_subroundoff
212 sdt_damp = sdt ;
if (cs%MEKE_KH >= 0.0 .or. cs%MEKE_K4 >= 0.) sdt_damp = 0.5*sdt
215 if (cs%MEKE_advection_factor>0.)
then
216 do j=js,je ;
do i=is-1,ie
220 do j=js,je ;
do i=is-1,ie
221 barohu(i,j) = hu(i,j,k) * gv%H_to_RZ
224 do j=js-1,je ;
do i=is,ie
228 do j=js-1,je ;
do i=is,ie
229 barohv(i,j) = hv(i,j,k) * gv%H_to_RZ
234 if (cs%MEKE_Cd_scale == 0.0 .and. .not. cs%visc_drag)
then
236 do j=js,je ;
do i=is,ie
237 drag_rate(i,j) = 0. ; drag_rate_j15(i,j) = 0.
242 if (cs%visc_drag)
then
244 do j=js,je ;
do i=is-1,ie
245 drag_vel_u(i,j) = 0.0
246 if ((g%mask2dCu(i,j) > 0.0) .and. (visc%bbl_thick_u(i,j) > 0.0)) &
247 drag_vel_u(i,j) = visc%Kv_bbl_u(i,j) / visc%bbl_thick_u(i,j)
250 do j=js-1,je ;
do i=is,ie
251 drag_vel_v(i,j) = 0.0
252 if ((g%mask2dCv(i,j) > 0.0) .and. (visc%bbl_thick_v(i,j) > 0.0)) &
253 drag_vel_v(i,j) = visc%Kv_bbl_v(i,j) / visc%bbl_thick_v(i,j)
257 do j=js,je ;
do i=is,ie
258 drag_rate_visc(i,j) = (0.25*g%IareaT(i,j) * us%Z_to_L * &
259 ((g%areaCu(i-1,j)*drag_vel_u(i-1,j) + &
260 g%areaCu(i,j)*drag_vel_u(i,j)) + &
261 (g%areaCv(i,j-1)*drag_vel_v(i,j-1) + &
262 g%areaCv(i,j)*drag_vel_v(i,j)) ) )
266 do j=js,je ;
do i=is,ie
267 drag_rate_visc(i,j) = 0.
273 do i=is-1,ie+1 ; mass(i,j) = 0.0 ;
enddo
274 do k=1,nz ;
do i=is-1,ie+1
275 mass(i,j) = mass(i,j) + g%mask2dT(i,j) * (gv%H_to_RZ * h(i,j,k))
279 if (mass(i,j) > 0.0) i_mass(i,j) = 1.0 / mass(i,j)
283 if (cs%initialize)
then
284 call meke_equilibrium(cs, meke, g, gv, us, sn_u, sn_v, drag_rate_visc, i_mass)
285 cs%initialize = .false.
289 call meke_lengthscales(cs, meke, g, gv, us, sn_u, sn_v, meke%MEKE, bottomfac2, barotrfac2, lmixscale)
292 call uvchksum(
"MEKE drag_vel_[uv]", drag_vel_u, drag_vel_v, g%HI, &
293 scale=us%Z_to_m*us%s_to_T, scalar_pair=.true.)
294 call hchksum(mass,
'MEKE mass',g%HI,haloshift=1, scale=us%RZ_to_kg_m2)
295 call hchksum(drag_rate_visc,
'MEKE drag_rate_visc', g%HI, scale=us%L_T_to_m_s)
296 call hchksum(bottomfac2,
'MEKE bottomFac2', g%HI)
297 call hchksum(barotrfac2,
'MEKE barotrFac2', g%HI)
298 call hchksum(lmixscale,
'MEKE LmixScale', g%HI,scale=us%L_to_m)
303 do j=js,je ;
do i=is,ie
304 src(i,j) = cs%MEKE_BGsrc
307 if (
associated(meke%mom_src))
then
309 do j=js,je ;
do i=is,ie
310 src(i,j) = src(i,j) - cs%MEKE_FrCoeff*i_mass(i,j)*meke%mom_src(i,j)
314 if (
associated(meke%GME_snk))
then
316 do j=js,je ;
do i=is,ie
317 src(i,j) = src(i,j) - cs%MEKE_GMECoeff*i_mass(i,j)*meke%GME_snk(i,j)
321 if (
associated(meke%GM_src))
then
322 if (cs%GM_src_alt)
then
324 do j=js,je ;
do i=is,ie
325 src(i,j) = src(i,j) - cs%MEKE_GMcoeff*meke%GM_src(i,j) / &
326 (gv%Rho0 * max(1.0*us%m_to_Z, g%bathyT(i,j)))
330 do j=js,je ;
do i=is,ie
331 src(i,j) = src(i,j) - cs%MEKE_GMcoeff*i_mass(i,j)*meke%GM_src(i,j)
336 if (cs%MEKE_equilibrium_restoring)
then
337 call meke_equilibrium_restoring(cs, g, us, sn_u, sn_v)
338 do j=js,je ;
do i=is,ie
339 src(i,j) = src(i,j) - cs%MEKE_restoring_rate*(meke%MEKE(i,j) - cs%equilibrium_value(i,j))
345 do j=js,je ;
do i=is,ie
346 meke%MEKE(i,j) = (meke%MEKE(i,j) + sdt*src(i,j))*g%mask2dT(i,j)
349 if (use_drag_rate)
then
352 do j=js,je ;
do i=is,ie
353 drag_rate(i,j) = (us%L_to_Z*rho0 * i_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
354 cdrag2 * ( max(0.0, 2.0*bottomfac2(i,j)*meke%MEKE(i,j)) + cs%MEKE_Uscale**2 ) )
360 do j=js,je ;
do i=is,ie
361 ldamping = cs%MEKE_damping + drag_rate(i,j) * bottomfac2(i,j)
362 if (meke%MEKE(i,j) < 0.) ldamping = 0.
365 meke%MEKE(i,j) = meke%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
366 meke_decay(i,j) = ldamping*g%mask2dT(i,j)
369 if (cs%kh_flux_enabled .or. cs%MEKE_K4 >= 0.0)
then
371 call cpu_clock_begin(cs%id_clock_pass)
372 call do_group_pass(cs%pass_MEKE, g%Domain)
373 call cpu_clock_end(cs%id_clock_pass)
376 if (cs%MEKE_K4 >= 0.0)
then
379 do j=js-1,je+1 ;
do i=is-2,ie+1
381 meke_uflux(i,j) = ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * g%mask2dCu(i,j)) * &
382 (meke%MEKE(i+1,j) - meke%MEKE(i,j))
389 do j=js-2,je+1 ;
do i=is-1,ie+1
391 meke_vflux(i,j) = ((g%dx_Cv(i,j)*g%IdyCv(i,j)) * g%mask2dCv(i,j)) * &
392 (meke%MEKE(i,j+1) - meke%MEKE(i,j))
400 do j=js-1,je+1 ;
do i=is-1,ie+1
401 del2meke(i,j) = g%IareaT(i,j) * &
402 ((meke_uflux(i,j) - meke_uflux(i-1,j)) + (meke_vflux(i,j) - meke_vflux(i,j-1)))
407 do j=js,je ;
do i=is-1,ie
410 inv_k4_max = 64.0 * sdt * ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * &
411 max(g%IareaT(i,j), g%IareaT(i+1,j)))**2
412 if (k4_here*inv_k4_max > 0.3) k4_here = 0.3 / inv_k4_max
415 meke_uflux(i,j) = ((k4_here * (g%dy_Cu(i,j)*g%IdxCu(i,j))) * &
416 ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * &
417 (del2meke(i+1,j) - del2meke(i,j))
420 do j=js-1,je ;
do i=is,ie
422 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
423 if (k4_here*inv_k4_max > 0.3) k4_here = 0.3 / inv_k4_max
426 meke_vflux(i,j) = ((k4_here * (g%dx_Cv(i,j)*g%IdyCv(i,j))) * &
427 ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * &
428 (del2meke(i,j+1) - del2meke(i,j))
432 do j=js,je ;
do i=is,ie
433 del4meke(i,j) = (sdt*(g%IareaT(i,j)*i_mass(i,j))) * &
434 ((meke_uflux(i-1,j) - meke_uflux(i,j)) + &
435 (meke_vflux(i,j-1) - meke_vflux(i,j)))
439 if (cs%kh_flux_enabled)
then
441 kh_here = max(0., cs%MEKE_Kh)
443 do j=js,je ;
do i=is-1,ie
445 if (
associated(meke%Kh)) &
446 kh_here = max(0., cs%MEKE_Kh) + &
447 cs%KhMEKE_Fac*0.5*(meke%Kh(i,j)+meke%Kh(i+1,j))
448 if (
associated(meke%Kh_diff)) &
449 kh_here = max(0.,cs%MEKE_Kh) + &
450 cs%KhMEKE_Fac*0.5*(meke%Kh_diff(i,j)+meke%Kh_diff(i+1,j))
451 inv_kh_max = 2.0*sdt * ((g%dy_Cu(i,j)*g%IdxCu(i,j)) * &
452 max(g%IareaT(i,j),g%IareaT(i+1,j)))
453 if (kh_here*inv_kh_max > 0.25) kh_here = 0.25 / inv_kh_max
457 meke_uflux(i,j) = ((kh_here * (g%dy_Cu(i,j)*g%IdxCu(i,j))) * &
458 ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * &
459 (meke%MEKE(i,j) - meke%MEKE(i+1,j))
462 do j=js-1,je ;
do i=is,ie
463 if (
associated(meke%Kh)) &
464 kh_here = max(0.,cs%MEKE_Kh) + cs%KhMEKE_Fac * 0.5*(meke%Kh(i,j)+meke%Kh(i,j+1))
465 if (
associated(meke%Kh_diff)) &
466 kh_here = max(0.,cs%MEKE_Kh) + cs%KhMEKE_Fac * 0.5*(meke%Kh_diff(i,j)+meke%Kh_diff(i,j+1))
467 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)))
468 if (kh_here*inv_kh_max > 0.25) kh_here = 0.25 / inv_kh_max
472 meke_vflux(i,j) = ((kh_here * (g%dx_Cv(i,j)*g%IdyCv(i,j))) * &
473 ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * &
474 (meke%MEKE(i,j) - meke%MEKE(i,j+1))
476 if (cs%MEKE_advection_factor>0.)
then
477 advfac = cs%MEKE_advection_factor / sdt
479 do j=js,je ;
do i=is-1,ie
481 if (barohu(i,j)>0.)
then
482 meke_uflux(i,j) = meke_uflux(i,j) + barohu(i,j)*meke%MEKE(i,j)*advfac
483 elseif (barohu(i,j)<0.)
then
484 meke_uflux(i,j) = meke_uflux(i,j) + barohu(i,j)*meke%MEKE(i+1,j)*advfac
488 do j=js-1,je ;
do i=is,ie
490 if (barohv(i,j)>0.)
then
491 meke_vflux(i,j) = meke_vflux(i,j) + barohv(i,j)*meke%MEKE(i,j)*advfac
492 elseif (barohv(i,j)<0.)
then
493 meke_vflux(i,j) = meke_vflux(i,j) + barohv(i,j)*meke%MEKE(i,j+1)*advfac
499 do j=js,je ;
do i=is,ie
500 meke%MEKE(i,j) = meke%MEKE(i,j) + (sdt*(g%IareaT(i,j)*i_mass(i,j))) * &
501 ((meke_uflux(i-1,j) - meke_uflux(i,j)) + &
502 (meke_vflux(i,j-1) - meke_vflux(i,j)))
507 if (cs%MEKE_K4 >= 0.0)
then
509 do j=js,je ;
do i=is,ie
510 meke%MEKE(i,j) = meke%MEKE(i,j) + del4meke(i,j)
515 if (cs%MEKE_KH >= 0.0 .or. cs%MEKE_K4 >= 0.0)
then
516 if (sdt>sdt_damp)
then
518 if (use_drag_rate)
then
520 do j=js,je ;
do i=is,ie
521 drag_rate(i,j) = (us%L_to_Z*rho0 * i_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 + &
522 cdrag2 * ( max(0.0, 2.0*bottomfac2(i,j)*meke%MEKE(i,j)) + cs%MEKE_Uscale**2 ) )
525 do j=js,je ;
do i=is,ie
526 ldamping = cs%MEKE_damping + drag_rate(i,j) * bottomfac2(i,j)
527 if (meke%MEKE(i,j) < 0.) ldamping = 0.
530 meke%MEKE(i,j) = meke%MEKE(i,j) / (1.0 + sdt_damp*ldamping)
531 meke_decay(i,j) = ldamping*g%mask2dT(i,j)
541 call cpu_clock_begin(cs%id_clock_pass)
542 call do_group_pass(cs%pass_MEKE, g%Domain)
543 call cpu_clock_end(cs%id_clock_pass)
546 if (cs%MEKE_KhCoeff>0.)
then
547 if (.not.cs%MEKE_GEOMETRIC)
then
548 if (cs%use_old_lscale)
then
549 if (cs%Rd_as_max_scale)
then
551 do j=js,je ;
do i=is,ie
552 meke%Kh(i,j) = (cs%MEKE_KhCoeff * &
553 sqrt(2.*max(0.,barotrfac2(i,j)*meke%MEKE(i,j))*g%areaT(i,j)) ) * &
554 min(meke%Rd_dx_h(i,j), 1.0)
558 do j=js,je ;
do i=is,ie
559 meke%Kh(i,j) = cs%MEKE_KhCoeff * &
560 sqrt(2.*max(0., barotrfac2(i,j)*meke%MEKE(i,j))*g%areaT(i,j))
565 do j=js,je ;
do i=is,ie
566 meke%Kh(i,j) = cs%MEKE_KhCoeff * &
567 sqrt(2.*max(0., barotrfac2(i,j)*meke%MEKE(i,j))) * lmixscale(i,j)
574 if (cs%viscosity_coeff_Ku /=0.)
then
575 do j=js,je ;
do i=is,ie
576 meke%Ku(i,j) = cs%viscosity_coeff_Ku * sqrt(2.*max(0.,meke%MEKE(i,j))) * lmixscale(i,j)
580 if (cs%viscosity_coeff_Au /=0.)
then
581 do j=js,je ;
do i=is,ie
582 meke%Au(i,j) = cs%viscosity_coeff_Au * sqrt(2.*max(0.,meke%MEKE(i,j))) * lmixscale(i,j)**3
586 if (
associated(meke%Kh) .or.
associated(meke%Ku) .or.
associated(meke%Au))
then
587 call cpu_clock_begin(cs%id_clock_pass)
588 call do_group_pass(cs%pass_Kh, g%Domain)
589 call cpu_clock_end(cs%id_clock_pass)
593 if (any([cs%id_Ue, cs%id_Ub, cs%id_Ut] > 0)) &
595 if (cs%id_MEKE>0)
call post_data(cs%id_MEKE, meke%MEKE, cs%diag)
597 do j=js,je ;
do i=is,ie
598 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j)))
603 do j=js,je ;
do i=is,ie
604 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j) * bottomfac2(i,j)))
609 do j=js,je ;
do i=is,ie
610 tmp(i,j) = sqrt(max(0., 2. * meke%MEKE(i,j) * barotrfac2(i,j)))
614 if (cs%id_Kh>0)
call post_data(cs%id_Kh, meke%Kh, cs%diag)
615 if (cs%id_Ku>0)
call post_data(cs%id_Ku, meke%Ku, cs%diag)
616 if (cs%id_Au>0)
call post_data(cs%id_Au, meke%Au, cs%diag)
617 if (cs%id_KhMEKE_u>0)
call post_data(cs%id_KhMEKE_u, kh_u, cs%diag)
618 if (cs%id_KhMEKE_v>0)
call post_data(cs%id_KhMEKE_v, kh_v, cs%diag)
619 if (cs%id_src>0)
call post_data(cs%id_src, src, cs%diag)
620 if (cs%id_decay>0)
call post_data(cs%id_decay, meke_decay, cs%diag)
621 if (cs%id_GM_src>0)
call post_data(cs%id_GM_src, meke%GM_src, cs%diag)
622 if (cs%id_mom_src>0)
call post_data(cs%id_mom_src, meke%mom_src, cs%diag)
623 if (cs%id_GME_snk>0)
call post_data(cs%id_GME_snk, meke%GME_snk, cs%diag)
624 if (cs%id_Le>0)
call post_data(cs%id_Le, lmixscale, cs%diag)
625 if (cs%id_gamma_b>0)
then
626 do j=js,je ;
do i=is,ie
627 bottomfac2(i,j) = sqrt(bottomfac2(i,j))
629 call post_data(cs%id_gamma_b, bottomfac2, cs%diag)
631 if (cs%id_gamma_t>0)
then
632 do j=js,je ;
do i=is,ie
633 barotrfac2(i,j) = sqrt(barotrfac2(i,j))
635 call post_data(cs%id_gamma_t, barotrfac2, cs%diag)
638 end subroutine step_forward_meke
643 subroutine meke_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_mass)
649 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
650 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
651 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: drag_rate_visc
653 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: I_mass
657 real :: bottomFac2, barotrFac2
658 real :: LmixScale, LRhines, LEady
666 real :: EKE, EKEmin, EKEmax, EKEerr
667 real :: resid, ResMin, ResMax
669 real :: beta_topo_x, beta_topo_y
670 integer :: i, j, is, ie, js, je, n1, n2
672 logical :: useSecant, debugIteration
674 real :: Lgrid, Ldeform, Lfrict
676 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
678 debugiteration = .false.
679 khcoeff = cs%MEKE_KhCoeff
680 ubg2 = cs%MEKE_Uscale**2
682 tolerance = 1.0e-12*us%m_s_to_L_T**2
685 do j=js,je ;
do i=is,ie
688 sn = min(sn_u(i,j), sn_u(i-1,j), sn_v(i,j), sn_v(i,j-1))
690 if (cs%MEKE_equilibrium_alt)
then
691 meke%MEKE(i,j) = (cs%MEKE_GEOMETRIC_alpha * sn * us%Z_to_m*g%bathyT(i,j))**2 / cd2
693 fath = 0.25*((g%CoriolisBu(i,j) + g%CoriolisBu(i-1,j-1)) + &
694 (g%CoriolisBu(i-1,j) + g%CoriolisBu(i,j-1)))
697 if (cs%MEKE_topographic_beta == 0. .or. g%bathyT(i,j) == 0.)
then
698 beta_topo_x = 0. ; beta_topo_y = 0.
702 beta_topo_x = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
703 (g%bathyT(i+1,j)-g%bathyT(i,j)) * g%IdxCu(i,j) &
704 / max(g%bathyT(i+1,j),g%bathyT(i,j), gv%H_subroundoff) &
705 + (g%bathyT(i,j)-g%bathyT(i-1,j)) * g%IdxCu(i-1,j) &
706 / max(g%bathyT(i,j),g%bathyT(i-1,j), gv%H_subroundoff) )
707 beta_topo_y = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
708 (g%bathyT(i,j+1)-g%bathyT(i,j)) * g%IdyCv(i,j) &
709 / max(g%bathyT(i,j+1),g%bathyT(i,j), gv%H_subroundoff) + &
710 (g%bathyT(i,j)-g%bathyT(i,j-1)) * g%IdyCv(i,j-1) &
711 / max(g%bathyT(i,j),g%bathyT(i,j-1), gv%H_subroundoff) )
713 beta = sqrt((g%dF_dx(i,j) + beta_topo_x)**2 + &
714 (g%dF_dy(i,j) + beta_topo_y)**2 )
716 i_h = us%L_to_Z*gv%Rho0 * i_mass(i,j)
718 if (khcoeff*sn*i_h>0.)
then
722 ekemax = 0.01*us%m_s_to_L_T**2
726 resid = 1.0*us%m_to_L**2*us%T_to_s**3 ; n1 = 0
730 call meke_lengthscales_0d(cs, us, g%areaT(i,j), beta, g%bathyT(i,j), &
731 meke%Rd_dx_h(i,j), sn, eke, &
732 bottomfac2, barotrfac2, lmixscale, lrhines, leady)
734 kh = (khcoeff * sqrt(2.*barotrfac2*eke) * lmixscale)
736 drag_rate = i_h * sqrt(drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomfac2*eke + ubg2 ) )
737 ldamping = cs%MEKE_damping + drag_rate * bottomfac2
738 resid = src - ldamping * eke
749 if (resid<resmin) usesecant = .true.
751 if (ekemax > 2.e17*us%m_s_to_L_T**2)
then
752 if (debugiteration) stop
'Something has gone very wrong'
753 debugiteration = .true.
755 ekemin = 0. ; resmin = 0.
756 ekemax = 0.01*us%m_s_to_L_T**2
764 n2 = 0 ; ekeerr = ekemax - ekemin
765 do while (ekeerr > tolerance)
768 eke = ekemin + (ekemax - ekemin) * (resmin / (resmin - resmax))
770 eke = 0.5 * (ekemin + ekemax)
772 ekeerr = min( eke-ekemin, ekemax-eke )
774 kh = (khcoeff * sqrt(2.*barotrfac2*eke) * lmixscale)
776 drag_rate = i_h * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomfac2*eke + ubg2 ) )
777 ldamping = cs%MEKE_damping + drag_rate * bottomfac2
778 resid = src - ldamping * eke
779 if (usesecant .and. resid>resmin) usesecant = .false.
782 if (resid<resmin) usesecant = .true.
784 elseif (resid<0.)
then
790 if (n2>200) stop
'Failing to converge?'
800 end subroutine meke_equilibrium
805 subroutine meke_equilibrium_restoring(CS, G, US, SN_u, SN_v)
809 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
810 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
813 integer :: i, j, is, ie, js, je
816 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
819 if (.not.
associated(cs%equilibrium_value))
allocate(cs%equilibrium_value(szi_(g),szj_(g)))
820 cs%equilibrium_value(:,:) = 0.0
823 do j=js,je ;
do i=is,ie
826 sn = min(sn_u(i,j), sn_u(i-1,j), sn_v(i,j), sn_v(i,j-1))
827 cs%equilibrium_value(i,j) = (cs%MEKE_GEOMETRIC_alpha * sn * us%Z_to_m*g%bathyT(i,j))**2 / cd2
830 if (cs%id_MEKE_equilibrium>0)
call post_data(cs%id_MEKE_equilibrium, cs%equilibrium_value, cs%diag)
832 end subroutine meke_equilibrium_restoring
837 subroutine meke_lengthscales(CS, MEKE, G, GV, US, SN_u, SN_v, &
838 EKE, bottomFac2, barotrFac2, LmixScale)
844 real,
dimension(SZIB_(G),SZJ_(G)),
intent(in) :: SN_u
845 real,
dimension(SZI_(G),SZJB_(G)),
intent(in) :: SN_v
846 real,
dimension(SZI_(G),SZJ_(G)),
intent(in) :: EKE
847 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: bottomFac2
848 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: barotrFac2
849 real,
dimension(SZI_(G),SZJ_(G)),
intent(out) :: LmixScale
851 real,
dimension(SZI_(G),SZJ_(G)) :: LRhines, LEady
855 real :: beta_topo_x, beta_topo_y
856 integer :: i, j, is, ie, js, je
858 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
861 do j=js,je ;
do i=is,ie
862 if (.not.cs%use_old_lscale)
then
863 if (cs%aEady > 0.)
then
864 sn = 0.25 * ( (sn_u(i,j) + sn_u(i-1,j)) + (sn_v(i,j) + sn_v(i,j-1)) )
868 fath = 0.25* ( ( g%CoriolisBu(i,j) + g%CoriolisBu(i-1,j-1) ) + &
869 ( g%CoriolisBu(i-1,j) + g%CoriolisBu(i,j-1) ) )
874 if (cs%MEKE_topographic_beta == 0. .or. g%bathyT(i,j) == 0.0)
then
875 beta_topo_x = 0. ; beta_topo_y = 0.
879 beta_topo_x = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
880 (g%bathyT(i+1,j)-g%bathyT(i,j)) * g%IdxCu(i,j) &
881 / max(g%bathyT(i+1,j),g%bathyT(i,j), gv%H_subroundoff) &
882 + (g%bathyT(i,j)-g%bathyT(i-1,j)) * g%IdxCu(i-1,j) &
883 / max(g%bathyT(i,j),g%bathyT(i-1,j), gv%H_subroundoff) )
884 beta_topo_y = -cs%MEKE_topographic_beta * fath * 0.5 * ( &
885 (g%bathyT(i,j+1)-g%bathyT(i,j)) * g%IdyCv(i,j) &
886 / max(g%bathyT(i,j+1),g%bathyT(i,j), gv%H_subroundoff) + &
887 (g%bathyT(i,j)-g%bathyT(i,j-1)) * g%IdyCv(i,j-1) &
888 / max(g%bathyT(i,j),g%bathyT(i,j-1), gv%H_subroundoff) )
890 beta = sqrt((g%dF_dx(i,j) + beta_topo_x)**2 + &
891 (g%dF_dy(i,j) + beta_topo_y)**2 )
897 call meke_lengthscales_0d(cs, us, g%areaT(i,j), beta, g%bathyT(i,j), &
898 meke%Rd_dx_h(i,j), sn, meke%MEKE(i,j), &
899 bottomfac2(i,j), barotrfac2(i,j), lmixscale(i,j), &
900 lrhines(i,j), leady(i,j))
902 if (cs%id_Lrhines>0)
call post_data(cs%id_LRhines, lrhines, cs%diag)
903 if (cs%id_Leady>0)
call post_data(cs%id_LEady, leady, cs%diag)
905 end subroutine meke_lengthscales
910 subroutine meke_lengthscales_0d(CS, US, area, beta, depth, Rd_dx, SN, EKE, & ! Z_to_L, &
911 bottomFac2, barotrFac2, LmixScale, Lrhines, Leady)
914 real,
intent(in) :: area
915 real,
intent(in) :: beta
916 real,
intent(in) :: depth
917 real,
intent(in) :: Rd_dx
918 real,
intent(in) :: SN
919 real,
intent(in) :: EKE
922 real,
intent(out) :: bottomFac2
923 real,
intent(out) :: barotrFac2
924 real,
intent(out) :: LmixScale
925 real,
intent(out) :: Lrhines
926 real,
intent(out) :: Leady
928 real :: Lgrid, Ldeform, Lfrict
933 ldeform = lgrid * rd_dx
934 lfrict = (us%Z_to_L * depth) / cs%cdrag
937 bottomfac2 = cs%MEKE_CD_SCALE**2
938 if (lfrict*cs%MEKE_Cb>0.) bottomfac2 = bottomfac2 + 1./( 1. + cs%MEKE_Cb*(ldeform/lfrict) )**0.8
939 bottomfac2 = max(bottomfac2, cs%MEKE_min_gamma)
943 if (lfrict*cs%MEKE_Ct>0.) barotrfac2 = 1. / ( 1. + cs%MEKE_Ct*(ldeform/lfrict) )**0.25
944 barotrfac2 = max(barotrfac2, cs%MEKE_min_gamma)
945 if (cs%use_old_lscale)
then
946 if (cs%Rd_as_max_scale)
then
947 lmixscale = min(ldeform, lgrid)
952 ue = sqrt( 2.0 * max( 0., barotrfac2*eke ) )
953 lrhines = sqrt( ue / max( beta, 1.e-30*us%T_to_s*us%L_to_m ) )
954 if (cs%aEady > 0.)
then
955 leady = ue / max( sn, 1.e-15*us%T_to_s )
959 if (cs%use_min_lscale)
then
961 if (cs%aDeform*ldeform > 0.) lmixscale = min(lmixscale,cs%aDeform*ldeform)
962 if (cs%aFrict *lfrict > 0.) lmixscale = min(lmixscale,cs%aFrict *lfrict)
963 if (cs%aRhines*lrhines > 0.) lmixscale = min(lmixscale,cs%aRhines*lrhines)
964 if (cs%aEady *leady > 0.) lmixscale = min(lmixscale,cs%aEady *leady)
965 if (cs%aGrid *lgrid > 0.) lmixscale = min(lmixscale,cs%aGrid *lgrid)
966 if (cs%Lfixed > 0.) lmixscale = min(lmixscale,cs%Lfixed)
969 if (cs%aDeform*ldeform > 0.) lmixscale = lmixscale + 1./(cs%aDeform*ldeform)
970 if (cs%aFrict *lfrict > 0.) lmixscale = lmixscale + 1./(cs%aFrict *lfrict)
971 if (cs%aRhines*lrhines > 0.) lmixscale = lmixscale + 1./(cs%aRhines*lrhines)
972 if (cs%aEady *leady > 0.) lmixscale = lmixscale + 1./(cs%aEady *leady)
973 if (cs%aGrid *lgrid > 0.) lmixscale = lmixscale + 1./(cs%aGrid *lgrid)
974 if (cs%Lfixed > 0.) lmixscale = lmixscale + 1./cs%Lfixed
975 if (lmixscale > 0.) lmixscale = 1. / lmixscale
979 end subroutine meke_lengthscales_0d
983 logical function meke_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS)
984 type(time_type),
intent(in) :: time
988 type(
diag_ctrl),
target,
intent(inout) :: diag
998 real :: meke_restoring_timescale
1000 integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
1001 logical :: laplacian, biharmonic, usevarmix, coldstart
1003 # include "version_variable.h"
1004 character(len=40) :: mdl =
"MOM_MEKE"
1006 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1007 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1010 call get_param(param_file, mdl,
"USE_MEKE", meke_init, default=.false., do_not_log=.true.)
1011 call log_version(param_file, mdl, version,
"", all_default=.not.meke_init)
1012 call get_param(param_file, mdl,
"USE_MEKE", meke_init, &
1013 "If true, turns on the MEKE scheme which calculates "// &
1014 "a sub-grid mesoscale eddy kinetic energy budget.", &
1016 if (.not. meke_init)
return
1018 if (.not.
associated(meke))
then
1020 call mom_error(warning,
"MEKE_init called with NO associated "// &
1021 "MEKE-type structure.")
1024 if (
associated(cs))
then
1025 call mom_error(warning, &
1026 "MEKE_init called with an associated control structure.")
1028 else ;
allocate(cs) ;
endif
1030 call mom_mesg(
"MEKE_init: reading parameters ", 5)
1033 call get_param(param_file, mdl,
"MEKE_DAMPING", cs%MEKE_damping, &
1034 "The local depth-independent MEKE dissipation rate.", &
1035 units=
"s-1", default=0.0, scale=us%T_to_s)
1036 call get_param(param_file, mdl,
"MEKE_CD_SCALE", cs%MEKE_Cd_scale, &
1037 "The ratio of the bottom eddy velocity to the column mean "//&
1038 "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1 "//&
1039 "to account for the surface intensification of MEKE.", &
1040 units=
"nondim", default=0.)
1041 call get_param(param_file, mdl,
"MEKE_CB", cs%MEKE_Cb, &
1042 "A coefficient in the expression for the ratio of bottom projected "//&
1043 "eddy energy and mean column energy (see Jansen et al. 2015).",&
1044 units=
"nondim", default=25.)
1045 call get_param(param_file, mdl,
"MEKE_MIN_GAMMA2", cs%MEKE_min_gamma, &
1046 "The minimum allowed value of gamma_b^2.",&
1047 units=
"nondim", default=0.0001)
1048 call get_param(param_file, mdl,
"MEKE_CT", cs%MEKE_Ct, &
1049 "A coefficient in the expression for the ratio of barotropic "//&
1050 "eddy energy and mean column energy (see Jansen et al. 2015).",&
1051 units=
"nondim", default=50.)
1052 call get_param(param_file, mdl,
"MEKE_GMCOEFF", cs%MEKE_GMcoeff, &
1053 "The efficiency of the conversion of potential energy "//&
1054 "into MEKE by the thickness mixing parameterization. "//&
1055 "If MEKE_GMCOEFF is negative, this conversion is not "//&
1056 "used or calculated.", units=
"nondim", default=-1.0)
1057 call get_param(param_file, mdl,
"MEKE_GEOMETRIC", cs%MEKE_GEOMETRIC, &
1058 "If MEKE_GEOMETRIC is true, uses the GM coefficient formulation "//&
1059 "from the GEOMETRIC framework (Marshall et al., 2012).", default=.false.)
1060 call get_param(param_file, mdl,
"MEKE_GEOMETRIC_ALPHA", cs%MEKE_GEOMETRIC_alpha, &
1061 "The nondimensional coefficient governing the efficiency of the GEOMETRIC \n"//&
1062 "thickness diffusion.", units=
"nondim", default=0.05)
1063 call get_param(param_file, mdl,
"MEKE_EQUILIBRIUM_ALT", cs%MEKE_equilibrium_alt, &
1064 "If true, use an alternative formula for computing the (equilibrium)"//&
1065 "initial value of MEKE.", default=.false.)
1066 call get_param(param_file, mdl,
"MEKE_EQUILIBRIUM_RESTORING", cs%MEKE_equilibrium_restoring, &
1067 "If true, restore MEKE back to its equilibrium value, which is calculated at "//&
1068 "each time step.", default=.false.)
1069 if (cs%MEKE_equilibrium_restoring)
then
1070 call get_param(param_file, mdl,
"MEKE_RESTORING_TIMESCALE", meke_restoring_timescale, &
1071 "The timescale used to nudge MEKE toward its equilibrium value.", units=
"s", &
1072 default=1e6, scale=us%T_to_s)
1073 cs%MEKE_restoring_rate = 1.0 / meke_restoring_timescale
1076 call get_param(param_file, mdl,
"MEKE_FRCOEFF", cs%MEKE_FrCoeff, &
1077 "The efficiency of the conversion of mean energy into "//&
1078 "MEKE. If MEKE_FRCOEFF is negative, this conversion "//&
1079 "is not used or calculated.", units=
"nondim", default=-1.0)
1080 call get_param(param_file, mdl,
"MEKE_GMECOEFF", cs%MEKE_GMECoeff, &
1081 "The efficiency of the conversion of MEKE into mean energy "//&
1082 "by GME. If MEKE_GMECOEFF is negative, this conversion "//&
1083 "is not used or calculated.", units=
"nondim", default=-1.0)
1084 call get_param(param_file, mdl,
"MEKE_BGSRC", cs%MEKE_BGsrc, &
1085 "A background energy source for MEKE.", units=
"W kg-1", &
1086 default=0.0, scale=us%m_to_L**2*us%T_to_s**3)
1087 call get_param(param_file, mdl,
"MEKE_KH", cs%MEKE_Kh, &
1088 "A background lateral diffusivity of MEKE. "//&
1089 "Use a negative value to not apply lateral diffusion to MEKE.", &
1090 units=
"m2 s-1", default=-1.0, scale=us%m_to_L**2*us%T_to_s)
1091 call get_param(param_file, mdl,
"MEKE_K4", cs%MEKE_K4, &
1092 "A lateral bi-harmonic diffusivity of MEKE. "//&
1093 "Use a negative value to not apply bi-harmonic diffusion to MEKE.", &
1094 units=
"m4 s-1", default=-1.0, scale=us%m_to_L**4*us%T_to_s)
1095 call get_param(param_file, mdl,
"MEKE_DTSCALE", cs%MEKE_dtScale, &
1096 "A scaling factor to accelerate the time evolution of MEKE.", &
1097 units=
"nondim", default=1.0)
1098 call get_param(param_file, mdl,
"MEKE_KHCOEFF", cs%MEKE_KhCoeff, &
1099 "A scaling factor in the expression for eddy diffusivity "//&
1100 "which is otherwise proportional to the MEKE velocity- "//&
1101 "scale times an eddy mixing-length. This factor "//&
1102 "must be >0 for MEKE to contribute to the thickness/ "//&
1103 "and tracer diffusivity in the rest of the model.", &
1104 units=
"nondim", default=1.0)
1105 call get_param(param_file, mdl,
"MEKE_USCALE", cs%MEKE_Uscale, &
1106 "The background velocity that is combined with MEKE to "//&
1107 "calculate the bottom drag.", units=
"m s-1", default=0.0, scale=us%m_s_to_L_T)
1108 call get_param(param_file, mdl,
"MEKE_GM_SRC_ALT", cs%GM_src_alt, &
1109 "If true, use the GM energy conversion form S^2*N^2*kappa rather "//&
1110 "than the streamfunction for the MEKE GM source term.", default=.false.)
1111 call get_param(param_file, mdl,
"MEKE_VISC_DRAG", cs%visc_drag, &
1112 "If true, use the vertvisc_type to calculate the bottom "//&
1113 "drag acting on MEKE.", default=.true.)
1114 call get_param(param_file, mdl,
"MEKE_KHTH_FAC", meke%KhTh_fac, &
1115 "A factor that maps MEKE%Kh to KhTh.", units=
"nondim", &
1117 call get_param(param_file, mdl,
"MEKE_KHTR_FAC", meke%KhTr_fac, &
1118 "A factor that maps MEKE%Kh to KhTr.", units=
"nondim", &
1120 call get_param(param_file, mdl,
"MEKE_KHMEKE_FAC", cs%KhMEKE_Fac, &
1121 "A factor that maps MEKE%Kh to Kh for MEKE itself.", &
1122 units=
"nondim", default=0.0)
1123 call get_param(param_file, mdl,
"MEKE_OLD_LSCALE", cs%use_old_lscale, &
1124 "If true, use the old formula for length scale which is "//&
1125 "a function of grid spacing and deformation radius.", &
1127 call get_param(param_file, mdl,
"MEKE_MIN_LSCALE", cs%use_min_lscale, &
1128 "If true, use a strict minimum of provided length scales "//&
1129 "rather than harmonic mean.", &
1131 call get_param(param_file, mdl,
"MEKE_RD_MAX_SCALE", cs%Rd_as_max_scale, &
1132 "If true, the length scale used by MEKE is the minimum of "//&
1133 "the deformation radius or grid-spacing. Only used if "//&
1134 "MEKE_OLD_LSCALE=True", units=
"nondim", default=.false.)
1135 call get_param(param_file, mdl,
"MEKE_VISCOSITY_COEFF_KU", cs%viscosity_coeff_Ku, &
1136 "If non-zero, is the scaling coefficient in the expression for"//&
1137 "viscosity used to parameterize harmonic lateral momentum mixing by"//&
1138 "unresolved eddies represented by MEKE. Can be negative to"//&
1139 "represent backscatter from the unresolved eddies.", &
1140 units=
"nondim", default=0.0)
1141 call get_param(param_file, mdl,
"MEKE_VISCOSITY_COEFF_AU", cs%viscosity_coeff_Au, &
1142 "If non-zero, is the scaling coefficient in the expression for"//&
1143 "viscosity used to parameterize biharmonic lateral momentum mixing by"//&
1144 "unresolved eddies represented by MEKE. Can be negative to"//&
1145 "represent backscatter from the unresolved eddies.", &
1146 units=
"nondim", default=0.0)
1147 call get_param(param_file, mdl,
"MEKE_FIXED_MIXING_LENGTH", cs%Lfixed, &
1148 "If positive, is a fixed length contribution to the expression "//&
1149 "for mixing length used in MEKE-derived diffusivity.", &
1150 units=
"m", default=0.0, scale=us%m_to_L)
1151 call get_param(param_file, mdl,
"MEKE_ALPHA_DEFORM", cs%aDeform, &
1152 "If positive, is a coefficient weighting the deformation scale "//&
1153 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1154 units=
"nondim", default=0.0)
1155 call get_param(param_file, mdl,
"MEKE_ALPHA_RHINES", cs%aRhines, &
1156 "If positive, is a coefficient weighting the Rhines scale "//&
1157 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1158 units=
"nondim", default=0.0)
1159 call get_param(param_file, mdl,
"MEKE_ALPHA_EADY", cs%aEady, &
1160 "If positive, is a coefficient weighting the Eady length scale "//&
1161 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1162 units=
"nondim", default=0.0)
1163 call get_param(param_file, mdl,
"MEKE_ALPHA_FRICT", cs%aFrict, &
1164 "If positive, is a coefficient weighting the frictional arrest scale "//&
1165 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1166 units=
"nondim", default=0.0)
1167 call get_param(param_file, mdl,
"MEKE_ALPHA_GRID", cs%aGrid, &
1168 "If positive, is a coefficient weighting the grid-spacing as a scale "//&
1169 "in the expression for mixing length used in MEKE-derived diffusivity.", &
1170 units=
"nondim", default=0.0)
1171 call get_param(param_file, mdl,
"MEKE_COLD_START", coldstart, &
1172 "If true, initialize EKE to zero. Otherwise a local equilibrium solution "//&
1173 "is used as an initial condition for EKE.", default=.false.)
1174 call get_param(param_file, mdl,
"MEKE_BACKSCAT_RO_C", meke%backscatter_Ro_c, &
1175 "The coefficient in the Rossby number function for scaling the biharmonic "//&
1176 "frictional energy source. Setting to non-zero enables the Rossby number function.", &
1177 units=
"nondim", default=0.0)
1178 call get_param(param_file, mdl,
"MEKE_BACKSCAT_RO_POW", meke%backscatter_Ro_pow, &
1179 "The power in the Rossby number function for scaling the biharmonic "//&
1180 "frictional energy source.", units=
"nondim", default=0.0)
1181 call get_param(param_file, mdl,
"MEKE_ADVECTION_FACTOR", cs%MEKE_advection_factor, &
1182 "A scale factor in front of advection of eddy energy. Zero turns advection off. "//&
1183 "Using unity would be normal but other values could accommodate a mismatch "//&
1184 "between the advecting barotropic flow and the vertical structure of MEKE.", &
1185 units=
"nondim", default=0.0)
1186 call get_param(param_file, mdl,
"MEKE_TOPOGRAPHIC_BETA", cs%MEKE_topographic_beta, &
1187 "A scale factor to determine how much topographic beta is weighed in " //&
1188 "computing beta in the expression of Rhines scale. Use 1 if full "//&
1189 "topographic beta effect is considered; use 0 if it's completely ignored.", &
1190 units=
"nondim", default=0.0)
1193 call get_param(param_file, mdl,
"CDRAG", cdrag, &
1194 "CDRAG is the drag coefficient relating the magnitude of "//&
1195 "the velocity field to the bottom stress.", units=
"nondim", &
1197 call get_param(param_file, mdl,
"MEKE_CDRAG", cs%cdrag, &
1198 "Drag coefficient relating the magnitude of the velocity "//&
1199 "field to the bottom stress in MEKE.", units=
"nondim", &
1201 call get_param(param_file, mdl,
"LAPLACIAN", laplacian, default=.false., do_not_log=.true.)
1202 call get_param(param_file, mdl,
"BIHARMONIC", biharmonic, default=.false., do_not_log=.true.)
1204 if (cs%viscosity_coeff_Ku/=0. .and. .not. laplacian)
call mom_error(fatal, &
1205 "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF_KU is true.")
1207 if (cs%viscosity_coeff_Au/=0. .and. .not. biharmonic)
call mom_error(fatal, &
1208 "BIHARMONIC must be true if MEKE_VISCOSITY_COEFF_AU is true.")
1210 call get_param(param_file, mdl,
"DEBUG", cs%debug, default=.false., do_not_log=.true.)
1213 cs%kh_flux_enabled = .false.
1214 if ((cs%MEKE_KH >= 0.0) .or. (cs%KhMEKE_FAC > 0.0) .or. (cs%MEKE_advection_factor > 0.0)) &
1215 cs%kh_flux_enabled = .true.
1219 cs%id_MEKE = register_diag_field(
'ocean_model',
'MEKE', diag%axesT1, time, &
1220 'Mesoscale Eddy Kinetic Energy',
'm2 s-2', conversion=us%L_T_to_m_s**2)
1221 if (.not.
associated(meke%MEKE)) cs%id_MEKE = -1
1222 cs%id_Kh = register_diag_field(
'ocean_model',
'MEKE_KH', diag%axesT1, time, &
1223 'MEKE derived diffusivity',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1224 if (.not.
associated(meke%Kh)) cs%id_Kh = -1
1225 cs%id_Ku = register_diag_field(
'ocean_model',
'MEKE_KU', diag%axesT1, time, &
1226 'MEKE derived lateral viscosity',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1227 if (.not.
associated(meke%Ku)) cs%id_Ku = -1
1228 cs%id_Au = register_diag_field(
'ocean_model',
'MEKE_AU', diag%axesT1, time, &
1229 'MEKE derived lateral biharmonic viscosity',
'm4 s-1', conversion=us%L_to_m**4*us%s_to_T)
1230 if (.not.
associated(meke%Au)) cs%id_Au = -1
1231 cs%id_Ue = register_diag_field(
'ocean_model',
'MEKE_Ue', diag%axesT1, time, &
1232 'MEKE derived eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1233 if (.not.
associated(meke%MEKE)) cs%id_Ue = -1
1234 cs%id_Ub = register_diag_field(
'ocean_model',
'MEKE_Ub', diag%axesT1, time, &
1235 'MEKE derived bottom eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1236 if (.not.
associated(meke%MEKE)) cs%id_Ub = -1
1237 cs%id_Ut = register_diag_field(
'ocean_model',
'MEKE_Ut', diag%axesT1, time, &
1238 'MEKE derived barotropic eddy-velocity scale',
'm s-1', conversion=us%L_T_to_m_s)
1239 if (.not.
associated(meke%MEKE)) cs%id_Ut = -1
1240 cs%id_src = register_diag_field(
'ocean_model',
'MEKE_src', diag%axesT1, time, &
1241 'MEKE energy source',
'm2 s-3', conversion=(us%L_T_to_m_s**2)*us%s_to_T)
1242 cs%id_decay = register_diag_field(
'ocean_model',
'MEKE_decay', diag%axesT1, time, &
1243 'MEKE decay rate',
's-1', conversion=us%s_to_T)
1244 cs%id_GM_src = register_diag_field(
'ocean_model',
'MEKE_GM_src', diag%axesT1, time, &
1245 'MEKE energy available from thickness mixing', &
1246 'W m-2', conversion=us%RZ3_T3_to_W_m2*us%L_to_Z**2)
1247 if (.not.
associated(meke%GM_src)) cs%id_GM_src = -1
1248 cs%id_mom_src = register_diag_field(
'ocean_model',
'MEKE_mom_src',diag%axesT1, time, &
1249 'MEKE energy available from momentum', &
1250 'W m-2', conversion=us%RZ3_T3_to_W_m2*us%L_to_Z**2)
1251 if (.not.
associated(meke%mom_src)) cs%id_mom_src = -1
1252 cs%id_GME_snk = register_diag_field(
'ocean_model',
'MEKE_GME_snk',diag%axesT1, time, &
1253 'MEKE energy lost to GME backscatter', &
1254 'W m-2', conversion=us%RZ3_T3_to_W_m2*us%L_to_Z**2)
1255 if (.not.
associated(meke%GME_snk)) cs%id_GME_snk = -1
1256 cs%id_Le = register_diag_field(
'ocean_model',
'MEKE_Le', diag%axesT1, time, &
1257 'Eddy mixing length used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1258 cs%id_Lrhines = register_diag_field(
'ocean_model',
'MEKE_Lrhines', diag%axesT1, time, &
1259 'Rhines length scale used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1260 cs%id_Leady = register_diag_field(
'ocean_model',
'MEKE_Leady', diag%axesT1, time, &
1261 'Eady length scale used in the MEKE derived eddy diffusivity',
'm', conversion=us%L_to_m)
1262 cs%id_gamma_b = register_diag_field(
'ocean_model',
'MEKE_gamma_b', diag%axesT1, time, &
1263 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity',
'nondim')
1264 cs%id_gamma_t = register_diag_field(
'ocean_model',
'MEKE_gamma_t', diag%axesT1, time, &
1265 'Ratio of barotropic eddy velocity to column-mean eddy velocity',
'nondim')
1267 if (cs%kh_flux_enabled)
then
1268 cs%id_KhMEKE_u = register_diag_field(
'ocean_model',
'KHMEKE_u', diag%axesCu1, time, &
1269 'Zonal diffusivity of MEKE',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1270 cs%id_KhMEKE_v = register_diag_field(
'ocean_model',
'KHMEKE_v', diag%axesCv1, time, &
1271 'Meridional diffusivity of MEKE',
'm2 s-1', conversion=us%L_to_m**2*us%s_to_T)
1274 if (cs%MEKE_equilibrium_restoring)
then
1275 cs%id_MEKE_equilibrium = register_diag_field(
'ocean_model',
'MEKE_equilibrium', diag%axesT1, time, &
1276 'Equilibrated Mesoscale Eddy Kinetic Energy',
'm2 s-2', conversion=us%L_T_to_m_s**2)
1279 cs%id_clock_pass = cpu_clock_id(
'(Ocean continuity halo updates)', grain=clock_routine)
1285 if (coldstart) cs%initialize = .false.
1286 if (cs%initialize)
call mom_error(warning, &
1287 "MEKE_init: Initializing MEKE with a local equilibrium balance.")
1292 if ((us%s_to_T_restart /= 0.0) .and. (us%s_to_T_restart /= us%s_to_T)) &
1293 i_t_rescale = us%s_to_T_restart / us%s_to_T
1295 if ((us%m_to_L_restart /= 0.0) .and. (us%m_to_L_restart /= us%m_to_L)) &
1296 l_rescale = us%m_to_L / us%m_to_L_restart
1298 if (l_rescale*i_t_rescale /= 1.0)
then
1299 if (
associated(meke%MEKE))
then ;
if (
query_initialized(meke%MEKE,
"MEKE_MEKE", restart_cs))
then
1300 do j=js,je ;
do i=is,ie
1301 meke%MEKE(i,j) = l_rescale*i_t_rescale * meke%MEKE(i,j)
1305 if (l_rescale**2*i_t_rescale /= 1.0)
then
1306 if (
associated(meke%Kh))
then ;
if (
query_initialized(meke%Kh,
"MEKE_Kh", restart_cs))
then
1307 do j=js,je ;
do i=is,ie
1308 meke%Kh(i,j) = l_rescale**2*i_t_rescale * meke%Kh(i,j)
1311 if (
associated(meke%Ku))
then ;
if (
query_initialized(meke%Ku,
"MEKE_Ku", restart_cs))
then
1312 do j=js,je ;
do i=is,ie
1313 meke%Ku(i,j) = l_rescale**2*i_t_rescale * meke%Ku(i,j)
1316 if (
associated(meke%Kh_diff))
then ;
if (
query_initialized(meke%Kh,
"MEKE_Kh_diff", restart_cs))
then
1317 do j=js,je ;
do i=is,ie
1318 meke%Kh_diff(i,j) = l_rescale**2*i_t_rescale * meke%Kh_diff(i,j)
1322 if (l_rescale**4*i_t_rescale /= 1.0)
then
1323 if (
associated(meke%Au))
then ;
if (
query_initialized(meke%Au,
"MEKE_Au", restart_cs))
then
1324 do j=js,je ;
do i=is,ie
1325 meke%Au(i,j) = l_rescale**4*i_t_rescale * meke%Au(i,j)
1331 if (
associated(meke%MEKE))
then
1333 if (
associated(meke%Kh_diff))
call create_group_pass(cs%pass_MEKE, meke%Kh_diff, g%Domain)
1334 if (.not.cs%initialize)
call do_group_pass(cs%pass_MEKE, g%Domain)
1340 if (
associated(meke%Kh) .or.
associated(meke%Ku) .or.
associated(meke%Au)) &
1341 call do_group_pass(cs%pass_Kh, g%Domain)
1343 end function meke_init
1346 subroutine meke_alloc_register_restart(HI, param_file, MEKE, restart_CS)
1354 real :: meke_gmcoeff, meke_frcoeff, meke_gmecoeff, meke_khcoeff, meke_visccoeff_ku, meke_visccoeff_au
1355 logical :: use_kh_in_meke
1357 integer :: isd, ied, jsd, jed
1360 usemeke = .false.;
call read_param(param_file,
"USE_MEKE",usemeke)
1363 meke_gmcoeff =-1.;
call read_param(param_file,
"MEKE_GMCOEFF",meke_gmcoeff)
1364 meke_frcoeff =-1.;
call read_param(param_file,
"MEKE_FRCOEFF",meke_frcoeff)
1365 meke_gmecoeff =-1.;
call read_param(param_file,
"MEKE_GMECOEFF",meke_gmecoeff)
1366 meke_khcoeff =1.;
call read_param(param_file,
"MEKE_KHCOEFF",meke_khcoeff)
1367 meke_visccoeff_ku =0.;
call read_param(param_file,
"MEKE_VISCOSITY_COEFF_KU",meke_visccoeff_ku)
1368 meke_visccoeff_au =0.;
call read_param(param_file,
"MEKE_VISCOSITY_COEFF_AU",meke_visccoeff_au)
1369 use_kh_in_meke = .false.;
call read_param(param_file,
"USE_KH_IN_MEKE", use_kh_in_meke)
1371 if (
associated(meke))
then
1372 call mom_error(warning,
"MEKE_alloc_register_restart called with an associated "// &
1375 else;
allocate(meke);
endif
1377 if (.not. usemeke)
return
1380 call mom_mesg(
"MEKE_alloc_register_restart: allocating and registering", 5)
1381 isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed
1382 allocate(meke%MEKE(isd:ied,jsd:jed)) ; meke%MEKE(:,:) = 0.0
1383 vd = var_desc(
"MEKE",
"m2 s-2", hor_grid=
'h', z_grid=
'1', &
1384 longname=
"Mesoscale Eddy Kinetic Energy")
1386 if (meke_gmcoeff>=0.)
then
1387 allocate(meke%GM_src(isd:ied,jsd:jed)) ; meke%GM_src(:,:) = 0.0
1389 if (meke_frcoeff>=0. .or. meke_gmecoeff>=0.)
then
1390 allocate(meke%mom_src(isd:ied,jsd:jed)) ; meke%mom_src(:,:) = 0.0
1392 if (meke_gmecoeff>=0.)
then
1393 allocate(meke%GME_snk(isd:ied,jsd:jed)) ; meke%GME_snk(:,:) = 0.0
1395 if (meke_khcoeff>=0.)
then
1396 allocate(meke%Kh(isd:ied,jsd:jed)) ; meke%Kh(:,:) = 0.0
1397 vd = var_desc(
"MEKE_Kh",
"m2 s-1", hor_grid=
'h', z_grid=
'1', &
1398 longname=
"Lateral diffusivity from Mesoscale Eddy Kinetic Energy")
1401 allocate(meke%Rd_dx_h(isd:ied,jsd:jed)) ; meke%Rd_dx_h(:,:) = 0.0
1402 if (meke_visccoeff_ku/=0.)
then
1403 allocate(meke%Ku(isd:ied,jsd:jed)) ; meke%Ku(:,:) = 0.0
1404 vd = var_desc(
"MEKE_Ku",
"m2 s-1", hor_grid=
'h', z_grid=
'1', &
1405 longname=
"Lateral viscosity from Mesoscale Eddy Kinetic Energy")
1408 if (use_kh_in_meke)
then
1409 allocate(meke%Kh_diff(isd:ied,jsd:jed)) ; meke%Kh_diff(:,:) = 0.0
1410 vd = var_desc(
"MEKE_Kh_diff",
"m2 s-1",hor_grid=
'h',z_grid=
'1', &
1411 longname=
"Copy of thickness diffusivity for diffusing MEKE")
1415 if (meke_visccoeff_au/=0.)
then
1416 allocate(meke%Au(isd:ied,jsd:jed)) ; meke%Au(:,:) = 0.0
1417 vd = var_desc(
"MEKE_Au",
"m4 s-1", hor_grid=
'h', z_grid=
'1', &
1418 longname=
"Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy")
1422 end subroutine meke_alloc_register_restart
1426 subroutine meke_end(MEKE, CS)
1430 if (
associated(cs))
deallocate(cs)
1432 if (.not.
associated(meke))
return
1434 if (
associated(meke%MEKE))
deallocate(meke%MEKE)
1435 if (
associated(meke%GM_src))
deallocate(meke%GM_src)
1436 if (
associated(meke%mom_src))
deallocate(meke%mom_src)
1437 if (
associated(meke%GME_snk))
deallocate(meke%GME_snk)
1438 if (
associated(meke%Kh))
deallocate(meke%Kh)
1439 if (
associated(meke%Kh_diff))
deallocate(meke%Kh_diff)
1440 if (
associated(meke%Ku))
deallocate(meke%Ku)
1441 if (
associated(meke%Au))
deallocate(meke%Au)
1444 end subroutine meke_end