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