8 use mom_debugging,
only : mom_debugging_init, hchksum, uvchksum
13 use mom_cpu_clock,
only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
15 use mom_cpu_clock,
only : clock_module_driver, clock_module, clock_routine
16 use mom_diag_mediator,
only : diag_mediator_init, enable_averaging, enable_averages
25 use mom_diag_mediator,
only : diag_copy_storage_to_diag, diag_copy_diag_to_storage
28 use mom_domains,
only : to_north, to_east, to_south, to_west
29 use mom_domains,
only : to_all, omit_corners, cgrid_ne, scalar_pair
31 use mom_domains,
only : start_group_pass, complete_group_pass, omit_corners
46 use mom_time_manager,
only : time_type, real_to_time, time_type_to_real,
operator(+)
47 use mom_time_manager,
only :
operator(-),
operator(>),
operator(*),
operator(/)
50 use coupler_types_mod,
only : coupler_type_send_data, coupler_1d_bc_type, coupler_type_spawn
53 use mom_ale,
only : ale_init, ale_end, ale_main,
ale_cs, adjustgridforintegrity
54 use mom_ale,
only : ale_getcoordinate, ale_getcoordinateunits, ale_writecoordinatefile
55 use mom_ale,
only : ale_updateverticalgridtype, ale_remap_init_conds, ale_register_diags
56 use mom_ale_sponge,
only : rotate_ale_sponge, update_ale_sponge_field
62 use mom_diagnostics,
only : calculate_diagnostic_fields, mom_diagnostics_init
63 use mom_diagnostics,
only : register_transport_diags, post_transport_diagnostics
65 use mom_diagnostics,
only : post_surface_dyn_diags, post_surface_thermo_diags
80 use mom_forcing_type,
only : deallocate_mech_forcing, deallocate_forcing_type
83 use mom_grid,
only : set_first_direction, rescale_grid_bathymetry
89 use mom_meke,
only : meke_init, meke_alloc_register_restart, step_forward_meke,
meke_cs 99 use mom_set_visc,
only : set_viscous_bbl, set_viscous_ml, set_visc_init
112 use mom_tracer_registry,
only : register_tracer_diagnostics, post_tracer_diagnostics_at_sync
129 use mom_verticalgrid,
only : get_thickness_units, get_flux_units, get_tr_flux_units
135 use mom_oda_driver_mod,
only : set_prior_tracer, set_analysis_time, apply_oda_tracer_increments
138 use mom_offline_main,
only : insert_offline_main, extract_offline_main, post_offline_convergence_diags
139 use mom_offline_main,
only : register_diags_offline_transport, offline_advection_ale
140 use mom_offline_main,
only : offline_redistribute_residual, offline_diabatic_ale
141 use mom_offline_main,
only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean
143 use mom_ale,
only : ale_offline_tracer_final, ale_main_offline
145 implicit none ;
private 147 #include <MOM_memory.h> 157 integer :: id_u = -1, id_v = -1, id_h = -1
160 integer :: id_ssh_inst = -1
166 real allocable_,
dimension(NIMEM_,NJMEM_,NKMEM_) :: &
167 h, & !< layer thickness [H ~> m or kg m-2]
168 t, & !< potential temperature [degC]
170 real allocable_,
dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
171 u, & !< zonal velocity component [L T-1 ~> m s-1]
172 uh, & !< uh = u * h * dy at u grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
174 real allocable_,
dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
175 v, & !< meridional velocity [L T-1 ~> m s-1]
176 vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1]
178 real allocable_,
dimension(NIMEM_,NJMEM_) :: ssh_rint
180 real allocable_,
dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc
183 real allocable_,
dimension(NIMEM_,NJMEM_) :: eta_av_bc
186 real,
dimension(:,:),
pointer :: &
188 real :: time_in_cycle
191 real :: time_in_thermo_cycle
196 logical :: rotate_index = .false.
203 real :: t_dyn_rel_adv
206 real :: t_dyn_rel_thermo
210 real :: t_dyn_rel_diag
212 logical :: preadv_h_stored = .false.
222 logical :: diabatic_first
224 logical :: use_ale_algorithm
227 logical :: offline_tracer_mode = .false.
231 type(time_type),
pointer :: time
234 logical :: thermo_spans_coupling
236 integer :: nstep_tot = 0
238 logical :: count_calls = .false.
243 integer :: cont_stencil
245 logical :: do_dynamics
250 logical :: thickness_diffuse
251 logical :: thickness_diffuse_first
252 logical :: mixedlayer_restrat
255 logical :: use_p_surf_in_eos
257 real :: dtbt_reset_period
260 type(time_type) :: dtbt_reset_interval
261 type(time_type) :: dtbt_reset_time
264 real,
dimension(:,:,:),
pointer :: &
265 h_pre_dyn => null(), &
266 t_pre_dyn => null(), &
272 real,
dimension(:,:,:),
pointer :: &
276 logical :: interp_p_surf
279 logical :: p_surf_prev_set
282 real,
dimension(:,:),
pointer :: &
283 p_surf_prev => null(), &
284 p_surf_begin => null(), &
289 character(len=120) :: ic_file
292 logical :: calc_rho_for_sea_lev
307 logical :: check_bad_sfc_vals
308 real :: bad_val_ssh_max
309 real :: bad_val_sst_max
310 real :: bad_val_sst_min
311 real :: bad_val_sss_max
312 real :: bad_val_col_thick
313 logical :: answers_2018
364 type(
ale_cs),
pointer :: ale_csp => null()
375 logical :: ensemble_ocean
383 public initialize_mom, finish_mom_initialization, mom_end
384 public step_mom, step_offline
385 public extract_surface_state, get_ocean_stocks
386 public get_mom_state_elements, mom_state_is_synchronized
387 public allocate_surface_state, deallocate_surface_state
390 integer :: id_clock_ocean
391 integer :: id_clock_dynamics
392 integer :: id_clock_thermo
393 integer :: id_clock_tracer
394 integer :: id_clock_diabatic
395 integer :: id_clock_adiabatic
396 integer :: id_clock_continuity
397 integer :: id_clock_thick_diff
398 integer :: id_clock_bbl_visc
399 integer :: id_clock_ml_restrat
400 integer :: id_clock_diagnostics
401 integer :: id_clock_z_diag
402 integer :: id_clock_init
403 integer :: id_clock_mom_init
404 integer :: id_clock_pass
405 integer :: id_clock_pass_init
406 integer :: id_clock_ale
407 integer :: id_clock_other
408 integer :: id_clock_offline_tracer
409 integer :: id_clock_unit_tests
419 subroutine step_mom(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS, &
420 Waves, do_dynamics, do_thermodynamics, start_cycle, &
421 end_cycle, cycle_length, reset_therm)
423 type(
forcing),
target,
intent(inout) :: fluxes_in
425 type(
surface),
target,
intent(inout) :: sfc_state
426 type(time_type),
intent(in) :: time_start
427 real,
intent(in) :: time_int_in
430 optional,
pointer :: waves
431 logical,
optional,
intent(in) :: do_dynamics
433 logical,
optional,
intent(in) :: do_thermodynamics
435 logical,
optional,
intent(in) :: start_cycle
438 logical,
optional,
intent(in) :: end_cycle
441 real,
optional,
intent(in) :: cycle_length
443 logical,
optional,
intent(in) :: reset_therm
457 integer :: i, j, k, is, ie, js, je, isq, ieq, jsq, jeq, nz, n
458 integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
460 real :: time_interval
464 real :: dt_therm_here
466 real :: wt_end, wt_beg
470 real :: rel_time = 0.0
474 logical :: do_advection
475 logical :: do_calc_bbl
476 logical :: thermo_does_span_coupling
480 logical :: cycle_start
484 logical :: therm_reset
486 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: &
489 real,
dimension(:,:,:),
pointer :: &
493 real,
dimension(:,:),
pointer :: &
497 type(time_type) :: time_local, end_time_thermo, time_temp
498 type(group_pass_type) :: pass_tau_ustar_psurf
499 logical :: showcalltree
503 type(
forcing),
pointer :: fluxes
504 type(
surface),
pointer :: sfc_state_diag
507 g => cs%G ; g_in => cs%G_in ; gv => cs%GV ; us => cs%US
508 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
509 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
510 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
511 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
512 u => cs%u ; v => cs%v ; h => cs%h
514 time_interval = us%s_to_T*time_int_in
515 do_dyn = .true. ;
if (
present(do_dynamics)) do_dyn = do_dynamics
516 do_thermo = .true. ;
if (
present(do_thermodynamics)) do_thermo = do_thermodynamics
517 if (.not.(do_dyn .or. do_thermo))
call mom_error(fatal,
"Step_MOM: "//&
518 "Both do_dynamics and do_thermodynamics are false, which makes no sense.")
519 cycle_start = .true. ;
if (
present(start_cycle)) cycle_start = start_cycle
520 cycle_end = .true. ;
if (
present(end_cycle)) cycle_end = end_cycle
521 cycle_time = time_interval ;
if (
present(cycle_length)) cycle_time = us%s_to_T*cycle_length
522 therm_reset = cycle_start ;
if (
present(reset_therm)) therm_reset = reset_therm
524 call cpu_clock_begin(id_clock_ocean)
525 call cpu_clock_begin(id_clock_other)
528 call mom_state_chksum(
"Beginning of step_MOM ", u, v, h, cs%uh, cs%vh, g, gv, us)
531 showcalltree = calltree_showquery()
532 if (showcalltree)
call calltree_enter(
"step_MOM(), MOM.F90")
535 if (cs%rotate_index)
then 539 call rotate_mech_forcing(forces_in, turns, forces)
543 call rotate_forcing(fluxes_in, fluxes, turns)
553 if (time_interval > cs%dt) n_max = ceiling(time_interval/cs%dt - 0.001)
554 dt = time_interval /
real(n_max)
555 thermo_does_span_coupling = (cs%thermo_spans_coupling .and. &
556 (cs%dt_therm > 1.5*cycle_time))
557 if (thermo_does_span_coupling)
then 559 dt_therm = cycle_time * floor(cs%dt_therm / cycle_time + 0.001)
560 ntstep = floor(dt_therm/dt + 0.001)
561 elseif (.not.do_thermo)
then 562 dt_therm = cs%dt_therm
563 if (
present(cycle_length)) dt_therm = min(cs%dt_therm, us%s_to_T*cycle_length)
566 ntstep = max(1, min(n_max, floor(cs%dt_therm/dt + 0.001)))
570 if (
associated(forces%p_surf)) p_surf => forces%p_surf
571 if (.not.
associated(forces%p_surf)) cs%interp_p_surf = .false.
572 cs%tv%p_surf => null()
573 if (cs%use_p_surf_in_EOS .and.
associated(forces%p_surf)) cs%tv%p_surf => forces%p_surf
576 call cpu_clock_begin(id_clock_pass)
578 if (
associated(forces%ustar)) &
580 if (
associated(forces%p_surf)) &
582 if (g%nonblocking_updates)
then 583 call start_group_pass(pass_tau_ustar_psurf, g%Domain)
585 call do_group_pass(pass_tau_ustar_psurf, g%Domain)
587 call cpu_clock_end(id_clock_pass)
591 if ((time_interval > cs%dt_therm) .and. (cs%dt_therm > 0.0)) &
592 n_max = ceiling(time_interval/cs%dt_therm - 0.001)
594 dt = time_interval /
real(n_max)
595 dt_therm = dt ; ntstep = 1
596 if (
associated(fluxes%p_surf)) p_surf => fluxes%p_surf
597 cs%tv%p_surf => null()
598 if (
associated(fluxes%p_surf))
then 599 if (cs%use_p_surf_in_EOS) cs%tv%p_surf => fluxes%p_surf
601 if (cs%UseWaves)
call pass_var(fluxes%ustar, g%Domain, clock=id_clock_pass)
604 if (therm_reset)
then 605 cs%time_in_thermo_cycle = 0.0
606 if (
associated(cs%tv%frazil)) cs%tv%frazil(:,:) = 0.0
607 if (
associated(cs%tv%salt_deficit)) cs%tv%salt_deficit(:,:) = 0.0
608 if (
associated(cs%tv%TempxPmE)) cs%tv%TempxPmE(:,:) = 0.0
609 if (
associated(cs%tv%internal_heat)) cs%tv%internal_heat(:,:) = 0.0
612 if (cycle_start)
then 613 cs%time_in_cycle = 0.0
614 do j=js,je ;
do i=is,ie ; cs%ssh_rint(i,j) = 0.0 ;
enddo ;
enddo 616 if (
associated(cs%VarMix))
then 617 call enable_averages(cycle_time, time_start + real_to_time(us%T_to_s*cycle_time), cs%diag)
618 call calc_resoln_function(h, cs%tv, g, gv, us, cs%VarMix)
619 call calc_depth_function(g, cs%VarMix)
620 call disable_averaging(cs%diag)
625 if (g%nonblocking_updates) &
626 call complete_group_pass(pass_tau_ustar_psurf, g%Domain, clock=id_clock_pass)
628 if (cs%interp_p_surf)
then 629 if (.not.
associated(cs%p_surf_end))
allocate(cs%p_surf_end(isd:ied,jsd:jed))
630 if (.not.
associated(cs%p_surf_begin))
allocate(cs%p_surf_begin(isd:ied,jsd:jed))
631 if (.not.cs%p_surf_prev_set)
then 632 do j=jsd,jed ;
do i=isd,ied
633 cs%p_surf_prev(i,j) = forces%p_surf(i,j)
635 cs%p_surf_prev_set = .true.
638 cs%p_surf_end => forces%p_surf
641 if (cs%UseWaves)
then 643 call enable_averages(time_interval, time_start + real_to_time(us%T_to_s*time_interval), cs%diag)
644 call update_stokes_drift(g, gv, us, waves, h, forces%ustar)
645 call disable_averaging(cs%diag)
649 call update_stokes_drift(g, gv, us, waves, h, fluxes%ustar)
656 if (do_dyn)
call mom_mech_forcing_chksum(
"Before steps", forces, g, us, haloshift=0)
657 if (do_dyn)
call check_redundant(
"Before steps ", forces%taux, forces%tauy, g)
659 call cpu_clock_end(id_clock_other)
663 rel_time = rel_time + dt
665 cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
667 time_local = time_start + real_to_time(us%T_to_s*rel_time)
669 if (showcalltree)
call calltree_enter(
"DT cycles (step_MOM) n=",n)
673 call diag_update_remap_grids(cs%diag, update_intensive = .false., update_extensive = .true. )
677 if (cs%diabatic_first .and. (cs%t_dyn_rel_adv==0.0) .and. do_thermo)
then 679 if (.not.do_dyn)
then 681 elseif (thermo_does_span_coupling)
then 683 if ((fluxes%dt_buoy_accum > 0.0) .and. (dtdia > time_interval) .and. &
684 (abs(fluxes%dt_buoy_accum - dtdia) > 1e-6*dtdia))
then 685 call mom_error(fatal,
"step_MOM: Mismatch between long thermodynamic "//&
686 "timestep and time over which buoyancy fluxes have been accumulated.")
688 call mom_error(fatal,
"MOM is not yet set up to have restarts that work "//&
689 "with THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
691 dtdia = dt*min(ntstep,n_max-(n-1))
694 end_time_thermo = time_local
698 cs%Time = cs%Time + real_to_time(0.5*us%T_to_s*(dtdia-dt))
701 end_time_thermo = Time_local + real_to_time(US%T_to_s*(dtdia-dt))
705 call step_mom_thermo(cs, g, gv, us, u, v, h, cs%tv, fluxes, dtdia, &
706 end_time_thermo, .true., Waves=Waves)
707 cs%time_in_thermo_cycle = cs%time_in_thermo_cycle + dtdia
710 cs%t_dyn_rel_thermo = -dtdia
711 if (showcalltree)
call calltree_waypoint(
"finished diabatic_first (step_MOM)")
714 cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
721 if (.not.cs%preadv_h_stored .and. (cs%t_dyn_rel_adv == 0.))
then 722 call diag_copy_diag_to_storage(cs%diag_pre_dyn, h, cs%diag)
723 cs%preadv_h_stored = .true.
727 if (
associated(cs%u_prev) .and.
associated(cs%v_prev))
then 728 do k=1,nz ;
do j=jsd,jed ;
do i=isdb,iedb
729 cs%u_prev(i,j,k) = u(i,j,k)
730 enddo ;
enddo ;
enddo 731 do k=1,nz ;
do j=jsdb,jedb ;
do i=isd,ied
732 cs%v_prev(i,j,k) = v(i,j,k)
733 enddo ;
enddo ;
enddo 736 dt_therm_here = dt_therm
737 if (do_thermo .and. do_dyn .and. .not.thermo_does_span_coupling) &
738 dt_therm_here = dt*min(ntstep, n_max-n+1)
744 if ((cs%t_dyn_rel_adv == 0.0) .or. (n==1)) &
745 bbl_time_int = max(dt, min(dt_therm - cs%t_dyn_rel_adv, dt*(1+n_max-n)) )
747 if ((cs%t_dyn_rel_adv == 0.0) .or. ((n==1) .and. cycle_start)) &
748 bbl_time_int = min(dt_therm, cycle_time)
751 if (cs%interp_p_surf)
then 752 wt_end =
real(n) /
real(n_max)
753 wt_beg =
real(n-1) /
real(n_max)
754 do j=jsd,jed ;
do i=isd,ied
755 cs%p_surf_end(i,j) = wt_end * forces%p_surf(i,j) + &
756 (1.0-wt_end) * cs%p_surf_prev(i,j)
757 cs%p_surf_begin(i,j) = wt_beg * forces%p_surf(i,j) + &
758 (1.0-wt_beg) * cs%p_surf_prev(i,j)
762 call step_mom_dynamics(forces, cs%p_surf_begin, cs%p_surf_end, dt, &
763 dt_therm_here, bbl_time_int, cs, &
764 time_local, waves=waves)
769 if (thermo_does_span_coupling .or. .not.do_thermo)
then 770 do_advection = (cs%t_dyn_rel_adv + 0.5*dt > dt_therm)
772 do_advection = ((mod(n,ntstep) == 0) .or. (n==n_max))
775 if (do_advection)
then 776 call step_mom_tracer_dyn(cs, g, gv, us, h, time_local)
777 if (cs%diabatic_first .and. abs(cs%t_dyn_rel_thermo) > 1e-6*dt)
call mom_error(fatal, &
778 "step_MOM: Mismatch between the dynamics and diabatic times "//&
779 "with DIABATIC_FIRST.")
785 if ((cs%t_dyn_rel_adv==0.0) .and. do_thermo .and. (.not.cs%diabatic_first))
then 787 dtdia = cs%t_dyn_rel_thermo
790 if ((cs%t_dyn_rel_thermo==0.0) .and. .not.do_dyn) dtdia = dt
792 if (cs%thermo_spans_coupling .and. (cs%dt_therm > 1.5*cycle_time) .and. &
793 (abs(dt_therm - dtdia) > 1e-6*dt_therm))
then 794 call mom_error(fatal,
"step_MOM: Mismatch between dt_therm and dtdia "//&
795 "before call to diabatic.")
800 if (dtdia > dt) cs%Time = cs%Time - real_to_time(0.5*us%T_to_s*(dtdia-dt))
803 call step_mom_thermo(cs, g, gv, us, u, v, h, cs%tv, fluxes, dtdia, &
804 time_local, .false., waves=waves)
805 cs%time_in_thermo_cycle = cs%time_in_thermo_cycle + dtdia
807 if ((cs%t_dyn_rel_thermo==0.0) .and. .not.do_dyn)
then 809 cs%t_dyn_rel_thermo = -dtdia
811 cs%t_dyn_rel_thermo = 0.0
815 cs%Time = time_start + real_to_time(us%T_to_s*(rel_time - 0.5*dt))
819 call cpu_clock_begin(id_clock_dynamics)
822 cs%time_in_cycle = cs%time_in_cycle + dt
823 call find_eta(h, cs%tv, g, gv, us, ssh, cs%eta_av_bc, eta_to_m=1.0)
824 do j=js,je ;
do i=is,ie
825 cs%ssh_rint(i,j) = cs%ssh_rint(i,j) + dt*ssh(i,j)
827 if (cs%IDs%id_ssh_inst > 0)
call post_data(cs%IDs%id_ssh_inst, ssh, cs%diag)
828 call cpu_clock_end(id_clock_dynamics)
833 if (mom_state_is_synchronized(cs))
then 835 call cpu_clock_begin(id_clock_other) ;
call cpu_clock_begin(id_clock_diagnostics)
838 call enable_averages(cs%t_dyn_rel_diag, time_local, cs%diag)
839 call calculate_diagnostic_fields(u, v, h, cs%uh, cs%vh, cs%tv, cs%ADp, &
840 cs%CDp, p_surf, cs%t_dyn_rel_diag, cs%diag_pre_sync,&
841 g, gv, us, cs%diagnostics_CSp)
842 call post_tracer_diagnostics_at_sync(cs%Tracer_reg, h, cs%diag_pre_sync, cs%diag, g, gv, cs%t_dyn_rel_diag)
843 call diag_copy_diag_to_storage(cs%diag_pre_sync, h, cs%diag)
844 if (showcalltree)
call calltree_waypoint(
"finished calculate_diagnostic_fields (step_MOM)")
845 call disable_averaging(cs%diag)
846 cs%t_dyn_rel_diag = 0.0
848 call cpu_clock_end(id_clock_diagnostics) ;
call cpu_clock_end(id_clock_other)
851 if (do_dyn .and. .not.cs%count_calls) cs%nstep_tot = cs%nstep_tot + 1
852 if (showcalltree)
call calltree_leave(
"DT cycles (step_MOM)")
856 if (cs%count_calls .and. cycle_start) cs%nstep_tot = cs%nstep_tot + 1
858 call cpu_clock_begin(id_clock_other)
860 if (cs%time_in_cycle > 0.0)
then 861 i_wt_ssh = 1.0/cs%time_in_cycle
862 do j=js,je ;
do i=is,ie
863 ssh(i,j) = cs%ssh_rint(i,j)*i_wt_ssh
864 cs%ave_ssh_ibc(i,j) = ssh(i,j)
867 call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, forces%p_surf_SSH, &
868 cs%calc_rho_for_sea_lev)
869 elseif (do_thermo)
then 870 call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, fluxes%p_surf_SSH, &
871 cs%calc_rho_for_sea_lev)
875 if (do_dyn .and. cs%interp_p_surf)
then ;
do j=jsd,jed ;
do i=isd,ied
876 cs%p_surf_prev(i,j) = forces%p_surf(i,j)
877 enddo ;
enddo ;
endif 879 if (cs%ensemble_ocean)
then 881 call set_analysis_time(cs%Time,cs%odaCS)
883 call set_prior_tracer(cs%Time, g, gv, cs%h, cs%tv, cs%odaCS)
885 call oda(cs%Time,cs%odaCS)
888 if (showcalltree)
call calltree_waypoint(
"calling extract_surface_state (step_MOM)")
890 call extract_surface_state(cs, sfc_state)
894 if (cs%rotate_index)
then 895 allocate(sfc_state_diag)
896 call rotate_surface_state(sfc_state, g_in, sfc_state_diag, g, turns)
898 sfc_state_diag => sfc_state
901 call cpu_clock_begin(id_clock_diagnostics)
902 if (cs%time_in_cycle > 0.0)
then 903 call enable_averages(cs%time_in_cycle, time_local, cs%diag)
904 call post_surface_dyn_diags(cs%sfc_IDs, g, cs%diag, sfc_state_diag, ssh)
906 if (cs%time_in_thermo_cycle > 0.0)
then 907 call enable_averages(cs%time_in_thermo_cycle, time_local, cs%diag)
908 call post_surface_thermo_diags(cs%sfc_IDs, g, gv, us, cs%diag, cs%time_in_thermo_cycle, &
909 sfc_state_diag, cs%tv, ssh, cs%ave_ssh_ibc)
911 call disable_averaging(cs%diag)
912 call cpu_clock_end(id_clock_diagnostics)
916 if (do_thermo .and. fluxes%fluxes_used) &
917 call accumulate_net_input(fluxes, sfc_state, cs%tv, fluxes%dt_buoy_accum, &
918 g, us, cs%sum_output_CSp)
920 if (mom_state_is_synchronized(cs)) &
921 call write_energy(cs%u, cs%v, cs%h, cs%tv, time_local, cs%nstep_tot, &
922 g, gv, us, cs%sum_output_CSp, cs%tracer_flow_CSp, &
923 dt_forcing=real_to_time(us%T_to_s*time_interval) )
925 call cpu_clock_end(id_clock_other)
928 if (cs%rotate_index)
then 929 call rotate_forcing(fluxes, fluxes_in, -turns)
931 call deallocate_mech_forcing(forces)
934 call deallocate_forcing_type(fluxes)
938 if (showcalltree)
call calltree_leave(
"step_MOM()")
939 call cpu_clock_end(id_clock_ocean)
941 end subroutine step_mom
944 subroutine step_mom_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
945 bbl_time_int, CS, Time_local, Waves)
946 type(mech_forcing),
intent(in) :: forces
947 real,
dimension(:,:),
pointer :: p_surf_begin
950 real,
dimension(:,:),
pointer :: p_surf_end
953 real,
intent(in) :: dt
954 real,
intent(in) :: dt_thermo
956 real,
intent(in) :: bbl_time_int
959 type(MOM_control_struct),
pointer :: CS
960 type(time_type),
intent(in) :: Time_local
961 type(wave_parameters_CS), &
962 optional,
pointer :: Waves
966 type(ocean_grid_type),
pointer :: G => null()
968 type(verticalGrid_type),
pointer :: GV => null()
969 type(unit_scale_type),
pointer :: US => null()
971 type(MOM_diag_IDs),
pointer :: IDs => null()
972 real,
dimension(:,:,:),
pointer :: &
979 logical :: showCallTree
981 integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
982 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
984 g => cs%G ; gv => cs%GV ; us => cs%US ; ids => cs%IDs
985 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
986 isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
987 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
988 isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
989 u => cs%u ; v => cs%v ; h => cs%h
990 showcalltree = calltree_showquery()
992 call cpu_clock_begin(id_clock_dynamics)
994 if ((cs%t_dyn_rel_adv == 0.0) .and. cs%thickness_diffuse .and. cs%thickness_diffuse_first)
then 996 call enable_averages(dt_thermo, time_local+real_to_time(us%T_to_s*(dt_thermo-dt)), cs%diag)
997 call cpu_clock_begin(id_clock_thick_diff)
998 if (
associated(cs%VarMix)) &
999 call calc_slope_functions(h, cs%tv, dt, g, gv, us, cs%VarMix, obc=cs%OBC)
1000 call thickness_diffuse(h, cs%uhtr, cs%vhtr, cs%tv, dt_thermo, g, gv, us, &
1001 cs%MEKE, cs%VarMix, cs%CDp, cs%thickness_diffuse_CSp)
1002 call cpu_clock_end(id_clock_thick_diff)
1003 call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
1004 call disable_averaging(cs%diag)
1005 if (showcalltree)
call calltree_waypoint(
"finished thickness_diffuse_first (step_MOM)")
1009 call diag_update_remap_grids(cs%diag)
1013 if (bbl_time_int > 0.0)
then 1014 call enable_averages(bbl_time_int, &
1015 time_local + real_to_time(us%T_to_s*(bbl_time_int-dt)), cs%diag)
1017 call cpu_clock_begin(id_clock_bbl_visc)
1018 call set_viscous_bbl(cs%u, cs%v, cs%h, cs%tv, cs%visc, g, gv, us, &
1019 cs%set_visc_CSp, symmetrize=.true.)
1020 call cpu_clock_end(id_clock_bbl_visc)
1021 if (showcalltree)
call calltree_waypoint(
"done with set_viscous_BBL (step_MOM)")
1022 call disable_averaging(cs%diag)
1026 if (cs%do_dynamics .and. cs%split)
then 1031 if (cs%dtbt_reset_period == 0.0) calc_dtbt = .true.
1032 if (cs%dtbt_reset_period > 0.0)
then 1033 if (time_local >= cs%dtbt_reset_time)
then 1035 cs%dtbt_reset_time = cs%dtbt_reset_time + cs%dtbt_reset_interval
1039 call step_mom_dyn_split_rk2(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
1040 p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
1041 cs%eta_av_bc, g, gv, us, cs%dyn_split_RK2_CSp, calc_dtbt, cs%VarMix, &
1042 cs%MEKE, cs%thickness_diffuse_CSp, waves=waves)
1043 if (showcalltree)
call calltree_waypoint(
"finished step_MOM_dyn_split (step_MOM)")
1045 elseif (cs%do_dynamics)
then 1053 if (cs%use_RK2)
then 1054 call step_mom_dyn_unsplit_rk2(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
1055 p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
1056 cs%eta_av_bc, g, gv, us, cs%dyn_unsplit_RK2_CSp, cs%VarMix, cs%MEKE)
1058 call step_mom_dyn_unsplit(u, v, h, cs%tv, cs%visc, time_local, dt, forces, &
1059 p_surf_begin, p_surf_end, cs%uh, cs%vh, cs%uhtr, cs%vhtr, &
1060 cs%eta_av_bc, g, gv, us, cs%dyn_unsplit_CSp, cs%VarMix, cs%MEKE, waves=waves)
1062 if (showcalltree)
call calltree_waypoint(
"finished step_MOM_dyn_unsplit (step_MOM)")
1066 if (cs%thickness_diffuse .and. .not.cs%thickness_diffuse_first)
then 1067 call cpu_clock_begin(id_clock_thick_diff)
1069 if (cs%debug)
call hchksum(h,
"Pre-thickness_diffuse h", g%HI, haloshift=0, scale=gv%H_to_m)
1071 if (
associated(cs%VarMix)) &
1072 call calc_slope_functions(h, cs%tv, dt, g, gv, us, cs%VarMix, obc=cs%OBC)
1073 call thickness_diffuse(h, cs%uhtr, cs%vhtr, cs%tv, dt, g, gv, us, &
1074 cs%MEKE, cs%VarMix, cs%CDp, cs%thickness_diffuse_CSp)
1076 if (cs%debug)
call hchksum(h,
"Post-thickness_diffuse h", g%HI, haloshift=1, scale=gv%H_to_m)
1077 call cpu_clock_end(id_clock_thick_diff)
1078 call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
1079 if (showcalltree)
call calltree_waypoint(
"finished thickness_diffuse (step_MOM)")
1083 if (cs%mixedlayer_restrat)
then 1085 call hchksum(h,
"Pre-mixedlayer_restrat h", g%HI, haloshift=1, scale=gv%H_to_m)
1086 call uvchksum(
"Pre-mixedlayer_restrat uhtr", &
1087 cs%uhtr, cs%vhtr, g%HI, haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
1089 call cpu_clock_begin(id_clock_ml_restrat)
1090 call mixedlayer_restrat(h, cs%uhtr, cs%vhtr, cs%tv, forces, dt, cs%visc%MLD, &
1091 cs%VarMix, g, gv, us, cs%mixedlayer_restrat_CSp)
1092 call cpu_clock_end(id_clock_ml_restrat)
1093 call pass_var(h, g%Domain, clock=id_clock_pass, halo=max(2,cs%cont_stencil))
1095 call hchksum(h,
"Post-mixedlayer_restrat h", g%HI, haloshift=1, scale=gv%H_to_m)
1096 call uvchksum(
"Post-mixedlayer_restrat [uv]htr", &
1097 cs%uhtr, cs%vhtr, g%HI, haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
1103 call diag_update_remap_grids(cs%diag)
1105 if (cs%useMEKE)
call step_forward_meke(cs%MEKE, h, cs%VarMix%SN_u, cs%VarMix%SN_v, &
1106 cs%visc, dt, g, gv, us, cs%MEKE_CSp, cs%uhtr, cs%vhtr)
1107 call disable_averaging(cs%diag)
1110 cs%t_dyn_rel_adv = cs%t_dyn_rel_adv + dt
1111 cs%t_dyn_rel_thermo = cs%t_dyn_rel_thermo + dt
1112 if (abs(cs%t_dyn_rel_thermo) < 1e-6*dt) cs%t_dyn_rel_thermo = 0.0
1113 cs%t_dyn_rel_diag = cs%t_dyn_rel_diag + dt
1115 call cpu_clock_end(id_clock_dynamics)
1117 call cpu_clock_begin(id_clock_other) ;
call cpu_clock_begin(id_clock_diagnostics)
1118 call enable_averages(dt, time_local, cs%diag)
1120 if (ids%id_u > 0)
call post_data(ids%id_u, u, cs%diag)
1121 if (ids%id_v > 0)
call post_data(ids%id_v, v, cs%diag)
1122 if (ids%id_h > 0)
call post_data(ids%id_h, h, cs%diag)
1123 call disable_averaging(cs%diag)
1124 call cpu_clock_end(id_clock_diagnostics) ;
call cpu_clock_end(id_clock_other)
1126 end subroutine step_mom_dynamics
1131 subroutine step_mom_tracer_dyn(CS, G, GV, US, h, Time_local)
1132 type(MOM_control_struct),
intent(inout) :: CS
1133 type(ocean_grid_type),
intent(inout) :: G
1134 type(verticalGrid_type),
intent(in) :: GV
1135 type(unit_scale_type),
intent(in) :: US
1136 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
1138 type(time_type),
intent(in) :: Time_local
1140 type(group_pass_type) :: pass_T_S
1142 logical :: showCallTree
1143 showcalltree = calltree_showquery()
1146 call cpu_clock_begin(id_clock_other)
1147 call hchksum(h,
"Pre-advection h", g%HI, haloshift=1, scale=gv%H_to_m)
1148 call uvchksum(
"Pre-advection uhtr", cs%uhtr, cs%vhtr, g%HI, &
1149 haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
1150 if (
associated(cs%tv%T))
call hchksum(cs%tv%T,
"Pre-advection T", g%HI, haloshift=1)
1151 if (
associated(cs%tv%S))
call hchksum(cs%tv%S,
"Pre-advection S", g%HI, haloshift=1)
1152 if (
associated(cs%tv%frazil))
call hchksum(cs%tv%frazil,
"Pre-advection frazil", g%HI, haloshift=0, &
1153 scale=g%US%Q_to_J_kg*g%US%RZ_to_kg_m2)
1154 if (
associated(cs%tv%salt_deficit))
call hchksum(cs%tv%salt_deficit, &
1155 "Pre-advection salt deficit", g%HI, haloshift=0, scale=us%RZ_to_kg_m2)
1157 call cpu_clock_end(id_clock_other)
1160 call cpu_clock_begin(id_clock_thermo) ;
call cpu_clock_begin(id_clock_tracer)
1161 call enable_averages(cs%t_dyn_rel_adv, time_local, cs%diag)
1163 call advect_tracer(h, cs%uhtr, cs%vhtr, cs%OBC, cs%t_dyn_rel_adv, g, gv, us, &
1164 cs%tracer_adv_CSp, cs%tracer_Reg)
1165 call tracer_hordiff(h, cs%t_dyn_rel_adv, cs%MEKE, cs%VarMix, g, gv, us, &
1166 cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
1167 if (showcalltree)
call calltree_waypoint(
"finished tracer advection/diffusion (step_MOM)")
1168 call update_segment_tracer_reservoirs(g, gv, cs%uhtr, cs%vhtr, h, cs%OBC, &
1169 cs%t_dyn_rel_adv, cs%tracer_Reg)
1170 call cpu_clock_end(id_clock_tracer) ;
call cpu_clock_end(id_clock_thermo)
1172 call cpu_clock_begin(id_clock_other) ;
call cpu_clock_begin(id_clock_diagnostics)
1173 call post_transport_diagnostics(g, gv, us, cs%uhtr, cs%vhtr, h, cs%transport_IDs, &
1174 cs%diag_pre_dyn, cs%diag, cs%t_dyn_rel_adv, cs%tracer_reg)
1177 call diag_update_remap_grids(cs%diag)
1179 call disable_averaging(cs%diag)
1180 call cpu_clock_end(id_clock_diagnostics) ;
call cpu_clock_end(id_clock_other)
1184 call cpu_clock_begin(id_clock_thermo) ;
call cpu_clock_begin(id_clock_tracer)
1185 cs%uhtr(:,:,:) = 0.0
1186 cs%vhtr(:,:,:) = 0.0
1187 cs%t_dyn_rel_adv = 0.0
1188 call cpu_clock_end(id_clock_tracer) ;
call cpu_clock_end(id_clock_thermo)
1190 if (
associated(cs%tv%T))
then 1191 call extract_diabatic_member(cs%diabatic_CSp, diabatic_halo=halo_sz)
1192 if (halo_sz > 0)
then 1193 call create_group_pass(pass_t_s, cs%tv%T, g%Domain, to_all, halo=halo_sz)
1194 call create_group_pass(pass_t_s, cs%tv%S, g%Domain, to_all, halo=halo_sz)
1195 call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
1196 elseif (cs%diabatic_first)
then 1199 call create_group_pass(pass_t_s, cs%tv%T, g%Domain, to_all+omit_corners, halo=1)
1200 call create_group_pass(pass_t_s, cs%tv%S, g%Domain, to_all+omit_corners, halo=1)
1201 call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
1205 cs%preadv_h_stored = .false.
1207 end subroutine step_mom_tracer_dyn
1211 subroutine step_mom_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, &
1212 Time_end_thermo, update_BBL, Waves)
1213 type(MOM_control_struct),
intent(inout) :: CS
1214 type(ocean_grid_type),
intent(inout) :: G
1215 type(verticalGrid_type),
intent(inout) :: GV
1216 type(unit_scale_type),
intent(in) :: US
1217 real,
dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
1219 real,
dimension(SZI_(G),SZJB_(G),SZK_(G)), &
1221 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
1223 type(thermo_var_ptrs),
intent(inout) :: tv
1224 type(forcing),
intent(inout) :: fluxes
1225 real,
intent(in) :: dtdia
1226 type(time_type),
intent(in) :: Time_end_thermo
1227 logical,
intent(in) :: update_BBL
1228 type(wave_parameters_CS), &
1229 optional,
pointer :: Waves
1232 logical :: use_ice_shelf
1233 logical :: showCallTree
1234 type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h
1235 integer :: dynamics_stencil
1238 integer :: i, j, k, is, ie, js, je, nz
1240 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
1241 showcalltree = calltree_showquery()
1242 if (showcalltree)
call calltree_enter(
"step_MOM_thermo(), MOM.F90")
1244 use_ice_shelf = .false.
1245 if (
associated(fluxes%frac_shelf_h)) use_ice_shelf = .true.
1247 call enable_averages(dtdia, time_end_thermo, cs%diag)
1249 if (
associated(cs%odaCS))
then 1250 call apply_oda_tracer_increments(us%T_to_s*dtdia,g,tv,h,cs%odaCS)
1253 if (
associated(fluxes%p_surf) .or.
associated(fluxes%p_surf_full))
then 1254 call extract_diabatic_member(cs%diabatic_CSp, diabatic_halo=halo_sz)
1255 if (halo_sz > 0)
then 1256 if (
associated(fluxes%p_surf_full)) &
1257 call pass_var(fluxes%p_surf_full, g%Domain, &
1258 clock=id_clock_pass, halo=halo_sz, complete=.not.
associated(fluxes%p_surf))
1259 call pass_var(fluxes%p_surf, g%Domain, clock=id_clock_pass, halo=halo_sz, complete=.true.)
1263 if (update_bbl)
then 1268 call cpu_clock_begin(id_clock_bbl_visc)
1269 call set_viscous_bbl(u, v, h, tv, cs%visc, g, gv, us, cs%set_visc_CSp, symmetrize=.true.)
1270 call cpu_clock_end(id_clock_bbl_visc)
1271 if (showcalltree)
call calltree_waypoint(
"done with set_viscous_BBL (step_MOM_thermo)")
1274 call cpu_clock_begin(id_clock_thermo)
1275 if (.not.cs%adiabatic)
then 1277 call uvchksum(
"Pre-diabatic [uv]", u, v, g%HI, haloshift=2, scale=us%L_T_to_m_s)
1278 call hchksum(h,
"Pre-diabatic h", g%HI, haloshift=1, scale=gv%H_to_m)
1279 call uvchksum(
"Pre-diabatic [uv]h", cs%uhtr, cs%vhtr, g%HI, &
1280 haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
1282 call mom_thermo_chksum(
"Pre-diabatic ", tv, g, us, haloshift=0)
1283 call check_redundant(
"Pre-diabatic ", u, v, g)
1284 call mom_forcing_chksum(
"Pre-diabatic", fluxes, g, us, haloshift=0)
1287 call cpu_clock_begin(id_clock_diabatic)
1289 call diabatic(u, v, h, tv, cs%Hml, fluxes, cs%visc, cs%ADp, cs%CDp, dtdia, &
1290 time_end_thermo, g, gv, us, cs%diabatic_CSp, obc=cs%OBC, waves=waves)
1291 fluxes%fluxes_used = .true.
1293 if (showcalltree)
call calltree_waypoint(
"finished diabatic (step_MOM_thermo)")
1298 if ( cs%use_ALE_algorithm )
then 1299 call enable_averages(dtdia, time_end_thermo, cs%diag)
1301 call cpu_clock_begin(id_clock_pass)
1302 if (
associated(tv%T)) &
1303 call create_group_pass(pass_t_s_h, tv%T, g%Domain, to_all+omit_corners, halo=1)
1304 if (
associated(tv%S)) &
1305 call create_group_pass(pass_t_s_h, tv%S, g%Domain, to_all+omit_corners, halo=1)
1306 call create_group_pass(pass_t_s_h, h, g%Domain, to_all+omit_corners, halo=1)
1307 call do_group_pass(pass_t_s_h, g%Domain)
1308 call cpu_clock_end(id_clock_pass)
1310 call preale_tracer_diagnostics(cs%tracer_Reg, g, gv)
1313 call mom_state_chksum(
"Pre-ALE ", u, v, h, cs%uh, cs%vh, g, gv, us)
1314 call hchksum(tv%T,
"Pre-ALE T", g%HI, haloshift=1)
1315 call hchksum(tv%S,
"Pre-ALE S", g%HI, haloshift=1)
1316 call check_redundant(
"Pre-ALE ", u, v, g)
1318 call cpu_clock_begin(id_clock_ale)
1319 if (use_ice_shelf)
then 1320 call ale_main(g, gv, us, h, u, v, tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC, &
1321 dtdia, fluxes%frac_shelf_h)
1323 call ale_main(g, gv, us, h, u, v, tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC, dtdia)
1326 if (showcalltree)
call calltree_waypoint(
"finished ALE_main (step_MOM_thermo)")
1327 call cpu_clock_end(id_clock_ale)
1330 dynamics_stencil = min(3, g%Domain%nihalo, g%Domain%njhalo)
1331 call create_group_pass(pass_uv_t_s_h, u, v, g%Domain, halo=dynamics_stencil)
1332 if (
associated(tv%T)) &
1333 call create_group_pass(pass_uv_t_s_h, tv%T, g%Domain, halo=dynamics_stencil)
1334 if (
associated(tv%S)) &
1335 call create_group_pass(pass_uv_t_s_h, tv%S, g%Domain, halo=dynamics_stencil)
1336 call create_group_pass(pass_uv_t_s_h, h, g%Domain, halo=dynamics_stencil)
1337 call do_group_pass(pass_uv_t_s_h, g%Domain, clock=id_clock_pass)
1339 if (cs%debug .and. cs%use_ALE_algorithm)
then 1340 call mom_state_chksum(
"Post-ALE ", u, v, h, cs%uh, cs%vh, g, gv, us)
1341 call hchksum(tv%T,
"Post-ALE T", g%HI, haloshift=1)
1342 call hchksum(tv%S,
"Post-ALE S", g%HI, haloshift=1)
1343 call check_redundant(
"Post-ALE ", u, v, g)
1349 call diag_update_remap_grids(cs%diag)
1352 call postale_tracer_diagnostics(cs%tracer_Reg, g, gv, cs%diag, dtdia)
1355 call uvchksum(
"Post-diabatic u", u, v, g%HI, haloshift=2, scale=us%L_T_to_m_s)
1356 call hchksum(h,
"Post-diabatic h", g%HI, haloshift=1, scale=gv%H_to_m)
1357 call uvchksum(
"Post-diabatic [uv]h", cs%uhtr, cs%vhtr, g%HI, &
1358 haloshift=0, scale=gv%H_to_m*us%L_to_m**2)
1361 if (
associated(tv%T))
call hchksum(tv%T,
"Post-diabatic T", g%HI, haloshift=1)
1362 if (
associated(tv%S))
call hchksum(tv%S,
"Post-diabatic S", g%HI, haloshift=1)
1363 if (
associated(tv%frazil))
call hchksum(tv%frazil,
"Post-diabatic frazil", g%HI, haloshift=0, &
1364 scale=g%US%Q_to_J_kg*g%US%RZ_to_kg_m2)
1365 if (
associated(tv%salt_deficit))
call hchksum(tv%salt_deficit, &
1366 "Post-diabatic salt deficit", g%HI, haloshift=0, scale=us%RZ_to_kg_m2)
1368 call check_redundant(
"Post-diabatic ", u, v, g)
1370 call disable_averaging(cs%diag)
1372 call cpu_clock_end(id_clock_diabatic)
1375 call cpu_clock_begin(id_clock_adiabatic)
1376 call adiabatic(h, tv, fluxes, dtdia, g, gv, us, cs%diabatic_CSp)
1377 fluxes%fluxes_used = .true.
1378 call cpu_clock_end(id_clock_adiabatic)
1380 if (
associated(tv%T))
then 1381 call create_group_pass(pass_t_s, tv%T, g%Domain, to_all+omit_corners, halo=1)
1382 call create_group_pass(pass_t_s, tv%S, g%Domain, to_all+omit_corners, halo=1)
1383 call do_group_pass(pass_t_s, g%Domain, clock=id_clock_pass)
1385 if (
associated(tv%T))
call hchksum(tv%T,
"Post-diabatic T", g%HI, haloshift=1)
1386 if (
associated(tv%S))
call hchksum(tv%S,
"Post-diabatic S", g%HI, haloshift=1)
1391 call cpu_clock_end(id_clock_thermo)
1393 call disable_averaging(cs%diag)
1395 if (showcalltree)
call calltree_leave(
"step_MOM_thermo(), MOM.F90")
1397 end subroutine step_mom_thermo
1404 subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS)
1405 type(mech_forcing),
intent(in) :: forces
1406 type(forcing),
intent(inout) :: fluxes
1407 type(surface),
intent(inout) :: sfc_state
1408 type(time_type),
intent(in) :: time_start
1409 real,
intent(in) :: time_interval
1413 type(ocean_grid_type),
pointer :: g => null()
1415 type(verticalgrid_type),
pointer :: gv => null()
1417 type(unit_scale_type),
pointer :: us => null()
1420 logical :: first_iter
1421 logical :: last_iter
1422 logical :: do_vertical
1423 logical :: adv_converged
1426 real :: dt_offline_vertical
1427 logical :: skip_diffusion
1428 integer :: id_eta_diff_end
1430 type(time_type),
pointer :: accumulated_time => null()
1431 type(time_type),
pointer :: vertical_time => null()
1433 integer :: is, ie, js, je, isd, ied, jsd, jed
1436 real,
dimension(:,:,:),
pointer :: &
1437 uhtr => null(), vhtr => null(), &
1438 eatr => null(), ebtr => null(), &
1442 real,
dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end
1443 type(time_type) :: time_end
1446 g => cs%G ; gv => cs%GV ; us => cs%US
1448 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1449 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1451 call cpu_clock_begin(id_clock_offline_tracer)
1452 call extract_offline_main(cs%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, &
1453 vertical_time, dt_offline, dt_offline_vertical, skip_diffusion)
1454 time_end = increment_date(time_start, seconds=floor(time_interval+0.001))
1456 call enable_averaging(time_interval, time_end, cs%diag)
1459 if (accumulated_time == real_to_time(0.0))
then 1462 first_iter = .false.
1466 if (first_iter .or. (accumulated_time >= vertical_time))
then 1467 do_vertical = .true.
1468 vertical_time = accumulated_time + real_to_time(us%T_to_s*dt_offline_vertical)
1470 do_vertical = .false.
1474 accumulated_time = accumulated_time + real_to_time(time_interval)
1476 last_iter = (accumulated_time >= real_to_time(us%T_to_s*dt_offline))
1478 if (cs%use_ALE_algorithm)
then 1481 if (first_iter)
then 1482 call mom_mesg(
"Reading in new offline fields")
1487 call update_offline_fields(cs%offline_CSp, cs%h, fluxes, cs%use_ALE_algorithm)
1490 call offline_fw_fluxes_into_ocean(g, gv, cs%offline_CSp, fluxes, cs%h)
1492 if (.not.cs%diabatic_first)
then 1493 call offline_advection_ale(fluxes, time_start, time_interval, cs%offline_CSp, id_clock_ale, &
1494 cs%h, uhtr, vhtr, converged=adv_converged)
1497 call offline_redistribute_residual(cs%offline_CSp, cs%h, uhtr, vhtr, adv_converged)
1500 if (.not. skip_diffusion)
then 1501 if (
associated(cs%VarMix))
then 1502 call pass_var(cs%h, g%Domain)
1503 call calc_resoln_function(cs%h, cs%tv, g, gv, us, cs%VarMix)
1504 call calc_depth_function(g, cs%VarMix)
1505 call calc_slope_functions(cs%h, cs%tv, dt_offline, g, gv, us, cs%VarMix, obc=cs%OBC)
1507 call tracer_hordiff(cs%h, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
1508 cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
1513 if (do_vertical)
then 1514 call offline_diabatic_ale(fluxes, time_start, time_end, cs%offline_CSp, cs%h, eatr, ebtr)
1519 if (cs%diabatic_first)
then 1520 call offline_advection_ale(fluxes, time_start, time_interval, cs%offline_CSp, id_clock_ale, &
1521 cs%h, uhtr, vhtr, converged=adv_converged)
1524 call offline_redistribute_residual(cs%offline_CSp, cs%h, uhtr, vhtr, adv_converged)
1526 if (.not. skip_diffusion)
then 1527 if (
associated(cs%VarMix))
then 1528 call pass_var(cs%h, g%Domain)
1529 call calc_resoln_function(cs%h, cs%tv, g, gv, us, cs%VarMix)
1530 call calc_depth_function(g, cs%VarMix)
1531 call calc_slope_functions(cs%h, cs%tv, dt_offline, g, gv, us, cs%VarMix, obc=cs%OBC)
1533 call tracer_hordiff(cs%h, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
1534 cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
1538 call mom_mesg(
"Last iteration of offline interval")
1541 call offline_fw_fluxes_out_ocean(g, gv, cs%offline_CSp, fluxes, cs%h)
1544 call post_offline_convergence_diags(cs%offline_CSp, cs%h, h_end, uhtr, vhtr)
1548 call cpu_clock_begin(id_clock_ale)
1549 call ale_offline_tracer_final( g, gv, cs%h, cs%tv, h_end, cs%tracer_Reg, cs%ALE_CSp, cs%OBC)
1550 call cpu_clock_end(id_clock_ale)
1551 call pass_var(cs%h, g%Domain)
1554 call mom_error(warning, &
1555 "Offline tracer mode in non-ALE configuration has not been thoroughly tested")
1559 if (abs(time_interval - us%T_to_s*dt_offline) > 1.0e-6)
then 1560 call mom_error(fatal, &
1561 "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval")
1563 call update_offline_fields(cs%offline_CSp, cs%h, fluxes, cs%use_ALE_algorithm)
1564 call offline_advection_layer(fluxes, time_start, time_interval, cs%offline_CSp, &
1565 cs%h, eatr, ebtr, uhtr, vhtr)
1567 if (.not. skip_diffusion)
then 1568 call tracer_hordiff(h_end, dt_offline, cs%MEKE, cs%VarMix, g, gv, us, &
1569 cs%tracer_diff_CSp, cs%tracer_Reg, cs%tv)
1574 call pass_var(cs%tv%T, g%Domain)
1575 call pass_var(cs%tv%S, g%Domain)
1576 call pass_var(cs%h, g%Domain)
1580 call adjust_ssh_for_p_atm(cs%tv, g, gv, us, cs%ave_ssh_ibc, forces%p_surf_SSH, &
1581 cs%calc_rho_for_sea_lev)
1582 call extract_surface_state(cs, sfc_state)
1584 call disable_averaging(cs%diag)
1585 call pass_var(cs%tv%T, g%Domain)
1586 call pass_var(cs%tv%S, g%Domain)
1587 call pass_var(cs%h, g%Domain)
1589 fluxes%fluxes_used = .true.
1592 accumulated_time = real_to_time(0.0)
1595 call cpu_clock_end(id_clock_offline_tracer)
1597 end subroutine step_offline
1601 subroutine initialize_mom(Time, Time_init, param_file, dirs, CS, restart_CSp, &
1602 Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
1603 count_calls, tracer_flow_CSp)
1604 type(time_type),
target,
intent(inout) :: time
1605 type(time_type),
intent(in) :: time_init
1606 type(param_file_type),
intent(out) :: param_file
1607 type(directories),
intent(out) :: dirs
1609 type(mom_restart_cs),
pointer :: restart_csp
1612 type(time_type),
optional,
intent(in) :: time_in
1614 logical,
optional,
intent(out) :: offline_tracer_mode
1615 character(len=*),
optional,
intent(in) :: input_restart_file
1616 type(diag_ctrl),
optional,
pointer :: diag_ptr
1618 type(tracer_flow_control_cs), &
1619 optional,
pointer :: tracer_flow_csp
1621 logical,
optional,
intent(in) :: count_calls
1625 type(ocean_grid_type),
pointer :: g => null()
1626 type(ocean_grid_type),
pointer :: g_in => null()
1627 type(hor_index_type),
pointer :: hi => null()
1628 type(hor_index_type),
target :: hi_in
1629 type(verticalgrid_type),
pointer :: gv => null()
1630 type(dyn_horgrid_type),
pointer :: dg => null()
1631 type(dyn_horgrid_type),
pointer :: dg_in => null()
1632 type(diag_ctrl),
pointer :: diag => null()
1633 type(unit_scale_type),
pointer :: us => null()
1634 character(len=4),
parameter :: vers_num =
'v2.0' 1638 real,
allocatable,
dimension(:,:,:) :: u_in, v_in, h_in
1639 real,
allocatable,
dimension(:,:,:),
target :: t_in, s_in
1640 type(ocean_obc_type),
pointer :: obc_in => null()
1641 type(sponge_cs),
pointer :: sponge_in_csp => null()
1642 type(ale_sponge_cs),
pointer :: ale_sponge_in_csp => null()
1645 # include "version_variable.h" 1647 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz
1648 integer :: isdb, iedb, jsdb, jedb
1651 real,
allocatable,
dimension(:,:) :: eta
1652 real,
allocatable,
dimension(:,:) :: area_shelf_h
1653 real,
dimension(:,:),
allocatable,
target :: frac_shelf_h
1654 real,
dimension(:,:),
pointer :: shelf_area => null()
1655 type(mom_restart_cs),
pointer :: restart_csp_tmp => null()
1656 type(group_pass_type) :: tmp_pass_uv_t_s_h, pass_uv_t_s_h
1659 logical :: write_geom_files
1660 logical :: ensemble_ocean
1662 logical :: use_geothermal
1664 logical :: symmetric
1666 logical :: do_unit_tests
1667 logical :: test_grid_copy = .false.
1669 logical :: bulkmixedlayer
1671 logical :: use_temperature
1672 logical :: use_frazil
1674 logical :: bound_salinity
1676 logical :: default_2018_answers
1677 logical :: use_cont_abss
1681 logical :: advect_ts
1683 logical :: use_ice_shelf
1684 logical :: global_indexing
1686 logical :: bathy_at_vel
1688 logical :: calc_dtbt
1690 logical :: debug_truncations
1691 integer :: first_direction
1695 integer :: nkml, nkbl, verbosity, write_geom
1696 integer :: dynamics_stencil
1698 real :: conv2watt, conv2salt
1699 real :: rl2_t2_rescale, z_rescale, qrz_rescale
1700 character(len=48) :: flux_units, s_flux_units
1702 type(vardesc) :: vd_t, vd_s
1703 type(time_type) :: start_time
1704 type(ocean_internal_state) :: mom_internal_state
1705 character(len=200) :: area_varname, ice_shelf_file, inputdir, filename
1707 if (
associated(cs))
then 1708 call mom_error(warning,
"initialize_MOM called with an associated "// &
1709 "control structure.")
1716 id_clock_init = cpu_clock_id(
'Ocean Initialization', grain=clock_subcomponent)
1717 call cpu_clock_begin(id_clock_init)
1719 start_time = time ;
if (
present(time_in)) start_time = time_in
1723 call get_mom_input(param_file, dirs, default_input_filename=input_restart_file)
1725 verbosity = 2 ;
call read_param(param_file,
"VERBOSITY", verbosity)
1726 call mom_set_verbosity(verbosity)
1727 call calltree_enter(
"initialize_MOM(), MOM.F90")
1729 call find_obsolete_params(param_file)
1732 call unit_scaling_init(param_file, cs%US)
1736 call log_version(param_file,
"MOM", version,
"", log_to_all=.true., layout=.true., debugging=.true.)
1737 call get_param(param_file,
"MOM",
"VERBOSITY", verbosity, &
1738 "Integer controlling level of messaging\n" // &
1739 "\t0 = Only FATAL messages\n" // &
1740 "\t2 = Only FATAL, WARNING, NOTE [default]\n" // &
1741 "\t9 = All)", default=2, debuggingparam=.true.)
1742 call get_param(param_file,
"MOM",
"DO_UNIT_TESTS", do_unit_tests, &
1743 "If True, exercises unit tests at model start up.", &
1744 default=.false., debuggingparam=.true.)
1745 if (do_unit_tests)
then 1746 id_clock_unit_tests = cpu_clock_id(
'(Ocean unit tests)', grain=clock_module)
1747 call cpu_clock_begin(id_clock_unit_tests)
1748 call unit_tests(verbosity)
1749 call cpu_clock_end(id_clock_unit_tests)
1752 call get_param(param_file,
"MOM",
"SPLIT", cs%split, &
1753 "Use the split time stepping if true.", default=.true.)
1755 cs%use_RK2 = .false.
1757 call get_param(param_file,
"MOM",
"USE_RK2", cs%use_RK2, &
1758 "If true, use RK2 instead of RK3 in the unsplit time stepping.", &
1762 call get_param(param_file,
"MOM",
"CALC_RHO_FOR_SEA_LEVEL", cs%calc_rho_for_sea_lev, &
1763 "If true, the in-situ density is used to calculate the "//&
1764 "effective sea level that is returned to the coupler. If false, "//&
1765 "the Boussinesq parameter RHO_0 is used.", default=.false.)
1766 call get_param(param_file,
"MOM",
"ENABLE_THERMODYNAMICS", use_temperature, &
1767 "If true, Temperature and salinity are used as state "//&
1768 "variables.", default=.true.)
1769 call get_param(param_file,
"MOM",
"USE_EOS", use_eos, &
1770 "If true, density is calculated from temperature and "//&
1771 "salinity with an equation of state. If USE_EOS is "//&
1772 "true, ENABLE_THERMODYNAMICS must be true as well.", &
1773 default=use_temperature)
1774 call get_param(param_file,
"MOM",
"DIABATIC_FIRST", cs%diabatic_first, &
1775 "If true, apply diabatic and thermodynamic processes, "//&
1776 "including buoyancy forcing and mass gain or loss, "//&
1777 "before stepping the dynamics forward.", default=.false.)
1778 call get_param(param_file,
"MOM",
"USE_CONTEMP_ABSSAL", use_cont_abss, &
1779 "If true, the prognostics T&S are the conservative temperature "//&
1780 "and absolute salinity. Care should be taken to convert them "//&
1781 "to potential temperature and practical salinity before "//&
1782 "exchanging them with the coupler and/or reporting T&S diagnostics.", &
1784 cs%tv%T_is_conT = use_cont_abss ; cs%tv%S_is_absS = use_cont_abss
1785 call get_param(param_file,
"MOM",
"ADIABATIC", cs%adiabatic, &
1786 "There are no diapycnal mass fluxes if ADIABATIC is "//&
1787 "true. This assumes that KD = KDML = 0.0 and that "//&
1788 "there is no buoyancy forcing, but makes the model "//&
1789 "faster by eliminating subroutine calls.", default=.false.)
1790 call get_param(param_file,
"MOM",
"DO_DYNAMICS", cs%do_dynamics, &
1791 "If False, skips the dynamics calls that update u & v, as well as "//&
1792 "the gravity wave adjustment to h. This may be a fragile feature, "//&
1793 "but can be useful during development", default=.true.)
1794 call get_param(param_file,
"MOM",
"ADVECT_TS", advect_ts, &
1795 "If True, advect temperature and salinity horizontally "//&
1796 "If False, T/S are registered for advection. "//&
1797 "This is intended only to be used in offline tracer mode "//&
1798 "and is by default false in that case.", &
1799 do_not_log = .true., default=.true. )
1800 if (
present(offline_tracer_mode))
then 1801 call get_param(param_file,
"MOM",
"OFFLINE_TRACER_MODE", cs%offline_tracer_mode, &
1802 "If true, barotropic and baroclinic dynamics, thermodynamics "//&
1803 "are all bypassed with all the fields necessary to integrate "//&
1804 "the tracer advection and diffusion equation are read in from "//&
1805 "files stored from a previous integration of the prognostic model. "//&
1806 "NOTE: This option only used in the ocean_solo_driver.", default=.false.)
1807 if (cs%offline_tracer_mode)
then 1808 call get_param(param_file,
"MOM",
"ADVECT_TS", advect_ts, &
1809 "If True, advect temperature and salinity horizontally "//&
1810 "If False, T/S are registered for advection. "//&
1811 "This is intended only to be used in offline tracer mode."//&
1812 "and is by default false in that case", &
1816 call get_param(param_file,
"MOM",
"USE_REGRIDDING", cs%use_ALE_algorithm, &
1817 "If True, use the ALE algorithm (regridding/remapping). "//&
1818 "If False, use the layered isopycnal algorithm.", default=.false. )
1819 call get_param(param_file,
"MOM",
"BULKMIXEDLAYER", bulkmixedlayer, &
1820 "If true, use a Kraus-Turner-like bulk mixed layer "//&
1821 "with transitional buffer layers. Layers 1 through "//&
1822 "NKML+NKBL have variable densities. There must be at "//&
1823 "least NKML+NKBL+1 layers if BULKMIXEDLAYER is true. "//&
1824 "BULKMIXEDLAYER can not be used with USE_REGRIDDING. "//&
1825 "The default is influenced by ENABLE_THERMODYNAMICS.", &
1826 default=use_temperature .and. .not.cs%use_ALE_algorithm)
1827 call get_param(param_file,
"MOM",
"THICKNESSDIFFUSE", cs%thickness_diffuse, &
1828 "If true, interface heights are diffused with a "//&
1829 "coefficient of KHTH.", default=.false.)
1830 call get_param(param_file,
"MOM",
"THICKNESSDIFFUSE_FIRST", &
1831 cs%thickness_diffuse_first, &
1832 "If true, do thickness diffusion before dynamics. "//&
1833 "This is only used if THICKNESSDIFFUSE is true.", &
1835 if (.not.cs%thickness_diffuse) cs%thickness_diffuse_first = .false.
1836 call get_param(param_file,
"MOM",
"BATHYMETRY_AT_VEL", bathy_at_vel, &
1837 "If true, there are separate values for the basin depths "//&
1838 "at velocity points. Otherwise the effects of topography "//&
1839 "are entirely determined from thickness points.", &
1841 call get_param(param_file,
"MOM",
"USE_WAVES", cs%UseWaves, default=.false., &
1844 call get_param(param_file,
"MOM",
"DEBUG", cs%debug, &
1845 "If true, write out verbose debugging data.", &
1846 default=.false., debuggingparam=.true.)
1847 call get_param(param_file,
"MOM",
"DEBUG_TRUNCATIONS", debug_truncations, &
1848 "If true, calculate all diagnostics that are useful for "//&
1849 "debugging truncations.", default=.false., debuggingparam=.true.)
1851 call get_param(param_file,
"MOM",
"DT", cs%dt, &
1852 "The (baroclinic) dynamics time step. The time-step that "//&
1853 "is actually used will be an integer fraction of the "//&
1854 "forcing time-step (DT_FORCING in ocean-only mode or the "//&
1855 "coupling timestep in coupled mode.)", units=
"s", scale=us%s_to_T, &
1856 fail_if_missing=.true.)
1857 call get_param(param_file,
"MOM",
"DT_THERM", cs%dt_therm, &
1858 "The thermodynamic and tracer advection time step. "//&
1859 "Ideally DT_THERM should be an integer multiple of DT "//&
1860 "and less than the forcing or coupling time-step, unless "//&
1861 "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//&
1862 "can be an integer multiple of the coupling timestep. By "//&
1863 "default DT_THERM is set to DT.", &
1864 units=
"s", scale=us%s_to_T, default=us%T_to_s*cs%dt)
1865 call get_param(param_file,
"MOM",
"THERMO_SPANS_COUPLING", cs%thermo_spans_coupling, &
1866 "If true, the MOM will take thermodynamic and tracer "//&
1867 "timesteps that can be longer than the coupling timestep. "//&
1868 "The actual thermodynamic timestep that is used in this "//&
1869 "case is the largest integer multiple of the coupling "//&
1870 "timestep that is less than or equal to DT_THERM.", default=.false.)
1872 if (bulkmixedlayer)
then 1873 cs%Hmix = -1.0 ; cs%Hmix_UV = -1.0
1875 call get_param(param_file,
"MOM",
"HMIX_SFC_PROP", cs%Hmix, &
1876 "If BULKMIXEDLAYER is false, HMIX_SFC_PROP is the depth "//&
1877 "over which to average to find surface properties like "//&
1878 "SST and SSS or density (but not surface velocities).", &
1879 units=
"m", default=1.0, scale=us%m_to_Z)
1880 call get_param(param_file,
"MOM",
"HMIX_UV_SFC_PROP", cs%Hmix_UV, &
1881 "If BULKMIXEDLAYER is false, HMIX_UV_SFC_PROP is the depth "//&
1882 "over which to average to find surface flow properties, "//&
1883 "SSU, SSV. A non-positive value indicates no averaging.", &
1884 units=
"m", default=0.0, scale=us%m_to_Z)
1886 call get_param(param_file,
"MOM",
"HFREEZE", cs%HFrz, &
1887 "If HFREEZE > 0, melt potential will be computed. The actual depth "//&
1888 "over which melt potential is computed will be min(HFREEZE, OBLD), "//&
1889 "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
1890 "melt potential will not be computed.", units=
"m", default=-1.0, scale=us%m_to_Z)
1891 call get_param(param_file,
"MOM",
"INTERPOLATE_P_SURF", cs%interp_p_surf, &
1892 "If true, linearly interpolate the surface pressure "//&
1893 "over the coupling time step, using the specified value "//&
1894 "at the end of the step.", default=.false.)
1897 call get_param(param_file,
"MOM",
"DTBT", dtbt, default=-0.98)
1898 default_val = us%T_to_s*cs%dt_therm ;
if (dtbt > 0.0) default_val = -1.0
1899 cs%dtbt_reset_period = -1.0
1900 call get_param(param_file,
"MOM",
"DTBT_RESET_PERIOD", cs%dtbt_reset_period, &
1901 "The period between recalculations of DTBT (if DTBT <= 0). "//&
1902 "If DTBT_RESET_PERIOD is negative, DTBT is set based "//&
1903 "only on information available at initialization. If 0, "//&
1904 "DTBT will be set every dynamics time step. The default "//&
1905 "is set by DT_THERM. This is only used if SPLIT is true.", &
1906 units=
"s", default=default_val, do_not_read=(dtbt > 0.0))
1910 use_frazil = .false. ; bound_salinity = .false.
1911 cs%tv%P_Ref = 2.0e7*us%kg_m3_to_R*us%m_s_to_L_T**2
1912 if (use_temperature)
then 1913 call get_param(param_file,
"MOM",
"FRAZIL", use_frazil, &
1914 "If true, water freezes if it gets too cold, and the "//&
1915 "accumulated heat deficit is returned in the "//&
1916 "surface state. FRAZIL is only used if "//&
1917 "ENABLE_THERMODYNAMICS is true.", default=.false.)
1918 call get_param(param_file,
"MOM",
"DO_GEOTHERMAL", use_geothermal, &
1919 "If true, apply geothermal heating.", default=.false.)
1920 call get_param(param_file,
"MOM",
"BOUND_SALINITY", bound_salinity, &
1921 "If true, limit salinity to being positive. (The sea-ice "//&
1922 "model may ask for more salt than is available and "//&
1923 "drive the salinity negative otherwise.)", default=.false.)
1924 call get_param(param_file,
"MOM",
"MIN_SALINITY", cs%tv%min_salinity, &
1925 "The minimum value of salinity when BOUND_SALINITY=True.", &
1926 units=
"PPT", default=0.0, do_not_log=.not.bound_salinity)
1927 call get_param(param_file,
"MOM",
"C_P", cs%tv%C_p, &
1928 "The heat capacity of sea water, approximated as a "//&
1929 "constant. This is only used if ENABLE_THERMODYNAMICS is "//&
1930 "true. The default value is from the TEOS-10 definition "//&
1931 "of conservative temperature.", units=
"J kg-1 K-1", &
1932 default=3991.86795711963, scale=us%J_kg_to_Q)
1933 call get_param(param_file,
"MOM",
"USE_PSURF_IN_EOS", cs%use_p_surf_in_EOS, &
1934 "If true, always include the surface pressure contributions "//&
1935 "in equation of state calculations.", default=.true.)
1937 if (use_eos)
call get_param(param_file,
"MOM",
"P_REF", cs%tv%P_Ref, &
1938 "The pressure that is used for calculating the coordinate "//&
1939 "density. (1 Pa = 1e4 dbar, so 2e7 is commonly used.) "//&
1940 "This is only used if USE_EOS and ENABLE_THERMODYNAMICS are true.", &
1941 units=
"Pa", default=2.0e7, scale=us%kg_m3_to_R*us%m_s_to_L_T**2)
1943 if (bulkmixedlayer)
then 1944 call get_param(param_file,
"MOM",
"NKML", nkml, &
1945 "The number of sublayers within the mixed layer if "//&
1946 "BULKMIXEDLAYER is true.", units=
"nondim", default=2)
1947 call get_param(param_file,
"MOM",
"NKBL", nkbl, &
1948 "The number of layers that are used as variable density "//&
1949 "buffer layers if BULKMIXEDLAYER is true.", units=
"nondim", &
1953 call get_param(param_file,
"MOM",
"GLOBAL_INDEXING", global_indexing, &
1954 "If true, use a global lateral indexing convention, so "//&
1955 "that corresponding points on different processors have "//&
1956 "the same index. This does not work with static memory.", &
1957 default=.false., layoutparam=.true.)
1958 #ifdef STATIC_MEMORY_ 1959 if (global_indexing)
call mom_error(fatal,
"initialize_MOM: "//&
1960 "GLOBAL_INDEXING can not be true with STATIC_MEMORY.")
1962 call get_param(param_file,
"MOM",
"FIRST_DIRECTION", first_direction, &
1963 "An integer that indicates which direction goes first "//&
1964 "in parts of the code that use directionally split "//&
1965 "updates, with even numbers (or 0) used for x- first "//&
1966 "and odd numbers used for y-first.", default=0)
1968 call get_param(param_file,
"MOM",
"CHECK_BAD_SURFACE_VALS", cs%check_bad_sfc_vals, &
1969 "If true, check the surface state for ridiculous values.", &
1971 if (cs%check_bad_sfc_vals)
then 1972 call get_param(param_file,
"MOM",
"BAD_VAL_SSH_MAX", cs%bad_val_ssh_max, &
1973 "The value of SSH above which a bad value message is "//&
1974 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
1975 units=
"m", default=20.0, scale=us%m_to_Z)
1976 call get_param(param_file,
"MOM",
"BAD_VAL_SSS_MAX", cs%bad_val_sss_max, &
1977 "The value of SSS above which a bad value message is "//&
1978 "triggered, if CHECK_BAD_SURFACE_VALS is true.", units=
"PPT", &
1980 call get_param(param_file,
"MOM",
"BAD_VAL_SST_MAX", cs%bad_val_sst_max, &
1981 "The value of SST above which a bad value message is "//&
1982 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
1983 units=
"deg C", default=45.0)
1984 call get_param(param_file,
"MOM",
"BAD_VAL_SST_MIN", cs%bad_val_sst_min, &
1985 "The value of SST below which a bad value message is "//&
1986 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
1987 units=
"deg C", default=-2.1)
1988 call get_param(param_file,
"MOM",
"BAD_VAL_COLUMN_THICKNESS", cs%bad_val_col_thick, &
1989 "The value of column thickness below which a bad value message is "//&
1990 "triggered, if CHECK_BAD_SURFACE_VALS is true.", &
1991 units=
"m", default=0.0, scale=us%m_to_Z)
1993 call get_param(param_file,
"MOM",
"DEFAULT_2018_ANSWERS", default_2018_answers, &
1994 "This sets the default value for the various _2018_ANSWERS parameters.", &
1996 call get_param(param_file,
"MOM",
"SURFACE_2018_ANSWERS", cs%answers_2018, &
1997 "If true, use expressions for the surface properties that recover the answers "//&
1998 "from the end of 2018. Otherwise, use more appropriate expressions that differ "//&
1999 "at roundoff for non-Boussinesq cases.", default=default_2018_answers)
2001 call get_param(param_file,
"MOM",
"SAVE_INITIAL_CONDS", save_ic, &
2002 "If true, write the initial conditions to a file given "//&
2003 "by IC_OUTPUT_FILE.", default=.false.)
2004 call get_param(param_file,
"MOM",
"IC_OUTPUT_FILE", cs%IC_file, &
2005 "The file into which to write the initial conditions.", &
2007 call get_param(param_file,
"MOM",
"WRITE_GEOM", write_geom, &
2008 "If =0, never write the geometry and vertical grid files. "//&
2009 "If =1, write the geometry and vertical grid files only for "//&
2010 "a new simulation. If =2, always write the geometry and "//&
2011 "vertical grid files. Other values are invalid.", default=1)
2012 if (write_geom<0 .or. write_geom>2)
call mom_error(fatal,
"MOM: "//&
2013 "WRITE_GEOM must be equal to 0, 1 or 2.")
2014 write_geom_files = ((write_geom==2) .or. ((write_geom==1) .and. &
2015 ((dirs%input_filename(1:1)==
'n') .and. (len_trim(dirs%input_filename)==1))))
2021 if (cs%use_ALE_algorithm .and. bulkmixedlayer)
call mom_error(fatal, &
2022 "MOM: BULKMIXEDLAYER can not currently be used with the ALE algorithm.")
2023 if (cs%use_ALE_algorithm .and. .not.use_temperature)
call mom_error(fatal, &
2024 "MOM: At this time, USE_EOS should be True when using the ALE algorithm.")
2025 if (cs%adiabatic .and. use_temperature)
call mom_error(warning, &
2026 "MOM: ADIABATIC and ENABLE_THERMODYNAMICS both defined is usually unwise.")
2027 if (use_eos .and. .not.use_temperature)
call mom_error(fatal, &
2028 "MOM: ENABLE_THERMODYNAMICS must be defined to use USE_EOS.")
2029 if (cs%adiabatic .and. bulkmixedlayer)
call mom_error(fatal, &
2030 "MOM: ADIABATIC and BULKMIXEDLAYER can not both be defined.")
2031 if (bulkmixedlayer .and. .not.use_eos)
call mom_error(fatal, &
2032 "initialize_MOM: A bulk mixed layer can only be used with T & S as "//&
2033 "state variables. Add USE_EOS = True to MOM_input.")
2035 call get_param(param_file,
'MOM',
"ICE_SHELF", use_ice_shelf, default=.false., do_not_log=.true.)
2036 if (use_ice_shelf)
then 2037 inputdir =
"." ;
call get_param(param_file,
'MOM',
"INPUTDIR", inputdir)
2038 inputdir = slasher(inputdir)
2039 call get_param(param_file,
'MOM',
"ICE_THICKNESS_FILE", ice_shelf_file, &
2040 "The file from which the ice bathymetry and area are read.", &
2041 fail_if_missing=.true.)
2042 call get_param(param_file,
'MOM',
"ICE_AREA_VARNAME", area_varname, &
2043 "The name of the area variable in ICE_THICKNESS_FILE.", &
2044 fail_if_missing=.true.)
2048 cs%ensemble_ocean=.false.
2049 call get_param(param_file,
"MOM",
"ENSEMBLE_OCEAN", cs%ensemble_ocean, &
2050 "If False, The model is being run in serial mode as a single realization. "//&
2051 "If True, The current model realization is part of a larger ensemble "//&
2052 "and at the end of step MOM, we will perform a gather of the ensemble "//&
2053 "members for statistical evaluation and/or data assimilation.", default=.false.)
2055 call calltree_waypoint(
"MOM parameters read (initialize_MOM)")
2058 call get_param(param_file,
"MOM",
"ROTATE_INDEX", cs%rotate_index, &
2059 "Enable rotation of the horizontal indices.", default=.false., &
2060 debuggingparam=.true.)
2061 if (cs%rotate_index)
then 2067 if (num_pes() /= 1) &
2068 call mom_error(fatal,
"Index rotation is only supported on one PE.")
2070 call get_param(param_file,
"MOM",
"INDEX_TURNS", turns, &
2071 "Number of counterclockwise quarter-turn index rotations.", &
2072 default=1, debuggingparam=.true.)
2076 #ifdef SYMMETRIC_MEMORY_ 2082 #ifdef STATIC_MEMORY_ 2083 call mom_domains_init(g_in%domain, param_file, symmetric=symmetric, &
2084 static_memory=.true., nihalo=nihalo_, njhalo=njhalo_, &
2085 niglobal=niglobal_, njglobal=njglobal_, niproc=niproc_, &
2088 call mom_domains_init(g_in%domain, param_file, symmetric=symmetric, &
2089 domain_name=
"MOM_in")
2094 if (cs%rotate_index)
then 2096 call clone_mom_domain(g_in%Domain, cs%G%Domain, turns=turns)
2097 first_direction = modulo(first_direction + turns, 2)
2104 if (test_grid_copy .and. cs%rotate_index) &
2105 call mom_error(fatal,
"Grid cannot be copied during index rotation.")
2107 if (test_grid_copy)
then ;
allocate(g)
2108 else ; g => cs%G ;
endif 2110 call calltree_waypoint(
"domains initialized (initialize_MOM)")
2112 call mom_debugging_init(param_file)
2113 call diag_mediator_infrastructure_init()
2114 call mom_io_init(param_file)
2117 call hor_index_init(g_in%Domain, hi_in, param_file, &
2118 local_indexing=.not.global_indexing)
2119 call create_dyn_horgrid(dg_in, hi_in, bathymetry_at_vel=bathy_at_vel)
2120 call clone_mom_domain(g_in%Domain, dg_in%Domain)
2123 call mom_initialize_fixed(dg_in, us, obc_in, param_file, write_geom_files, &
2124 dirs%output_directory)
2126 call calltree_waypoint(
"returned from MOM_initialize_fixed() (initialize_MOM)")
2129 if (cs%rotate_index)
then 2131 call rotate_hor_index(hi_in, turns, hi)
2132 call create_dyn_horgrid(dg, hi, bathymetry_at_vel=bathy_at_vel)
2133 call clone_mom_domain(g%Domain, dg%Domain)
2134 call rotate_dyngrid(dg_in, dg, us, turns)
2135 if (
associated(obc_in))
then 2137 if (modulo(turns, 4) /= 1) &
2138 call mom_error(fatal,
"OBC index rotation of 180 and 270 degrees is " &
2139 //
"not yet unsupported.")
2141 call rotate_obc_config(obc_in, dg_in, cs%OBC, dg, turns)
2149 call verticalgridinit( param_file, cs%GV, us )
2153 if (cs%debug .or. dg%symmetric) &
2154 call clone_mom_domain(dg%Domain, dg%Domain_aux, symmetric=.false.)
2156 call calltree_waypoint(
"grids initialized (initialize_MOM)")
2158 call mom_timing_init(cs)
2160 if (
associated(cs%OBC))
call call_obc_register(param_file, cs%update_OBC_CSp, cs%OBC)
2162 call tracer_registry_init(param_file, cs%tracer_Reg)
2165 is = dg%isc ; ie = dg%iec ; js = dg%jsc ; je = dg%jec ; nz = gv%ke
2166 isd = dg%isd ; ied = dg%ied ; jsd = dg%jsd ; jed = dg%jed
2167 isdb = dg%IsdB ; iedb = dg%IedB ; jsdb = dg%JsdB ; jedb = dg%JedB
2168 alloc_(cs%u(isdb:iedb,jsd:jed,nz)) ; cs%u(:,:,:) = 0.0
2169 alloc_(cs%v(isd:ied,jsdb:jedb,nz)) ; cs%v(:,:,:) = 0.0
2170 alloc_(cs%h(isd:ied,jsd:jed,nz)) ; cs%h(:,:,:) = gv%Angstrom_H
2171 alloc_(cs%uh(isdb:iedb,jsd:jed,nz)) ; cs%uh(:,:,:) = 0.0
2172 alloc_(cs%vh(isd:ied,jsdb:jedb,nz)) ; cs%vh(:,:,:) = 0.0
2173 if (use_temperature)
then 2174 alloc_(cs%T(isd:ied,jsd:jed,nz)) ; cs%T(:,:,:) = 0.0
2175 alloc_(cs%S(isd:ied,jsd:jed,nz)) ; cs%S(:,:,:) = 0.0
2176 cs%tv%T => cs%T ; cs%tv%S => cs%S
2177 if (cs%tv%T_is_conT)
then 2178 vd_t = var_desc(name=
"contemp", units=
"Celsius", longname=
"Conservative Temperature", &
2179 cmor_field_name=
"thetao", cmor_longname=
"Sea Water Potential Temperature", &
2180 conversion=us%Q_to_J_kg*cs%tv%C_p)
2182 vd_t = var_desc(name=
"temp", units=
"degC", longname=
"Potential Temperature", &
2183 cmor_field_name=
"thetao", cmor_longname=
"Sea Water Potential Temperature", &
2184 conversion=us%Q_to_J_kg*cs%tv%C_p)
2186 if (cs%tv%S_is_absS)
then 2187 vd_s = var_desc(name=
"abssalt",units=
"g kg-1",longname=
"Absolute Salinity", &
2188 cmor_field_name=
"so", cmor_longname=
"Sea Water Salinity", &
2191 vd_s = var_desc(name=
"salt",units=
"psu",longname=
"Salinity", &
2192 cmor_field_name=
"so", cmor_longname=
"Sea Water Salinity", &
2197 s_flux_units = get_tr_flux_units(gv,
"psu")
2198 conv2watt = gv%H_to_kg_m2 * us%Q_to_J_kg*cs%tv%C_p
2199 if (gv%Boussinesq)
then 2200 conv2salt = gv%H_to_m
2202 conv2salt = gv%H_to_kg_m2
2204 call register_tracer(cs%tv%T, cs%tracer_Reg, param_file, dg%HI, gv, &
2205 tr_desc=vd_t, registry_diags=.true., flux_nameroot=
'T', &
2206 flux_units=
'W', flux_longname=
'Heat', &
2207 flux_scale=conv2watt, convergence_units=
'W m-2', &
2208 convergence_scale=conv2watt, cmor_tendprefix=
"opottemp", diag_form=2)
2209 call register_tracer(cs%tv%S, cs%tracer_Reg, param_file, dg%HI, gv, &
2210 tr_desc=vd_s, registry_diags=.true., flux_nameroot=
'S', &
2211 flux_units=s_flux_units, flux_longname=
'Salt', &
2212 flux_scale=conv2salt, convergence_units=
'kg m-2 s-1', &
2213 convergence_scale=0.001*gv%H_to_kg_m2, cmor_tendprefix=
"osalt", diag_form=2)
2225 if (cs%rotate_index .and.
associated(obc_in)) &
2226 call register_temp_salt_segments(gv, obc_in, cs%tracer_Reg, param_file)
2227 if (
associated(cs%OBC)) &
2228 call register_temp_salt_segments(gv, cs%OBC, cs%tracer_Reg, param_file)
2230 if (use_frazil)
then 2231 allocate(cs%tv%frazil(isd:ied,jsd:jed)) ; cs%tv%frazil(:,:) = 0.0
2233 if (bound_salinity)
then 2234 allocate(cs%tv%salt_deficit(isd:ied,jsd:jed)) ; cs%tv%salt_deficit(:,:) = 0.0
2237 if (bulkmixedlayer .or. use_temperature)
then 2238 allocate(cs%Hml(isd:ied,jsd:jed)) ; cs%Hml(:,:) = 0.0
2241 if (bulkmixedlayer)
then 2242 gv%nkml = nkml ; gv%nk_rho_varies = nkml + nkbl
2244 gv%nkml = 0 ; gv%nk_rho_varies = 0
2246 if (cs%use_ALE_algorithm)
then 2247 call get_param(param_file,
"MOM",
"NK_RHO_VARIES", gv%nk_rho_varies, default=0)
2250 alloc_(cs%uhtr(isdb:iedb,jsd:jed,nz)) ; cs%uhtr(:,:,:) = 0.0
2251 alloc_(cs%vhtr(isd:ied,jsdb:jedb,nz)) ; cs%vhtr(:,:,:) = 0.0
2252 cs%t_dyn_rel_adv = 0.0 ; cs%t_dyn_rel_thermo = 0.0 ; cs%t_dyn_rel_diag = 0.0
2254 if (debug_truncations)
then 2255 allocate(cs%u_prev(isdb:iedb,jsd:jed,nz)) ; cs%u_prev(:,:,:) = 0.0
2256 allocate(cs%v_prev(isd:ied,jsdb:jedb,nz)) ; cs%v_prev(:,:,:) = 0.0
2257 mom_internal_state%u_prev => cs%u_prev
2258 mom_internal_state%v_prev => cs%v_prev
2259 call safe_alloc_ptr(cs%ADp%du_dt_visc,isdb,iedb,jsd,jed,nz)
2260 call safe_alloc_ptr(cs%ADp%dv_dt_visc,isd,ied,jsdb,jedb,nz)
2261 if (.not.cs%adiabatic)
then 2262 call safe_alloc_ptr(cs%ADp%du_dt_dia,isdb,iedb,jsd,jed,nz)
2263 call safe_alloc_ptr(cs%ADp%dv_dt_dia,isd,ied,jsdb,jedb,nz)
2267 mom_internal_state%u => cs%u ; mom_internal_state%v => cs%v
2268 mom_internal_state%h => cs%h
2269 mom_internal_state%uh => cs%uh ; mom_internal_state%vh => cs%vh
2270 if (use_temperature)
then 2271 mom_internal_state%T => cs%T ; mom_internal_state%S => cs%S
2274 cs%CDp%uh => cs%uh ; cs%CDp%vh => cs%vh
2276 if (cs%interp_p_surf)
then 2277 allocate(cs%p_surf_prev(isd:ied,jsd:jed)) ; cs%p_surf_prev(:,:) = 0.0
2280 alloc_(cs%ssh_rint(isd:ied,jsd:jed)) ; cs%ssh_rint(:,:) = 0.0
2281 alloc_(cs%ave_ssh_ibc(isd:ied,jsd:jed)) ; cs%ave_ssh_ibc(:,:) = 0.0
2282 alloc_(cs%eta_av_bc(isd:ied,jsd:jed)) ; cs%eta_av_bc(:,:) = 0.0
2283 cs%time_in_cycle = 0.0 ; cs%time_in_thermo_cycle = 0.0
2288 if (use_eos)
call eos_init(param_file, cs%tv%eqn_of_state, us)
2289 if (use_temperature)
then 2290 allocate(cs%tv%TempxPmE(isd:ied,jsd:jed)) ; cs%tv%TempxPmE(:,:) = 0.0
2291 if (use_geothermal)
then 2292 allocate(cs%tv%internal_heat(isd:ied,jsd:jed)) ; cs%tv%internal_heat(:,:) = 0.0
2295 call calltree_waypoint(
"state variables allocated (initialize_MOM)")
2299 call restart_init(param_file, restart_csp)
2300 call set_restart_fields(gv, us, param_file, cs, restart_csp)
2302 call register_restarts_dyn_split_rk2(dg%HI, gv, param_file, &
2303 cs%dyn_split_RK2_CSp, restart_csp, cs%uh, cs%vh)
2304 elseif (cs%use_RK2)
then 2305 call register_restarts_dyn_unsplit_rk2(dg%HI, gv, param_file, &
2306 cs%dyn_unsplit_RK2_CSp, restart_csp)
2308 call register_restarts_dyn_unsplit(dg%HI, gv, param_file, &
2309 cs%dyn_unsplit_CSp, restart_csp)
2314 call call_tracer_register(dg%HI, gv, us, param_file, cs%tracer_flow_CSp, &
2315 cs%tracer_Reg, restart_csp)
2317 call meke_alloc_register_restart(dg%HI, param_file, cs%MEKE, restart_csp)
2318 call set_visc_register_restarts(dg%HI, gv, param_file, cs%visc, restart_csp)
2319 call mixedlayer_restrat_register_restarts(dg%HI, param_file, &
2320 cs%mixedlayer_restrat_CSp, restart_csp)
2322 if (
associated(cs%OBC)) &
2323 call open_boundary_register_restarts(dg%HI, gv, cs%OBC, cs%tracer_Reg, &
2324 param_file, restart_csp, use_temperature)
2326 call calltree_waypoint(
"restart registration complete (initialize_MOM)")
2329 call cpu_clock_begin(id_clock_mom_init)
2330 call mom_initialize_coord(gv, us, param_file, write_geom_files, &
2331 dirs%output_directory, cs%tv, dg%max_depth)
2332 call calltree_waypoint(
"returned from MOM_initialize_coord() (initialize_MOM)")
2334 if (cs%use_ALE_algorithm)
then 2335 call ale_init(param_file, gv, us, dg%max_depth, cs%ALE_CSp)
2336 call calltree_waypoint(
"returned from ALE_init() (initialize_MOM)")
2346 if (cs%rotate_index)
then 2347 call mom_grid_init(g, param_file, us, hi, bathymetry_at_vel=bathy_at_vel)
2348 call copy_dyngrid_to_mom_grid(dg, g, us)
2349 call destroy_dyn_horgrid(dg)
2351 call mom_grid_init(g_in, param_file, us, hi_in, bathymetry_at_vel=bathy_at_vel)
2352 call copy_dyngrid_to_mom_grid(dg_in, g_in, us)
2353 call destroy_dyn_horgrid(dg_in)
2356 call set_first_direction(g, first_direction)
2358 if (cs%debug .or. g%symmetric)
then 2359 call clone_mom_domain(g%Domain, g%Domain_aux, symmetric=.false.)
2360 else ; g%Domain_aux => g%Domain ;
endif 2365 if (cs%rotate_index)
then 2368 allocate(u_in(g_in%IsdB:g_in%IedB, g_in%jsd:g_in%jed, nz))
2369 allocate(v_in(g_in%isd:g_in%ied, g_in%JsdB:g_in%JedB, nz))
2370 allocate(h_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
2373 h_in(:,:,:) = gv%Angstrom_H
2375 if (use_temperature)
then 2376 allocate(t_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
2377 allocate(s_in(g_in%isd:g_in%ied, g_in%jsd:g_in%jed, nz))
2385 call mom_initialize_state(u_in, v_in, h_in, cs%tv, time, g_in, gv, us, &
2386 param_file, dirs, restart_csp, cs%ALE_CSp, cs%tracer_Reg, &
2387 sponge_in_csp, ale_sponge_in_csp, obc_in, time_in)
2389 if (use_temperature)
then 2394 call rotate_initial_state(u_in, v_in, h_in, t_in, s_in, use_temperature, &
2395 turns, cs%u, cs%v, cs%h, cs%T, cs%S)
2397 if (
associated(sponge_in_csp))
then 2399 call mom_error(fatal,
"Index rotation of non-ALE sponge is not yet implemented.")
2402 if (
associated(ale_sponge_in_csp))
then 2403 call rotate_ale_sponge(ale_sponge_in_csp, g_in, cs%ALE_sponge_CSp, g, turns, param_file)
2404 call update_ale_sponge_field(cs%ALE_sponge_CSp, t_in, g, gv, cs%T)
2405 call update_ale_sponge_field(cs%ALE_sponge_CSp, s_in, g, gv, cs%S)
2408 if (
associated(obc_in)) &
2409 call rotate_obc_init(obc_in, g, gv, us, param_file, cs%tv, restart_csp, cs%OBC)
2414 if (use_temperature)
then 2419 call mom_initialize_state(cs%u, cs%v, cs%h, cs%tv, time, g, gv, us, &
2420 param_file, dirs, restart_csp, cs%ALE_CSp, cs%tracer_Reg, &
2421 cs%sponge_CSp, cs%ALE_sponge_CSp, cs%OBC, time_in)
2424 call cpu_clock_end(id_clock_mom_init)
2425 call calltree_waypoint(
"returned from MOM_initialize_state() (initialize_MOM)")
2437 if (test_grid_copy)
then 2439 call create_dyn_horgrid(dg, g%HI)
2440 call clone_mom_domain(g%Domain, dg%Domain)
2442 call clone_mom_domain(g%Domain, cs%G%Domain)
2443 call mom_grid_init(cs%G, param_file, us)
2445 call copy_mom_grid_to_dyngrid(g, dg, us)
2446 call copy_dyngrid_to_mom_grid(dg, cs%G, us)
2448 call destroy_dyn_horgrid(dg)
2449 call mom_grid_end(g) ;
deallocate(g)
2452 if (cs%debug .or. cs%G%symmetric)
then 2453 call clone_mom_domain(cs%G%Domain, cs%G%Domain_aux, symmetric=.false.)
2454 else ; cs%G%Domain_aux => cs%G%Domain ;
endif 2462 if (ale_remap_init_conds(cs%ALE_CSp) .and. .not. query_initialized(cs%h,
"h",restart_csp))
then 2467 call uvchksum(
"Pre ALE adjust init cond [uv]", &
2468 cs%u, cs%v, g%HI, haloshift=1)
2469 call hchksum(cs%h,
"Pre ALE adjust init cond h", g%HI, haloshift=1, scale=gv%H_to_m)
2471 call calltree_waypoint(
"Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)")
2472 call adjustgridforintegrity(cs%ALE_CSp, g, gv, cs%h )
2473 call calltree_waypoint(
"Calling ALE_main() to remap initial conditions (initialize_MOM)")
2474 if (use_ice_shelf)
then 2475 filename = trim(inputdir)//trim(ice_shelf_file)
2476 if (.not.file_exists(filename, g%Domain))
call mom_error(fatal, &
2477 "MOM: Unable to open "//trim(filename))
2479 allocate(area_shelf_h(isd:ied,jsd:jed))
2480 allocate(frac_shelf_h(isd:ied,jsd:jed))
2481 call mom_read_data(filename, trim(area_varname), area_shelf_h, g%Domain, scale=us%m_to_L**2)
2483 frac_shelf_h(:,:) = 0.0
2485 do j=jsd,jed ;
do i=isd,ied
2486 if (g%areaT(i,j) > 0.0) &
2487 frac_shelf_h(i,j) = area_shelf_h(i,j) / g%areaT(i,j)
2490 shelf_area => frac_shelf_h
2491 call ale_main(g, gv, us, cs%h, cs%u, cs%v, cs%tv, cs%tracer_Reg, cs%ALE_CSp, &
2492 cs%OBC, frac_shelf_h=shelf_area)
2494 call ale_main( g, gv, us, cs%h, cs%u, cs%v, cs%tv, cs%tracer_Reg, cs%ALE_CSp, cs%OBC)
2497 call cpu_clock_begin(id_clock_pass_init)
2498 call create_group_pass(tmp_pass_uv_t_s_h, cs%u, cs%v, g%Domain)
2499 if (use_temperature)
then 2500 call create_group_pass(tmp_pass_uv_t_s_h, cs%tv%T, g%Domain, halo=1)
2501 call create_group_pass(tmp_pass_uv_t_s_h, cs%tv%S, g%Domain, halo=1)
2503 call create_group_pass(tmp_pass_uv_t_s_h, cs%h, g%Domain, halo=1)
2504 call do_group_pass(tmp_pass_uv_t_s_h, g%Domain)
2505 call cpu_clock_end(id_clock_pass_init)
2508 call uvchksum(
"Post ALE adjust init cond [uv]", cs%u, cs%v, g%HI, haloshift=1)
2509 call hchksum(cs%h,
"Post ALE adjust init cond h", g%HI, haloshift=1, scale=gv%H_to_m)
2512 if ( cs%use_ALE_algorithm )
call ale_updateverticalgridtype( cs%ALE_CSp, gv )
2516 call diag_mediator_init(g, gv, us, gv%ke, param_file, diag, doc_file_dir=dirs%output_directory)
2517 if (
present(diag_ptr)) diag_ptr => cs%diag
2522 call diag_masks_set(g, gv%ke, diag)
2526 call diag_set_state_ptrs(cs%h, cs%T, cs%S, cs%tv%eqn_of_state, diag)
2530 call set_axes_info(g, gv, us, param_file, diag)
2535 call diag_update_remap_grids(diag)
2538 call diag_grid_storage_init(cs%diag_pre_sync, g, diag)
2539 call diag_grid_storage_init(cs%diag_pre_dyn, g, diag)
2545 call set_masks_for_axes(g, diag)
2548 call write_static_fields(g, gv, us, cs%tv, cs%diag)
2549 call calltree_waypoint(
"static fields written (initialize_MOM)")
2552 call register_cell_measure(g, cs%diag, time)
2554 call cpu_clock_begin(id_clock_mom_init)
2555 if (cs%use_ALE_algorithm)
then 2556 call ale_writecoordinatefile( cs%ALE_CSp, gv, dirs%output_directory )
2558 call cpu_clock_end(id_clock_mom_init)
2559 call calltree_waypoint(
"ALE initialized (initialize_MOM)")
2561 cs%useMEKE = meke_init(time, g, us, param_file, diag, cs%MEKE_CSp, cs%MEKE, restart_csp)
2563 call varmix_init(time, g, gv, us, param_file, diag, cs%VarMix)
2564 call set_visc_init(time, g, gv, us, param_file, diag, cs%visc, cs%set_visc_CSp, restart_csp, cs%OBC)
2565 call thickness_diffuse_init(time, g, gv, us, param_file, diag, cs%CDp, cs%thickness_diffuse_CSp)
2568 allocate(eta(szi_(g),szj_(g))) ; eta(:,:) = 0.0
2569 call initialize_dyn_split_rk2(cs%u, cs%v, cs%h, cs%uh, cs%vh, eta, time, &
2570 g, gv, us, param_file, diag, cs%dyn_split_RK2_CSp, restart_csp, &
2571 cs%dt, cs%ADp, cs%CDp, mom_internal_state, cs%VarMix, cs%MEKE, &
2572 cs%thickness_diffuse_CSp, &
2573 cs%OBC, cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp, &
2574 cs%visc, dirs, cs%ntrunc, calc_dtbt=calc_dtbt, cont_stencil=cs%cont_stencil)
2575 if (cs%dtbt_reset_period > 0.0)
then 2576 cs%dtbt_reset_interval = real_to_time(cs%dtbt_reset_period)
2578 cs%dtbt_reset_time = time_init + cs%dtbt_reset_interval * &
2579 ((time - time_init) / cs%dtbt_reset_interval)
2580 if ((cs%dtbt_reset_time > time) .and. calc_dtbt)
then 2584 cs%dtbt_reset_time = cs%dtbt_reset_time - cs%dtbt_reset_interval
2587 elseif (cs%use_RK2)
then 2588 call initialize_dyn_unsplit_rk2(cs%u, cs%v, cs%h, time, g, gv, us, &
2589 param_file, diag, cs%dyn_unsplit_RK2_CSp, restart_csp, &
2590 cs%ADp, cs%CDp, mom_internal_state, cs%MEKE, cs%OBC, &
2591 cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp, cs%visc, dirs, &
2592 cs%ntrunc, cont_stencil=cs%cont_stencil)
2594 call initialize_dyn_unsplit(cs%u, cs%v, cs%h, time, g, gv, us, &
2595 param_file, diag, cs%dyn_unsplit_CSp, restart_csp, &
2596 cs%ADp, cs%CDp, mom_internal_state, cs%MEKE, cs%OBC, &
2597 cs%update_OBC_CSp, cs%ALE_CSp, cs%set_visc_CSp, cs%visc, dirs, &
2598 cs%ntrunc, cont_stencil=cs%cont_stencil)
2601 call calltree_waypoint(
"dynamics initialized (initialize_MOM)")
2603 cs%mixedlayer_restrat = mixedlayer_restrat_init(time, g, gv, us, param_file, diag, &
2604 cs%mixedlayer_restrat_CSp, restart_csp)
2605 if (cs%mixedlayer_restrat)
then 2606 if (.not.(bulkmixedlayer .or. cs%use_ALE_algorithm)) &
2607 call mom_error(fatal,
"MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.")
2609 if (.not. cs%diabatic_first .and.
associated(cs%visc%MLD)) &
2610 call pass_var(cs%visc%MLD, g%domain, halo=1)
2613 call mom_diagnostics_init(mom_internal_state, cs%ADp, cs%CDp, time, g, gv, us, &
2614 param_file, diag, cs%diagnostics_CSp, cs%tv)
2615 call diag_copy_diag_to_storage(cs%diag_pre_sync, cs%h, cs%diag)
2617 if (
associated(cs%sponge_CSp)) &
2618 call init_sponge_diags(time, g, gv, us, diag, cs%sponge_CSp)
2620 if (
associated(cs%ALE_sponge_CSp)) &
2621 call init_ale_sponge_diags(time, g, diag, cs%ALE_sponge_CSp)
2623 if (cs%adiabatic)
then 2624 call adiabatic_driver_init(time, g, param_file, diag, cs%diabatic_CSp, &
2627 call diabatic_driver_init(time, g, gv, us, param_file, cs%use_ALE_algorithm, diag, &
2628 cs%ADp, cs%CDp, cs%diabatic_CSp, cs%tracer_flow_CSp, &
2629 cs%sponge_CSp, cs%ALE_sponge_CSp)
2632 call tracer_advect_init(time, g, us, param_file, diag, cs%tracer_adv_CSp)
2633 call tracer_hor_diff_init(time, g, us, param_file, diag, cs%tv%eqn_of_state, cs%diabatic_CSp, &
2636 call lock_tracer_registry(cs%tracer_Reg)
2637 call calltree_waypoint(
"tracer registry now locked (initialize_MOM)")
2640 call register_surface_diags(time, g, us, cs%sfc_IDs, cs%diag, cs%tv)
2641 call register_diags(time, g, gv, us, cs%IDs, cs%diag)
2642 call register_transport_diags(time, g, gv, us, cs%transport_IDs, cs%diag)
2643 call register_tracer_diagnostics(cs%tracer_Reg, cs%h, time, diag, g, gv, us, &
2644 cs%use_ALE_algorithm)
2645 if (cs%use_ALE_algorithm)
then 2646 call ale_register_diags(time, g, gv, us, diag, cs%ALE_CSp)
2650 new_sim = is_new_run(restart_csp)
2651 call tracer_flow_control_init(.not.new_sim, time, g, gv, us, cs%h, param_file, &
2652 cs%diag, cs%OBC, cs%tracer_flow_CSp, cs%sponge_CSp, &
2653 cs%ALE_sponge_CSp, cs%tv)
2654 if (
present(tracer_flow_csp)) tracer_flow_csp => cs%tracer_flow_CSp
2658 if (
present(offline_tracer_mode)) offline_tracer_mode=cs%offline_tracer_mode
2660 if (cs%offline_tracer_mode)
then 2662 call offline_transport_init(param_file, cs%offline_CSp, cs%diabatic_CSp, g, gv, us)
2663 call insert_offline_main( cs=cs%offline_CSp, ale_csp=cs%ALE_CSp, diabatic_csp=cs%diabatic_CSp, &
2664 diag=cs%diag, obc=cs%OBC, tracer_adv_csp=cs%tracer_adv_CSp, &
2665 tracer_flow_csp=cs%tracer_flow_CSp, tracer_reg=cs%tracer_Reg, &
2666 tv=cs%tv, x_before_y = (mod(first_direction,2)==0), debug=cs%debug )
2667 call register_diags_offline_transport(time, cs%diag, cs%offline_CSp)
2671 call cpu_clock_begin(id_clock_pass_init)
2672 dynamics_stencil = min(3, g%Domain%nihalo, g%Domain%njhalo)
2673 call create_group_pass(pass_uv_t_s_h, cs%u, cs%v, g%Domain, halo=dynamics_stencil)
2674 if (use_temperature)
then 2675 call create_group_pass(pass_uv_t_s_h, cs%tv%T, g%Domain, halo=dynamics_stencil)
2676 call create_group_pass(pass_uv_t_s_h, cs%tv%S, g%Domain, halo=dynamics_stencil)
2678 call create_group_pass(pass_uv_t_s_h, cs%h, g%Domain, halo=dynamics_stencil)
2680 call do_group_pass(pass_uv_t_s_h, g%Domain)
2682 if (
associated(cs%visc%Kv_shear)) &
2683 call pass_var(cs%visc%Kv_shear, g%Domain, to_all+omit_corners, halo=1)
2685 if (
associated(cs%visc%Kv_slow)) &
2686 call pass_var(cs%visc%Kv_slow, g%Domain, to_all+omit_corners, halo=1)
2688 call cpu_clock_end(id_clock_pass_init)
2690 call register_obsolete_diagnostics(param_file, cs%diag)
2692 if (use_frazil)
then 2693 if (query_initialized(cs%tv%frazil,
"frazil", restart_csp))
then 2695 if ((us%kg_m3_to_R_restart*us%m_to_Z_restart*us%J_kg_to_Q_restart /= 0.0) .and. &
2696 ((us%J_kg_to_Q*us%kg_m3_to_R*us%m_to_Z) /= &
2697 (us%J_kg_to_Q_restart*us%kg_m3_to_R_restart*us%m_to_Z_restart)) )
then 2698 qrz_rescale = (us%J_kg_to_Q*us%kg_m3_to_R*us%m_to_Z) / &
2699 (us%J_kg_to_Q_restart*us%kg_m3_to_R_restart*us%m_to_Z_restart)
2700 do j=js,je ;
do i=is,ie
2701 cs%tv%frazil(i,j) = qrz_rescale * cs%tv%frazil(i,j)
2705 cs%tv%frazil(:,:) = 0.0
2709 if (cs%interp_p_surf)
then 2710 cs%p_surf_prev_set = query_initialized(cs%p_surf_prev,
"p_surf_prev",restart_csp)
2712 if (cs%p_surf_prev_set)
then 2714 if ((us%kg_m3_to_R_restart*us%s_to_T_restart*us%m_to_L_restart /= 0.0) .and. &
2715 ((us%kg_m3_to_R*(us%m_to_L*us%s_to_T_restart)**2) /= &
2716 (us%kg_m3_to_R_restart*(us%m_to_L_restart*us%s_to_T)**2)) )
then 2717 rl2_t2_rescale = (us%kg_m3_to_R*(us%m_to_L*us%s_to_T_restart)**2) / &
2718 (us%kg_m3_to_R_restart*(us%m_to_L_restart*us%s_to_T)**2)
2719 do j=js,je ;
do i=is,ie
2720 cs%p_surf_prev(i,j) = rl2_t2_rescale * cs%p_surf_prev(i,j)
2724 call pass_var(cs%p_surf_prev, g%domain)
2728 if (use_ice_shelf .and.
associated(cs%Hml))
then 2729 if (query_initialized(cs%Hml,
"hML", restart_csp))
then 2731 if ((us%m_to_Z_restart /= 0.0) .and. (us%m_to_Z /= us%m_to_Z_restart) )
then 2732 z_rescale = us%m_to_Z / us%m_to_Z_restart
2733 do j=js,je ;
do i=is,ie
2734 cs%Hml(i,j) = z_rescale * cs%Hml(i,j)
2740 if (.not.query_initialized(cs%ave_ssh_ibc,
"ave_ssh",restart_csp))
then 2742 call find_eta(cs%h, cs%tv, g, gv, us, cs%ave_ssh_ibc, eta, eta_to_m=1.0)
2744 call find_eta(cs%h, cs%tv, g, gv, us, cs%ave_ssh_ibc, eta_to_m=1.0)
2747 if (cs%split)
deallocate(eta)
2750 if (
present(count_calls)) cs%count_calls = count_calls
2751 call mom_sum_output_init(g_in, us, param_file, dirs%output_directory, &
2752 cs%ntrunc, time_init, cs%sum_output_CSp)
2755 cs%write_IC = save_ic .and. &
2756 .not.((dirs%input_filename(1:1) ==
'r') .and. &
2757 (len_trim(dirs%input_filename) == 1))
2759 if (cs%ensemble_ocean)
then 2760 call init_oda(time, g, gv, cs%odaCS)
2767 call calltree_leave(
"initialize_MOM()")
2768 call cpu_clock_end(id_clock_init)
2770 end subroutine initialize_mom
2773 subroutine finish_mom_initialization(Time, dirs, CS, restart_CSp)
2774 type(time_type),
intent(in) :: time
2775 type(directories),
intent(in) :: dirs
2777 type(mom_restart_cs),
pointer :: restart_csp
2780 type(ocean_grid_type),
pointer :: g => null()
2782 type(verticalgrid_type),
pointer :: gv => null()
2783 type(unit_scale_type),
pointer :: us => null()
2785 type(mom_restart_cs),
pointer :: restart_csp_tmp => null()
2786 real,
allocatable :: z_interface(:,:,:)
2789 call cpu_clock_begin(id_clock_init)
2790 call calltree_enter(
"finish_MOM_initialization()")
2793 g => cs%G ; gv => cs%GV ; us => cs%US
2796 call fix_restart_scaling(gv)
2797 call fix_restart_unit_scaling(us)
2800 if (cs%write_IC)
then 2801 allocate(restart_csp_tmp)
2802 restart_csp_tmp = restart_csp
2803 allocate(z_interface(szi_(g),szj_(g),szk_(g)+1))
2804 call find_eta(cs%h, cs%tv, g, gv, us, z_interface, eta_to_m=1.0)
2805 call register_restart_field(z_interface,
"eta", .true., restart_csp_tmp, &
2806 "Interface heights",
"meter", z_grid=
'i')
2808 call save_restart(dirs%output_directory, time, cs%G_in, &
2809 restart_csp_tmp, filename=cs%IC_file, gv=gv)
2810 deallocate(z_interface)
2811 deallocate(restart_csp_tmp)
2814 call write_energy(cs%u, cs%v, cs%h, cs%tv, time, 0, g, gv, us, &
2815 cs%sum_output_CSp, cs%tracer_flow_CSp)
2817 call calltree_leave(
"finish_MOM_initialization()")
2818 call cpu_clock_end(id_clock_init)
2820 end subroutine finish_mom_initialization
2823 subroutine register_diags(Time, G, GV, US, IDs, diag)
2824 type(time_type),
intent(in) :: Time
2825 type(ocean_grid_type),
intent(in) :: G
2826 type(verticalGrid_type),
intent(in) :: GV
2827 type(unit_scale_type),
intent(inout) :: US
2828 type(MOM_diag_IDs),
intent(inout) :: IDs
2829 type(diag_ctrl),
intent(inout) :: diag
2832 character(len=48) :: thickness_units
2834 thickness_units = get_thickness_units(gv)
2835 if (gv%Boussinesq)
then 2836 h_convert = gv%H_to_m
2838 h_convert = gv%H_to_kg_m2
2842 ids%id_u = register_diag_field(
'ocean_model',
'u_dyn', diag%axesCuL, time, &
2843 'Zonal velocity after the dynamics update',
'm s-1', conversion=us%L_T_to_m_s)
2844 ids%id_v = register_diag_field(
'ocean_model',
'v_dyn', diag%axesCvL, time, &
2845 'Meridional velocity after the dynamics update',
'm s-1', conversion=us%L_T_to_m_s)
2846 ids%id_h = register_diag_field(
'ocean_model',
'h_dyn', diag%axesTL, time, &
2847 'Layer Thickness after the dynamics update', thickness_units, &
2848 v_extensive=.true., conversion=h_convert)
2849 ids%id_ssh_inst = register_diag_field(
'ocean_model',
'SSH_inst', diag%axesT1, &
2850 time,
'Instantaneous Sea Surface Height',
'm')
2851 end subroutine register_diags
2854 subroutine mom_timing_init(CS)
2855 type(MOM_control_struct),
intent(in) :: CS
2857 id_clock_ocean = cpu_clock_id(
'Ocean', grain=clock_component)
2858 id_clock_dynamics = cpu_clock_id(
'Ocean dynamics', grain=clock_subcomponent)
2859 id_clock_thermo = cpu_clock_id(
'Ocean thermodynamics and tracers', grain=clock_subcomponent)
2860 id_clock_other = cpu_clock_id(
'Ocean Other', grain=clock_subcomponent)
2861 id_clock_tracer = cpu_clock_id(
'(Ocean tracer advection)', grain=clock_module_driver)
2862 if (.not.cs%adiabatic)
then 2863 id_clock_diabatic = cpu_clock_id(
'(Ocean diabatic driver)', grain=clock_module_driver)
2865 id_clock_adiabatic = cpu_clock_id(
'(Ocean adiabatic driver)', grain=clock_module_driver)
2868 id_clock_continuity = cpu_clock_id(
'(Ocean continuity equation *)', grain=clock_module)
2869 id_clock_bbl_visc = cpu_clock_id(
'(Ocean set BBL viscosity)', grain=clock_module)
2870 id_clock_pass = cpu_clock_id(
'(Ocean message passing *)', grain=clock_module)
2871 id_clock_mom_init = cpu_clock_id(
'(Ocean MOM_initialize_state)', grain=clock_module)
2872 id_clock_pass_init = cpu_clock_id(
'(Ocean init message passing *)', grain=clock_routine)
2873 if (cs%thickness_diffuse) &
2874 id_clock_thick_diff = cpu_clock_id(
'(Ocean thickness diffusion *)', grain=clock_module)
2876 id_clock_ml_restrat = cpu_clock_id(
'(Ocean mixed layer restrat)', grain=clock_module)
2877 id_clock_diagnostics = cpu_clock_id(
'(Ocean collective diagnostics)', grain=clock_module)
2878 id_clock_z_diag = cpu_clock_id(
'(Ocean Z-space diagnostics)', grain=clock_module)
2879 id_clock_ale = cpu_clock_id(
'(Ocean ALE)', grain=clock_module)
2880 if (cs%offline_tracer_mode)
then 2881 id_clock_offline_tracer = cpu_clock_id(
'Ocean offline tracers', grain=clock_subcomponent)
2884 end subroutine mom_timing_init
2895 subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp)
2896 type(verticalGrid_type),
intent(inout) :: GV
2897 type(unit_scale_type),
intent(inout) :: US
2898 type(param_file_type),
intent(in) :: param_file
2899 type(MOM_control_struct),
intent(in) :: CS
2900 type(MOM_restart_CS),
pointer :: restart_CSp
2903 logical :: use_ice_shelf
2904 character(len=48) :: thickness_units, flux_units
2905 type(vardesc) :: u_desc, v_desc
2907 thickness_units = get_thickness_units(gv)
2908 flux_units = get_flux_units(gv)
2910 u_desc = var_desc(
"u",
"m s-1",
"Zonal velocity", hor_grid=
'Cu')
2911 v_desc = var_desc(
"v",
"m s-1",
"Meridional velocity", hor_grid=
'Cv')
2913 if (
associated(cs%tv%T)) &
2914 call register_restart_field(cs%tv%T,
"Temp", .true., restart_csp, &
2915 "Potential Temperature",
"degC")
2916 if (
associated(cs%tv%S)) &
2917 call register_restart_field(cs%tv%S,
"Salt", .true., restart_csp, &
2920 call register_restart_field(cs%h,
"h", .true., restart_csp, &
2921 "Layer Thickness", thickness_units)
2923 call register_restart_pair(cs%u, cs%v, u_desc, v_desc, .true., restart_csp)
2925 if (
associated(cs%tv%frazil)) &
2926 call register_restart_field(cs%tv%frazil,
"frazil", .false., restart_csp, &
2927 "Frazil heat flux into ocean",
"J m-2")
2929 if (cs%interp_p_surf)
then 2930 call register_restart_field(cs%p_surf_prev,
"p_surf_prev", .false., restart_csp, &
2931 "Previous ocean surface pressure",
"Pa")
2934 call register_restart_field(cs%ave_ssh_ibc,
"ave_ssh", .false., restart_csp, &
2935 "Time average sea surface height",
"meter")
2938 call get_param(param_file,
'',
"ICE_SHELF", use_ice_shelf, default=.false., &
2940 if (use_ice_shelf .and.
associated(cs%Hml))
then 2941 call register_restart_field(cs%Hml,
"hML", .false., restart_csp, &
2942 "Mixed layer thickness",
"meter")
2946 call register_restart_field(us%m_to_Z_restart,
"m_to_Z", .false., restart_csp, &
2947 "Height unit conversion factor",
"Z meter-1")
2948 call register_restart_field(gv%m_to_H_restart,
"m_to_H", .false., restart_csp, &
2949 "Thickness unit conversion factor",
"H meter-1")
2950 call register_restart_field(us%m_to_L_restart,
"m_to_L", .false., restart_csp, &
2951 "Length unit conversion factor",
"L meter-1")
2952 call register_restart_field(us%s_to_T_restart,
"s_to_T", .false., restart_csp, &
2953 "Time unit conversion factor",
"T second-1")
2954 call register_restart_field(us%kg_m3_to_R_restart,
"kg_m3_to_R", .false., restart_csp, &
2955 "Density unit conversion factor",
"R m3 kg-1")
2956 call register_restart_field(us%J_kg_to_Q_restart,
"J_kg_to_Q", .false., restart_csp, &
2957 "Heat content unit conversion factor.", units=
"Q kg J-1")
2959 end subroutine set_restart_fields
2963 subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS)
2964 type(thermo_var_ptrs),
intent(in) :: tv
2965 type(ocean_grid_type),
intent(in) :: G
2966 type(verticalGrid_type),
intent(in) :: GV
2967 type(unit_scale_type),
intent(in) :: US
2968 real,
dimension(SZI_(G),SZJ_(G)),
intent(inout) :: ssh
2969 real,
dimension(:,:),
optional,
pointer :: p_atm
2970 logical,
optional,
intent(in) :: use_EOS
2973 real :: Rho_conv(SZI_(G))
2977 integer,
dimension(2) :: EOSdom
2978 integer :: i, j, is, ie, js, je
2980 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2981 eosdom(:) = eos_domain(g%HI)
2982 if (
present(p_atm))
then ;
if (
associated(p_atm))
then 2983 calc_rho =
associated(tv%eqn_of_state)
2984 if (
present(use_eos) .and. calc_rho) calc_rho = use_eos
2988 call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), rho_conv, &
2989 tv%eqn_of_state, eosdom)
2991 igr0 = us%Z_to_m / (rho_conv(i) * gv%g_Earth)
2992 ssh(i,j) = ssh(i,j) + p_atm(i,j) * igr0
2996 ssh(i,j) = ssh(i,j) + p_atm(i,j) * (us%Z_to_m / (gv%Rho0 * gv%g_Earth))
3002 end subroutine adjust_ssh_for_p_atm
3007 subroutine extract_surface_state(CS, sfc_state_in)
3009 type(surface),
target,
intent(inout) :: sfc_state_in
3015 type(ocean_grid_type),
pointer :: g => null()
3017 type(ocean_grid_type),
pointer :: g_in => null()
3018 type(verticalgrid_type),
pointer :: gv => null()
3019 type(unit_scale_type),
pointer :: us => null()
3020 type(surface),
pointer :: sfc_state => null()
3021 real,
dimension(:,:,:),
pointer :: &
3023 real :: depth(szi_(cs%g))
3030 real :: missing_depth
3034 real :: delt(szi_(cs%g))
3035 logical :: use_temperature
3036 integer :: i, j, k, is, ie, js, je, nz, numberoferrors, ig, jg
3037 integer :: isd, ied, jsd, jed
3038 integer :: iscb, iecb, jscb, jecb, isdb, iedb, jsdb, jedb
3039 logical :: localerror
3040 character(240) :: msg
3043 call calltree_enter(
"extract_surface_state(), MOM.F90")
3044 g => cs%G ; g_in => cs%G_in ; gv => cs%GV ; us => cs%US
3045 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
3046 isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
3047 iscb = g%iscB ; iecb = g%iecB; jscb = g%jscB ; jecb = g%jecB
3048 isdb = g%isdB ; iedb = g%iedB; jsdb = g%jsdB ; jedb = g%jedB
3051 use_temperature =
associated(cs%tv%T)
3054 if (cs%rotate_index) &
3057 if (.not.sfc_state_in%arrays_allocated) &
3060 call allocate_surface_state(sfc_state_in, g_in, use_temperature, &
3061 do_integrals=.true., omit_frazil=.not.
associated(cs%tv%frazil))
3063 if (cs%rotate_index)
then 3065 call allocate_surface_state(sfc_state, g, use_temperature, &
3066 do_integrals=.true., omit_frazil=.not.
associated(cs%tv%frazil))
3068 sfc_state => sfc_state_in
3071 sfc_state%T_is_conT = cs%tv%T_is_conT
3072 sfc_state%S_is_absS = cs%tv%S_is_absS
3074 do j=js,je ;
do i=is,ie
3075 sfc_state%sea_lev(i,j) = us%m_to_Z*cs%ave_ssh_ibc(i,j)
3078 if (
allocated(sfc_state%frazil) .and.
associated(cs%tv%frazil))
then ;
do j=js,je ;
do i=is,ie
3079 sfc_state%frazil(i,j) = cs%tv%frazil(i,j)
3080 enddo ;
enddo ;
endif 3083 if (
associated(cs%Hml))
then 3084 do j=js,je ;
do i=is,ie
3085 sfc_state%Hml(i,j) = cs%Hml(i,j)
3089 if (cs%Hmix < 0.0)
then 3090 if (use_temperature)
then ;
do j=js,je ;
do i=is,ie
3091 sfc_state%SST(i,j) = cs%tv%T(i,j,1)
3092 sfc_state%SSS(i,j) = cs%tv%S(i,j,1)
3093 enddo ;
enddo ;
endif 3094 do j=js,je ;
do i=is-1,ie
3095 sfc_state%u(i,j) = cs%u(i,j,1)
3097 do j=js-1,je ;
do i=is,ie
3098 sfc_state%v(i,j) = cs%v(i,j,1)
3102 h_rescale = 1.0 ;
if (cs%answers_2018) h_rescale = gv%H_to_Z
3104 if (.not.cs%answers_2018) depth_ml = cs%Hmix*gv%Z_to_H
3111 if (use_temperature)
then 3112 sfc_state%SST(i,j) = 0.0 ; sfc_state%SSS(i,j) = 0.0
3114 sfc_state%sfc_density(i,j) = 0.0
3118 do k=1,nz ;
do i=is,ie
3119 if (depth(i) + h(i,j,k)*h_rescale < depth_ml)
then 3120 dh = h(i,j,k)*h_rescale
3121 elseif (depth(i) < depth_ml)
then 3122 dh = depth_ml - depth(i)
3126 if (use_temperature)
then 3127 sfc_state%SST(i,j) = sfc_state%SST(i,j) + dh * cs%tv%T(i,j,k)
3128 sfc_state%SSS(i,j) = sfc_state%SSS(i,j) + dh * cs%tv%S(i,j,k)
3130 sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) + dh * gv%Rlay(k)
3132 depth(i) = depth(i) + dh
3136 if (cs%answers_2018)
then 3137 if (depth(i) < gv%H_subroundoff*h_rescale) &
3138 depth(i) = gv%H_subroundoff*h_rescale
3139 if (use_temperature)
then 3140 sfc_state%SST(i,j) = sfc_state%SST(i,j) / depth(i)
3141 sfc_state%SSS(i,j) = sfc_state%SSS(i,j) / depth(i)
3143 sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) / depth(i)
3146 if (depth(i) < gv%H_subroundoff*h_rescale)
then 3147 i_depth = 1.0 / (gv%H_subroundoff*h_rescale)
3148 missing_depth = gv%H_subroundoff*h_rescale - depth(i)
3149 if (use_temperature)
then 3150 sfc_state%SST(i,j) = (sfc_state%SST(i,j) + missing_depth*cs%tv%T(i,j,1)) * i_depth
3151 sfc_state%SSS(i,j) = (sfc_state%SSS(i,j) + missing_depth*cs%tv%S(i,j,1)) * i_depth
3153 sfc_state%sfc_density(i,j) = (sfc_state%sfc_density(i,j) + &
3154 missing_depth*gv%Rlay(1)) * i_depth
3157 i_depth = 1.0 / depth(i)
3158 if (use_temperature)
then 3159 sfc_state%SST(i,j) = sfc_state%SST(i,j) * i_depth
3160 sfc_state%SSS(i,j) = sfc_state%SSS(i,j) * i_depth
3162 sfc_state%sfc_density(i,j) = sfc_state%sfc_density(i,j) * i_depth
3173 if (cs%Hmix_UV>0.)
then 3174 depth_ml = cs%Hmix_UV
3175 if (.not.cs%answers_2018) depth_ml = cs%Hmix_UV*gv%Z_to_H
3180 sfc_state%v(i,j) = 0.0
3182 do k=1,nz ;
do i=is,ie
3183 hv = 0.5 * (h(i,j,k) + h(i,j+1,k)) * h_rescale
3184 if (depth(i) + hv < depth_ml)
then 3186 elseif (depth(i) < depth_ml)
then 3187 dh = depth_ml - depth(i)
3191 sfc_state%v(i,j) = sfc_state%v(i,j) + dh * cs%v(i,j,k)
3192 depth(i) = depth(i) + dh
3196 sfc_state%v(i,j) = sfc_state%v(i,j) / max(depth(i), gv%H_subroundoff*h_rescale)
3204 sfc_state%u(i,j) = 0.0
3206 do k=1,nz ;
do i=is-1,ie
3207 hu = 0.5 * (h(i,j,k) + h(i+1,j,k)) * h_rescale
3208 if (depth(i) + hu < depth_ml)
then 3210 elseif (depth(i) < depth_ml)
then 3211 dh = depth_ml - depth(i)
3215 sfc_state%u(i,j) = sfc_state%u(i,j) + dh * cs%u(i,j,k)
3216 depth(i) = depth(i) + dh
3220 sfc_state%u(i,j) = sfc_state%u(i,j) / max(depth(i), gv%H_subroundoff*h_rescale)
3224 do j=js,je ;
do i=is-1,ie
3225 sfc_state%u(i,j) = cs%u(i,j,1)
3227 do j=js-1,je ;
do i=is,ie
3228 sfc_state%v(i,j) = cs%v(i,j,1)
3234 if (
allocated(sfc_state%melt_potential))
then 3242 do k=1,nz ;
do i=is,ie
3243 depth_ml = min(cs%HFrz, cs%visc%MLD(i,j))
3244 if (depth(i) + h(i,j,k)*gv%H_to_Z < depth_ml)
then 3245 dh = h(i,j,k)*gv%H_to_Z
3246 elseif (depth(i) < depth_ml)
then 3247 dh = depth_ml - depth(i)
3253 call calculate_tfreeze(cs%tv%S(i,j,k), 0.0, t_freeze, cs%tv%eqn_of_state)
3254 depth(i) = depth(i) + dh
3255 delt(i) = delt(i) + dh * (cs%tv%T(i,j,k) - t_freeze)
3260 sfc_state%melt_potential(i,j) = 0.0
3262 if (g%mask2dT(i,j)>0.)
then 3264 sfc_state%melt_potential(i,j) = cs%tv%C_p * gv%Rho0 * delt(i)
3270 if (
allocated(sfc_state%salt_deficit) .and.
associated(cs%tv%salt_deficit))
then 3272 do j=js,je ;
do i=is,ie
3274 sfc_state%salt_deficit(i,j) = 0.001 * cs%tv%salt_deficit(i,j)
3277 if (
allocated(sfc_state%TempxPmE) .and.
associated(cs%tv%TempxPmE))
then 3279 do j=js,je ;
do i=is,ie
3280 sfc_state%TempxPmE(i,j) = cs%tv%TempxPmE(i,j)
3283 if (
allocated(sfc_state%internal_heat) .and.
associated(cs%tv%internal_heat))
then 3285 do j=js,je ;
do i=is,ie
3286 sfc_state%internal_heat(i,j) = cs%tv%internal_heat(i,j)
3289 if (
allocated(sfc_state%taux_shelf) .and.
associated(cs%visc%taux_shelf))
then 3291 do j=js,je ;
do i=is-1,ie
3292 sfc_state%taux_shelf(i,j) = cs%visc%taux_shelf(i,j)
3295 if (
allocated(sfc_state%tauy_shelf) .and.
associated(cs%visc%tauy_shelf))
then 3297 do j=js-1,je ;
do i=is,ie
3298 sfc_state%tauy_shelf(i,j) = cs%visc%tauy_shelf(i,j)
3302 if (
allocated(sfc_state%ocean_mass) .and.
allocated(sfc_state%ocean_heat) .and. &
3303 allocated(sfc_state%ocean_salt))
then 3305 do j=js,je ;
do i=is,ie
3306 sfc_state%ocean_mass(i,j) = 0.0
3307 sfc_state%ocean_heat(i,j) = 0.0 ; sfc_state%ocean_salt(i,j) = 0.0
3310 do j=js,je ;
do k=1,nz;
do i=is,ie
3311 mass = gv%H_to_RZ*h(i,j,k)
3312 sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + mass
3313 sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass * cs%tv%T(i,j,k)
3314 sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*cs%tv%S(i,j,k))
3315 enddo ;
enddo ;
enddo 3317 if (
allocated(sfc_state%ocean_mass))
then 3319 do j=js,je ;
do i=is,ie ; sfc_state%ocean_mass(i,j) = 0.0 ;
enddo ;
enddo 3321 do j=js,je ;
do k=1,nz ;
do i=is,ie
3322 sfc_state%ocean_mass(i,j) = sfc_state%ocean_mass(i,j) + gv%H_to_RZ*h(i,j,k)
3323 enddo ;
enddo ;
enddo 3325 if (
allocated(sfc_state%ocean_heat))
then 3327 do j=js,je ;
do i=is,ie ; sfc_state%ocean_heat(i,j) = 0.0 ;
enddo ;
enddo 3329 do j=js,je ;
do k=1,nz ;
do i=is,ie
3330 mass = gv%H_to_RZ*h(i,j,k)
3331 sfc_state%ocean_heat(i,j) = sfc_state%ocean_heat(i,j) + mass*cs%tv%T(i,j,k)
3332 enddo ;
enddo ;
enddo 3334 if (
allocated(sfc_state%ocean_salt))
then 3336 do j=js,je ;
do i=is,ie ; sfc_state%ocean_salt(i,j) = 0.0 ;
enddo ;
enddo 3338 do j=js,je ;
do k=1,nz ;
do i=is,ie
3339 mass = gv%H_to_RZ*h(i,j,k)
3340 sfc_state%ocean_salt(i,j) = sfc_state%ocean_salt(i,j) + mass * (1.0e-3*cs%tv%S(i,j,k))
3341 enddo ;
enddo ;
enddo 3345 if (
associated(cs%tracer_flow_CSp))
then 3346 call call_tracer_surface_state(sfc_state, h, g, cs%tracer_flow_CSp)
3349 if (cs%check_bad_sfc_vals)
then 3351 do j=js,je;
do i=is,ie
3352 if (g%mask2dT(i,j)>0.)
then 3353 localerror = sfc_state%sea_lev(i,j) <= -g%bathyT(i,j) &
3354 .or. sfc_state%sea_lev(i,j) >= cs%bad_val_ssh_max &
3355 .or. sfc_state%sea_lev(i,j) <= -cs%bad_val_ssh_max &
3356 .or. sfc_state%sea_lev(i,j) + g%bathyT(i,j) < cs%bad_val_col_thick
3357 if (use_temperature) localerror = localerror &
3358 .or. sfc_state%SSS(i,j)<0. &
3359 .or. sfc_state%SSS(i,j)>=cs%bad_val_sss_max &
3360 .or. sfc_state%SST(i,j)< cs%bad_val_sst_min &
3361 .or. sfc_state%SST(i,j)>=cs%bad_val_sst_max
3362 if (localerror)
then 3363 numberoferrors=numberoferrors+1
3364 if (numberoferrors<9)
then 3365 ig = i + g%HI%idg_offset
3366 jg = j + g%HI%jdg_offset
3367 if (use_temperature)
then 3368 write(msg(1:240),
'(2(a,i4,x),4(a,f8.3,x),8(a,es11.4,x))') &
3369 'Extreme surface sfc_state detected: i=',ig,
'j=',jg, &
3370 'lon=',g%geoLonT(i,j),
'lat=',g%geoLatT(i,j), &
3371 'x=',g%gridLonT(ig),
'y=',g%gridLatT(jg), &
3372 'D=',cs%US%Z_to_m*g%bathyT(i,j),
'SSH=',cs%US%Z_to_m*sfc_state%sea_lev(i,j), &
3373 'SST=',sfc_state%SST(i,j),
'SSS=',sfc_state%SSS(i,j), &
3374 'U-=',us%L_T_to_m_s*sfc_state%u(i-1,j),
'U+=',us%L_T_to_m_s*sfc_state%u(i,j), &
3375 'V-=',us%L_T_to_m_s*sfc_state%v(i,j-1),
'V+=',us%L_T_to_m_s*sfc_state%v(i,j)
3377 write(msg(1:240),
'(2(a,i4,x),4(a,f8.3,x),6(a,es11.4))') &
3378 'Extreme surface sfc_state detected: i=',ig,
'j=',jg, &
3379 'lon=',g%geoLonT(i,j),
'lat=',g%geoLatT(i,j), &
3380 'x=',g%gridLonT(i),
'y=',g%gridLatT(j), &
3381 'D=',cs%US%Z_to_m*g%bathyT(i,j),
'SSH=',cs%US%Z_to_m*sfc_state%sea_lev(i,j), &
3382 'U-=',us%L_T_to_m_s*sfc_state%u(i-1,j),
'U+=',us%L_T_to_m_s*sfc_state%u(i,j), &
3383 'V-=',us%L_T_to_m_s*sfc_state%v(i,j-1),
'V+=',us%L_T_to_m_s*sfc_state%v(i,j)
3385 call mom_error(warning, trim(msg), all_print=.true.)
3386 elseif (numberoferrors==9)
then 3387 call mom_error(warning,
'There were more unreported extreme events!', all_print=.true.)
3392 call sum_across_pes(numberoferrors)
3393 if (numberoferrors>0)
then 3394 write(msg(1:240),
'(3(a,i9,x))')
'There were a total of ',numberoferrors, &
3395 'locations detected with extreme surface values!' 3396 call mom_error(fatal, trim(msg))
3400 if (cs%debug)
call mom_surface_chksum(
"Post extract_sfc", sfc_state, g, us, haloshift=0)
3403 if (cs%rotate_index)
then 3404 call rotate_surface_state(sfc_state, g, sfc_state_in, g_in, -turns)
3405 call deallocate_surface_state(sfc_state)
3408 call calltree_leave(
"extract_surface_sfc_state()")
3409 end subroutine extract_surface_state
3412 subroutine rotate_initial_state(u_in, v_in, h_in, T_in, S_in, &
3413 use_temperature, turns, u, v, h, T, S)
3414 real,
dimension(:,:,:),
intent(in) :: u_in, v_in, h_in, T_in, S_in
3415 logical,
intent(in) :: use_temperature
3416 integer,
intent(in) :: turns
3417 real,
dimension(:,:,:),
intent(out) :: u, v, h, T, S
3419 call rotate_vector(u_in, v_in, turns, u, v)
3420 call rotate_array(h_in, turns, h)
3421 if (use_temperature)
then 3422 call rotate_array(t_in, turns, t)
3423 call rotate_array(s_in, turns, s)
3425 end subroutine rotate_initial_state
3428 function mom_state_is_synchronized(CS, adv_dyn)
result(in_synch)
3430 logical,
optional,
intent(in) :: adv_dyn
3437 adv_only = .false. ;
if (
present(adv_dyn)) adv_only = adv_dyn
3440 in_synch = (cs%t_dyn_rel_adv == 0.0)
3442 in_synch = ((cs%t_dyn_rel_adv == 0.0) .and. (cs%t_dyn_rel_thermo == 0.0))
3445 end function mom_state_is_synchronized
3449 subroutine get_mom_state_elements(CS, G, GV, US, C_p, C_p_scaled, use_temp)
3451 type(ocean_grid_type),
optional,
pointer :: g
3452 type(verticalgrid_type),
optional,
pointer :: gv
3453 type(unit_scale_type),
optional,
pointer :: us
3454 real,
optional,
intent(out) :: c_p
3455 real,
optional,
intent(out) :: c_p_scaled
3457 logical,
optional,
intent(out) :: use_temp
3459 if (
present(g)) g => cs%G_in
3460 if (
present(gv)) gv => cs%GV
3461 if (
present(us)) us => cs%US
3462 if (
present(c_p)) c_p = cs%US%Q_to_J_kg * cs%tv%C_p
3463 if (
present(c_p_scaled)) c_p_scaled = cs%tv%C_p
3464 if (
present(use_temp)) use_temp =
associated(cs%tv%T)
3465 end subroutine get_mom_state_elements
3468 subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only)
3470 real,
optional,
intent(out) :: heat
3471 real,
optional,
intent(out) :: salt
3472 real,
optional,
intent(out) :: mass
3473 logical,
optional,
intent(in) :: on_pe_only
3475 if (
present(mass)) &
3476 mass = global_mass_integral(cs%h, cs%G, cs%GV, on_pe_only=on_pe_only)
3477 if (
present(heat)) &
3478 heat = cs%US%Q_to_J_kg*cs%tv%C_p * global_mass_integral(cs%h, cs%G, cs%GV, cs%tv%T, on_pe_only=on_pe_only)
3479 if (
present(salt)) &
3480 salt = 1.0e-3 * global_mass_integral(cs%h, cs%G, cs%GV, cs%tv%S, on_pe_only=on_pe_only)
3482 end subroutine get_ocean_stocks
3485 subroutine mom_end(CS)
3488 if (cs%use_ALE_algorithm)
call ale_end(cs%ALE_CSp)
3490 dealloc_(cs%u) ; dealloc_(cs%v) ; dealloc_(cs%h)
3491 dealloc_(cs%uh) ; dealloc_(cs%vh)
3493 if (
associated(cs%tv%T))
then 3494 dealloc_(cs%T) ; cs%tv%T => null() ; dealloc_(cs%S) ; cs%tv%S => null()
3496 if (
associated(cs%tv%frazil))
deallocate(cs%tv%frazil)
3497 if (
associated(cs%tv%salt_deficit))
deallocate(cs%tv%salt_deficit)
3498 if (
associated(cs%Hml))
deallocate(cs%Hml)
3500 call tracer_advect_end(cs%tracer_adv_CSp)
3501 call tracer_hor_diff_end(cs%tracer_diff_CSp)
3502 call tracer_registry_end(cs%tracer_Reg)
3503 call tracer_flow_control_end(cs%tracer_flow_CSp)
3505 call diabatic_driver_end(cs%diabatic_CSp)
3507 if (cs%offline_tracer_mode)
call offline_transport_end(cs%offline_CSp)
3509 dealloc_(cs%uhtr) ; dealloc_(cs%vhtr)
3511 call end_dyn_split_rk2(cs%dyn_split_RK2_CSp)
3512 elseif (cs%use_RK2)
then 3513 call end_dyn_unsplit_rk2(cs%dyn_unsplit_RK2_CSp)
3515 call end_dyn_unsplit(cs%dyn_unsplit_CSp)
3517 dealloc_(cs%ave_ssh_ibc) ; dealloc_(cs%ssh_rint)
3518 if (
associated(cs%update_OBC_CSp))
call obc_register_end(cs%update_OBC_CSp)
3520 call verticalgridend(cs%GV)
3521 call unit_scaling_end(cs%US)
3522 call mom_grid_end(cs%G)
3526 end subroutine mom_end
Calculates the heights of sruface or all interfaces from layer thicknesses.
A structure with diagnostic IDs of the state variables.
Control structure for mom_mixed_layer_restrat.
MOM_dynamics_split_RK2 module control structure.
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
The routines here implement the offline tracer algorithm used in MOM6. These are called from step_off...
Interfaces for MOM6 ensembles and data assimilation.
Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means...
Wraps the FMS time manager functions.
Time steps the ocean dynamics with an unsplit quasi 3rd order scheme.
This module contains the main regridding routines.
Provides a mechanism for recording diagnostic variables that are no longer valid, along with their re...
The control structure for the MOM_boundary_update module.
Methods for testing for, and list of, obsolete run-time parameters.
This module implements boundary forcing for MOM6.
Reports integrated quantities for monitoring the model state.
MOM_dynamics_unsplit_RK2 module control structure.
Control structure for this module.
Initializes fixed aspects of the model, such as horizontal grid metrics, topography and Coriolis...
Functions for calculating interface heights, including free surface height.
Ocean grid type. See mom_grid for details.
The central module of the MOM6 ocean model.
Calculates density of sea water from T, S and P.
Calculates the freezing point of sea water from T, S and P.
Controls where open boundary conditions are applied.
Allocate the fields of a mechanical forcing type, based on either a set of input flags for each group...
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Vertical viscosities, drag coefficients, and related fields.
Wraps the MPP cpu clock functions.
This routine drives the diabatic/dianeutral physics for MOM.
Register fields for restarts.
Describes the horizontal ocean grid with only dynamic memory arrays.
Main routine for lateral (along surface or neutral) diffusion of tracers.
Control structure for MOM_set_visc.
This type is used to exchange information related to the MEKE calculations.
This module contains I/O framework code.
Calculates various values related to the bottom boundary layer, such as the viscosity and thickness o...
The MOM6 facility to parse input files for runtime parameters.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Pointers to arrays with accelerations, which can later be used for derived diagnostics, like energy balances.
Register a pair of restart fieilds whose rotations map onto each other.
Variable mixing coefficients.
This module contains the routines used to apply sponge layers when using the ALE mode.
ALE sponge control structure.
Do a halo update on a pair of arrays representing the two components of a vector. ...
Container for horizontal index ranges for data, computational and global domains. ...
Orchestrates the registration and calling of tracer packages.
Structure that contains pointers to the mechanical forcing at the surface used to drive the liquid oc...
Variable mixing coefficients.
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Allocate the fields of a (flux) forcing type, based on either a set of input flags for each group of ...
The control structure for the MOM_sum_output module.
Control structure that contains MEKE parameters and diagnostics handles.
Control structure that contains a transpose of the ocean state across ensemble members.
Interface for surface waves.
Make a diagnostic available for averaging or output.
A structure with diagnostic IDs of the surface and integrated variables.
A restart registry and the control structure for restarts.
Describes various unit conversion factors.
Copy one MOM_domain_type into another.
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Provides routines that do checksums of groups of MOM variables.
Invokes unit tests in all modules that have them.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Type to carry basic OBC information needed for updating values.
Describes the decomposed MOM domain and has routines for communications across PEs.
Type to carry basic tracer information.
Thickness diffusion (or Gent McWilliams)
The control structure for the offline transport module.
Pointers to arrays with transports, which can later be used for derived diagnostics, like energy balances.
Routines for error handling and I/O management.
Control structure for the MOM module, including the variables that describe the state of the ocean...
This control structure holds memory and parameters for the MOM_sponge module.
The control structure for the MOM_diagnostics module.
The MOM6 facility for reading and writing restart files, and querying what has been read...
Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90.
The control structure for orchestrating the calling of tracer packages.
Implements the Mesoscale Eddy Kinetic Energy framework with topographic beta effect included in compu...
Container for all surface wave related parameters.
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Implements sponge regions in isopycnal mode.
Provides subroutines for quantities specific to the equation of state.
Type for describing a variable, typically a tracer.
Control structure for this module.
An overloaded interface to log version information about modules.
Describes the vertical ocean grid, including unit conversion factors.
Indicate whether a file exists, perhaps with domain decomposition.
MOM_dynamics_unsplit module control structure.
Initialization functions for state variables, u, v, h, T and S.
Initializes fixed aspects of the related to its vertical coordinate.
An overloaded interface to read various types of parameters.
Set up a group of halo updates.
Check for consistency between the duplicated points of a C-grid vector.
Time steps the ocean dynamics with an unsplit quasi 2nd order Runge-Kutta scheme. ...
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
This module contains the subroutines that advect tracers along coordinate surfaces.
Control structure for thickness diffusion.
Indicate whether a field has been read from a restart file.
Module with routines for copying information from a shared dynamic horizontal grid to an ocean-specif...
The barotropic stepping control stucture.
Contains a shareable dynamic type for describing horizontal grids and metric data and utilty routines...
Controls where open boundary conditions are applied.
Provides a transparent vertical ocean grid type and supporting routines.
The control structure for along-layer and epineutral tracer diffusion.
Provides transparent structures with groups of MOM6 variables and supporting routines.
A structure with diagnostic IDs of mass transport related diagnostics.
Do a halo update on an array.
Read a data field from a file.
Time step the adiabatic dynamic core of MOM using RK2 method.
Write out checksums of the MOM6 state variables.
An overloaded interface to read and log the values of various types of parameters.
Provides checksumming functions for debugging.
Parameterization of mixed layer restratification by unresolved mixed-layer eddies.
Calculates any requested diagnostic quantities that are not calculated in the various subroutines...