6 use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
18 implicit none ;
private 20 #include <MOM_memory.h> 22 public regularize_layers, regularize_layers_init
26 logical :: regularize_surface_layers
30 logical :: reg_sfc_detrain
33 real :: density_match_tol
49 type(time_type),
pointer :: time => null()
52 logical :: answers_2018
57 integer :: id_def_rat = -1
58 logical :: allow_clocks_in_omp_loops
64 integer :: id_clock_pass, id_clock_eos
71 subroutine regularize_layers(h, tv, dt, ea, eb, G, GV, US, CS)
74 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
79 real,
intent(in) :: dt
80 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
84 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
92 integer :: i, j, k, is, ie, js, je, nz
94 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
96 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_regularize_layers: "//&
97 "Module must be initialized before it is used.")
99 if (cs%regularize_surface_layers)
then 100 call pass_var(h, g%Domain, clock=id_clock_pass)
101 call regularize_surface(h, tv, dt, ea, eb, g, gv, us, cs)
104 end subroutine regularize_layers
108 subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS)
111 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
116 real,
intent(in) :: dt
117 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
121 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
129 real,
dimension(SZIB_(G),SZJ_(G)) :: &
131 real,
dimension(SZI_(G),SZJB_(G)) :: &
133 real,
dimension(SZI_(G),SZJ_(G)) :: &
135 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: &
138 real,
dimension(SZI_(G),SZK_(G)+1) :: &
140 real,
dimension(SZI_(G),SZK_(G)) :: &
154 real,
dimension(SZI_(G)) :: &
159 h_add_tgt, h_add_tot, &
160 h_tot1, th_tot1, sh_tot1, &
161 h_tot3, th_tot3, sh_tot3, &
162 h_tot2, th_tot2, sh_tot2
163 real,
dimension(SZK_(G)) :: &
168 real :: e_e, e_w, e_n, e_s
173 real,
dimension(SZK_(G)+1) :: &
174 int_flux, int_Tflux, int_Sflux, int_Rflux
181 real :: int_top, int_bot
186 logical :: cols_left, ent_any, more_ent_i(szi_(g)), ent_i(szi_(g))
187 logical :: det_any, det_i(szi_(g))
188 logical :: do_j(szj_(g)), do_i(szi_(g)), find_i(szi_(g))
189 logical :: debug = .false.
190 logical :: fatal_error
191 character(len=256) :: mesg
192 integer,
dimension(2) :: EOSdom
193 integer :: i, j, k, is, ie, js, je, nz, nkmb, nkml, k1, k2, k3, ks, nz_filt, kmax_d_ea
195 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
197 if (.not.
associated(cs))
call mom_error(fatal,
"MOM_regularize_layers: "//&
198 "Module must be initialized before it is used.")
200 if (gv%nkml<1)
return 201 nkmb = gv%nk_rho_varies ; nkml = gv%nkml
202 if (.not.
associated(tv%eqn_of_state))
call mom_error(fatal, &
203 "MOM_regularize_layers: This module now requires the use of temperature and "//&
204 "an equation of state.")
206 h_neglect = gv%H_subroundoff
207 debug = (debug .or. cs%debug)
209 i_dtol = 1.0 / max(cs%h_def_tol2 - cs%h_def_tol1, 1e-40)
210 i_dtol34 = 1.0 / max(cs%h_def_tol4 - cs%h_def_tol3, 1e-40)
212 p_ref_cv(:) = tv%P_Ref
213 eosdom(:) = eos_domain(g%HI)
215 do j=js-1,je+1 ;
do i=is-1,ie+1
218 do k=1,nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
219 e(i,j,k+1) = e(i,j,k) - h(i,j,k)
220 enddo ;
enddo ;
enddo 222 call find_deficit_ratios(e, def_rat_u, def_rat_v, g, gv, cs, h=h)
225 do j=js,je ; do_j(j) = .false. ;
enddo 226 do j=js,je ;
do i=is,ie
227 def_rat_h(i,j) = max(def_rat_u(i-1,j), def_rat_u(i,j), &
228 def_rat_v(i,j-1), def_rat_v(i,j))
229 if (def_rat_h(i,j) > cs%h_def_tol1) do_j(j) = .true.
236 do j=js,je ;
if (do_j(j))
then 242 do k=1,nz ;
do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ;
enddo ;
enddo 247 do_i(i) = def_rat_h(i,j) > cs%h_def_tol1
248 if (def_rat_h(i,j) > max_def_rat) max_def_rat = def_rat_h(i,j)
250 nz_filt = nkmb+1 ;
if (max_def_rat > cs%h_def_tol3) nz_filt = nz+1
255 do k=1,nz_filt ;
do i=is,ie ;
if (do_i(i))
then 256 if (g%mask2dCu(i,j) <= 0.0)
then ; e_e = e(i,j,k) ;
else 257 e_e = max(e(i+1,j,k) + min(e(i,j,k) - e(i+1,j,nz+1), 0.0), &
258 e(i,j,nz+1) + (nz+1-k)*gv%Angstrom_H)
261 if (g%mask2dCu(i-1,j) <= 0.0)
then ; e_w = e(i,j,k) ;
else 262 e_w = max(e(i-1,j,k) + min(e(i,j,k) - e(i-1,j,nz+1), 0.0), &
263 e(i,j,nz+1) + (nz+1-k)*gv%Angstrom_H)
265 if (g%mask2dCv(i,j) <= 0.0)
then ; e_n = e(i,j,k) ;
else 266 e_n = max(e(i,j+1,k) + min(e(i,j,k) - e(i,j+1,nz+1), 0.0), &
267 e(i,j,nz+1) + (nz+1-k)*gv%Angstrom_H)
269 if (g%mask2dCv(i,j-1) <= 0.0)
then ; e_s = e(i,j,k) ;
else 270 e_s = max(e(i,j-1,k) + min(e(i,j,k) - e(i,j-1,nz+1), 0.0), &
271 e(i,j,nz+1) + (nz+1-k)*gv%Angstrom_H)
274 wt = max(0.0, min(1.0, i_dtol*(def_rat_h(i,j)-cs%h_def_tol1)))
276 e_filt(i,k) = (1.0 - 0.5*wt) * e(i,j,k) + &
277 wt * 0.125 * ((e_e + e_w) + (e_n + e_s))
279 endif ;
enddo ;
enddo 280 do k=1,nz ;
do i=is,ie
282 t_2d(i,k) = tv%T(i,j,k) ; s_2d(i,k) = tv%S(i,j,k)
286 do k=1,nz ;
do i=is,ie ;
if (do_i(i))
then 287 h_2d_init(i,k) = h(i,j,k)
288 t_2d_init(i,k) = tv%T(i,j,k) ; s_2d_init(i,k) = tv%S(i,j,k)
289 endif ;
enddo ;
enddo 295 more_ent_i(i) = .false. ; ent_i(i) = .false.
296 h_add_tgt(i) = 0.0 ; h_add_tot(i) = 0.0
297 if (do_i(i) .and. (e_2d(i,nkmb+1) > e_filt(i,nkmb+1)))
then 298 more_ent_i(i) = .true. ; ent_i(i) = .true. ; ent_any = .true.
299 h_add_tgt(i) = e_2d(i,nkmb+1) - e_filt(i,nkmb+1)
306 do i=is,ie ;
if (more_ent_i(i))
then 307 if (h_2d(i,k) - gv%Angstrom_H > h_neglect)
then 308 if (e_2d(i,nkmb+1)-e_filt(i,nkmb+1) > h_2d(i,k) - gv%Angstrom_H)
then 309 h_add = h_2d(i,k) - gv%Angstrom_H
310 h_2d(i,k) = gv%Angstrom_H
311 e_2d(i,nkmb+1) = e_2d(i,nkmb+1) - h_add
313 h_add = e_2d(i,nkmb+1) - e_filt(i,nkmb+1)
314 h_2d(i,k) = h_2d(i,k) - h_add
315 if (cs%answers_2018)
then 316 e_2d(i,nkmb+1) = e_2d(i,nkmb+1) - h_add
318 e_2d(i,nkmb+1) = e_filt(i,nkmb+1)
321 d_eb(i,k-1) = d_eb(i,k-1) + h_add
322 h_add_tot(i) = h_add_tot(i) + h_add
323 h_prev = h_2d(i,nkmb)
324 h_2d(i,nkmb) = h_2d(i,nkmb) + h_add
326 t_2d(i,nkmb) = (h_prev*t_2d(i,nkmb) + h_add*t_2d(i,k)) / h_2d(i,nkmb)
327 s_2d(i,nkmb) = (h_prev*s_2d(i,nkmb) + h_add*s_2d(i,k)) / h_2d(i,nkmb)
329 if ((e_2d(i,nkmb+1) <= e_filt(i,nkmb+1)) .or. &
330 (h_add_tot(i) > 0.6*h_add_tgt(i)))
then 331 more_ent_i(i) = .false.
339 if (.not.cols_left)
exit 343 do k=ks,nkmb,-1 ;
do i=is,ie ;
if (ent_i(i))
then 344 d_eb(i,k) = d_eb(i,k) + d_eb(i,k+1)
345 endif ;
enddo ;
enddo 357 if ((max_def_rat > cs%h_def_tol3) .and. (cs%reg_sfc_detrain))
then 359 det_i(i) = .false. ; rcv_tol(i) = 0.0
360 if (do_i(i) .and. (e_2d(i,nkmb+1) < e_filt(i,nkmb+1)) .and. &
361 (def_rat_h(i,j) > cs%h_def_tol3))
then 362 det_i(i) = .true. ; det_any = .true.
364 rcv_tol(i) = cs%density_match_tol * min((def_rat_h(i,j) - cs%h_def_tol3), 1.0)
369 call cpu_clock_begin(id_clock_eos)
371 call calculate_density(t_2d(:,k), s_2d(:,k), p_ref_cv, rcv(:,k), tv%eqn_of_state, eosdom)
373 call cpu_clock_end(id_clock_eos)
375 do i=is,ie ;
if (det_i(i))
then 381 rcv_min_det = (gv%Rlay(k2) + rcv_tol(i)*(gv%Rlay(k2-1)-gv%Rlay(k2)))
383 rcv_max_det = (gv%Rlay(k2) + rcv_tol(i)*(gv%Rlay(k2+1)-gv%Rlay(k2)))
385 rcv_max_det = (gv%Rlay(nz) + rcv_tol(i)*(gv%Rlay(nz)-gv%Rlay(nz-1)))
387 if (rcv(i,k1) > rcv_max_det) &
390 h_deficit = (e_filt(i,k2)-e_filt(i,k2+1)) - h_2d(i,k2)
391 if ((e_filt(i,k2) > e_2d(i,k1+1)) .and. (h_deficit > 0.0) .and. &
392 (rcv(i,k1) < rcv_max_det) .and. (rcv(i,k1) > rcv_min_det))
then 394 h_add = min(e_filt(i,k2) - e_2d(i,k2), h_deficit )
395 if (h_add < h_2d(i,k1))
then 397 if (h_add > 0.0)
then 399 h_2d(i,k2) = h_2d(i,k2) + h_add
400 e_2d(i,k2) = e_2d(i,k2+1) + h_2d(i,k2)
401 d_ea(i,k2) = d_ea(i,k2) + h_add
402 kmax_d_ea = max(kmax_d_ea, k2)
404 t_2d(i,k2) = (h_prev*t_2d(i,k2) + h_add*t_2d(i,k1)) / h_2d(i,k2)
405 s_2d(i,k2) = (h_prev*s_2d(i,k2) + h_add*s_2d(i,k1)) / h_2d(i,k2)
406 h_det_tot = h_det_tot + h_add
408 h_2d(i,k1) = h_2d(i,k1) - h_add
409 do k3=k1,nkmb ; e_2d(i,k3+1) = e_2d(i,k3) - h_2d(i,k3) ;
enddo 410 do k3=k1+1,nkmb ; d_ea(i,k3) = d_ea(i,k3) + h_add ;
enddo 413 call mom_error(fatal,
"h_add is negative. Some logic is wrong.")
419 if (k2>nkmb+1) e_2d(i,k2) = e_2d(i,k2) + h_det_tot
423 h_2d(i,k2) = h_2d(i,k2) + h_add
424 e_2d(i,k2) = e_2d(i,k2+1) + h_2d(i,k2)
425 d_ea(i,k2) = d_ea(i,k2) + h_add
426 kmax_d_ea = max(kmax_d_ea, k2)
427 t_2d(i,k2) = (h_prev*t_2d(i,k2) + h_add*t_2d(i,k1)) / h_2d(i,k2)
428 s_2d(i,k2) = (h_prev*s_2d(i,k2) + h_add*s_2d(i,k1)) / h_2d(i,k2)
429 h_det_tot = h_det_tot + h_add
432 do k3=k1,nkmb ; e_2d(i,k3+1) = e_2d(i,k3) - h_2d(i,k3) ;
enddo 433 do k3=k1+1,nkmb ; d_ea(i,k3) = d_ea(i,k3) + h_add ;
enddo 442 if (k2>nkmb+1) e_2d(i,k2) = e_2d(i,k2) + h_det_tot
447 do k=kmax_d_ea-1,nkmb+1,-1 ;
do i=is,ie ;
if (det_i(i))
then 448 d_ea(i,k) = d_ea(i,k) + d_ea(i,k+1)
449 endif ;
enddo ;
enddo 452 do i=is,ie ; h_tot3(i) = 0.0 ; th_tot3(i) = 0.0 ; sh_tot3(i) = 0.0 ;
enddo 453 do k=1,nz ;
do i=is,ie ;
if (do_i(i))
then 454 h_tot3(i) = h_tot3(i) + h_2d(i,k)
455 th_tot3(i) = th_tot3(i) + h_2d(i,k) * t_2d(i,k)
456 sh_tot3(i) = sh_tot3(i) + h_2d(i,k) * s_2d(i,k)
457 endif ;
enddo ;
enddo 460 do i=is,ie ;
if (do_i(i))
then 463 scale = e_2d(i,nkmb+1) / e_filt(i,nkmb+1)
464 do k=2,nkmb+1 ; e_filt(i,k) = e_filt(i,k) * scale ;
enddo 468 if (e_filt(i,2) < e_2d(i,nkml))
then 469 scale = (e_2d(i,nkml) - e_filt(i,nkmb+1)) / &
470 ((e_filt(i,2) - e_filt(i,nkmb+1)) + h_neglect)
472 e_filt(i,k) = e_filt(i,nkmb+1) + scale * (e_filt(i,k) - e_filt(i,nkmb+1))
474 e_filt(i,2) = e_2d(i,nkml)
482 int_flux(k) = 0.0 ; int_rflux(k) = 0.0
483 int_tflux(k) = 0.0 ; int_sflux(k) = 0.0
486 int_bot = max(e_2d(i,k1+1),e_filt(i,k2+1))
487 h_add = int_top - int_bot
491 d_ea(i,k3) = d_ea(i,k3) + h_add
492 int_flux(k3) = int_flux(k3) + h_add
493 int_tflux(k3) = int_tflux(k3) + h_add*t_2d(i,k1)
494 int_sflux(k3) = int_sflux(k3) + h_add*s_2d(i,k1)
496 elseif (k1 > k2)
then 498 d_eb(i,k3) = d_eb(i,k3) + h_add
499 int_flux(k3+1) = int_flux(k3+1) - h_add
500 int_tflux(k3+1) = int_tflux(k3+1) - h_add*t_2d(i,k1)
501 int_sflux(k3+1) = int_sflux(k3+1) - h_add*s_2d(i,k1)
505 if (int_bot <= e_filt(i,k2+1))
then 508 elseif (int_bot <= e_2d(i,k1+1))
then 512 call mom_error(fatal, &
513 "Regularize_surface: Could not increment target or source.")
515 if ((k1 > nkmb) .or. (k2 > nkmb))
exit 519 call mom_error(fatal,
"Regularize_surface: Did not assign fluid to layer nkmb.")
523 do k=1,nkmb ; h_prev_1d(k) = h_2d(i,k) ;
enddo 524 h_2d(i,1) = h_2d(i,1) - int_flux(2)
526 h_2d(i,k) = h_2d(i,k) + (int_flux(k) - int_flux(k+1))
530 h_2d(i,nkmb) = h_2d(i,nkmb) + int_flux(nkmb)
532 t_2d(i,1) = (t_2d(i,1)*h_prev_1d(1) - int_tflux(2)) / h_2d(i,1)
533 s_2d(i,1) = (s_2d(i,1)*h_prev_1d(1) - int_sflux(2)) / h_2d(i,1)
535 t_2d(i,k) = (t_2d(i,k)*h_prev_1d(k) + (int_tflux(k) - int_tflux(k+1))) / h_2d(i,k)
536 s_2d(i,k) = (s_2d(i,k)*h_prev_1d(k) + (int_sflux(k) - int_sflux(k+1))) / h_2d(i,k)
538 t_2d(i,nkmb) = (t_2d(i,nkmb)*h_prev_1d(nkmb) + int_tflux(nkmb) ) / h_2d(i,nkmb)
539 s_2d(i,nkmb) = (s_2d(i,nkmb)*h_prev_1d(nkmb) + int_sflux(nkmb) ) / h_2d(i,nkmb)
544 do k=1,nz ;
do i=is,ie ;
if (do_i(i))
then 546 tv%T(i,j,k) = t_2d(i,k) ; tv%S(i,j,k) = s_2d(i,k)
547 ea(i,j,k) = ea(i,j,k) + d_ea(i,k)
548 eb(i,j,k) = eb(i,j,k) + d_eb(i,k)
549 endif ;
enddo ;
enddo 552 do i=is,ie ; h_tot1(i) = 0.0 ; th_tot1(i) = 0.0 ; sh_tot1(i) = 0.0 ;
enddo 553 do i=is,ie ; h_tot2(i) = 0.0 ; th_tot2(i) = 0.0 ; sh_tot2(i) = 0.0 ;
enddo 555 do k=1,nz ;
do i=is,ie ;
if (do_i(i))
then 556 h_tot1(i) = h_tot1(i) + h_2d_init(i,k)
557 h_tot2(i) = h_tot2(i) + h(i,j,k)
559 th_tot1(i) = th_tot1(i) + h_2d_init(i,k) * t_2d_init(i,k)
560 th_tot2(i) = th_tot2(i) + h(i,j,k) * tv%T(i,j,k)
561 sh_tot1(i) = sh_tot1(i) + h_2d_init(i,k) * s_2d_init(i,k)
562 sh_tot2(i) = sh_tot2(i) + h(i,j,k) * tv%S(i,j,k)
563 if (h(i,j,k) < 0.0) &
564 call mom_error(fatal,
"regularize_surface: Negative thicknesses.")
565 if (k==1)
then ; h_predicted = h_2d_init(i,k) + (d_eb(i,k) - d_ea(i,k+1))
566 elseif (k==nz)
then ; h_predicted = h_2d_init(i,k) + (d_ea(i,k) - d_eb(i,k-1))
568 h_predicted = h_2d_init(i,k) + ((d_ea(i,k) - d_eb(i,k-1)) + &
569 (d_eb(i,k) - d_ea(i,k+1)))
571 if (abs(h(i,j,k) - h_predicted) > max(1e-9*abs(h_predicted),gv%Angstrom_H)) &
572 call mom_error(fatal,
"regularize_surface: d_ea mismatch.")
573 endif ;
enddo ;
enddo 574 do i=is,ie ;
if (do_i(i))
then 575 fatal_error = .false.
576 if (abs(h_tot1(i) - h_tot2(i)) > 1e-12*h_tot1(i))
then 577 write(mesg,
'(ES11.4," became ",ES11.4," diff ",ES11.4)') &
578 h_tot1(i), h_tot2(i), (h_tot1(i) - h_tot2(i))
579 call mom_error(warning,
"regularize_surface: Mass non-conservation."//&
583 if (abs(th_tot1(i) - th_tot2(i)) > 1e-12*(th_tot1(i)+10.0*h_tot1(i)))
then 584 write(mesg,
'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') &
585 th_tot1(i), th_tot2(i), (th_tot1(i) - th_tot2(i)), (th_tot1(i) - th_tot3(i))
586 call mom_error(warning,
"regularize_surface: Heat non-conservation."//&
590 if (abs(sh_tot1(i) - sh_tot2(i)) > 1e-12*(sh_tot1(i)+10.0*h_tot1(i)))
then 591 write(mesg,
'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') &
592 sh_tot1(i), sh_tot2(i), (sh_tot1(i) - sh_tot2(i)), (sh_tot1(i) - sh_tot3(i))
593 call mom_error(warning,
"regularize_surface: Salinity non-conservation."//&
597 if (fatal_error)
then 598 write(mesg,
'("Error at lat/lon ",2(ES11.4))') g%geoLatT(i,j), g%geoLonT(i,j)
599 call mom_error(fatal,
"regularize_surface: Terminating with fatal error. "//&
607 if (cs%id_def_rat > 0)
call post_data(cs%id_def_rat, def_rat_h, cs%diag)
609 end subroutine regularize_surface
615 subroutine find_deficit_ratios(e, def_rat_u, def_rat_v, G, GV, CS, &
616 def_rat_u_2lay, def_rat_v_2lay, halo, h)
619 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)+1), &
621 real,
dimension(SZIB_(G),SZJ_(G)), &
622 intent(out) :: def_rat_u
624 real,
dimension(SZI_(G),SZJB_(G)), &
625 intent(out) :: def_rat_v
629 real,
dimension(SZIB_(G),SZJ_(G)), &
630 optional,
intent(out) :: def_rat_u_2lay
633 real,
dimension(SZI_(G),SZJB_(G)), &
634 optional,
intent(out) :: def_rat_v_2lay
637 integer,
optional,
intent(in) :: halo
638 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
639 optional,
intent(in) :: h
643 real,
dimension(SZIB_(G),SZJ_(G)) :: &
648 real,
dimension(SZI_(G),SZJB_(G)) :: &
657 integer :: i, j, k, is, ie, js, je, nz, nkmb
659 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
660 if (
present(halo))
then 661 is = g%isc-halo ; ie = g%iec+halo ; js = g%jsc-halo ; je = g%jec+halo
663 nkmb = gv%nk_rho_varies
664 h_neglect = gv%H_subroundoff
665 hmix_min = cs%Hmix_min
668 do j=js,je ;
do i=is-1,ie
671 h1 = e(i,j,nkmb+1)-e(i,j,nz+1) ; h2 = e(i+1,j,nkmb+1)-e(i+1,j,nz+1)
672 if (e(i,j,nz+1) < e(i+1,j,nz+1))
then 673 if (h1 > h2) h1 = max(e(i,j,nkmb+1)-e(i+1,j,nz+1), h2)
674 elseif (e(i+1,j,nz+1) < e(i,j,nz+1))
then 675 if (h2 > h1) h2 = max(e(i+1,j,nkmb+1)-e(i,j,nz+1), h1)
677 h_def_u(i,j) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
678 h_norm_u(i,j) = 0.5*(h1+h2)
680 if (
present(def_rat_u_2lay))
then ;
do j=js,je ;
do i=is-1,ie
682 h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i+1,j,1)-e(i+1,j,nkmb+1)
683 if (e(i,j,nkmb+1) < e(i+1,j,nz+1))
then 684 if (h1 > h2) h1 = max(e(i,j,1)-e(i+1,j,nz+1), h2)
685 elseif (e(i+1,j,nkmb+1) < e(i,j,nz+1))
then 686 if (h2 > h1) h2 = max(e(i+1,j,1)-e(i,j,nz+1), h1)
688 h_def2_u(i,j) = h_def_u(i,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
689 enddo ;
enddo ;
endif 690 do k=1,nkmb ;
do j=js,je ;
do i=is-1,ie
692 h1 = h(i,j,k) ; h2 = h(i+1,j,k)
694 h1 = e(i,j,k)-e(i,j,k+1) ; h2 = e(i+1,j,k)-e(i+1,j,k+1)
698 if (e(i,j,k+1) < e(i+1,j,nz+1))
then 699 if (h1 > h2) h1 = max(e(i,j,k)-e(i+1,j,nz+1), h2)
700 elseif (e(i+1,j,k+1) < e(i,j,nz+1))
then 701 if (h2 > h1) h2 = max(e(i+1,j,k)-e(i,j,nz+1), h1)
703 h_def_u(i,j) = h_def_u(i,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
704 h_norm_u(i,j) = h_norm_u(i,j) + 0.5*(h1+h2)
705 enddo ;
enddo ;
enddo 706 if (
present(def_rat_u_2lay))
then ;
do j=js,je ;
do i=is-1,ie
707 def_rat_u(i,j) = g%mask2dCu(i,j) * h_def_u(i,j) / &
708 (max(hmix_min, h_norm_u(i,j)) + h_neglect)
709 def_rat_u_2lay(i,j) = g%mask2dCu(i,j) * h_def2_u(i,j) / &
710 (max(hmix_min, h_norm_u(i,j)) + h_neglect)
711 enddo ;
enddo ;
else ;
do j=js,je ;
do i=is-1,ie
712 def_rat_u(i,j) = g%mask2dCu(i,j) * h_def_u(i,j) / &
713 (max(hmix_min, h_norm_u(i,j)) + h_neglect)
714 enddo ;
enddo ;
endif 717 do j=js-1,je ;
do i=is,ie
720 h1 = e(i,j,nkmb+1)-e(i,j,nz+1) ; h2 = e(i,j+1,nkmb+1)-e(i,j+1,nz+1)
721 if (e(i,j,nz+1) < e(i,j+1,nz+1))
then 722 if (h1 > h2) h1 = max(e(i,j,nkmb+1)-e(i,j+1,nz+1), h2)
723 elseif (e(i,j+1,nz+1) < e(i,j,nz+1))
then 724 if (h2 > h1) h2 = max(e(i,j+1,nkmb+1)-e(i,j,nz+1), h1)
726 h_def_v(i,j) = 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
727 h_norm_v(i,j) = 0.5*(h1+h2)
729 if (
present(def_rat_v_2lay))
then ;
do j=js-1,je ;
do i=is,ie
731 h1 = e(i,j,1)-e(i,j,nkmb+1) ; h2 = e(i,j+1,1)-e(i,j+1,nkmb+1)
732 if (e(i,j,nkmb+1) < e(i,j+1,nz+1))
then 733 if (h1 > h2) h1 = max(e(i,j,1)-e(i,j+1,nz+1), h2)
734 elseif (e(i,j+1,nkmb+1) < e(i,j,nz+1))
then 735 if (h2 > h1) h2 = max(e(i,j+1,1)-e(i,j,nz+1), h1)
737 h_def2_v(i,j) = h_def_v(i,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
738 enddo ;
enddo ;
endif 739 do k=1,nkmb ;
do j=js-1,je ;
do i=is,ie
741 h1 = h(i,j,k) ; h2 = h(i,j+1,k)
743 h1 = e(i,j,k)-e(i,j,k+1) ; h2 = e(i,j+1,k)-e(i,j+1,k+1)
747 if (e(i,j,k+1) < e(i,j+1,nz+1))
then 748 if (h1 > h2) h1 = max(e(i,j,k)-e(i,j+1,nz+1), h2)
749 elseif (e(i,j+1,k+1) < e(i,j,nz+1))
then 750 if (h2 > h1) h2 = max(e(i,j+1,k)-e(i,j,nz+1), h1)
752 h_def_v(i,j) = h_def_v(i,j) + 0.5*(h1-h2)**2 / ((h1 + h2) + h_neglect)
753 h_norm_v(i,j) = h_norm_v(i,j) + 0.5*(h1+h2)
754 enddo ;
enddo ;
enddo 755 if (
present(def_rat_v_2lay))
then ;
do j=js-1,je ;
do i=is,ie
756 def_rat_v(i,j) = g%mask2dCv(i,j) * h_def_v(i,j) / &
757 (max(hmix_min, h_norm_v(i,j)) + h_neglect)
758 def_rat_v_2lay(i,j) = g%mask2dCv(i,j) * h_def2_v(i,j) / &
759 (max(hmix_min, h_norm_v(i,j)) + h_neglect)
760 enddo ;
enddo ;
else ;
do j=js-1,je ;
do i=is,ie
761 def_rat_v(i,j) = g%mask2dCv(i,j) * h_def_v(i,j) / &
762 (max(hmix_min, h_norm_v(i,j)) + h_neglect)
763 enddo ;
enddo ;
endif 765 end subroutine find_deficit_ratios
768 subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS)
769 type(time_type),
target,
intent(in) :: Time
774 type(
diag_ctrl),
target,
intent(inout) :: diag
778 #include "version_variable.h" 779 character(len=40) :: mdl =
"MOM_regularize_layers" 780 logical :: use_temperature
781 logical :: default_2018_answers
783 integer :: isd, ied, jsd, jed
784 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
786 if (
associated(cs))
then 787 call mom_error(warning,
"regularize_layers_init called with an associated"// &
788 "associated control structure.")
790 else ;
allocate(cs) ;
endif 796 call get_param(param_file, mdl,
"REGULARIZE_SURFACE_LAYERS", cs%regularize_surface_layers, &
797 default=.false., do_not_log=.true.)
798 call log_version(param_file, mdl, version,
"", all_default=.not.cs%regularize_surface_layers)
799 call get_param(param_file, mdl,
"REGULARIZE_SURFACE_LAYERS", cs%regularize_surface_layers, &
800 "If defined, vertically restructure the near-surface "//&
801 "layers when they have too much lateral variations to "//&
802 "allow for sensible lateral barotropic transports.", &
804 just_read = .not.cs%regularize_surface_layers
805 if (cs%regularize_surface_layers)
then 806 call get_param(param_file, mdl,
"REGULARIZE_SURFACE_DETRAIN", cs%reg_sfc_detrain, &
807 "If true, allow the buffer layers to detrain into the "//&
808 "interior as a part of the restructuring when "//&
809 "REGULARIZE_SURFACE_LAYERS is true.", default=.true., do_not_log=just_read)
810 call get_param(param_file, mdl,
"REG_SFC_DENSE_MATCH_TOLERANCE", cs%density_match_tol, &
811 "A relative tolerance for how well the densities must match with the target "//&
812 "densities during detrainment when regularizing the near-surface layers. The "//&
813 "default of 0.6 gives 20% overlaps in density", &
814 units=
"nondim", default=0.6, do_not_log=just_read)
815 call get_param(param_file, mdl,
"DEFAULT_2018_ANSWERS", default_2018_answers, &
816 "This sets the default value for the various _2018_ANSWERS parameters.", &
817 default=.false., do_not_log=just_read)
818 call get_param(param_file, mdl,
"REGULARIZE_LAYERS_2018_ANSWERS", cs%answers_2018, &
819 "If true, use the order of arithmetic and expressions that recover the answers "//&
820 "from the end of 2018. Otherwise, use updated and more robust forms of the "//&
821 "same expressions.", default=default_2018_answers, do_not_log=just_read)
824 call get_param(param_file, mdl,
"HMIX_MIN", cs%Hmix_min, &
825 "The minimum mixed layer depth if the mixed layer depth is determined "//&
826 "dynamically.", units=
"m", default=0.0, scale=gv%m_to_H, do_not_log=just_read)
827 call get_param(param_file, mdl,
"REG_SFC_DEFICIT_TOLERANCE", cs%h_def_tol1, &
828 "The value of the relative thickness deficit at which "//&
829 "to start modifying the layer structure when "//&
830 "REGULARIZE_SURFACE_LAYERS is true.", units=
"nondim", &
831 default=0.5, do_not_log=just_read)
832 cs%h_def_tol2 = 0.2 + 0.8*cs%h_def_tol1
833 cs%h_def_tol3 = 0.3 + 0.7*cs%h_def_tol1
834 cs%h_def_tol4 = 0.5 + 0.5*cs%h_def_tol1
836 call get_param(param_file, mdl,
"DEBUG", cs%debug, default=.false.)
841 call get_param(param_file, mdl,
"ALLOW_CLOCKS_IN_OMP_LOOPS", cs%allow_clocks_in_omp_loops, &
842 "If true, clocks can be called from inside loops that can "//&
843 "be threaded. To run with multiple threads, set to False.", &
844 default=.true., do_not_log=just_read)
846 if (.not.cs%regularize_surface_layers)
return 848 cs%id_def_rat = register_diag_field(
'ocean_model',
'deficit_ratio', diag%axesT1, &
849 time,
'Max face thickness deficit ratio',
'nondim')
851 if (cs%allow_clocks_in_omp_loops)
then 852 id_clock_eos = cpu_clock_id(
'(Ocean regularize_layers EOS)', grain=clock_routine)
854 id_clock_pass = cpu_clock_id(
'(Ocean regularize_layers halo updates)', grain=clock_routine)
856 end subroutine regularize_layers_init
Ocean grid type. See mom_grid for details.
Calculates density of sea water from T, S and P.
Provides regularization of layers in isopycnal mode.
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Wraps the MPP cpu clock functions.
The MOM6 facility to parse input files for runtime parameters.
This control structure holds parameters used by the MOM_regularize_layers module. ...
Make a diagnostic available for averaging or output.
Describes various unit conversion factors.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Describes the decomposed MOM domain and has routines for communications across PEs.
Routines for error handling and I/O management.
Calculate the derivatives of density with temperature and salinity from T, S, and P...
Provides subroutines for quantities specific to the equation of state.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Provides a transparent vertical ocean grid type and supporting routines.
Provides transparent structures with groups of MOM6 variables and supporting routines.
Do a halo update on an array.
An overloaded interface to read and log the values of various types of parameters.