5 use mpp_domains_mod
, only : center, corner, north, east
8 use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
10 use mom_cpu_clock, only : clock_module_driver, clock_module, clock_routine
21 use mom_io, only : read_data
38 implicit none ;
private 40 #include "MOM_memory.h" 41 #include "version_variable.h" 46 type(
ale_cs),
pointer :: ale_csp => null()
60 integer :: start_index
63 integer :: accumulated_time
64 integer :: & !< Index of each of the variables to be read in
68 character(len=200) :: offlinedir
69 character(len=200) :: &
70 surf_file, & !< Contains surface fields (2d arrays)
71 snap_file, & !< Snapshotted fields (layer thicknesses)
72 sum_file, & !< Fields which are accumulated over time
74 character(len=20) :: redistribute_method
78 character(len=20) :: mld_var_name
79 logical :: fields_are_offset
82 logical :: print_adv_offline
83 logical :: skip_diffusion
88 logical :: redistribute_barotropic
90 logical :: redistribute_upwards
93 logical :: read_all_ts_uvh
96 integer :: num_off_iter
97 integer :: num_vert_iter
98 integer :: off_ale_mod
100 real :: dt_offline_vertical
101 real :: evap_cfl_limit, minimum_forcing_depth
113 id_uhr_redist = -1, &
114 id_vhr_redist = -1, &
117 id_eta_pre_distribute = -1, &
118 id_eta_post_distribute = -1, &
124 id_uhtr_regrid = -1, &
125 id_vhtr_regrid = -1, &
126 id_temp_regrid = -1, &
127 id_salt_regrid = -1, &
132 id_clock_read_fields = -1, &
133 id_clock_offline_diabatic = -1, &
134 id_clock_offline_adv = -1, &
135 id_clock_redistribute = -1
138 real,
allocatable,
dimension(:,:,:) :: uhtr
139 real,
allocatable,
dimension(:,:,:) :: vhtr
142 real,
allocatable,
dimension(:,:,:) :: &
143 eatr, & !< Amount of fluid entrained from the layer above within
148 real,
allocatable,
dimension(:,:,:) :: kd
149 real,
allocatable,
dimension(:,:,:) :: h_end
151 real,
allocatable,
dimension(:,:) :: netmassin
152 real,
allocatable,
dimension(:,:) :: netmassout
153 real,
allocatable,
dimension(:,:) :: mld
156 real,
allocatable,
dimension(:,:,:,:) :: &
157 uhtr_all, vhtr_all, hend_all, temp_all, salt_all
180 subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged)
182 type(time_type),
intent(in) :: Time_start
183 real,
intent(in) :: time_interval
185 integer,
intent(in) :: id_clock_ALE
186 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
187 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
188 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
189 logical,
intent( out) :: converged
197 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub
199 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub
201 real :: prev_tot_residual, tot_residual
204 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
208 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end
209 integer :: niter, iter
211 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
212 integer :: isv, iev, jsv, jev
213 integer :: IsdB, IedB, JsdB, JedB
214 logical :: z_first, x_before_y
215 real :: evap_CFL_limit, minimum_forcing_depth, dt_iter, dt_offline
218 real :: stock_values(max_fields_)
219 character*20 :: debug_msg
220 call cpu_clock_begin(cs%id_clock_offline_adv)
226 x_before_y = cs%x_before_y
229 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
230 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
231 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
233 dt_offline = cs%dt_offline
234 evap_cfl_limit = cs%evap_CFL_limit
235 minimum_forcing_depth = cs%minimum_forcing_depth
237 niter = cs%num_off_iter
238 inum_iter = 1./
real(niter)
239 dt_iter = dt_offline*inum_iter
244 uhtr_sub(:,:,:) = 0.0
245 vhtr_sub(:,:,:) = 0.0
270 do k=1,nz ;
do j=jsd,jed ;
do i=isdb,iedb
271 uhtr_sub(i,j,k) = uhtr(i,j,k)
272 enddo ;
enddo ;
enddo 273 do k=1,nz ;
do j=jsdb,jedb ;
do i=isd,ied
274 vhtr_sub(i,j,k) = vhtr(i,j,k)
275 enddo ;
enddo ;
enddo 276 do k=1,nz ;
do j=js,je ;
do i=is,ie
277 h_new(i,j,k) = h_pre(i,j,k)
278 enddo ;
enddo ;
enddo 281 call hchksum(h_pre,
"h_pre before transport",g%HI)
282 call uvchksum(
"[uv]htr_sub before transport", uhtr_sub, vhtr_sub, g%HI)
285 if (cs%print_adv_offline)
then 286 if (is_root_pe())
then 287 write(*,
'(A,ES24.16)')
"Main advection starting transport: ", tot_residual
293 do iter=1,cs%num_off_iter
295 do k=1,nz ;
do j=js,je ;
do i=is,ie
296 h_vol(i,j,k) = h_new(i,j,k)*g%areaT(i,j)
297 h_pre(i,j,k) = h_new(i,j,k)
298 enddo ;
enddo ;
enddo 301 call hchksum(h_vol,
"h_vol before advect",g%HI)
302 call uvchksum(
"[uv]htr_sub before advect", uhtr_sub, vhtr_sub, g%HI)
303 write(debug_msg,
'(A,I4.4)')
'Before advect ', iter
307 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, cs%dt_offline, g, gv, &
308 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=1, &
309 uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y)
312 x_before_y = .not. x_before_y
315 do k=1,nz ;
do j=js,je ;
do i=is,ie
316 h_new(i,j,k) = h_new(i,j,k)/g%areaT(i,j)
317 enddo ;
enddo ;
enddo 319 if (modulo(iter,cs%off_ale_mod)==0)
then 323 call hchksum(h_new,
"h_new before ALE",g%HI)
324 write(debug_msg,
'(A,I4.4)')
'Before ALE ', iter
327 call cpu_clock_begin(id_clock_ale)
328 call ale_main_offline(g, gv, h_new, cs%tv, cs%tracer_Reg, cs%ALE_CSp, cs%dt_offline)
329 call cpu_clock_end(id_clock_ale)
332 call hchksum(h_new,
"h_new after ALE",g%HI)
333 write(debug_msg,
'(A,I4.4)')
'After ALE ', iter
338 do k=1,nz;
do j=js,je ;
do i=is,ie
339 uhtr_sub(i,j,k) = uhtr(i,j,k)
340 vhtr_sub(i,j,k) = vhtr(i,j,k)
341 enddo ;
enddo ;
enddo 348 if (cs%print_adv_offline)
then 349 if (is_root_pe())
then 350 write(*,
'(A,ES24.16)')
"Main advection remaining transport: ", tot_residual
354 if (tot_residual == 0.0)
then 355 if (is_root_pe())
write(0,*)
"Converged after iteration", iter
360 if ( (tot_residual == prev_tot_residual) .or. (tot_residual<cs%min_residual) )
then 365 prev_tot_residual = tot_residual
370 h_pre(:,:,:) = h_new(:,:,:)
374 call hchksum(h_pre,
"h after offline_advection_ale",g%HI)
375 call uvchksum(
"[uv]htr after offline_advection_ale", uhtr, vhtr, g%HI)
376 call mom_tracer_chkinv(
"After offline_advection_ale", g, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
379 call cpu_clock_end(cs%id_clock_offline_adv)
390 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
391 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
392 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
393 logical,
intent(in ) :: converged
399 logical :: x_before_y
401 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
406 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work
407 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhr
408 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhr
410 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter
411 real :: prev_tot_residual, tot_residual, stock_values(max_fields_)
418 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
419 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
421 x_before_y = cs%x_before_y
423 if (cs%id_eta_pre_distribute>0)
then 425 do k=1,nz ;
do j=js,je ;
do i=is,ie
426 if (h_pre(i,j,k)>gv%Angstrom)
then 427 eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
429 enddo ;
enddo ;
enddo 430 call post_data(cs%id_eta_pre_distribute,eta_work,cs%diag)
434 if (cs%id_h_redist>0)
call post_data(cs%id_h_redist, h_pre, cs%diag)
435 if (cs%id_uhr_redist>0)
call post_data(cs%id_uhr_redist, uhtr, cs%diag)
436 if (cs%id_vhr_redist>0)
call post_data(cs%id_vhr_redist, vhtr, cs%diag)
438 if (converged)
return 441 call mom_tracer_chkinv(
"Before redistribute ", g, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
444 call cpu_clock_begin(cs%id_clock_redistribute)
446 if (cs%redistribute_upwards .or. cs%redistribute_barotropic)
then 447 do iter = 1, cs%num_off_iter
450 if (cs%redistribute_upwards)
then 453 do k=1,nz ;
do j=js,je ;
do i=is,ie
454 h_vol(i,j,k) = h_pre(i,j,k)*g%areaT(i,j)
455 enddo ;
enddo ;
enddo 460 h_pre(:,:,:) = h_vol(:,:,:)
463 call mom_tracer_chksum(
"Before upwards redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
464 call uvchksum(
"[uv]tr before upwards redistribute", uhtr, vhtr, g%HI)
475 call advect_tracer(h_pre, uhtr, vhtr, cs%OBC, cs%dt_offline, g, gv, &
476 cs%tracer_adv_CSp, cs%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, &
477 h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y)
480 call mom_tracer_chksum(
"After upwards redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
484 do k=1,nz ;
do j=js,je ;
do i=is,ie
485 uhtr(i,j,k) = uhr(i,j,k)
486 vhtr(i,j,k) = vhr(i,j,k)
487 h_vol(i,j,k) = h_new(i,j,k)
488 h_new(i,j,k) = h_new(i,j,k)/g%areaT(i,j)
489 h_pre(i,j,k) = h_new(i,j,k)
490 enddo ;
enddo ;
enddo 495 if (cs%redistribute_barotropic)
then 498 do k=1,nz ;
do j=js,je ;
do i=is,ie
499 h_vol(i,j,k) = h_pre(i,j,k)*g%areaT(i,j)
500 enddo ;
enddo ;
enddo 505 h_pre(:,:,:) = h_vol(:,:,:)
508 call mom_tracer_chksum(
"Before barotropic redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
509 call uvchksum(
"[uv]tr before upwards redistribute", uhtr, vhtr, g%HI)
513 call distribute_residual_uh_barotropic(g, gv, h_vol, uhtr)
514 call distribute_residual_vh_barotropic(g, gv, h_vol, vhtr)
516 call distribute_residual_vh_barotropic(g, gv, h_vol, vhtr)
517 call distribute_residual_uh_barotropic(g, gv, h_vol, uhtr)
520 call advect_tracer(h_pre, uhtr, vhtr, cs%OBC, cs%dt_offline, g, gv, &
521 cs%tracer_adv_CSp, cs%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, &
522 h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y)
525 call mom_tracer_chksum(
"After barotropic redistribute ", cs%tracer_Reg%Tr, cs%tracer_Reg%ntr, g)
529 do k=1,nz ;
do j=js,je ;
do i=is,ie
530 uhtr(i,j,k) = uhr(i,j,k)
531 vhtr(i,j,k) = vhr(i,j,k)
532 h_vol(i,j,k) = h_new(i,j,k)
533 h_new(i,j,k) = h_new(i,j,k)/g%areaT(i,j)
534 h_pre(i,j,k) = h_new(i,j,k)
535 enddo ;
enddo ;
enddo 541 if (cs%print_adv_offline)
then 542 if (is_root_pe())
then 543 write(*,
'(A,ES24.16)')
"Residual advection remaining transport: ", tot_residual
547 if (tot_residual==0.0 )
then 551 if ( (tot_residual == prev_tot_residual) .or. (tot_residual<cs%min_residual) )
exit 552 prev_tot_residual = tot_residual
557 if (cs%id_eta_post_distribute>0)
then 559 do k=1,nz ;
do j=js,je ;
do i=is,ie
560 if (h_pre(i,j,k)>gv%Angstrom)
then 561 eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k)
563 enddo ;
enddo ;
enddo 564 call post_data(cs%id_eta_post_distribute,eta_work,cs%diag)
567 if (cs%id_uhr>0)
call post_data(cs%id_uhr,uhtr,cs%diag)
568 if (cs%id_vhr>0)
call post_data(cs%id_vhr,vhtr,cs%diag)
571 call hchksum(h_pre,
"h_pre after redistribute",g%HI)
572 call uvchksum(
"uhtr after redistribute", uhtr, vhtr, g%HI)
573 call mom_tracer_chkinv(
"after redistribute ", g, h_new, cs%tracer_Reg%Tr, cs%tracer_Reg%ntr)
576 call cpu_clock_end(cs%id_clock_redistribute)
583 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(in ) :: uhtr
584 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(in ) :: vhtr
588 integer :: is, ie, js, je, nz
594 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec
596 h_min = cs%GV%H_subroundoff
599 do k=1,nz;
do j=js,je ;
do i=is,ie
600 uh_neglect = h_min*min(cs%G%areaT(i,j),cs%G%areaT(i+1,j))
601 vh_neglect = h_min*min(cs%G%areaT(i,j),cs%G%areaT(i,j+1))
602 if (abs(uhtr(i,j,k))>uh_neglect)
then 605 if (abs(vhtr(i,j,k))>vh_neglect)
then 618 type(forcing),
intent(inout) :: fluxes
619 type(time_type),
intent(in) :: Time_start
620 type(time_type),
intent(in) :: Time_end
622 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
623 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: eatr
624 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: ebtr
625 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir
629 integer :: is, ie, js, je, nz
631 real :: stock_values(max_fields_)
635 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec
637 call cpu_clock_begin(cs%id_clock_offline_diabatic)
639 if (is_root_pe())
write (0,*)
"Applying tracer source, sinks, and vertical mixing" 642 call hchksum(h_pre,
"h_pre before offline_diabatic_ale",cs%G%HI)
643 call hchksum(eatr,
"eatr before offline_diabatic_ale",cs%G%HI)
644 call hchksum(ebtr,
"ebtr before offline_diabatic_ale",cs%G%HI)
645 call mom_tracer_chkinv(
"Before offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
654 do j=js,je ;
do i=is,ie
658 if (cs%Kd(i,j,k)>0.)
then 659 kd_bot = cs%Kd(i,j,k)
666 cs%Kd(i,j,k) = kd_bot
670 do j=js,je ;
do i=is,ie
673 do k=2,nz ;
do j=js,je ;
do i=is,ie
674 hval=1.0/(cs%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k)))
675 eatr(i,j,k) = (cs%GV%m_to_H**2) * cs%dt_offline_vertical * hval * cs%Kd(i,j,k)
676 ebtr(i,j,k-1) = eatr(i,j,k)
677 enddo ;
enddo ;
enddo 678 do j=js,je ;
do i=is,ie
683 if (cs%diurnal_SW .and. cs%read_sw)
then 685 sw_vis(:,:) = fluxes%sw_vis_dir
686 sw_nir(:,:) = fluxes%sw_nir_dir
687 call offline_add_diurnal_sw(fluxes, cs%G, time_start, time_end)
690 if (
associated(cs%optics)) &
691 call set_opacity(cs%optics, fluxes, cs%G, cs%GV, cs%opacity_CSp)
695 call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, cs%MLD, cs%dt_offline_vertical, cs%G, cs%GV, &
696 cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
698 if (cs%diurnal_SW .and. cs%read_sw)
then 700 fluxes%sw_vis_dir(:,:) = sw_vis
701 fluxes%sw_nir_dir(:,:) = sw_nir
705 call hchksum(h_pre,
"h_pre after offline_diabatic_ale",cs%G%HI)
706 call hchksum(eatr,
"eatr after offline_diabatic_ale",cs%G%HI)
707 call hchksum(ebtr,
"ebtr after offline_diabatic_ale",cs%G%HI)
708 call mom_tracer_chkinv(
"After offline_diabatic_ale", cs%G, h_pre, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
711 call cpu_clock_end(cs%id_clock_offline_diabatic)
719 type(ocean_grid_type),
intent(in) :: G
720 type(verticalgrid_type),
intent(in) :: GV
721 type(forcing),
intent(inout) :: fluxes
722 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(inout) :: h
724 real,
dimension(SZI_(G),SZJ_(G)),
optional,
intent(in) :: in_flux_optional
727 real,
dimension(SZI_(G),SZJ_(G)) :: negative_fw
730 if (
present(in_flux_optional) ) &
731 call mom_error(warning,
"Positive freshwater fluxes with non-zero tracer concentration not supported yet")
734 negative_fw(:,:) = 0.
737 do j=g%jsc,g%jec ;
do i=g%isc,g%iec
738 if (fluxes%netMassOut(i,j)<0.0)
then 739 negative_fw(i,j) = fluxes%netMassOut(i,j)
740 fluxes%netMassOut(i,j) = 0.
745 call hchksum(h,
"h before fluxes into ocean",g%HI)
746 call mom_tracer_chkinv(
"Before fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
748 do m = 1,cs%tracer_reg%ntr
750 update_h = ( m == cs%tracer_reg%ntr )
751 call applytracerboundaryfluxesinout(g, gv, cs%tracer_reg%tr(m)%t, cs%dt_offline, fluxes, h, &
752 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
755 call hchksum(h,
"h after fluxes into ocean",g%HI)
756 call mom_tracer_chkinv(
"After fluxes into ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
760 fluxes%netMassOut(:,:) = negative_fw(:,:)
767 type(ocean_grid_type),
intent(in) :: G
768 type(verticalgrid_type),
intent(in) :: GV
769 type(forcing),
intent(inout) :: fluxes
770 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(inout) :: h
772 real,
dimension(SZI_(G),SZJ_(G)),
optional,
intent(in) :: out_flux_optional
777 if (
present(out_flux_optional) ) &
778 call mom_error(warning,
"Negative freshwater fluxes with non-zero tracer concentration not supported yet")
781 call hchksum(h,
"h before fluxes out of ocean",g%HI)
782 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
784 do m = 1, cs%tracer_reg%ntr
786 update_h = ( m == cs%tracer_reg%ntr )
787 call applytracerboundaryfluxesinout(g, gv, cs%tracer_reg%tr(m)%t, cs%dt_offline, fluxes, h, &
788 cs%evap_CFL_limit, cs%minimum_forcing_depth, update_h_opt = update_h)
791 call hchksum(h,
"h after fluxes out of ocean",g%HI)
792 call mom_tracer_chkinv(
"Before fluxes out of ocean", g, h, cs%tracer_reg%Tr, cs%tracer_reg%ntr)
800 type(forcing),
intent(inout) :: fluxes
801 type(time_type),
intent(in) :: Time_start
802 real,
intent(in) :: time_interval
804 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_pre
805 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: eatr
806 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: ebtr
807 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
808 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
810 type(ocean_grid_type),
pointer :: G => null()
812 type(verticalgrid_type),
pointer :: GV => null()
815 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub
817 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub
819 real :: sum_abs_fluxes, sum_u, sum_v
824 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
828 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
832 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: &
833 temp_old, salt_old, &
834 temp_mean, salt_mean, &
836 integer :: niter, iter
837 real :: Inum_iter, dt_iter
839 integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz
840 integer :: isv, iev, jsv, jev
841 integer :: IsdB, IedB, JsdB, JedB
842 logical :: z_first, x_before_y
844 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
845 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
846 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
848 do iter=1,cs%num_off_iter
850 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
851 eatr_sub(i,j,k) = eatr(i,j,k)
852 ebtr_sub(i,j,k) = ebtr(i,j,k)
855 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
856 uhtr_sub(i,j,k) = uhtr(i,j,k)
859 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
860 vhtr_sub(i,j,k) = vhtr(i,j,k)
865 call limit_mass_flux_3d(g, gv, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre)
869 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
870 call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, &
871 fluxes, cs%mld, dt_iter, g, gv, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
873 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
874 h_pre(i,j,k) = h_new(i,j,k)
875 enddo ;
enddo ;
enddo 876 call pass_var(h_pre,g%Domain)
879 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
880 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
881 h_vol(i,j,k) = h_pre(i,j,k)*g%areaT(i,j)
883 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, &
884 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
887 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
888 h_pre(i,j,k) = h_new(i,j,k)
889 enddo ;
enddo ;
enddo 893 if (.not. z_first)
then 896 call update_h_horizontal_flux(g, gv, uhtr_sub, vhtr_sub, h_pre, h_new)
897 do k = 1, nz ;
do i = is-1, ie+1 ;
do j=js-1, je+1
898 h_vol(i,j,k) = h_pre(i,j,k)*g%areaT(i,j)
900 call advect_tracer(h_pre, uhtr_sub, vhtr_sub, cs%OBC, dt_iter, g, gv, &
901 cs%tracer_adv_CSp, cs%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y)
904 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
905 h_pre(i,j,k) = h_new(i,j,k)
906 enddo ;
enddo ;
enddo 909 call update_h_vertical_flux(g, gv, eatr_sub, ebtr_sub, h_pre, h_new)
910 call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, &
911 fluxes, cs%mld, dt_iter, g, gv, cs%tv, cs%optics, cs%tracer_flow_CSp, cs%debug)
913 do k = 1, nz ;
do i=is-1,ie+1 ;
do j=js-1,je+1
914 h_pre(i,j,k) = h_new(i,j,k)
915 enddo ;
enddo ;
enddo 920 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-1,ie+1
921 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k)
922 ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k)
925 do k = 1, nz ;
do j=js-1,je+1 ;
do i=is-2,ie+1
926 uhtr(i,j,k) = uhtr(i,j,k) - uhtr_sub(i,j,k)
929 do k = 1, nz ;
do j=js-2,je+1 ;
do i=is-1,ie+1
930 vhtr(i,j,k) = vhtr(i,j,k) - vhtr_sub(i,j,k)
933 call pass_var(eatr,g%Domain)
934 call pass_var(ebtr,g%Domain)
935 call pass_var(h_pre,g%Domain)
936 call pass_vector(uhtr,vhtr,g%Domain)
942 do k=1,nz;
do j=js,je;
do i=is,ie
943 sum_u = sum_u + abs(uhtr(i-1,j,k))+abs(uhtr(i,j,k))
944 sum_v = sum_v + abs(vhtr(i,j-1,k))+abs(vhtr(i,j,k))
945 sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(i-1,j,k)) + &
946 abs(uhtr(i,j,k)) + abs(vhtr(i,j-1,k)) + abs(vhtr(i,j,k))
948 call sum_across_pes(sum_abs_fluxes)
950 print *,
"Remaining u-flux, v-flux:", sum_u, sum_v
951 if (sum_abs_fluxes==0)
then 952 print *,
'Converged after iteration', iter
957 z_first = .not. z_first
958 x_before_y = .not. x_before_y
967 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h
968 type(forcing),
intent(inout) :: fluxes
969 logical,
intent(in ) :: do_ale
971 integer :: i, j, k, is, ie, js, je, nz
972 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h_start
973 is = cs%G%isc ; ie = cs%G%iec ; js = cs%G%jsc ; je = cs%G%jec ; nz = cs%GV%ke
975 call cpu_clock_begin(cs%id_clock_read_fields)
976 call calltree_enter(
"update_offline_fields, MOM_offline_main.F90")
979 h_start(:,:,:) = h(:,:,:)
982 call update_offline_from_files( cs%G, cs%GV, cs%nk_input, cs%mean_file, cs%sum_file, cs%snap_file, cs%surf_file, &
983 cs%h_end, cs%uhtr, cs%vhtr, cs%tv%T, cs%tv%S, cs%mld, cs%Kd, fluxes, &
984 cs%ridx_sum, cs%ridx_snap, cs%read_mld, cs%read_sw, .not. cs%read_all_ts_uvh, do_ale)
986 if (cs%read_all_ts_uvh)
then 987 call update_offline_from_arrays(cs%G, cs%GV, cs%nk_input, cs%ridx_sum, cs%mean_file, cs%sum_file, cs%snap_file, &
988 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)
991 call uvchksum(
"[uv]h after update offline from files and arrays", cs%uhtr, cs%vhtr, cs%G%HI)
997 call pass_var(h, cs%G%Domain)
998 call pass_var(cs%tv%T, cs%G%Domain)
999 call pass_var(cs%tv%S, cs%G%Domain)
1000 call ale_offline_inputs(cs%ALE_CSp, cs%G, cs%GV, h, cs%tv, cs%tracer_Reg, cs%uhtr, cs%vhtr, cs%Kd, cs%debug)
1001 if (cs%id_temp_regrid>0)
call post_data(cs%id_temp_regrid, cs%tv%T, cs%diag)
1002 if (cs%id_salt_regrid>0)
call post_data(cs%id_salt_regrid, cs%tv%S, cs%diag)
1003 if (cs%id_uhtr_regrid>0)
call post_data(cs%id_uhtr_regrid, cs%uhtr, cs%diag)
1004 if (cs%id_vhtr_regrid>0)
call post_data(cs%id_vhtr_regrid, cs%vhtr, cs%diag)
1005 if (cs%id_h_regrid>0)
call post_data(cs%id_h_regrid, h, cs%diag)
1007 call uvchksum(
"[uv]h after ALE regridding/remapping of inputs", cs%uhtr, cs%vhtr, cs%G%HI)
1008 call hchksum(h_start,
"h_start after update offline from files and arrays", cs%G%HI)
1013 call pass_var(cs%h_end, cs%G%Domain)
1014 call pass_var(cs%tv%T, cs%G%Domain)
1015 call pass_var(cs%tv%S, cs%G%Domain)
1018 cs%ridx_snap = next_modulo_time(cs%ridx_snap,cs%numtime)
1019 cs%ridx_sum = next_modulo_time(cs%ridx_sum,cs%numtime)
1022 do k=1,nz ;
do j=js,je ;
do i=is,ie
1023 if (cs%G%mask2dT(i,j)<1.0)
then 1024 cs%h_end(i,j,k) = cs%GV%Angstrom
1026 enddo; enddo ; enddo
1028 do k=1,nz+1 ;
do j=js,je ;
do i=is,ie
1029 cs%Kd(i,j,k) = max(0.0, cs%Kd(i,j,k))
1030 if (cs%Kd_max>0.)
then 1031 cs%Kd(i,j,k) = min(cs%Kd_max, cs%Kd(i,j,k))
1033 enddo ;
enddo ;
enddo ;
1035 do k=1,nz ;
do j=js-1,je ;
do i=is,ie
1036 if (cs%G%mask2dCv(i,j)<1.0)
then 1037 cs%vhtr(i,j,k) = 0.0
1039 enddo; enddo ; enddo
1041 do k=1,nz ;
do j=js,je ;
do i=is-1,ie
1042 if (cs%G%mask2dCu(i,j)<1.0)
then 1043 cs%uhtr(i,j,k) = 0.0
1045 enddo; enddo ; enddo
1048 call uvchksum(
"[uv]htr_sub after update_offline_fields", cs%uhtr, cs%vhtr, cs%G%HI)
1049 call hchksum(cs%h_end,
"h_end after update_offline_fields", cs%G%HI)
1050 call hchksum(cs%tv%T,
"Temp after update_offline_fields", cs%G%HI)
1051 call hchksum(cs%tv%S,
"Salt after update_offline_fields", cs%G%HI)
1054 call calltree_leave(
"update_offline_fields")
1055 call cpu_clock_end(cs%id_clock_read_fields)
1063 type(time_type),
intent(in) :: Time
1064 type(diag_ctrl) :: diag
1067 cs%id_uhr = register_diag_field(
'ocean_model',
'uhr', diag%axesCuL, time, &
1068 'Zonal thickness fluxes remaining at end of advection',
'kg')
1069 cs%id_uhr_redist = register_diag_field(
'ocean_model',
'uhr_redist', diag%axesCuL, time, &
1070 'Zonal thickness fluxes to be redistributed vertically',
'kg')
1071 cs%id_uhr_end = register_diag_field(
'ocean_model',
'uhr_end', diag%axesCuL, time, &
1072 'Zonal thickness fluxes at end of offline step',
'kg')
1075 cs%id_vhr = register_diag_field(
'ocean_model',
'vhr', diag%axesCvL, time, &
1076 'Meridional thickness fluxes remaining at end of advection',
'kg')
1077 cs%id_vhr_redist = register_diag_field(
'ocean_model',
'vhr_redist', diag%axesCvL, time, &
1078 'Meridional thickness to be redistributed vertically',
'kg')
1079 cs%id_vhr_end = register_diag_field(
'ocean_model',
'vhr_end', diag%axesCvL, time, &
1080 'Meridional thickness at end of offline step',
'kg')
1083 cs%id_hdiff = register_diag_field(
'ocean_model',
'hdiff', diag%axesTL, time, &
1084 'Difference between the stored and calculated layer thickness',
'm')
1085 cs%id_hr = register_diag_field(
'ocean_model',
'hr', diag%axesTL, time, &
1086 'Layer thickness at end of offline step',
'm')
1087 cs%id_ear = register_diag_field(
'ocean_model',
'ear', diag%axesTL, time, &
1088 'Remaining thickness entrained from above',
'm')
1089 cs%id_ebr = register_diag_field(
'ocean_model',
'ebr', diag%axesTL, time, &
1090 'Remaining thickness entrained from below',
'm')
1091 cs%id_eta_pre_distribute = register_diag_field(
'ocean_model',
'eta_pre_distribute', &
1092 diag%axesT1, time,
'Total water column height before residual transport redistribution',
'm')
1093 cs%id_eta_post_distribute = register_diag_field(
'ocean_model',
'eta_post_distribute', &
1094 diag%axesT1, time,
'Total water column height after residual transport redistribution',
'm')
1095 cs%id_eta_diff_end = register_diag_field(
'ocean_model',
'eta_diff_end', diag%axesT1, time, &
1096 'Difference in total water column height from online and offline ' // &
1097 'at the end of the offline timestep',
'm')
1098 cs%id_h_redist = register_diag_field(
'ocean_model',
'h_redist', diag%axesTL, time, &
1099 'Layer thicknesses before redistribution of mass fluxes',
'm')
1102 cs%id_uhtr_regrid = register_diag_field(
'ocean_model',
'uhtr_regrid', diag%axesCuL, time, &
1103 'Zonal mass transport regridded/remapped onto offline grid',
'kg')
1104 cs%id_vhtr_regrid = register_diag_field(
'ocean_model',
'vhtr_regrid', diag%axesCvL, time, &
1105 'Meridional mass transport regridded/remapped onto offline grid',
'kg')
1106 cs%id_temp_regrid = register_diag_field(
'ocean_model',
'temp_regrid', diag%axesTL, time, &
1107 'Temperature regridded/remapped onto offline grid',
'C')
1108 cs%id_salt_regrid = register_diag_field(
'ocean_model',
'salt_regrid', diag%axesTL, time, &
1109 'Salinity regridded/remapped onto offline grid',
'g kg-1')
1110 cs%id_h_regrid = register_diag_field(
'ocean_model',
'h_regrid', diag%axesTL, time, &
1111 'Layer thicknesses regridded/remapped onto offline grid',
'm')
1119 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_off
1120 real,
dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: h_end
1121 real,
dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)),
intent(inout) :: uhtr
1122 real,
dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)),
intent(inout) :: vhtr
1124 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff
1127 if (cs%id_eta_diff_end>0)
then 1130 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1131 eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k)
1132 enddo ;
enddo ;
enddo 1133 do k=1,cs%GV%ke ;
do j=cs%G%jsc,cs%G%jec ;
do i=cs%G%isc,cs%G%iec
1134 eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k)
1135 enddo ;
enddo ;
enddo 1137 call post_data(cs%id_eta_diff_end, eta_diff, cs%diag)
1140 if (cs%id_hdiff>0)
call post_data(cs%id_hdiff, h_off-h_end, cs%diag)
1141 if (cs%id_hr>0)
call post_data(cs%id_hr, h_off, cs%diag)
1142 if (cs%id_uhr_end>0)
call post_data(cs%id_uhr_end, uhtr, cs%diag)
1143 if (cs%id_vhr_end>0)
call post_data(cs%id_vhr_end, vhtr, cs%diag)
1149 subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, dt_offline, dt_offline_vertical, &
1153 real,
dimension(:,:,:),
pointer,
optional,
intent( out) :: uhtr
1154 real,
dimension(:,:,:),
pointer,
optional,
intent( out) :: vhtr
1155 real,
dimension(:,:,:),
pointer,
optional,
intent( out) :: eatr
1156 real,
dimension(:,:,:),
pointer,
optional,
intent( out) :: ebtr
1157 real,
dimension(:,:,:),
pointer,
optional,
intent( out) :: h_end
1158 integer,
pointer,
optional,
intent( out) :: accumulated_time
1159 integer,
optional,
intent( out) :: dt_offline
1160 integer,
optional,
intent( out) :: dt_offline_vertical
1161 logical,
optional,
intent( out) :: skip_diffusion
1164 if (
present(uhtr)) uhtr => cs%uhtr
1165 if (
present(vhtr)) vhtr => cs%vhtr
1166 if (
present(eatr)) eatr => cs%eatr
1167 if (
present(ebtr)) ebtr => cs%ebtr
1168 if (
present(h_end)) h_end => cs%h_end
1171 if (
present(accumulated_time)) accumulated_time => cs%accumulated_time
1174 if (
present(dt_offline)) dt_offline = cs%dt_offline
1175 if (
present(dt_offline_vertical)) dt_offline_vertical = cs%dt_offline_vertical
1176 if (
present(skip_diffusion)) skip_diffusion = cs%skip_diffusion
1183 tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug)
1186 type(ale_cs),
target,
optional,
intent(in ) :: ALE_CSp
1187 type(diabatic_cs),
target,
optional,
intent(in ) :: diabatic_CSp
1188 type(diag_ctrl),
target,
optional,
intent(in ) :: diag
1189 type(ocean_obc_type),
target,
optional,
intent(in ) :: OBC
1190 type(tracer_advect_cs),
target,
optional,
intent(in ) :: tracer_adv_CSp
1191 type(tracer_flow_control_cs),
target,
optional,
intent(in ) :: tracer_flow_CSp
1192 type(tracer_registry_type),
target,
optional,
intent(in ) :: tracer_Reg
1193 type(thermo_var_ptrs),
target,
optional,
intent(in ) :: tv
1194 type(ocean_grid_type),
target,
optional,
intent(in ) :: G
1195 type(verticalgrid_type),
target,
optional,
intent(in ) :: GV
1196 logical,
optional,
intent(in ) :: x_before_y
1197 logical,
optional,
intent(in ) :: debug
1200 if (
present(ale_csp)) cs%ALE_CSp => ale_csp
1201 if (
present(diabatic_csp)) cs%diabatic_CSp => diabatic_csp
1202 if (
present(diag)) cs%diag => diag
1203 if (
present(obc)) cs%OBC => obc
1204 if (
present(tracer_adv_csp)) cs%tracer_adv_CSp => tracer_adv_csp
1205 if (
present(tracer_flow_csp)) cs%tracer_flow_CSp => tracer_flow_csp
1206 if (
present(tracer_reg)) cs%tracer_Reg => tracer_reg
1207 if (
present(tv)) cs%tv => tv
1208 if (
present(g)) cs%G => g
1209 if (
present(gv)) cs%GV => gv
1210 if (
present(x_before_y)) cs%x_before_y = x_before_y
1211 if (
present(debug)) cs%debug = debug
1219 type(param_file_type),
intent(in) :: param_file
1221 type(diabatic_cs),
pointer,
intent(in) :: diabatic_CSp
1222 type(ocean_grid_type),
pointer,
intent(in) :: G
1223 type(verticalgrid_type),
pointer,
intent(in) :: GV
1225 character(len=40) :: mdl =
"offline_transport" 1226 character(len=20) :: redistribute_method
1228 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
1229 integer :: IsdB, IedB, JsdB, JedB
1231 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
1232 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1233 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1235 call calltree_enter(
"offline_transport_init, MOM_offline_control.F90")
1237 if (
associated(cs))
then 1238 call mom_error(warning,
"offline_transport_init called with an associated "// &
1239 "control structure.")
1243 call log_version(param_file, mdl,version,
"This module allows for tracers to be run offline")
1246 call get_param(param_file, mdl,
"OFFLINEDIR", cs%offlinedir, &
1247 "Input directory where the offline fields can be found", fail_if_missing = .true.)
1248 call get_param(param_file, mdl,
"OFF_SUM_FILE", cs%sum_file, &
1249 "Filename where the accumulated fields can be found", fail_if_missing = .true.)
1250 call get_param(param_file, mdl,
"OFF_SNAP_FILE", cs%snap_file, &
1251 "Filename where snapshot fields can be found", fail_if_missing = .true.)
1252 call get_param(param_file, mdl,
"OFF_MEAN_FILE", cs%mean_file, &
1253 "Filename where averaged fields can be found", fail_if_missing = .true.)
1254 call get_param(param_file, mdl,
"OFF_SURF_FILE", cs%surf_file, &
1255 "Filename where averaged fields can be found", fail_if_missing = .true.)
1256 call get_param(param_file, mdl,
"NUMTIME", cs%numtime, &
1257 "Number of timelevels in offline input files", fail_if_missing = .true.)
1258 call get_param(param_file, mdl,
"NK_INPUT", cs%nk_input, &
1259 "Number of vertical levels in offline input files", default = nz)
1260 call get_param(param_file, mdl,
"DT_OFFLINE", cs%dt_offline, &
1261 "Length of time between reading in of input fields", fail_if_missing = .true.)
1262 call get_param(param_file, mdl,
"DT_OFFLINE_VERTICAL", cs%dt_offline_vertical, &
1263 "Length of the offline timestep for tracer column sources/sinks\n" //&
1264 "This should be set to the length of the coupling timestep for \n" //&
1265 "tracers which need shortwave fluxes", fail_if_missing = .true.)
1266 call get_param(param_file, mdl,
"START_INDEX", cs%start_index, &
1267 "Which time index to start from", default=1)
1268 call get_param(param_file, mdl,
"FIELDS_ARE_OFFSET", cs%fields_are_offset, &
1269 "True if the time-averaged fields and snapshot fields\n"//&
1270 "are offset by one time level", default=.false.)
1271 call get_param(param_file, mdl,
"REDISTRIBUTE_METHOD", redistribute_method, &
1272 "Redistributes any remaining horizontal fluxes throughout\n" //&
1273 "the rest of water column. Options are 'barotropic' which\n" //&
1274 "evenly distributes flux throughout the entire water column,\n" //&
1275 "'upwards' which adds the maximum of the remaining flux in\n" //&
1276 "each layer above, both which first applies upwards and then\n" //&
1277 "barotropic, and 'none' which does no redistribution", &
1278 default=
'barotropic')
1279 call get_param(param_file, mdl,
"NUM_OFF_ITER", cs%num_off_iter, &
1280 "Number of iterations to subdivide the offline tracer advection and diffusion", &
1282 call get_param(param_file, mdl,
"OFF_ALE_MOD", cs%off_ale_mod, &
1283 "Sets how many horizontal advection steps are taken before an ALE\n" //&
1284 "remapping step is done. 1 would be x->y->ALE, 2 would be" //&
1285 "x->y->x->y->ALE", default = 1)
1286 call get_param(param_file, mdl,
"PRINT_ADV_OFFLINE", cs%print_adv_offline, &
1287 "Print diagnostic output every advection subiteration",default=.false.)
1288 call get_param(param_file, mdl,
"SKIP_DIFFUSION_OFFLINE", cs%skip_diffusion, &
1289 "Do not do horizontal diffusion",default=.false.)
1290 call get_param(param_file, mdl,
"READ_SW", cs%read_sw, &
1291 "Read in shortwave radiation field instead of using values from the coupler"//&
1292 "when in offline tracer mode",default=.false.)
1293 call get_param(param_file, mdl,
"READ_MLD", cs%read_mld, &
1294 "Read in mixed layer depths for tracers which exchange with the atmosphere"//&
1295 "when in offline tracer mode",default=.false.)
1296 call get_param(param_file, mdl,
"MLD_VAR_NAME", cs%mld_var_name, &
1297 "Name of the variable containing the depth of active mixing",&
1298 default=
'ePBL_h_ML')
1299 call get_param(param_file, mdl,
"OFFLINE_ADD_DIURNAL_SW", cs%diurnal_sw, &
1300 "Adds a synthetic diurnal cycle in the same way that the ice\n" // &
1301 "model would have when time-averaged fields of shortwave\n" // &
1302 "radiation are read in", default=.false.)
1303 call get_param(param_file, mdl,
"KD_MAX", cs%Kd_max, &
1304 "The maximum permitted increment for the diapycnal \n"//&
1305 "diffusivity from TKE-based parameterizations, or a \n"//&
1306 "negative value for no limit.", units=
"m2 s-1", default=-1.0)
1307 call get_param(param_file, mdl,
"MIN_RESIDUAL_TRANSPORT", cs%min_residual, &
1308 "How much remaining transport before the main offline advection\n"// &
1309 "is exited. The default value corresponds to about 1 meter of\n" // &
1310 "difference in a grid cell", default = 1.e9)
1311 call get_param(param_file, mdl,
"READ_ALL_TS_UVH", cs%read_all_ts_uvh, &
1312 "Reads all time levels of a subset of the fields necessary to run \n" // &
1313 "the model offline. This can require a large amount of memory\n"// &
1314 "and will make initialization very slow. However, for offline\n"// &
1315 "runs spanning more than a year this can reduce total I/O overhead", &
1319 cs%snap_file = trim(cs%offlinedir)//trim(cs%snap_file)
1320 cs%mean_file = trim(cs%offlinedir)//trim(cs%mean_file)
1321 cs%sum_file = trim(cs%offlinedir)//trim(cs%sum_file)
1322 cs%surf_file = trim(cs%offlinedir)//trim(cs%surf_file)
1324 cs%num_vert_iter = cs%dt_offline/cs%dt_offline_vertical
1327 select case (redistribute_method)
1329 cs%redistribute_barotropic = .true.
1330 cs%redistribute_upwards = .false.
1332 cs%redistribute_barotropic = .false.
1333 cs%redistribute_upwards = .true.
1335 cs%redistribute_barotropic = .true.
1336 cs%redistribute_upwards = .true.
1338 cs%redistribute_barotropic = .false.
1339 cs%redistribute_upwards = .false.
1343 cs%accumulated_time = 0
1345 cs%ridx_sum = cs%start_index
1346 if (cs%fields_are_offset) cs%ridx_snap = next_modulo_time(cs%start_index,cs%numtime)
1347 if (.not. cs%fields_are_offset) cs%ridx_snap = cs%start_index
1350 call extract_diabatic_member(diabatic_csp, opacity_csp=cs%opacity_CSp, optics_csp=cs%optics,&
1351 evap_cfl_limit=cs%evap_CFL_limit, &
1352 minimum_forcing_depth=cs%minimum_forcing_depth)
1359 allocate(cs%uhtr(isdb:iedb,jsd:jed,nz)) ; cs%uhtr(:,:,:) = 0.0
1360 allocate(cs%vhtr(isd:ied,jsdb:jedb,nz)) ; cs%vhtr(:,:,:) = 0.0
1361 allocate(cs%eatr(isd:ied,jsd:jed,nz)) ; cs%eatr(:,:,:) = 0.0
1362 allocate(cs%ebtr(isd:ied,jsd:jed,nz)) ; cs%ebtr(:,:,:) = 0.0
1363 allocate(cs%h_end(isd:ied,jsd:jed,nz)) ; cs%h_end(:,:,:) = 0.0
1364 allocate(cs%netMassOut(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassOut(:,:) = 0.0
1365 allocate(cs%netMassIn(g%isd:g%ied,g%jsd:g%jed)) ; cs%netMassIn(:,:) = 0.0
1366 allocate(cs%Kd(isd:ied,jsd:jed,nz+1)) ; cs%Kd = 0.
1367 if (cs%read_mld)
then 1368 allocate(cs%mld(g%isd:g%ied,g%jsd:g%jed)) ; cs%mld(:,:) = 0.0
1371 if (cs%read_all_ts_uvh)
then 1376 cs%id_clock_read_fields = cpu_clock_id(
'(Offline read fields)',grain=clock_module)
1377 cs%id_clock_offline_diabatic = cpu_clock_id(
'(Offline diabatic)',grain=clock_module)
1378 cs%id_clock_offline_adv = cpu_clock_id(
'(Offline transport)',grain=clock_module)
1379 cs%id_clock_redistribute = cpu_clock_id(
'(Offline redistribute)',grain=clock_module)
1381 call calltree_leave(
"offline_transport_init")
1390 integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime
1391 integer :: IsdB, IedB, JsdB, JedB
1393 nz = cs%GV%ke ; ntime = cs%numtime
1394 isd = cs%G%isd ; ied = cs%G%ied ; jsd = cs%G%jsd ; jed = cs%G%jed
1395 isdb = cs%G%IsdB ; iedb = cs%G%IedB ; jsdb = cs%G%JsdB ; jedb = cs%G%JedB
1398 if (cs%read_all_ts_uvh)
then 1399 if (
allocated(cs%uhtr_all))
call mom_error(fatal,
"uhtr_all is already allocated")
1400 if (
allocated(cs%vhtr_all))
call mom_error(fatal,
"vhtr_all is already allocated")
1401 if (
allocated(cs%hend_all))
call mom_error(fatal,
"hend_all is already allocated")
1402 if (
allocated(cs%temp_all))
call mom_error(fatal,
"temp_all is already allocated")
1403 if (
allocated(cs%salt_all))
call mom_error(fatal,
"salt_all is already allocated")
1405 allocate(cs%uhtr_all(isdb:iedb,jsd:jed,nz,ntime)) ; cs%uhtr_all(:,:,:,:) = 0.0
1406 allocate(cs%vhtr_all(isd:ied,jsdb:jedb,nz,ntime)) ; cs%vhtr_all(:,:,:,:) = 0.0
1407 allocate(cs%hend_all(isd:ied,jsd:jed,nz,ntime)) ; cs%hend_all(:,:,:,:) = 0.0
1408 allocate(cs%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%temp_all(:,:,:,:) = 0.0
1409 allocate(cs%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; cs%salt_all(:,:,:,:) = 0.0
1411 if (is_root_pe())
write (0,*)
"Reading in uhtr, vhtr, h_start, h_end, temp, salt" 1413 call read_data(cs%sum_file,
'uhtr_sum', cs%uhtr_all(:,:,1:cs%nk_input,t), domain=cs%G%Domain%mpp_domain, &
1414 timelevel=t, position=east)
1415 call read_data(cs%sum_file,
'vhtr_sum', cs%vhtr_all(:,:,1:cs%nk_input,t), domain=cs%G%Domain%mpp_domain, &
1416 timelevel=t, position=north)
1417 call read_data(cs%snap_file,
'h_end', cs%hend_all(:,:,1:cs%nk_input,t), domain=cs%G%Domain%mpp_domain, &
1418 timelevel=t, position=center)
1419 call read_data(cs%mean_file,
'temp', cs%temp_all(:,:,1:cs%nk_input,t), domain=cs%G%Domain%mpp_domain, &
1420 timelevel=t, position=center)
1421 call read_data(cs%mean_file,
'salt', cs%salt_all(:,:,1:cs%nk_input,t), domain=cs%G%Domain%mpp_domain, &
1422 timelevel=t, position=center)
1437 deallocate(cs%h_end)
1438 deallocate(cs%netMassOut)
1439 deallocate(cs%netMassIn)
1441 if (cs%read_mld)
deallocate(cs%mld)
1442 if (cs%read_all_ts_uvh)
then 1443 deallocate(cs%uhtr_all)
1444 deallocate(cs%vhtr_all)
1445 deallocate(cs%hend_all)
1446 deallocate(cs%temp_all)
1447 deallocate(cs%salt_all)
subroutine, public register_diags_offline_transport(Time, diag, CS)
Initialize additional diagnostics required for offline tracer transport.
The routines here implement the offline tracer algorithm used in MOM6. These are called from step_off...
subroutine, public ale_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug)
Regrid/remap stored fields used for offline tracer integrations. These input fields are assumed to ha...
This module contains the main regridding routines. Regridding comprises two steps: (1) Interpolation ...
This module implements boundary forcing for MOM6.
subroutine, public distribute_residual_vh_upwards(G, GV, hvol, vh)
In the case where offline advection has failed to converge, redistribute the u-flux into layers above...
subroutine, public offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr)
The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolate...
Control structure for this module.
subroutine, public set_opacity(optics, fluxes, G, GV, CS)
subroutine, public update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_file, surf_file, h_end, uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, read_ts_uvh, do_ale_in)
Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored in a previous integ...
Ocean grid type. See mom_grid for details.
Contains routines related to offline transport of tracers. These routines are likely to be called fro...
subroutine, public offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged)
3D advection is done by doing flux-limited nonlinear horizontal advection interspersed with an ALE re...
Provides the ocean grid type.
subroutine, public mom_tracer_chksum(mesg, Tr, ntr, G)
This subroutine writes out chksums for tracers.
subroutine, public call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, tv, optics, CS, debug, evap_CFL_limit, minimum_forcing_depth)
This subroutine calls all registered tracer column physics subroutines.
subroutine, public offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional)
Apply positive freshwater fluxes (into the ocean) and update netMassOut with only the negative (out o...
This routine drives the diabatic/dianeutral physics for MOM.
subroutine, public post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr)
Posts diagnostics related to offline convergence diagnostics.
subroutine, public calltree_leave(mesg)
Writes a message about leaving a subroutine if call tree reporting is active.
subroutine, public distribute_residual_vh_barotropic(G, GV, hvol, vh)
Redistribute the v-flux as a barotropic equivalent.
This module contains I/O framework code.
subroutine, public offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged)
In the case where the main advection routine did not converge, something needs to be done with the re...
subroutine, public offline_add_diurnal_sw(fluxes, G, Time_start, Time_end)
add_diurnal_SW adjusts the shortwave fluxes in an forcying_type variable to add a synthetic diurnal c...
subroutine, public advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out)
This routine time steps the tracer concentration using a monotonic, conservative, weakly diffusive sc...
real function remaining_transport_sum(CS, uhtr, vhtr)
Sums any non-negligible remaining transport to check for advection convergence.
subroutine, public extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth)
Returns pointers or values of members within the diabatic_CS type. For extensibility, each returned argument is an optional argument.
subroutine, public offline_transport_end(CS)
Deallocates (if necessary) arrays within the offline control structure.
subroutine, public extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, dt_offline, dt_offline_vertical, skip_diffusion)
Extracts members of the offline main control structure. All arguments are optional except the control...
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
subroutine, public call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, num_stocks, stock_index, got_min_max, global_min, global_max, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax)
This subroutine calls all registered tracer packages to enable them to add to the surface state retur...
Control structure for diabatic_aux.
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Type to carry basic tracer information.
subroutine, public update_offline_fields(CS, h, fluxes, do_ale)
Update fields used in this round of offline transport. First fields are updated from files or from ar...
logical function, public is_root_pe()
subroutine, public ale_offline_tracer_final(G, GV, h, tv, h_target, Reg, CS)
Remaps all tracers from h onto h_target. This is intended to be called when tracers are done offline...
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
integer function, public next_modulo_time(inidx, numtime)
Calculates the next timelevel to read from the input fields. This allows the 'looping' of the fields...
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
subroutine, public distribute_residual_uh_barotropic(G, GV, hvol, uh)
In the case where offline advection has failed to converge, redistribute the u-flux into remainder of...
Control structure for this module.
subroutine, public update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new)
This updates thickness based on the convergence of horizontal mass fluxes NOTE: Only used in non-ALE ...
subroutine read_all_input(CS)
Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files...
subroutine, public update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new)
Updates layer thicknesses due to vertical mass transports NOTE: Only used in non-ALE configuration...
subroutine, public mom_tracer_chkinv(mesg, G, h, Tr, ntr)
Calculates and prints the global inventory of all tracers in the registry.
subroutine, public insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug)
Inserts (assigns values to) members of the offline main control structure. All arguments are optional...
The thermo_var_ptrs structure contains pointers to an assortment of thermodynamic fields that may be ...
subroutine, public offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr)
When in layer mode, 3D horizontal advection using stored mass fluxes must be used. Horizontal advection is done via tracer_advect, whereas the vertical component is actually handled by vertdiff in tracer_column_fns.
This program contains the subroutines that advect tracers along coordinate surfaces.
subroutine, public distribute_residual_uh_upwards(G, GV, hvol, uh)
In the case where offline advection has failed to converge, redistribute the u-flux into layers above...
subroutine, public ale_main_offline(G, GV, h, tv, Reg, CS, dt)
Takes care of (1) building a new grid and (2) remapping all variables between the old grid and the ne...
subroutine, public update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_file, snap_file, uhtr, vhtr, hend, uhtr_all, vhtr_all, hend_all, temp, salt, temp_all, salt_all)
Fields for offline transport are copied from the stored arrays read during initialization.
Controls where open boundary conditions are applied.
subroutine, public limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre)
This routine limits the mass fluxes so that the a layer cannot be completely depleted. NOTE: Only used in non-ALE mode.
subroutine, public tridiagts(G, GV, is, ie, js, je, hold, ea, eb, T, S)
subroutine, public mom_error(level, message, all_print)
subroutine, public offline_transport_init(param_file, CS, diabatic_CSp, G, GV)
Initializes the control structure for offline transport and reads in some of the. ...
subroutine, public offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional)
Apply negative freshwater fluxes (out of the ocean)
subroutine, public calltree_enter(mesg, n)
Writes a message about entering a subroutine if call tree reporting is active.