7 use mom_ale,
only :
ale_cs, ale_main_offline, ale_offline_inputs
9 use mom_cpu_clock,
only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
11 use mom_cpu_clock,
only : clock_module_driver, clock_module, clock_routine
23 use mom_offline_aux,
only : update_offline_from_arrays, update_offline_from_files
25 use mom_offline_aux,
only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d
26 use mom_offline_aux,
only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic
27 use mom_offline_aux,
only : distribute_residual_uh_upwards, distribute_residual_vh_upwards
39 implicit none ;
private 41 #include "MOM_memory.h" 42 #include "version_variable.h" 48 type(
ale_cs),
pointer :: ale_csp => null()
78 integer :: start_index
81 type(time_type) :: accumulated_time
82 type(time_type) :: vertical_time
85 integer :: ridx_sum = -1
86 integer :: ridx_snap = -1
88 character(len=200) :: offlinedir
89 character(len=200) :: &
90 surf_file, & !< Contains surface fields (2d arrays)
91 snap_file, & !< Snapshotted fields (layer thicknesses)
92 sum_file, & !< Fields which are accumulated over time
94 character(len=20) :: redistribute_method
98 character(len=20) :: mld_var_name
99 logical :: fields_are_offset
101 logical :: x_before_y
102 logical :: print_adv_offline
103 logical :: skip_diffusion
106 logical :: diurnal_sw
108 logical :: redistribute_barotropic
110 logical :: redistribute_upwards
113 logical :: read_all_ts_uvh
116 integer :: num_off_iter
117 integer :: num_vert_iter
118 integer :: off_ale_mod
120 real :: dt_offline_vertical
121 real :: evap_cfl_limit
124 real :: minimum_forcing_depth
137 id_uhr_redist = -1, &
138 id_vhr_redist = -1, &
141 id_eta_pre_distribute = -1, &
142 id_eta_post_distribute = -1, &
148 id_uhtr_regrid = -1, &
149 id_vhtr_regrid = -1, &
150 id_temp_regrid = -1, &
151 id_salt_regrid = -1, &
156 integer :: id_clock_read_fields = -1
157 integer :: id_clock_offline_diabatic = -1
158 integer :: id_clock_offline_adv = -1
159 integer :: id_clock_redistribute = -1
162 real,
allocatable,
dimension(:,:,:) :: uhtr
164 real,
allocatable,
dimension(:,:,:) :: vhtr
167 real,
allocatable,
dimension(:,:,:) :: eatr
170 real,
allocatable,
dimension(:,:,:) :: ebtr
174 real,
allocatable,
dimension(:,:,:) :: kd
175 real,
allocatable,
dimension(:,:,:) :: h_end
177 real,
allocatable,
dimension(:,:) :: netmassin
178 real,
allocatable,
dimension(:,:) :: netmassout
179 real,
allocatable,
dimension(:,:) :: mld
182 real,
allocatable,
dimension(:,:,:,:) :: uhtr_all
183 real,
allocatable,
dimension(:,:,:,:) :: vhtr_all
184 real,
allocatable,
dimension(:,:,:,:) :: hend_all
185 real,
allocatable,
dimension(:,:,:,:) :: temp_all
186 real,
allocatable,
dimension(:,:,:,:) :: salt_all
190 public offline_advection_ale
191 public offline_redistribute_residual
192 public offline_diabatic_ale
193 public offline_fw_fluxes_into_ocean
194 public offline_fw_fluxes_out_ocean
195 public offline_advection_layer
196 public register_diags_offline_transport
197 public update_offline_fields
198 public insert_offline_main
199 public extract_offline_main
200 public post_offline_convergence_diags
201 public offline_transport_init
202 public offline_transport_end
209 subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged)
211 type(time_type),
intent(in) :: time_start
212 real,
intent(in) :: time_interval
214 integer,
intent(in) :: id_clock_ale
215 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
216 intent(inout) :: h_pre
218 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
219 intent(inout) :: uhtr
220 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), &
221 intent(inout) :: vhtr
222 logical,
intent( out) :: converged
230 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub
232 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub
234 real :: prev_tot_residual, tot_residual
237 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
241 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end
242 integer :: niter, iter
244 character(len=256) :: mesg
245 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
246 integer :: isv, iev, jsv, jev
247 integer :: isdb, iedb, jsdb, jedb
248 logical :: z_first, x_before_y
249 real :: evap_cfl_limit
251 real :: minimum_forcing_depth
255 real :: stock_values(max_fields_)
256 character(len=20) :: debug_msg
257 call cpu_clock_begin(cs%id_clock_offline_adv)
263 x_before_y = cs%x_before_y
266 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
267 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
268 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
270 evap_cfl_limit = cs%evap_CFL_limit
271 minimum_forcing_depth = cs%minimum_forcing_depth
273 niter = cs%num_off_iter
274 inum_iter = 1./real(niter)
275 dt_iter = cs%dt_offline*inum_iter
280 uhtr_sub(:,:,:) = 0.0
281 vhtr_sub(:,:,:) = 0.0
306 do k=1,nz ;
do j=jsd,jed ;
do i=isdb,iedb
307 uhtr_sub(i,j,k) = uhtr(i,j,k)
308 enddo ;
enddo ;
enddo 309 do k=1,nz ;
do j=jsdb,jedb ;
do i=isd,ied
310 vhtr_sub(i,j,k) = vhtr(i,j,k)
311 enddo ;
enddo ;
enddo 312 do k=1,nz ;
do j=js,je ;
do i=is,ie
313 h_new(i,j,k) = h_pre(i,j,k)
314 enddo ;
enddo ;
enddo 317 call hchksum(h_pre,
"h_pre before transport",g%HI)
318 call uvchksum(
"[uv]htr_sub before transport", uhtr_sub, vhtr_sub, g%HI)
320 tot_residual = remaining_transport_sum(cs, uhtr, vhtr)
321 if (cs%print_adv_offline)
then 322 write(mesg,
'(A,ES24.16)')
"Main advection starting transport: ", tot_residual
328 do iter=1,cs%num_off_iter
330 do k=1,nz ;
do j=js,je ;
do i=is,ie
331 h_vol(i,j,k) = h_new(i,j,k) * g%US%L_to_m**2*g%areaT(i,j)
332 h_pre(i,j,k) = h_new(i,j,k)
333 enddo ;
enddo ;
enddo 336 call hchksum(h_vol,
"h_vol before advect",g%HI)
337 call uvchksum(
"[uv]htr_sub before advect", uhtr_sub, vhtr_sub, g%HI)
338 write(debug_msg,
'(A,I4.4)')
'Before advect ', iter
339 call mom_tracer_chkinv(debug_msg, g, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
342 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, cs%dt_offline, g, gv, cs%US, &
343 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=1, &
344 uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y)
347 x_before_y = .not. x_before_y
350 do k=1,nz ;
do j=js,je ;
do i=is,ie
351 h_new(i,j,k) = h_new(i,j,k) / (g%US%L_to_m**2*g%areaT(i,j))
352 enddo ;
enddo ;
enddo 354 if (modulo(iter,cs%off_ale_mod)==0)
then 358 call hchksum(h_new,
"h_new before ALE",g%HI)
359 write(debug_msg,
'(A,I4.4)')
'Before ALE ', iter
360 call mom_tracer_chkinv(debug_msg, g, h_new, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
362 call cpu_clock_begin(id_clock_ale)
363 call ale_main_offline(g, gv, h_new, cs%tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC, cs%dt_offline)
364 call cpu_clock_end(id_clock_ale)
367 call hchksum(h_new,
"h_new after ALE",g%HI)
368 write(debug_msg,
'(A,I4.4)')
'After ALE ', iter
369 call mom_tracer_chkinv(debug_msg, g, h_new, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
373 do k=1,nz;
do j=js,je ;
do i=is,ie
374 uhtr_sub(i,j,k) = uhtr(i,j,k)
375 vhtr_sub(i,j,k) = vhtr(i,j,k)
376 enddo ;
enddo ;
enddo 382 tot_residual = remaining_transport_sum(cs, uhtr, vhtr)
383 if (cs%print_adv_offline)
then 384 write(mesg,
'(A,ES24.16)')
"Main advection remaining transport: ", tot_residual
388 if (tot_residual == 0.0)
then 389 write(mesg,*)
"Converged after iteration ", iter
395 if ( (tot_residual == prev_tot_residual) .or. (tot_residual<cs%min_residual) )
then 400 prev_tot_residual = tot_residual
405 h_pre(:,:,:) = h_new(:,:,:)
409 call hchksum(h_pre,
"h after offline_advection_ale",g%HI)
410 call uvchksum(
"[uv]htr after offline_advection_ale", uhtr, vhtr, g%HI)
411 call mom_tracer_chkinv(
"After offline_advection_ale", g, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
414 call cpu_clock_end(cs%id_clock_offline_adv)
416 end subroutine offline_advection_ale
422 subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
424 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
425 intent(inout) :: h_pre
426 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
427 intent(inout) :: uhtr
428 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), &
429 intent(inout) :: vhtr
430 logical,
intent(in ) :: converged
436 logical :: x_before_y
438 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
443 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work
444 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhr
445 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhr
447 character(len=256) :: mesg
448 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter
449 real :: prev_tot_residual, tot_residual, stock_values(max_fields_)
456 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
457 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
459 x_before_y = cs%x_before_y
461 if (cs%id_eta_pre_distribute>0)
then 463 do k=1,nz ;
do j=js,je ;
do i=is,ie
464 if (h_pre(i,j,k)>gv%Angstrom_H)
then 465 eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
467 enddo ;
enddo ;
enddo 468 call post_data(cs%id_eta_pre_distribute,eta_work,cs%diag)
472 if (cs%id_h_redist>0)
call post_data(cs%id_h_redist, h_pre, cs%diag)
473 if (cs%id_uhr_redist>0)
call post_data(cs%id_uhr_redist, uhtr, cs%diag)
474 if (cs%id_vhr_redist>0)
call post_data(cs%id_vhr_redist, vhtr, cs%diag)
476 if (converged)
return 479 call mom_tracer_chkinv(
"Before redistribute ", g, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
482 call cpu_clock_begin(cs%id_clock_redistribute)
484 if (cs%redistribute_upwards .or. cs%redistribute_barotropic)
then 485 do iter = 1, cs%num_off_iter
488 if (cs%redistribute_upwards)
then 491 do k=1,nz ;
do j=js,je ;
do i=is,ie
492 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
493 enddo ;
enddo ;
enddo 498 h_pre(:,:,:) = h_vol(:,:,:)
501 call mom_tracer_chksum(
"Before upwards redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
502 call uvchksum(
"[uv]tr before upwards redistribute", uhtr, vhtr, g%HI)
506 call distribute_residual_uh_upwards(g, gv, h_vol, uhtr)
507 call distribute_residual_vh_upwards(g, gv, h_vol, vhtr)
509 call distribute_residual_vh_upwards(g, gv, h_vol, vhtr)
510 call distribute_residual_uh_upwards(g, gv, h_vol, uhtr)
513 call advect_tracer(h_pre, uhtr, vhtr, cs%OBC, cs%dt_offline, g, gv, cs%US, &
514 cs%tracer_adv_CSp, cs%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, &
515 h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y)
518 call mom_tracer_chksum(
"After upwards redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
522 do k=1,nz ;
do j=js,je ;
do i=is,ie
523 uhtr(i,j,k) = uhr(i,j,k)
524 vhtr(i,j,k) = vhr(i,j,k)
525 h_vol(i,j,k) = h_new(i,j,k)
526 h_new(i,j,k) = h_new(i,j,k) / (g%US%L_to_m**2*g%areaT(i,j))
527 h_pre(i,j,k) = h_new(i,j,k)
528 enddo ;
enddo ;
enddo 533 if (cs%redistribute_barotropic)
then 536 do k=1,nz ;
do j=js,je ;
do i=is,ie
537 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
538 enddo ;
enddo ;
enddo 543 h_pre(:,:,:) = h_vol(:,:,:)
546 call mom_tracer_chksum(
"Before barotropic redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
547 call uvchksum(
"[uv]tr before upwards redistribute", uhtr, vhtr, g%HI)
551 call distribute_residual_uh_barotropic(g, gv, h_vol, uhtr)
552 call distribute_residual_vh_barotropic(g, gv, h_vol, vhtr)
554 call distribute_residual_vh_barotropic(g, gv, h_vol, vhtr)
555 call distribute_residual_uh_barotropic(g, gv, h_vol, uhtr)
558 call advect_tracer(h_pre, uhtr, vhtr, cs%OBC, cs%dt_offline, g, gv, cs%US, &
559 cs%tracer_adv_CSp, cs%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, &
560 h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y)
563 call mom_tracer_chksum(
"After barotropic redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
567 do k=1,nz ;
do j=js,je ;
do i=is,ie
568 uhtr(i,j,k) = uhr(i,j,k)
569 vhtr(i,j,k) = vhr(i,j,k)
570 h_vol(i,j,k) = h_new(i,j,k)
571 h_new(i,j,k) = h_new(i,j,k) / (g%US%L_to_m**2*g%areaT(i,j))
572 h_pre(i,j,k) = h_new(i,j,k)
573 enddo ;
enddo ;
enddo 578 tot_residual = remaining_transport_sum(cs, uhtr, vhtr)
579 if (cs%print_adv_offline)
then 580 write(mesg,
'(A,ES24.16)')
"Residual advection remaining transport: ", tot_residual
584 if (tot_residual==0.0 )
then 588 if ( (tot_residual == prev_tot_residual) .or. (tot_residual<cs%min_residual) )
exit 589 prev_tot_residual = tot_residual
594 if (cs%id_eta_post_distribute>0)
then 596 do k=1,nz ;
do j=js,je ;
do i=is,ie
597 if (h_pre(i,j,k)>gv%Angstrom_H)
then 598 eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
600 enddo ;
enddo ;
enddo 601 call post_data(cs%id_eta_post_distribute,eta_work,cs%diag)
604 if (cs%id_uhr>0)
call post_data(cs%id_uhr,uhtr,cs%diag)
605 if (cs%id_vhr>0)
call post_data(cs%id_vhr,vhtr,cs%diag)
608 call hchksum(h_pre,
"h_pre after redistribute",g%HI)
609 call uvchksum(
"uhtr after redistribute", uhtr, vhtr, g%HI)
610 call mom_tracer_chkinv(
"after redistribute ", g, h_new, cs%tracer_Reg%Tr, cs%tracer_Reg%ntr)
613 call cpu_clock_end(cs%id_clock_redistribute)
615 end subroutine offline_redistribute_residual
618 real function remaining_transport_sum(CS, uhtr, vhtr)
620 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(in ) :: uhtr
621 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(in ) :: vhtr
625 integer :: is, ie, js, je, nz
631 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec
633 h_min = cs%GV%H_subroundoff
635 remaining_transport_sum = 0.
636 do k=1,nz;
do j=js,je ;
do i=is,ie
637 uh_neglect = h_min*cs%G%US%L_to_m**2*min(cs%G%areaT(i,j),cs%G%areaT(i+1,j))
638 vh_neglect = h_min*cs%G%US%L_to_m**2*min(cs%G%areaT(i,j),cs%G%areaT(i,j+1))
639 if (abs(uhtr(i,j,k))>uh_neglect)
then 640 remaining_transport_sum = remaining_transport_sum + abs(uhtr(i,j,k))
642 if (abs(vhtr(i,j,k))>vh_neglect)
then 643 remaining_transport_sum = remaining_transport_sum + abs(vhtr(i,j,k))
645 enddo ;
enddo ;
enddo 646 call sum_across_pes(remaining_transport_sum)
648 end function remaining_transport_sum
653 subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr)
655 type(
forcing),
intent(inout) :: fluxes
656 type(time_type),
intent(in) :: time_start
657 type(time_type),
intent(in) :: time_end
659 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
660 intent(inout) :: h_pre
661 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
662 intent(inout) :: eatr
663 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), &
664 intent(inout) :: ebtr
666 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
670 integer :: is, ie, js, je, nz
672 real :: stock_values(max_fields_)
676 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec
678 call cpu_clock_begin(cs%id_clock_offline_diabatic)
680 call mom_mesg(
"Applying tracer source, sinks, and vertical mixing")
683 call hchksum(h_pre,
"h_pre before offline_diabatic_ale",cs%G%HI)
684 call hchksum(eatr,
"eatr before offline_diabatic_ale",cs%G%HI)
685 call hchksum(ebtr,
"ebtr before offline_diabatic_ale",cs%G%HI)
686 call mom_tracer_chkinv(
"Before offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
695 do j=js,je ;
do i=is,ie
699 if (cs%Kd(i,j,k)>0.)
then 700 kd_bot = cs%Kd(i,j,k)
707 cs%Kd(i,j,k) = kd_bot
711 do j=js,je ;
do i=is,ie
714 do k=2,nz ;
do j=js,je ;
do i=is,ie
715 hval=1.0/(cs%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k)))
716 eatr(i,j,k) = (cs%GV%m_to_H**2*cs%US%T_to_s) * cs%dt_offline_vertical * hval * cs%Kd(i,j,k)
717 ebtr(i,j,k-1) = eatr(i,j,k)
718 enddo ;
enddo ;
enddo 719 do j=js,je ;
do i=is,ie
724 if (cs%diurnal_SW .and. cs%read_sw)
then 725 sw(:,:) = fluxes%sw(:,:)
726 sw_vis(:,:) = fluxes%sw_vis_dir(:,:)
727 sw_nir(:,:) = fluxes%sw_nir_dir(:,:)
728 call offline_add_diurnal_sw(fluxes, cs%G, time_start, time_end)
731 if (
associated(cs%optics)) &
732 call set_pen_shortwave(cs%optics, fluxes, cs%G, cs%GV, cs%US, cs%diabatic_aux_CSp, &
733 cs%opacity_CSp, cs%tracer_flow_CSp)
737 call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, cs%MLD, cs%dt_offline_vertical, &
738 cs%G, cs%GV, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
740 if (cs%diurnal_SW .and. cs%read_sw)
then 741 fluxes%sw(:,:) = sw(:,:)
742 fluxes%sw_vis_dir(:,:) = sw_vis(:,:)
743 fluxes%sw_nir_dir(:,:) = sw_nir(:,:)
747 call hchksum(h_pre,
"h_pre after offline_diabatic_ale",cs%G%HI)
748 call hchksum(eatr,
"eatr after offline_diabatic_ale",cs%G%HI)
749 call hchksum(ebtr,
"ebtr after offline_diabatic_ale",cs%G%HI)
750 call mom_tracer_chkinv(
"After offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
753 call cpu_clock_end(cs%id_clock_offline_diabatic)
755 end subroutine offline_diabatic_ale
759 subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional)
763 type(
forcing),
intent(inout) :: fluxes
764 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
766 real,
dimension(SZI_(G),SZJ_(G)), &
767 optional,
intent(in) :: in_flux_optional
771 real,
dimension(SZI_(G),SZJ_(G)) :: negative_fw
774 if (
present(in_flux_optional) ) &
775 call mom_error(warning,
"Positive freshwater fluxes with non-zero tracer concentration not supported yet")
778 negative_fw(:,:) = 0.
781 do j=g%jsc,g%jec ;
do i=g%isc,g%iec
782 if (fluxes%netMassOut(i,j)<0.0)
then 783 negative_fw(i,j) = fluxes%netMassOut(i,j)
784 fluxes%netMassOut(i,j) = 0.
789 call hchksum(h,
"h before fluxes into ocean",g%HI)
790 call mom_tracer_chkinv(
"Before fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
792 do m = 1,cs%tracer_reg%ntr
794 update_h = ( m == cs%tracer_reg%ntr )
795 call applytracerboundaryfluxesinout(g, gv, cs%tracer_reg%tr(m)%t, cs%dt_offline, fluxes, h, &
796 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
799 call hchksum(h,
"h after fluxes into ocean",g%HI)
800 call mom_tracer_chkinv(
"After fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
804 fluxes%netMassOut(:,:) = negative_fw(:,:)
806 end subroutine offline_fw_fluxes_into_ocean
809 subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional)
813 type(
forcing),
intent(inout) :: fluxes
814 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
816 real,
dimension(SZI_(G),SZJ_(G)), &
817 optional,
intent(in) :: out_flux_optional
823 if (
present(out_flux_optional) ) &
824 call mom_error(warning,
"Negative freshwater fluxes with non-zero tracer concentration not supported yet")
827 call hchksum(h,
"h before fluxes out of ocean",g%HI)
828 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
830 do m = 1, cs%tracer_reg%ntr
832 update_h = ( m == cs%tracer_reg%ntr )
833 call applytracerboundaryfluxesinout(g, gv, cs%tracer_reg%tr(m)%t, cs%dt_offline, fluxes, h, &
834 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
837 call hchksum(h,
"h after fluxes out of ocean",g%HI)
838 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
841 end subroutine offline_fw_fluxes_out_ocean
845 subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr)
847 type(time_type),
intent(in) :: time_start
848 real,
intent(in) :: time_interval
850 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
851 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: eatr
852 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: ebtr
853 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
854 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
861 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub
863 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub
865 real :: sum_abs_fluxes, sum_u, sum_v
870 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
874 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
878 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
879 temp_old, salt_old, &
880 temp_mean, salt_mean, &
882 integer :: niter, iter
886 character(len=160) :: mesg
887 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
888 integer :: isv, iev, jsv, jev
889 integer :: isdb, iedb, jsdb, jedb
890 logical :: z_first, x_before_y
892 g => cs%G ; gv => cs%GV
893 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
894 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
895 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
897 dt_iter = cs%US%s_to_T * time_interval / real(max(1, cs%num_off_iter))
899 do iter=1,cs%num_off_iter
901 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
902 eatr_sub(i,j,k) = eatr(i,j,k)
903 ebtr_sub(i,j,k) = ebtr(i,j,k)
904 enddo ;
enddo ;
enddo 906 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
907 uhtr_sub(i,j,k) = uhtr(i,j,k)
908 enddo ;
enddo ;
enddo 910 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
911 vhtr_sub(i,j,k) = vhtr(i,j,k)
912 enddo ;
enddo ;
enddo 916 call limit_mass_flux_3d(g, gv, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre)
920 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
921 call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, &
922 fluxes, cs%mld, dt_iter, g, gv, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
924 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
925 h_pre(i,j,k) = h_new(i,j,k)
926 enddo ;
enddo ;
enddo 930 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
931 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
932 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
933 enddo ;
enddo ;
enddo 934 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, cs%US, &
935 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
938 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
939 h_pre(i,j,k) = h_new(i,j,k)
940 enddo ;
enddo ;
enddo 944 if (.not. z_first)
then 947 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
948 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
949 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
950 enddo ;
enddo ;
enddo 951 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, cs%US, &
952 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
955 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
956 h_pre(i,j,k) = h_new(i,j,k)
957 enddo ;
enddo ;
enddo 960 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
961 call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, &
962 fluxes, cs%mld, dt_iter, g, gv, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
964 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
965 h_pre(i,j,k) = h_new(i,j,k)
966 enddo ;
enddo ;
enddo 971 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
972 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k)
973 ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k)
974 enddo ;
enddo ;
enddo 976 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
977 uhtr(i,j,k) = uhtr(i,j,k) - uhtr_sub(i,j,k)
978 enddo ;
enddo ;
enddo 980 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
981 vhtr(i,j,k) = vhtr(i,j,k) - vhtr_sub(i,j,k)
982 enddo ;
enddo ;
enddo 993 do k=1,nz;
do j=js,je;
do i=is,ie
994 sum_u = sum_u + abs(uhtr(i-1,j,k))+abs(uhtr(i,j,k))
995 sum_v = sum_v + abs(vhtr(i,j-1,k))+abs(vhtr(i,j,k))
996 sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(i-1,j,k)) + &
997 abs(uhtr(i,j,k)) + abs(vhtr(i,j-1,k)) + abs(vhtr(i,j,k))
998 enddo ;
enddo ;
enddo 999 call sum_across_pes(sum_abs_fluxes)
1001 write(mesg,*)
"offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v
1003 if (sum_abs_fluxes==0)
then 1004 write(mesg,*)
'offline_advection_layer: Converged after iteration', iter
1010 z_first = .not. z_first
1011 x_before_y = .not. x_before_y
1014 end subroutine offline_advection_layer
1018 subroutine update_offline_fields(CS, h, fluxes, do_ale)
1020 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h
1021 type(
forcing),
intent(inout) :: fluxes
1022 logical,
intent(in ) :: do_ale
1024 integer :: i, j, k, is, ie, js, je, nz
1025 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h_start
1026 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec ; nz = cs%GV%ke
1028 call cpu_clock_begin(cs%id_clock_read_fields)
1029 call calltree_enter(
"update_offline_fields, MOM_offline_main.F90")
1032 h_start(:,:,:) = h(:,:,:)
1035 call update_offline_from_files( cs%G, cs%GV, cs%nk_input, cs%mean_file, cs%sum_file, cs%snap_file, cs%surf_file, &
1036 cs%h_end, cs%uhtr, cs%vhtr, cs%tv%T, cs%tv%S, cs%mld, cs%Kd, fluxes, &
1037 cs%ridx_sum, cs%ridx_snap, cs%read_mld, cs%read_sw, .not. cs%read_all_ts_uvh, do_ale)
1039 if (cs%read_all_ts_uvh)
then 1040 call update_offline_from_arrays(cs%G, cs%GV, cs%nk_input, cs%ridx_sum, cs%mean_file, cs%sum_file, cs%snap_file, &
1041 cs%uhtr, cs%vhtr, cs%h_end, cs%uhtr_all, cs%vhtr_all, cs%hend_all, cs%tv%T, cs%tv%S, cs%temp_all, cs%salt_all)
1044 call uvchksum(
"[uv]h after update offline from files and arrays", cs%uhtr, cs%vhtr, cs%G%HI)
1051 call pass_var(cs%tv%T, cs%G%Domain)
1052 call pass_var(cs%tv%S, cs%G%Domain)
1053 call ale_offline_inputs(cs%ALE_CSp, cs%G, cs%GV, h, cs%tv, cs%tracer_Reg, cs%uhtr, cs%vhtr, cs%Kd, &
1055 if (cs%id_temp_regrid>0)
call post_data(cs%id_temp_regrid, cs%tv%T, cs%diag)
1056 if (cs%id_salt_regrid>0)
call post_data(cs%id_salt_regrid, cs%tv%S, cs%diag)
1057 if (cs%id_uhtr_regrid>0)
call post_data(cs%id_uhtr_regrid, cs%uhtr, cs%diag)
1058 if (cs%id_vhtr_regrid>0)
call post_data(cs%id_vhtr_regrid, cs%vhtr, cs%diag)
1059 if (cs%id_h_regrid>0)
call post_data(cs%id_h_regrid, h, cs%diag)
1061 call uvchksum(
"[uv]h after ALE regridding/remapping of inputs", cs%uhtr, cs%vhtr, cs%G%HI)
1062 call hchksum(h_start,
"h_start after update offline from files and arrays", cs%G%HI)
1067 call pass_var(cs%h_end, cs%G%Domain)
1068 call pass_var(cs%tv%T, cs%G%Domain)
1069 call pass_var(cs%tv%S, cs%G%Domain)
1072 cs%ridx_snap = next_modulo_time(cs%ridx_snap,cs%numtime)
1073 cs%ridx_sum = next_modulo_time(cs%ridx_sum,cs%numtime)
1076 do k=1,nz ;
do j=js,je ;
do i=is,ie
1077 if (cs%G%mask2dT(i,j)<1.0)
then 1078 cs%h_end(i,j,k) = cs%GV%Angstrom_H
1080 enddo ;
enddo ;
enddo 1082 do k=1,nz+1 ;
do j=js,je ;
do i=is,ie
1083 cs%Kd(i,j,k) = max(0.0, cs%Kd(i,j,k))
1084 if (cs%Kd_max>0.)
then 1085 cs%Kd(i,j,k) = min(cs%Kd_max, cs%Kd(i,j,k))
1087 enddo ;
enddo ;
enddo 1089 do k=1,nz ;
do j=js-1,je ;
do i=is,ie
1090 if (cs%G%mask2dCv(i,j)<1.0)
then 1091 cs%vhtr(i,j,k) = 0.0
1093 enddo ;
enddo ;
enddo 1095 do k=1,nz ;
do j=js,je ;
do i=is-1,ie
1096 if (cs%G%mask2dCu(i,j)<1.0)
then 1097 cs%uhtr(i,j,k) = 0.0
1099 enddo ;
enddo ;
enddo 1102 call uvchksum(
"[uv]htr_sub after update_offline_fields", cs%uhtr, cs%vhtr, cs%G%HI)
1103 call hchksum(cs%h_end,
"h_end after update_offline_fields", cs%G%HI)
1104 call hchksum(cs%tv%T,
"Temp after update_offline_fields", cs%G%HI)
1105 call hchksum(cs%tv%S,
"Salt after update_offline_fields", cs%G%HI)
1108 call calltree_leave(
"update_offline_fields")
1109 call cpu_clock_end(cs%id_clock_read_fields)
1111 end subroutine update_offline_fields
1114 subroutine register_diags_offline_transport(Time, diag, CS)
1117 type(time_type),
intent(in) :: time
1121 cs%id_uhr = register_diag_field(
'ocean_model',
'uhr', diag%axesCuL, time, &
1122 'Zonal thickness fluxes remaining at end of advection',
'kg')
1123 cs%id_uhr_redist = register_diag_field(
'ocean_model',
'uhr_redist', diag%axesCuL, time, &
1124 'Zonal thickness fluxes to be redistributed vertically',
'kg')
1125 cs%id_uhr_end = register_diag_field(
'ocean_model',
'uhr_end', diag%axesCuL, time, &
1126 'Zonal thickness fluxes at end of offline step',
'kg')
1129 cs%id_vhr = register_diag_field(
'ocean_model',
'vhr', diag%axesCvL, time, &
1130 'Meridional thickness fluxes remaining at end of advection',
'kg')
1131 cs%id_vhr_redist = register_diag_field(
'ocean_model',
'vhr_redist', diag%axesCvL, time, &
1132 'Meridional thickness to be redistributed vertically',
'kg')
1133 cs%id_vhr_end = register_diag_field(
'ocean_model',
'vhr_end', diag%axesCvL, time, &
1134 'Meridional thickness at end of offline step',
'kg')
1137 cs%id_hdiff = register_diag_field(
'ocean_model',
'hdiff', diag%axesTL, time, &
1138 'Difference between the stored and calculated layer thickness',
'm')
1139 cs%id_hr = register_diag_field(
'ocean_model',
'hr', diag%axesTL, time, &
1140 'Layer thickness at end of offline step',
'm')
1141 cs%id_ear = register_diag_field(
'ocean_model',
'ear', diag%axesTL, time, &
1142 'Remaining thickness entrained from above',
'm')
1143 cs%id_ebr = register_diag_field(
'ocean_model',
'ebr', diag%axesTL, time, &
1144 'Remaining thickness entrained from below',
'm')
1145 cs%id_eta_pre_distribute = register_diag_field(
'ocean_model',
'eta_pre_distribute', &
1146 diag%axesT1, time,
'Total water column height before residual transport redistribution',
'm')
1147 cs%id_eta_post_distribute = register_diag_field(
'ocean_model',
'eta_post_distribute', &
1148 diag%axesT1, time,
'Total water column height after residual transport redistribution',
'm')
1149 cs%id_eta_diff_end = register_diag_field(
'ocean_model',
'eta_diff_end', diag%axesT1, time, &
1150 'Difference in total water column height from online and offline ' // &
1151 'at the end of the offline timestep',
'm')
1152 cs%id_h_redist = register_diag_field(
'ocean_model',
'h_redist', diag%axesTL, time, &
1153 'Layer thicknesses before redistribution of mass fluxes',
'm')
1156 cs%id_uhtr_regrid = register_diag_field(
'ocean_model',
'uhtr_regrid', diag%axesCuL, time, &
1157 'Zonal mass transport regridded/remapped onto offline grid',
'kg')
1158 cs%id_vhtr_regrid = register_diag_field(
'ocean_model',
'vhtr_regrid', diag%axesCvL, time, &
1159 'Meridional mass transport regridded/remapped onto offline grid',
'kg')
1160 cs%id_temp_regrid = register_diag_field(
'ocean_model',
'temp_regrid', diag%axesTL, time, &
1161 'Temperature regridded/remapped onto offline grid',
'C')
1162 cs%id_salt_regrid = register_diag_field(
'ocean_model',
'salt_regrid', diag%axesTL, time, &
1163 'Salinity regridded/remapped onto offline grid',
'g kg-1')
1164 cs%id_h_regrid = register_diag_field(
'ocean_model',
'h_regrid', diag%axesTL, time, &
1165 'Layer thicknesses regridded/remapped onto offline grid',
'm')
1168 end subroutine register_diags_offline_transport
1171 subroutine post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr)
1173 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_off
1174 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_end
1175 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
1176 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
1178 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff
1181 if (cs%id_eta_diff_end>0)
then 1184 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1185 eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k)
1186 enddo ;
enddo ;
enddo 1187 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1188 eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k)
1189 enddo ;
enddo ;
enddo 1191 call post_data(cs%id_eta_diff_end, eta_diff, cs%diag)
1194 if (cs%id_hdiff>0)
call post_data(cs%id_hdiff, h_off-h_end, cs%diag)
1195 if (cs%id_hr>0)
call post_data(cs%id_hr, h_off, cs%diag)
1196 if (cs%id_uhr_end>0)
call post_data(cs%id_uhr_end, uhtr, cs%diag)
1197 if (cs%id_vhr_end>0)
call post_data(cs%id_vhr_end, vhtr, cs%diag)
1199 end subroutine post_offline_convergence_diags
1203 subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, vertical_time, &
1204 dt_offline, dt_offline_vertical, skip_diffusion)
1207 real,
dimension(:,:,:),
optional,
pointer :: uhtr
1208 real,
dimension(:,:,:),
optional,
pointer :: vhtr
1209 real,
dimension(:,:,:),
optional,
pointer :: eatr
1211 real,
dimension(:,:,:),
optional,
pointer :: ebtr
1213 real,
dimension(:,:,:),
optional,
pointer :: h_end
1215 type(time_type),
optional,
pointer :: accumulated_time
1217 type(time_type),
optional,
pointer :: vertical_time
1219 real,
optional,
intent( out) :: dt_offline
1220 real,
optional,
intent( out) :: dt_offline_vertical
1222 logical,
optional,
intent( out) :: skip_diffusion
1225 if (
present(uhtr)) uhtr => cs%uhtr
1226 if (
present(vhtr)) vhtr => cs%vhtr
1227 if (
present(eatr)) eatr => cs%eatr
1228 if (
present(ebtr)) ebtr => cs%ebtr
1229 if (
present(h_end)) h_end => cs%h_end
1232 if (
present(accumulated_time)) accumulated_time => cs%accumulated_time
1233 if (
present(vertical_time)) vertical_time => cs%vertical_time
1236 if (
present(dt_offline)) dt_offline = cs%dt_offline
1237 if (
present(dt_offline_vertical)) dt_offline_vertical = cs%dt_offline_vertical
1238 if (
present(skip_diffusion)) skip_diffusion = cs%skip_diffusion
1240 end subroutine extract_offline_main
1244 subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, &
1245 tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug)
1249 target,
optional,
intent(in ) :: ale_csp
1251 target,
optional,
intent(in ) :: diabatic_csp
1253 target,
optional,
intent(in ) :: diag
1255 target,
optional,
intent(in ) :: obc
1257 target,
optional,
intent(in ) :: tracer_adv_csp
1259 target,
optional,
intent(in ) :: tracer_flow_csp
1261 target,
optional,
intent(in ) :: tracer_reg
1263 target,
optional,
intent(in ) :: tv
1265 target,
optional,
intent(in ) :: g
1267 target,
optional,
intent(in ) :: gv
1268 logical,
optional,
intent(in ) :: x_before_y
1269 logical,
optional,
intent(in ) :: debug
1272 if (
present(ale_csp)) cs%ALE_CSp => ale_csp
1273 if (
present(diabatic_csp)) cs%diabatic_CSp => diabatic_csp
1274 if (
present(diag)) cs%diag => diag
1275 if (
present(obc)) cs%OBC => obc
1276 if (
present(tracer_adv_csp)) cs%tracer_adv_CSp => tracer_adv_csp
1277 if (
present(tracer_flow_csp)) cs%tracer_flow_CSp => tracer_flow_csp
1278 if (
present(tracer_reg)) cs%tracer_Reg => tracer_reg
1279 if (
present(tv)) cs%tv => tv
1280 if (
present(g)) cs%G => g
1281 if (
present(gv)) cs%GV => gv
1282 if (
present(x_before_y)) cs%x_before_y = x_before_y
1283 if (
present(debug)) cs%debug = debug
1285 end subroutine insert_offline_main
1289 subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US)
1298 character(len=40) :: mdl =
"offline_transport" 1299 character(len=20) :: redistribute_method
1301 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
1302 integer :: isdb, iedb, jsdb, jedb
1304 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
1305 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1306 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1308 call calltree_enter(
"offline_transport_init, MOM_offline_control.F90")
1310 if (
associated(cs))
then 1311 call mom_error(warning,
"offline_transport_init called with an associated "// &
1312 "control structure.")
1316 call log_version(param_file, mdl,version,
"This module allows for tracers to be run offline")
1322 call get_param(param_file, mdl,
"OFFLINEDIR", cs%offlinedir, &
1323 "Input directory where the offline fields can be found", fail_if_missing = .true.)
1324 call get_param(param_file, mdl,
"OFF_SUM_FILE", cs%sum_file, &
1325 "Filename where the accumulated fields can be found", fail_if_missing = .true.)
1326 call get_param(param_file, mdl,
"OFF_SNAP_FILE", cs%snap_file, &
1327 "Filename where snapshot fields can be found", fail_if_missing = .true.)
1328 call get_param(param_file, mdl,
"OFF_MEAN_FILE", cs%mean_file, &
1329 "Filename where averaged fields can be found", fail_if_missing = .true.)
1330 call get_param(param_file, mdl,
"OFF_SURF_FILE", cs%surf_file, &
1331 "Filename where averaged fields can be found", fail_if_missing = .true.)
1332 call get_param(param_file, mdl,
"NUMTIME", cs%numtime, &
1333 "Number of timelevels in offline input files", fail_if_missing = .true.)
1334 call get_param(param_file, mdl,
"NK_INPUT", cs%nk_input, &
1335 "Number of vertical levels in offline input files", default = nz)
1336 call get_param(param_file, mdl,
"DT_OFFLINE", cs%dt_offline, &
1337 "Length of time between reading in of input fields", units=
's', scale=us%s_to_T, fail_if_missing = .true.)
1338 call get_param(param_file, mdl,
"DT_OFFLINE_VERTICAL", cs%dt_offline_vertical, &
1339 "Length of the offline timestep for tracer column sources/sinks " //&
1340 "This should be set to the length of the coupling timestep for " //&
1341 "tracers which need shortwave fluxes", units=
"s", scale=us%s_to_T, fail_if_missing = .true.)
1342 call get_param(param_file, mdl,
"START_INDEX", cs%start_index, &
1343 "Which time index to start from", default=1)
1344 call get_param(param_file, mdl,
"FIELDS_ARE_OFFSET", cs%fields_are_offset, &
1345 "True if the time-averaged fields and snapshot fields "//&
1346 "are offset by one time level", default=.false.)
1347 call get_param(param_file, mdl,
"REDISTRIBUTE_METHOD", redistribute_method, &
1348 "Redistributes any remaining horizontal fluxes throughout " //&
1349 "the rest of water column. Options are 'barotropic' which " //&
1350 "evenly distributes flux throughout the entire water column, " //&
1351 "'upwards' which adds the maximum of the remaining flux in " //&
1352 "each layer above, both which first applies upwards and then " //&
1353 "barotropic, and 'none' which does no redistribution", &
1354 default=
'barotropic')
1355 call get_param(param_file, mdl,
"NUM_OFF_ITER", cs%num_off_iter, &
1356 "Number of iterations to subdivide the offline tracer advection and diffusion", &
1358 call get_param(param_file, mdl,
"OFF_ALE_MOD", cs%off_ale_mod, &
1359 "Sets how many horizontal advection steps are taken before an ALE " //&
1360 "remapping step is done. 1 would be x->y->ALE, 2 would be" //&
1361 "x->y->x->y->ALE", default = 1)
1362 call get_param(param_file, mdl,
"PRINT_ADV_OFFLINE", cs%print_adv_offline, &
1363 "Print diagnostic output every advection subiteration",default=.false.)
1364 call get_param(param_file, mdl,
"SKIP_DIFFUSION_OFFLINE", cs%skip_diffusion, &
1365 "Do not do horizontal diffusion",default=.false.)
1366 call get_param(param_file, mdl,
"READ_SW", cs%read_sw, &
1367 "Read in shortwave radiation field instead of using values from the coupler"//&
1368 "when in offline tracer mode",default=.false.)
1369 call get_param(param_file, mdl,
"READ_MLD", cs%read_mld, &
1370 "Read in mixed layer depths for tracers which exchange with the atmosphere"//&
1371 "when in offline tracer mode",default=.false.)
1372 call get_param(param_file, mdl,
"MLD_VAR_NAME", cs%mld_var_name, &
1373 "Name of the variable containing the depth of active mixing",&
1374 default=
'ePBL_h_ML')
1375 call get_param(param_file, mdl,
"OFFLINE_ADD_DIURNAL_SW", cs%diurnal_sw, &
1376 "Adds a synthetic diurnal cycle in the same way that the ice " // &
1377 "model would have when time-averaged fields of shortwave " // &
1378 "radiation are read in", default=.false.)
1379 call get_param(param_file, mdl,
"KD_MAX", cs%Kd_max, &
1380 "The maximum permitted increment for the diapycnal "//&
1381 "diffusivity from TKE-based parameterizations, or a "//&
1382 "negative value for no limit.", units=
"m2 s-1", default=-1.0)
1383 call get_param(param_file, mdl,
"MIN_RESIDUAL_TRANSPORT", cs%min_residual, &
1384 "How much remaining transport before the main offline advection "// &
1385 "is exited. The default value corresponds to about 1 meter of " // &
1386 "difference in a grid cell", default = 1.e9)
1387 call get_param(param_file, mdl,
"READ_ALL_TS_UVH", cs%read_all_ts_uvh, &
1388 "Reads all time levels of a subset of the fields necessary to run " // &
1389 "the model offline. This can require a large amount of memory "// &
1390 "and will make initialization very slow. However, for offline "// &
1391 "runs spanning more than a year this can reduce total I/O overhead", &
1395 cs%snap_file = trim(cs%offlinedir)//trim(cs%snap_file)
1396 cs%mean_file = trim(cs%offlinedir)//trim(cs%mean_file)
1397 cs%sum_file = trim(cs%offlinedir)//trim(cs%sum_file)
1398 cs%surf_file = trim(cs%offlinedir)//trim(cs%surf_file)
1400 cs%num_vert_iter = cs%dt_offline/cs%dt_offline_vertical
1403 select case (redistribute_method)
1405 cs%redistribute_barotropic = .true.
1406 cs%redistribute_upwards = .false.
1408 cs%redistribute_barotropic = .false.
1409 cs%redistribute_upwards = .true.
1411 cs%redistribute_barotropic = .true.
1412 cs%redistribute_upwards = .true.
1414 cs%redistribute_barotropic = .false.
1415 cs%redistribute_upwards = .false.
1419 cs%accumulated_time = real_to_time(0.0)
1420 cs%vertical_time = cs%accumulated_time
1422 cs%ridx_sum = cs%start_index
1423 if (cs%fields_are_offset) cs%ridx_snap = next_modulo_time(cs%start_index,cs%numtime)
1424 if (.not. cs%fields_are_offset) cs%ridx_snap = cs%start_index
1427 call extract_diabatic_member(diabatic_csp, opacity_csp=cs%opacity_CSp, optics_csp=cs%optics, &
1428 diabatic_aux_csp=cs%diabatic_aux_CSp, &
1429 evap_cfl_limit=cs%evap_CFL_limit, &
1430 minimum_forcing_depth=cs%minimum_forcing_depth)
1437 allocate(cs%uhtr(isdb:iedb,jsd:jed,nz)) ; cs%uhtr(:,:,:) = 0.0
1438 allocate(cs%vhtr(isd:ied,jsdb:jedb,nz)) ; cs%vhtr(:,:,:) = 0.0
1439 allocate(cs%eatr(isd:ied,jsd:jed,nz)) ; cs%eatr(:,:,:) = 0.0
1440 allocate(cs%ebtr(isd:ied,jsd:jed,nz)) ; cs%ebtr(:,:,:) = 0.0
1441 allocate(cs%h_end(isd:ied,jsd:jed,nz)) ; cs%h_end(:,:,:) = 0.0
1442 allocate(cs%netMassOut(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassOut(:,:) = 0.0
1443 allocate(cs%netMassIn(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassIn(:,:) = 0.0
1444 allocate(cs%Kd(isd:ied,jsd:jed,nz+1)) ; cs%Kd = 0.
1445 if (cs%read_mld)
then 1446 allocate(cs%mld(g%isd:g%ied,g%jsd:g%jed)) ; cs%mld(:,:) = 0.0
1449 if (cs%read_all_ts_uvh)
then 1450 call read_all_input(cs)
1454 cs%id_clock_read_fields = cpu_clock_id(
'(Offline read fields)',grain=clock_module)
1455 cs%id_clock_offline_diabatic = cpu_clock_id(
'(Offline diabatic)',grain=clock_module)
1456 cs%id_clock_offline_adv = cpu_clock_id(
'(Offline transport)',grain=clock_module)
1457 cs%id_clock_redistribute = cpu_clock_id(
'(Offline redistribute)',grain=clock_module)
1459 call calltree_leave(
"offline_transport_init")
1461 end subroutine offline_transport_init
1465 subroutine read_all_input(CS)
1468 integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime
1469 integer :: IsdB, IedB, JsdB, JedB
1471 nz = cs%GV%ke ; ntime = cs%numtime
1472 isd = cs%G%isd ; ied = cs%G%ied ; jsd = cs%G%jsd ; jed = cs%G%jed
1473 isdb = cs%G%IsdB ; iedb = cs%G%IedB ; jsdb = cs%G%JsdB ; jedb = cs%G%JedB
1476 if (cs%read_all_ts_uvh)
then 1477 if (
allocated(cs%uhtr_all))
call mom_error(fatal,
"uhtr_all is already allocated")
1478 if (
allocated(cs%vhtr_all))
call mom_error(fatal,
"vhtr_all is already allocated")
1479 if (
allocated(cs%hend_all))
call mom_error(fatal,
"hend_all is already allocated")
1480 if (
allocated(cs%temp_all))
call mom_error(fatal,
"temp_all is already allocated")
1481 if (
allocated(cs%salt_all))
call mom_error(fatal,
"salt_all is already allocated")
1483 allocate(cs%uhtr_all(isdb:iedb,jsd:jed,nz,ntime)) ; cs%uhtr_all(:,:,:,:) = 0.0
1484 allocate(cs%vhtr_all(isd:ied,jsdb:jedb,nz,ntime)) ; cs%vhtr_all(:,:,:,:) = 0.0
1485 allocate(cs%hend_all(isd:ied,jsd:jed,nz,ntime)) ; cs%hend_all(:,:,:,:) = 0.0
1486 allocate(cs%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%temp_all(:,:,:,:) = 0.0
1487 allocate(cs%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%salt_all(:,:,:,:) = 0.0
1489 call mom_mesg(
"Reading in uhtr, vhtr, h_start, h_end, temp, salt")
1491 call mom_read_vector(cs%snap_file,
'uhtr_sum',
'vhtr_sum', cs%uhtr_all(:,:,1:cs%nk_input,t), &
1492 cs%vhtr_all(:,:,1:cs%nk_input,t), cs%G%Domain, timelevel=t)
1493 call mom_read_data(cs%snap_file,
'h_end', cs%hend_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1494 timelevel=t, position=center)
1495 call mom_read_data(cs%mean_file,
'temp', cs%temp_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1496 timelevel=t, position=center)
1497 call mom_read_data(cs%mean_file,
'salt', cs%salt_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1498 timelevel=t, position=center)
1502 end subroutine read_all_input
1505 subroutine offline_transport_end(CS)
1513 deallocate(cs%h_end)
1514 deallocate(cs%netMassOut)
1515 deallocate(cs%netMassIn)
1517 if (cs%read_mld)
deallocate(cs%mld)
1518 if (cs%read_all_ts_uvh)
then 1519 deallocate(cs%uhtr_all)
1520 deallocate(cs%vhtr_all)
1521 deallocate(cs%hend_all)
1522 deallocate(cs%temp_all)
1523 deallocate(cs%salt_all)
1528 end subroutine offline_transport_end
The routines here implement the offline tracer algorithm used in MOM6. These are called from step_off...
Wraps the FMS time manager functions.
This module contains the main regridding routines.
This module implements boundary forcing for MOM6.
Control structure for this module.
Provides functions for some diabatic processes such as fraxil, brine rejection, tendency due to surfa...
Ocean grid type. See mom_grid for details.
Contains routines related to offline transport of tracers. These routines are likely to be called fro...
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Wraps the MPP cpu clock functions.
This routine drives the diabatic/dianeutral physics for MOM.
This module contains I/O framework code.
The MOM6 facility to parse input files for runtime parameters.
Checksums a pair velocity arrays (2d or 3d) staggered at C-grid locations.
Do a halo update on a pair of arrays representing the two components of a vector.
Read a pair of data fields representing the two components of a vector from a file.
Routines to calculate checksums of various array and vector types.
Orchestrates the registration and calling of tracer packages.
Make a diagnostic available for averaging or output.
The control structure with paramters for the MOM_opacity module.
Describes various unit conversion factors.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Checksums an array (2d or 3d) staggered at tracer points.
Control structure for diabatic_aux.
Routines used to calculate the opacity of the ocean.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Describes the decomposed MOM domain and has routines for communications across PEs.
Type to carry basic tracer information.
The control structure for the offline transport module.
Routines for error handling and I/O management.
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
The control structure for orchestrating the calling of tracer packages.
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Control structure for this module.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
An overloaded interface to read various types of parameters.
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
This module contains the subroutines that advect tracers along coordinate surfaces.
This type is used to store information about ocean optical properties.
Controls where open boundary conditions are applied.
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.
Read a data field from a file.
An overloaded interface to read and log the values of various types of parameters.