7 use mpp_domains_mod,
only : center, corner, north, east
10 use mom_cpu_clock,
only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
12 use mom_cpu_clock,
only : clock_module_driver, clock_module, clock_routine
40 implicit none ;
private
42 #include "MOM_memory.h"
43 #include "version_variable.h"
49 type(
ale_cs),
pointer :: ale_csp => null()
79 integer :: start_index
82 integer :: accumulated_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
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)
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
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
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
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
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)
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)
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
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)
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
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
642 if (abs(vhtr(i,j,k))>vh_neglect)
then
645 enddo ;
enddo ;
enddo
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)) :: sw, sw_vis, sw_nir
669 integer :: is, ie, js, je, nz
671 real :: stock_values(max_fields_)
675 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec
677 call cpu_clock_begin(cs%id_clock_offline_diabatic)
679 call mom_mesg(
"Applying tracer source, sinks, and vertical mixing")
682 call hchksum(h_pre,
"h_pre before offline_diabatic_ale",cs%G%HI)
683 call hchksum(eatr,
"eatr before offline_diabatic_ale",cs%G%HI)
684 call hchksum(ebtr,
"ebtr before offline_diabatic_ale",cs%G%HI)
685 call mom_tracer_chkinv(
"Before offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
694 do j=js,je ;
do i=is,ie
698 if (cs%Kd(i,j,k)>0.)
then
699 kd_bot = cs%Kd(i,j,k)
706 cs%Kd(i,j,k) = kd_bot
710 do j=js,je ;
do i=is,ie
713 do k=2,nz ;
do j=js,je ;
do i=is,ie
714 hval=1.0/(cs%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k)))
715 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)
716 ebtr(i,j,k-1) = eatr(i,j,k)
717 enddo ;
enddo ;
enddo
718 do j=js,je ;
do i=is,ie
723 if (cs%diurnal_SW .and. cs%read_sw)
then
725 sw_vis(:,:) = fluxes%sw_vis_dir
726 sw_nir(:,:) = fluxes%sw_nir_dir
727 call offline_add_diurnal_sw(fluxes, cs%G, time_start, time_end)
730 if (
associated(cs%optics)) &
731 call set_pen_shortwave(cs%optics, fluxes, cs%G, cs%GV, cs%diabatic_aux_CSp, cs%opacity_CSp, cs%tracer_flow_CSp)
736 cs%G, cs%GV, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
738 if (cs%diurnal_SW .and. cs%read_sw)
then
740 fluxes%sw_vis_dir(:,:) = sw_vis
741 fluxes%sw_nir_dir(:,:) = sw_nir
745 call hchksum(h_pre,
"h_pre after offline_diabatic_ale",cs%G%HI)
746 call hchksum(eatr,
"eatr after offline_diabatic_ale",cs%G%HI)
747 call hchksum(ebtr,
"ebtr after offline_diabatic_ale",cs%G%HI)
748 call mom_tracer_chkinv(
"After offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
751 call cpu_clock_end(cs%id_clock_offline_diabatic)
761 type(
forcing),
intent(inout) :: fluxes
762 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
764 real,
dimension(SZI_(G),SZJ_(G)), &
765 optional,
intent(in) :: in_flux_optional
769 real,
dimension(SZI_(G),SZJ_(G)) :: negative_fw
772 if (
present(in_flux_optional) ) &
773 call mom_error(warning,
"Positive freshwater fluxes with non-zero tracer concentration not supported yet")
776 negative_fw(:,:) = 0.
779 do j=g%jsc,g%jec ;
do i=g%isc,g%iec
780 if (fluxes%netMassOut(i,j)<0.0)
then
781 negative_fw(i,j) = fluxes%netMassOut(i,j)
782 fluxes%netMassOut(i,j) = 0.
787 call hchksum(h,
"h before fluxes into ocean",g%HI)
788 call mom_tracer_chkinv(
"Before fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
790 do m = 1,cs%tracer_reg%ntr
792 update_h = ( m == cs%tracer_reg%ntr )
794 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
797 call hchksum(h,
"h after fluxes into ocean",g%HI)
798 call mom_tracer_chkinv(
"After fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
802 fluxes%netMassOut(:,:) = negative_fw(:,:)
811 type(
forcing),
intent(inout) :: fluxes
812 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
814 real,
dimension(SZI_(G),SZJ_(G)), &
815 optional,
intent(in) :: out_flux_optional
821 if (
present(out_flux_optional) ) &
822 call mom_error(warning,
"Negative freshwater fluxes with non-zero tracer concentration not supported yet")
825 call hchksum(h,
"h before fluxes out of ocean",g%HI)
826 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
828 do m = 1, cs%tracer_reg%ntr
830 update_h = ( m == cs%tracer_reg%ntr )
832 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
835 call hchksum(h,
"h after fluxes out of ocean",g%HI)
836 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
845 type(time_type),
intent(in) :: time_start
846 real,
intent(in) :: time_interval
848 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
849 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: eatr
850 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: ebtr
851 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
852 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
859 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub
861 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub
863 real :: sum_abs_fluxes, sum_u, sum_v
868 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
872 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
876 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
877 temp_old, salt_old, &
878 temp_mean, salt_mean, &
880 integer :: niter, iter
884 character(len=160) :: mesg
885 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
886 integer :: isv, iev, jsv, jev
887 integer :: isdb, iedb, jsdb, jedb
888 logical :: z_first, x_before_y
890 g => cs%G ; gv => cs%GV
891 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
892 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
893 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
895 dt_iter = cs%US%s_to_T * time_interval / real(max(1, cs%num_off_iter))
897 do iter=1,cs%num_off_iter
899 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
900 eatr_sub(i,j,k) = eatr(i,j,k)
901 ebtr_sub(i,j,k) = ebtr(i,j,k)
902 enddo ;
enddo ;
enddo
904 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
905 uhtr_sub(i,j,k) = uhtr(i,j,k)
906 enddo ;
enddo ;
enddo
908 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
909 vhtr_sub(i,j,k) = vhtr(i,j,k)
910 enddo ;
enddo ;
enddo
914 call limit_mass_flux_3d(g, gv, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre)
918 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
920 fluxes, cs%mld, dt_iter, g, gv, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
922 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
923 h_pre(i,j,k) = h_new(i,j,k)
924 enddo ;
enddo ;
enddo
928 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
929 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
930 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
931 enddo ;
enddo ;
enddo
932 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, cs%US, &
933 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
936 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
937 h_pre(i,j,k) = h_new(i,j,k)
938 enddo ;
enddo ;
enddo
942 if (.not. z_first)
then
945 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
946 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
947 h_vol(i,j,k) = h_pre(i,j,k)*g%US%L_to_m**2*g%areaT(i,j)
948 enddo ;
enddo ;
enddo
949 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, cs%US, &
950 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
953 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
954 h_pre(i,j,k) = h_new(i,j,k)
955 enddo ;
enddo ;
enddo
958 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
960 fluxes, cs%mld, dt_iter, g, gv, cs%US, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
962 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
963 h_pre(i,j,k) = h_new(i,j,k)
964 enddo ;
enddo ;
enddo
969 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
970 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k)
971 ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k)
972 enddo ;
enddo ;
enddo
974 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
975 uhtr(i,j,k) = uhtr(i,j,k) - uhtr_sub(i,j,k)
976 enddo ;
enddo ;
enddo
978 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
979 vhtr(i,j,k) = vhtr(i,j,k) - vhtr_sub(i,j,k)
980 enddo ;
enddo ;
enddo
991 do k=1,nz;
do j=js,je;
do i=is,ie
992 sum_u = sum_u + abs(uhtr(i-1,j,k))+abs(uhtr(i,j,k))
993 sum_v = sum_v + abs(vhtr(i,j-1,k))+abs(vhtr(i,j,k))
994 sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(i-1,j,k)) + &
995 abs(uhtr(i,j,k)) + abs(vhtr(i,j-1,k)) + abs(vhtr(i,j,k))
996 enddo ;
enddo ;
enddo
997 call sum_across_pes(sum_abs_fluxes)
999 write(mesg,*)
"offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v
1001 if (sum_abs_fluxes==0)
then
1002 write(mesg,*)
'offline_advection_layer: Converged after iteration', iter
1008 z_first = .not. z_first
1009 x_before_y = .not. x_before_y
1018 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h
1019 type(
forcing),
intent(inout) :: fluxes
1020 logical,
intent(in ) :: do_ale
1022 integer :: i, j, k, is, ie, js, je, nz
1023 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h_start
1024 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec ; nz = cs%GV%ke
1026 call cpu_clock_begin(cs%id_clock_read_fields)
1027 call calltree_enter(
"update_offline_fields, MOM_offline_main.F90")
1030 h_start(:,:,:) = h(:,:,:)
1033 call update_offline_from_files( cs%G, cs%GV, cs%nk_input, cs%mean_file, cs%sum_file, cs%snap_file, cs%surf_file, &
1034 cs%h_end, cs%uhtr, cs%vhtr, cs%tv%T, cs%tv%S, cs%mld, cs%Kd, fluxes, &
1035 cs%ridx_sum, cs%ridx_snap, cs%read_mld, cs%read_sw, .not. cs%read_all_ts_uvh, do_ale)
1037 if (cs%read_all_ts_uvh)
then
1038 call update_offline_from_arrays(cs%G, cs%GV, cs%nk_input, cs%ridx_sum, cs%mean_file, cs%sum_file, cs%snap_file, &
1039 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)
1042 call uvchksum(
"[uv]h after update offline from files and arrays", cs%uhtr, cs%vhtr, cs%G%HI)
1049 call pass_var(cs%tv%T, cs%G%Domain)
1050 call pass_var(cs%tv%S, cs%G%Domain)
1051 call ale_offline_inputs(cs%ALE_CSp, cs%G, cs%GV, h, cs%tv, cs%tracer_Reg, cs%uhtr, cs%vhtr, cs%Kd, &
1053 if (cs%id_temp_regrid>0)
call post_data(cs%id_temp_regrid, cs%tv%T, cs%diag)
1054 if (cs%id_salt_regrid>0)
call post_data(cs%id_salt_regrid, cs%tv%S, cs%diag)
1055 if (cs%id_uhtr_regrid>0)
call post_data(cs%id_uhtr_regrid, cs%uhtr, cs%diag)
1056 if (cs%id_vhtr_regrid>0)
call post_data(cs%id_vhtr_regrid, cs%vhtr, cs%diag)
1057 if (cs%id_h_regrid>0)
call post_data(cs%id_h_regrid, h, cs%diag)
1059 call uvchksum(
"[uv]h after ALE regridding/remapping of inputs", cs%uhtr, cs%vhtr, cs%G%HI)
1060 call hchksum(h_start,
"h_start after update offline from files and arrays", cs%G%HI)
1065 call pass_var(cs%h_end, cs%G%Domain)
1066 call pass_var(cs%tv%T, cs%G%Domain)
1067 call pass_var(cs%tv%S, cs%G%Domain)
1070 cs%ridx_snap = next_modulo_time(cs%ridx_snap,cs%numtime)
1071 cs%ridx_sum = next_modulo_time(cs%ridx_sum,cs%numtime)
1074 do k=1,nz ;
do j=js,je ;
do i=is,ie
1075 if (cs%G%mask2dT(i,j)<1.0)
then
1076 cs%h_end(i,j,k) = cs%GV%Angstrom_H
1078 enddo ;
enddo ;
enddo
1080 do k=1,nz+1 ;
do j=js,je ;
do i=is,ie
1081 cs%Kd(i,j,k) = max(0.0, cs%Kd(i,j,k))
1082 if (cs%Kd_max>0.)
then
1083 cs%Kd(i,j,k) = min(cs%Kd_max, cs%Kd(i,j,k))
1085 enddo ;
enddo ;
enddo
1087 do k=1,nz ;
do j=js-1,je ;
do i=is,ie
1088 if (cs%G%mask2dCv(i,j)<1.0)
then
1089 cs%vhtr(i,j,k) = 0.0
1091 enddo ;
enddo ;
enddo
1093 do k=1,nz ;
do j=js,je ;
do i=is-1,ie
1094 if (cs%G%mask2dCu(i,j)<1.0)
then
1095 cs%uhtr(i,j,k) = 0.0
1097 enddo ;
enddo ;
enddo
1100 call uvchksum(
"[uv]htr_sub after update_offline_fields", cs%uhtr, cs%vhtr, cs%G%HI)
1101 call hchksum(cs%h_end,
"h_end after update_offline_fields", cs%G%HI)
1102 call hchksum(cs%tv%T,
"Temp after update_offline_fields", cs%G%HI)
1103 call hchksum(cs%tv%S,
"Salt after update_offline_fields", cs%G%HI)
1107 call cpu_clock_end(cs%id_clock_read_fields)
1115 type(time_type),
intent(in) :: time
1120 'Zonal thickness fluxes remaining at end of advection',
'kg')
1122 'Zonal thickness fluxes to be redistributed vertically',
'kg')
1124 'Zonal thickness fluxes at end of offline step',
'kg')
1128 'Meridional thickness fluxes remaining at end of advection',
'kg')
1130 'Meridional thickness to be redistributed vertically',
'kg')
1132 'Meridional thickness at end of offline step',
'kg')
1136 'Difference between the stored and calculated layer thickness',
'm')
1138 'Layer thickness at end of offline step',
'm')
1140 'Remaining thickness entrained from above',
'm')
1142 'Remaining thickness entrained from below',
'm')
1144 diag%axesT1, time,
'Total water column height before residual transport redistribution',
'm')
1146 diag%axesT1, time,
'Total water column height after residual transport redistribution',
'm')
1147 cs%id_eta_diff_end =
register_diag_field(
'ocean_model',
'eta_diff_end', diag%axesT1, time, &
1148 'Difference in total water column height from online and offline ' // &
1149 'at the end of the offline timestep',
'm')
1151 'Layer thicknesses before redistribution of mass fluxes',
'm')
1154 cs%id_uhtr_regrid =
register_diag_field(
'ocean_model',
'uhtr_regrid', diag%axesCuL, time, &
1155 'Zonal mass transport regridded/remapped onto offline grid',
'kg')
1156 cs%id_vhtr_regrid =
register_diag_field(
'ocean_model',
'vhtr_regrid', diag%axesCvL, time, &
1157 'Meridional mass transport regridded/remapped onto offline grid',
'kg')
1158 cs%id_temp_regrid =
register_diag_field(
'ocean_model',
'temp_regrid', diag%axesTL, time, &
1159 'Temperature regridded/remapped onto offline grid',
'C')
1160 cs%id_salt_regrid =
register_diag_field(
'ocean_model',
'salt_regrid', diag%axesTL, time, &
1161 'Salinity regridded/remapped onto offline grid',
'g kg-1')
1163 'Layer thicknesses regridded/remapped onto offline grid',
'm')
1171 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_off
1172 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_end
1173 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
1174 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
1176 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff
1179 if (cs%id_eta_diff_end>0)
then
1182 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1183 eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k)
1184 enddo ;
enddo ;
enddo
1185 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1186 eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k)
1187 enddo ;
enddo ;
enddo
1189 call post_data(cs%id_eta_diff_end, eta_diff, cs%diag)
1192 if (cs%id_hdiff>0)
call post_data(cs%id_hdiff, h_off-h_end, cs%diag)
1193 if (cs%id_hr>0)
call post_data(cs%id_hr, h_off, cs%diag)
1194 if (cs%id_uhr_end>0)
call post_data(cs%id_uhr_end, uhtr, cs%diag)
1195 if (cs%id_vhr_end>0)
call post_data(cs%id_vhr_end, vhtr, cs%diag)
1202 dt_offline, dt_offline_vertical, skip_diffusion)
1205 real,
dimension(:,:,:),
optional,
pointer :: uhtr
1206 real,
dimension(:,:,:),
optional,
pointer :: vhtr
1207 real,
dimension(:,:,:),
optional,
pointer :: eatr
1209 real,
dimension(:,:,:),
optional,
pointer :: ebtr
1211 real,
dimension(:,:,:),
optional,
pointer :: h_end
1214 integer,
optional,
pointer :: accumulated_time
1216 real,
optional,
intent( out) :: dt_offline
1217 real,
optional,
intent( out) :: dt_offline_vertical
1219 logical,
optional,
intent( out) :: skip_diffusion
1222 if (
present(uhtr)) uhtr => cs%uhtr
1223 if (
present(vhtr)) vhtr => cs%vhtr
1224 if (
present(eatr)) eatr => cs%eatr
1225 if (
present(ebtr)) ebtr => cs%ebtr
1226 if (
present(h_end)) h_end => cs%h_end
1229 if (
present(accumulated_time)) accumulated_time => cs%accumulated_time
1232 if (
present(dt_offline)) dt_offline = cs%dt_offline
1233 if (
present(dt_offline_vertical)) dt_offline_vertical = cs%dt_offline_vertical
1234 if (
present(skip_diffusion)) skip_diffusion = cs%skip_diffusion
1241 tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug)
1245 target,
optional,
intent(in ) :: ale_csp
1247 target,
optional,
intent(in ) :: diabatic_csp
1249 target,
optional,
intent(in ) :: diag
1251 target,
optional,
intent(in ) :: obc
1253 target,
optional,
intent(in ) :: tracer_adv_csp
1255 target,
optional,
intent(in ) :: tracer_flow_csp
1257 target,
optional,
intent(in ) :: tracer_reg
1259 target,
optional,
intent(in ) :: tv
1261 target,
optional,
intent(in ) :: g
1263 target,
optional,
intent(in ) :: gv
1264 logical,
optional,
intent(in ) :: x_before_y
1265 logical,
optional,
intent(in ) :: debug
1268 if (
present(ale_csp)) cs%ALE_CSp => ale_csp
1269 if (
present(diabatic_csp)) cs%diabatic_CSp => diabatic_csp
1270 if (
present(diag)) cs%diag => diag
1271 if (
present(obc)) cs%OBC => obc
1272 if (
present(tracer_adv_csp)) cs%tracer_adv_CSp => tracer_adv_csp
1273 if (
present(tracer_flow_csp)) cs%tracer_flow_CSp => tracer_flow_csp
1274 if (
present(tracer_reg)) cs%tracer_Reg => tracer_reg
1275 if (
present(tv)) cs%tv => tv
1276 if (
present(g)) cs%G => g
1277 if (
present(gv)) cs%GV => gv
1278 if (
present(x_before_y)) cs%x_before_y = x_before_y
1279 if (
present(debug)) cs%debug = debug
1294 character(len=40) :: mdl =
"offline_transport"
1295 character(len=20) :: redistribute_method
1297 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
1298 integer :: isdb, iedb, jsdb, jedb
1300 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
1301 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1302 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1304 call calltree_enter(
"offline_transport_init, MOM_offline_control.F90")
1306 if (
associated(cs))
then
1307 call mom_error(warning,
"offline_transport_init called with an associated "// &
1308 "control structure.")
1312 call log_version(param_file, mdl,version,
"This module allows for tracers to be run offline")
1318 call get_param(param_file, mdl,
"OFFLINEDIR", cs%offlinedir, &
1319 "Input directory where the offline fields can be found", fail_if_missing = .true.)
1320 call get_param(param_file, mdl,
"OFF_SUM_FILE", cs%sum_file, &
1321 "Filename where the accumulated fields can be found", fail_if_missing = .true.)
1322 call get_param(param_file, mdl,
"OFF_SNAP_FILE", cs%snap_file, &
1323 "Filename where snapshot fields can be found", fail_if_missing = .true.)
1324 call get_param(param_file, mdl,
"OFF_MEAN_FILE", cs%mean_file, &
1325 "Filename where averaged fields can be found", fail_if_missing = .true.)
1326 call get_param(param_file, mdl,
"OFF_SURF_FILE", cs%surf_file, &
1327 "Filename where averaged fields can be found", fail_if_missing = .true.)
1328 call get_param(param_file, mdl,
"NUMTIME", cs%numtime, &
1329 "Number of timelevels in offline input files", fail_if_missing = .true.)
1330 call get_param(param_file, mdl,
"NK_INPUT", cs%nk_input, &
1331 "Number of vertical levels in offline input files", default = nz)
1332 call get_param(param_file, mdl,
"DT_OFFLINE", cs%dt_offline, &
1333 "Length of time between reading in of input fields", units=
's', scale=us%s_to_T, fail_if_missing = .true.)
1334 call get_param(param_file, mdl,
"DT_OFFLINE_VERTICAL", cs%dt_offline_vertical, &
1335 "Length of the offline timestep for tracer column sources/sinks " //&
1336 "This should be set to the length of the coupling timestep for " //&
1337 "tracers which need shortwave fluxes", units=
"s", scale=us%s_to_T, fail_if_missing = .true.)
1338 call get_param(param_file, mdl,
"START_INDEX", cs%start_index, &
1339 "Which time index to start from", default=1)
1340 call get_param(param_file, mdl,
"FIELDS_ARE_OFFSET", cs%fields_are_offset, &
1341 "True if the time-averaged fields and snapshot fields "//&
1342 "are offset by one time level", default=.false.)
1343 call get_param(param_file, mdl,
"REDISTRIBUTE_METHOD", redistribute_method, &
1344 "Redistributes any remaining horizontal fluxes throughout " //&
1345 "the rest of water column. Options are 'barotropic' which " //&
1346 "evenly distributes flux throughout the entire water column, " //&
1347 "'upwards' which adds the maximum of the remaining flux in " //&
1348 "each layer above, both which first applies upwards and then " //&
1349 "barotropic, and 'none' which does no redistribution", &
1350 default=
'barotropic')
1351 call get_param(param_file, mdl,
"NUM_OFF_ITER", cs%num_off_iter, &
1352 "Number of iterations to subdivide the offline tracer advection and diffusion", &
1354 call get_param(param_file, mdl,
"OFF_ALE_MOD", cs%off_ale_mod, &
1355 "Sets how many horizontal advection steps are taken before an ALE " //&
1356 "remapping step is done. 1 would be x->y->ALE, 2 would be" //&
1357 "x->y->x->y->ALE", default = 1)
1358 call get_param(param_file, mdl,
"PRINT_ADV_OFFLINE", cs%print_adv_offline, &
1359 "Print diagnostic output every advection subiteration",default=.false.)
1360 call get_param(param_file, mdl,
"SKIP_DIFFUSION_OFFLINE", cs%skip_diffusion, &
1361 "Do not do horizontal diffusion",default=.false.)
1362 call get_param(param_file, mdl,
"READ_SW", cs%read_sw, &
1363 "Read in shortwave radiation field instead of using values from the coupler"//&
1364 "when in offline tracer mode",default=.false.)
1365 call get_param(param_file, mdl,
"READ_MLD", cs%read_mld, &
1366 "Read in mixed layer depths for tracers which exchange with the atmosphere"//&
1367 "when in offline tracer mode",default=.false.)
1368 call get_param(param_file, mdl,
"MLD_VAR_NAME", cs%mld_var_name, &
1369 "Name of the variable containing the depth of active mixing",&
1370 default=
'ePBL_h_ML')
1371 call get_param(param_file, mdl,
"OFFLINE_ADD_DIURNAL_SW", cs%diurnal_sw, &
1372 "Adds a synthetic diurnal cycle in the same way that the ice " // &
1373 "model would have when time-averaged fields of shortwave " // &
1374 "radiation are read in", default=.false.)
1375 call get_param(param_file, mdl,
"KD_MAX", cs%Kd_max, &
1376 "The maximum permitted increment for the diapycnal "//&
1377 "diffusivity from TKE-based parameterizations, or a "//&
1378 "negative value for no limit.", units=
"m2 s-1", default=-1.0)
1379 call get_param(param_file, mdl,
"MIN_RESIDUAL_TRANSPORT", cs%min_residual, &
1380 "How much remaining transport before the main offline advection "// &
1381 "is exited. The default value corresponds to about 1 meter of " // &
1382 "difference in a grid cell", default = 1.e9)
1383 call get_param(param_file, mdl,
"READ_ALL_TS_UVH", cs%read_all_ts_uvh, &
1384 "Reads all time levels of a subset of the fields necessary to run " // &
1385 "the model offline. This can require a large amount of memory "// &
1386 "and will make initialization very slow. However, for offline "// &
1387 "runs spanning more than a year this can reduce total I/O overhead", &
1391 cs%snap_file = trim(cs%offlinedir)//trim(cs%snap_file)
1392 cs%mean_file = trim(cs%offlinedir)//trim(cs%mean_file)
1393 cs%sum_file = trim(cs%offlinedir)//trim(cs%sum_file)
1394 cs%surf_file = trim(cs%offlinedir)//trim(cs%surf_file)
1396 cs%num_vert_iter = cs%dt_offline/cs%dt_offline_vertical
1399 select case (redistribute_method)
1401 cs%redistribute_barotropic = .true.
1402 cs%redistribute_upwards = .false.
1404 cs%redistribute_barotropic = .false.
1405 cs%redistribute_upwards = .true.
1407 cs%redistribute_barotropic = .true.
1408 cs%redistribute_upwards = .true.
1410 cs%redistribute_barotropic = .false.
1411 cs%redistribute_upwards = .false.
1415 cs%accumulated_time = 0
1417 cs%ridx_sum = cs%start_index
1418 if (cs%fields_are_offset) cs%ridx_snap = next_modulo_time(cs%start_index,cs%numtime)
1419 if (.not. cs%fields_are_offset) cs%ridx_snap = cs%start_index
1423 diabatic_aux_csp=cs%diabatic_aux_CSp, &
1424 evap_cfl_limit=cs%evap_CFL_limit, &
1425 minimum_forcing_depth=cs%minimum_forcing_depth)
1432 allocate(cs%uhtr(isdb:iedb,jsd:jed,nz)) ; cs%uhtr(:,:,:) = 0.0
1433 allocate(cs%vhtr(isd:ied,jsdb:jedb,nz)) ; cs%vhtr(:,:,:) = 0.0
1434 allocate(cs%eatr(isd:ied,jsd:jed,nz)) ; cs%eatr(:,:,:) = 0.0
1435 allocate(cs%ebtr(isd:ied,jsd:jed,nz)) ; cs%ebtr(:,:,:) = 0.0
1436 allocate(cs%h_end(isd:ied,jsd:jed,nz)) ; cs%h_end(:,:,:) = 0.0
1437 allocate(cs%netMassOut(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassOut(:,:) = 0.0
1438 allocate(cs%netMassIn(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassIn(:,:) = 0.0
1439 allocate(cs%Kd(isd:ied,jsd:jed,nz+1)) ; cs%Kd = 0.
1440 if (cs%read_mld)
then
1441 allocate(cs%mld(g%isd:g%ied,g%jsd:g%jed)) ; cs%mld(:,:) = 0.0
1444 if (cs%read_all_ts_uvh)
then
1449 cs%id_clock_read_fields = cpu_clock_id(
'(Offline read fields)',grain=clock_module)
1450 cs%id_clock_offline_diabatic = cpu_clock_id(
'(Offline diabatic)',grain=clock_module)
1451 cs%id_clock_offline_adv = cpu_clock_id(
'(Offline transport)',grain=clock_module)
1452 cs%id_clock_redistribute = cpu_clock_id(
'(Offline redistribute)',grain=clock_module)
1463 integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime
1464 integer :: IsdB, IedB, JsdB, JedB
1466 nz = cs%GV%ke ; ntime = cs%numtime
1467 isd = cs%G%isd ; ied = cs%G%ied ; jsd = cs%G%jsd ; jed = cs%G%jed
1468 isdb = cs%G%IsdB ; iedb = cs%G%IedB ; jsdb = cs%G%JsdB ; jedb = cs%G%JedB
1471 if (cs%read_all_ts_uvh)
then
1472 if (
allocated(cs%uhtr_all))
call mom_error(fatal,
"uhtr_all is already allocated")
1473 if (
allocated(cs%vhtr_all))
call mom_error(fatal,
"vhtr_all is already allocated")
1474 if (
allocated(cs%hend_all))
call mom_error(fatal,
"hend_all is already allocated")
1475 if (
allocated(cs%temp_all))
call mom_error(fatal,
"temp_all is already allocated")
1476 if (
allocated(cs%salt_all))
call mom_error(fatal,
"salt_all is already allocated")
1478 allocate(cs%uhtr_all(isdb:iedb,jsd:jed,nz,ntime)) ; cs%uhtr_all(:,:,:,:) = 0.0
1479 allocate(cs%vhtr_all(isd:ied,jsdb:jedb,nz,ntime)) ; cs%vhtr_all(:,:,:,:) = 0.0
1480 allocate(cs%hend_all(isd:ied,jsd:jed,nz,ntime)) ; cs%hend_all(:,:,:,:) = 0.0
1481 allocate(cs%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%temp_all(:,:,:,:) = 0.0
1482 allocate(cs%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%salt_all(:,:,:,:) = 0.0
1484 call mom_mesg(
"Reading in uhtr, vhtr, h_start, h_end, temp, salt")
1486 call mom_read_vector(cs%snap_file,
'uhtr_sum',
'vhtr_sum', cs%uhtr_all(:,:,1:cs%nk_input,t), &
1487 cs%vhtr_all(:,:,1:cs%nk_input,t), cs%G%Domain, timelevel=t)
1488 call mom_read_data(cs%snap_file,
'h_end', cs%hend_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1489 timelevel=t, position=center)
1490 call mom_read_data(cs%mean_file,
'temp', cs%temp_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1491 timelevel=t, position=center)
1492 call mom_read_data(cs%mean_file,
'salt', cs%salt_all(:,:,1:cs%nk_input,t), cs%G%Domain, &
1493 timelevel=t, position=center)
1508 deallocate(cs%h_end)
1509 deallocate(cs%netMassOut)
1510 deallocate(cs%netMassIn)
1512 if (cs%read_mld)
deallocate(cs%mld)
1513 if (cs%read_all_ts_uvh)
then
1514 deallocate(cs%uhtr_all)
1515 deallocate(cs%vhtr_all)
1516 deallocate(cs%hend_all)
1517 deallocate(cs%temp_all)
1518 deallocate(cs%salt_all)