43 use mom_time_manager,
only :
operator(+),
operator(-),
operator(*),
operator(/)
45 use mom_time_manager,
only :
operator(<), real_to_time_type, time_type_to_real
53 use coupler_types_mod,
only : coupler_1d_bc_type, coupler_2d_bc_type
54 use coupler_types_mod,
only : coupler_type_spawn, coupler_type_write_chksums
55 use coupler_types_mod,
only : coupler_type_initialized, coupler_type_copy_data
56 use coupler_types_mod,
only : coupler_type_set_diags, coupler_type_send_data
57 use mpp_domains_mod,
only : domain2d, mpp_get_layout, mpp_get_global_domain
58 use mpp_domains_mod,
only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
59 use fms_mod,
only : stdout
60 use mpp_mod,
only : mpp_chksum
61 use mom_eos,
only : gsw_sp_from_sr, gsw_pt_from_ct
68 #include <MOM_memory.h>
70 #ifdef _USE_GENERIC_TRACER
74 implicit none ;
public
81 public ice_ocn_bnd_type_chksum
89 type(domain2d) :: domain
90 logical :: is_ocean_pe
91 character(len=32) :: instance_name =
''
94 integer,
pointer,
dimension(:) :: pelist => null()
95 logical,
pointer,
dimension(:,:) :: maskmap =>null()
101 integer :: stagger = -999
110 real,
pointer,
dimension(:,:) :: &
119 melt_potential => null(), &
122 type(coupler_2d_bc_type) :: fields
127 integer,
dimension(2) :: axes = 0
136 logical :: is_ocean_pe = .false.
137 type(time_type) :: time
138 integer :: restart_control
146 logical :: use_ice_shelf
149 logical :: icebergs_alter_ocean
151 logical :: restore_salinity
153 logical :: restore_temp
158 logical :: offline_tracer_mode = .false.
166 logical :: single_step_call
173 logical :: thermo_spans_coupling
175 logical :: diabatic_first
198 ice_shelf_csp => null()
202 marine_ice_csp => null()
207 forcing_csp => null()
209 restart_csp => null()
223 subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file)
225 intent(inout) :: ocean_sfc
231 type(time_type),
intent(in) :: time_init
232 type(time_type),
intent(in) :: time_in
233 type(coupler_1d_bc_type), &
234 optional,
intent(in) :: gas_fields_ocn
239 character(len=*),
optional,
intent(in) :: input_restart_file
247 logical :: use_melt_pot
250 #include "version_variable.h"
251 character(len=40) :: mdl =
"ocean_model_init"
252 character(len=48) :: stagger
253 integer :: secs, days
255 logical :: use_temperature
257 call calltree_enter(
"ocean_model_init(), MOM_ocean_model_mct.F90")
258 if (
associated(os))
then
259 call mom_error(warning,
"ocean_model_init called with an associated "// &
260 "ocean_state_type structure. Model is already initialized.")
265 os%is_ocean_pe = ocean_sfc%is_ocean_pe
266 if (.not.os%is_ocean_pe)
return
269 call initialize_mom(os%Time, time_init, param_file, os%dirs, os%MOM_CSp, &
270 os%restart_CSp, time_in, offline_tracer_mode=os%offline_tracer_mode, &
271 input_restart_file=input_restart_file, &
272 diag_ptr=os%diag, count_calls=.true.)
273 call get_mom_state_elements(os%MOM_CSp, g=os%grid, gv=os%GV, us=os%US, c_p=os%C_p, &
274 use_temp=use_temperature)
275 os%fluxes%C_p = os%C_p
280 call get_param(param_file, mdl,
"SINGLE_STEPPING_CALL", os%single_step_call, &
281 "If true, advance the state of MOM with a single step "//&
282 "including both dynamics and thermodynamics. If false, "//&
283 "the two phases are advanced with separate calls.", default=.true.)
284 call get_param(param_file, mdl,
"DT", os%dt, &
285 "The (baroclinic) dynamics time step. The time-step that "//&
286 "is actually used will be an integer fraction of the "//&
287 "forcing time-step.", units=
"s", fail_if_missing=.true.)
288 call get_param(param_file, mdl,
"DT_THERM", os%dt_therm, &
289 "The thermodynamic and tracer advection time step. "//&
290 "Ideally DT_THERM should be an integer multiple of DT "//&
291 "and less than the forcing or coupling time-step, unless "//&
292 "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//&
293 "can be an integer multiple of the coupling timestep. By "//&
294 "default DT_THERM is set to DT.", units=
"s", default=os%dt)
295 call get_param(param_file,
"MOM",
"THERMO_SPANS_COUPLING", os%thermo_spans_coupling, &
296 "If true, the MOM will take thermodynamic and tracer "//&
297 "timesteps that can be longer than the coupling timestep. "//&
298 "The actual thermodynamic timestep that is used in this "//&
299 "case is the largest integer multiple of the coupling "//&
300 "timestep that is less than or equal to DT_THERM.", default=.false.)
301 call get_param(param_file, mdl,
"DIABATIC_FIRST", os%diabatic_first, &
302 "If true, apply diabatic and thermodynamic processes, "//&
303 "including buoyancy forcing and mass gain or loss, "//&
304 "before stepping the dynamics forward.", default=.false.)
306 call get_param(param_file, mdl,
"RESTART_CONTROL", os%Restart_control, &
307 "An integer whose bits encode which restart files are "//&
308 "written. Add 2 (bit 1) for a time-stamped file, and odd "//&
309 "(bit 0) for a non-time-stamped file. A restart file "//&
310 "will be saved at the end of the run segment for any "//&
311 "non-negative value.", default=1)
312 call get_param(param_file, mdl,
"OCEAN_SURFACE_STAGGER", stagger, &
313 "A case-insensitive character string to indicate the "//&
314 "staggering of the surface velocity field that is "//&
315 "returned to the coupler. Valid values include "//&
316 "'A', 'B', or 'C'.", default=
"C")
317 if (
uppercase(stagger(1:1)) ==
'A')
then ; ocean_sfc%stagger = agrid
318 elseif (
uppercase(stagger(1:1)) ==
'B')
then ; ocean_sfc%stagger = bgrid_ne
319 elseif (
uppercase(stagger(1:1)) ==
'C')
then ; ocean_sfc%stagger = cgrid_ne
320 else ;
call mom_error(fatal,
"ocean_model_init: OCEAN_SURFACE_STAGGER = "// &
321 trim(stagger)//
" is invalid.") ;
endif
323 call get_param(param_file, mdl,
"RESTORE_SALINITY",os%restore_salinity, &
324 "If true, the coupled driver will add a globally-balanced "//&
325 "fresh-water flux that drives sea-surface salinity "//&
326 "toward specified values.", default=.false.)
327 call get_param(param_file, mdl,
"RESTORE_TEMPERATURE",os%restore_temp, &
328 "If true, the coupled driver will add a "//&
329 "heat flux that drives sea-surface temperature "//&
330 "toward specified values.", default=.false.)
331 call get_param(param_file, mdl,
"RHO_0", rho0, &
332 "The mean ocean density used with BOUSSINESQ true to "//&
333 "calculate accelerations and the mass for conservation "//&
334 "properties, or with BOUSSINSEQ false to convert some "//&
335 "parameters from vertical units of m to kg m-2.", &
336 units=
"kg m-3", default=1035.0)
337 call get_param(param_file, mdl,
"G_EARTH", g_earth, &
338 "The gravitational acceleration of the Earth.", &
339 units=
"m s-2", default = 9.80)
341 call get_param(param_file, mdl,
"ICE_SHELF", os%use_ice_shelf, &
342 "If true, enables the ice shelf model.", default=.false.)
344 call get_param(param_file, mdl,
"ICEBERGS_APPLY_RIGID_BOUNDARY", os%icebergs_alter_ocean, &
345 "If true, allows icebergs to change boundary condition felt by ocean", default=.false.)
347 os%press_to_z = 1.0/(rho0*g_earth)
349 call get_param(param_file, mdl,
"HFREEZE", hfrz, &
350 "If HFREEZE > 0, melt potential will be computed. The actual depth "//&
351 "over which melt potential is computed will be min(HFREEZE, OBLD), "//&
352 "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
353 "melt potential will not be computed.", units=
"m", default=-1.0, do_not_log=.true.)
355 if (hfrz .gt. 0.0)
then
363 call allocate_surface_state(os%sfc_state, os%grid, use_temperature, &
364 do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot)
366 call surface_forcing_init(time_in, os%grid, os%US, param_file, os%diag, &
367 os%forcing_CSp, os%restore_salinity, os%restore_temp)
369 if (os%use_ice_shelf)
then
370 call initialize_ice_shelf(param_file, os%grid, os%Time, os%ice_shelf_CSp, &
371 os%diag, os%forces, os%fluxes)
374 if (os%icebergs_alter_ocean)
then
375 call marine_ice_init(os%Time, os%grid, param_file, os%diag, os%marine_ice_CSp)
376 if (.not. os%use_ice_shelf) &
377 call allocate_forcing_type(os%grid, os%fluxes, shelf=.true.)
380 call get_param(param_file, mdl,
"USE_WAVES", os%Use_Waves, &
381 "If true, enables surface wave modules.", default=.false.)
382 if (os%use_waves)
then
383 call mom_wave_interface_init(os%Time, os%grid, os%GV, os%US, param_file, os%Waves, os%diag)
388 if (
associated(os%grid%Domain%maskmap))
then
390 os%diag, maskmap=os%grid%Domain%maskmap, &
391 gas_fields_ocn=gas_fields_ocn)
394 os%diag, gas_fields_ocn=gas_fields_ocn)
399 if (
present(gas_fields_ocn))
then
400 call coupler_type_set_diags(ocean_sfc%fields,
"ocean_sfc", &
401 ocean_sfc%axes(1:2), time_in)
403 call extract_surface_state(os%MOM_CSp, os%sfc_state)
412 write(*,
'(/12x,a/)')
'======== COMPLETED MOM INITIALIZATION ========'
423 time_start_update, Ocean_coupling_time_step, &
424 update_dyn, update_thermo, Ocn_fluxes_used)
426 intent(in) :: ice_ocean_boundary
432 intent(inout) :: ocean_sfc
436 type(time_type),
intent(in) :: time_start_update
437 type(time_type),
intent(in) :: ocean_coupling_time_step
439 logical,
optional,
intent(in) :: update_dyn
441 logical,
optional,
intent(in) :: update_thermo
443 logical,
optional,
intent(in) :: ocn_fluxes_used
447 type(time_type) :: master_time
449 type(time_type) :: time1
451 integer :: index_bnds(4)
460 real :: t_elapsed_seg
461 integer :: n, n_max, n_last_thermo
462 type(time_type) :: time2
463 logical :: thermo_does_span_coupling
467 logical :: step_thermo
468 integer :: secs, days
469 integer :: is, ie, js, je
471 call calltree_enter(
"update_ocean_model(), MOM_ocean_model_mct.F90")
472 call get_time(ocean_coupling_time_step, secs, days)
473 dt_coupling = 86400.0*real(days) + real(secs)
475 if (time_start_update /= os%Time)
then
476 call mom_error(warning,
"update_ocean_model: internal clock does not "//&
477 "agree with time_start_update argument.")
480 if (.not.
associated(os))
then
481 call mom_error(fatal,
"update_ocean_model called with an unassociated "// &
482 "ocean_state_type structure. ocean_model_init must be "// &
483 "called first to allocate this structure.")
487 do_dyn = .true. ;
if (
present(update_dyn)) do_dyn = update_dyn
488 do_thermo = .true. ;
if (
present(update_thermo)) do_thermo = update_thermo
492 is = os%grid%isc ; ie = os%grid%iec ; js = os%grid%jsc ; je = os%grid%jec
493 call coupler_type_spawn(ocean_sfc%fields, os%sfc_state%tr_fields, &
494 (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
497 call mpp_get_compute_domain(ocean_sfc%Domain, index_bnds(1), index_bnds(2), &
498 index_bnds(3), index_bnds(4))
501 call convert_iob_to_forces(ice_ocean_boundary, os%forces, index_bnds, os%Time, &
502 os%grid, os%US, os%forcing_CSp)
504 if (os%fluxes%fluxes_used)
then
507 call enable_averaging(dt_coupling, os%Time + ocean_coupling_time_step, os%diag)
510 call convert_iob_to_fluxes(ice_ocean_boundary, os%fluxes, index_bnds, os%Time, dt_coupling, &
511 os%grid, os%US, os%forcing_CSp, os%sfc_state, &
512 os%restore_salinity, os%restore_temp)
515 if (os%use_ice_shelf)
then
517 call shelf_calc_flux(os%sfc_state, os%fluxes, os%Time, dt_coupling, os%Ice_shelf_CSp)
521 if (os%icebergs_alter_ocean)
then
524 os%sfc_state, dt_coupling, os%marine_ice_CSp)
526 call iceberg_fluxes(os%grid, os%US, os%fluxes, os%use_ice_shelf, &
527 os%sfc_state, dt_coupling, os%marine_ice_CSp)
531 call copy_common_forcing_fields(os%forces, os%fluxes, os%grid)
533 #ifdef _USE_GENERIC_TRACER
534 call enable_averaging(dt_coupling, os%Time + ocean_coupling_time_step, os%diag)
535 call mom_generic_tracer_fluxes_accumulate(os%fluxes, weight)
540 os%flux_tmp%C_p = os%fluxes%C_p
543 call convert_iob_to_fluxes(ice_ocean_boundary, os%flux_tmp, index_bnds, os%Time, dt_coupling, &
544 os%grid, os%US, os%forcing_CSp, os%sfc_state, os%restore_salinity,os%restore_temp)
546 if (os%use_ice_shelf)
then
548 call shelf_calc_flux(os%sfc_state, os%flux_tmp, os%Time, dt_coupling, os%Ice_shelf_CSp)
552 if (os%icebergs_alter_ocean)
then
555 os%sfc_state, dt_coupling, os%marine_ice_CSp)
557 call iceberg_fluxes(os%grid, os%US, os%flux_tmp, os%use_ice_shelf, &
558 os%sfc_state, dt_coupling, os%marine_ice_CSp)
561 call forcing_accumulate(os%flux_tmp, os%forces, os%fluxes, os%grid, weight)
565 call copy_back_forcing_fields(os%fluxes, os%forces, os%grid)
567 #ifdef _USE_GENERIC_TRACER
568 call mom_generic_tracer_fluxes_accumulate(os%flux_tmp, weight)
572 call set_derived_forcing_fields(os%forces, os%fluxes, os%grid, os%US, os%GV%Rho0)
573 call set_net_mass_forcing(os%fluxes, os%forces, os%grid, os%US)
575 if (os%use_waves)
then
579 if (os%nstep==0)
then
580 call finish_mom_initialization(os%Time, os%dirs, os%MOM_CSp, os%restart_CSp)
583 call disable_averaging(os%diag)
584 master_time = os%Time ; time1 = os%Time
586 if(os%offline_tracer_mode)
then
587 call step_offline(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp)
589 elseif ((.not.do_thermo) .or. (.not.do_dyn))
then
591 call step_mom(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp, &
592 waves=os%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, &
593 reset_therm=ocn_fluxes_used)
595 elseif (os%single_step_call)
then
596 call step_mom(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp, waves=os%Waves)
599 n_max = 1 ;
if (dt_coupling > os%dt) n_max = ceiling(dt_coupling/os%dt - 0.001)
600 dt_dyn = dt_coupling / real(n_max)
601 thermo_does_span_coupling = (os%thermo_spans_coupling .and. &
602 (os%dt_therm > 1.5*dt_coupling))
604 if (thermo_does_span_coupling)
then
605 dt_therm = dt_coupling * floor(os%dt_therm / dt_coupling + 0.001)
606 nts = floor(dt_therm/dt_dyn + 0.001)
608 nts = max(1,min(n_max,floor(os%dt_therm/dt_dyn + 0.001)))
612 time2 = time1 ; t_elapsed_seg = 0.0
614 if (os%diabatic_first)
then
615 if (thermo_does_span_coupling)
call mom_error(fatal, &
616 "MOM is not yet set up to have restarts that work with "//&
617 "THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
618 if (modulo(n-1,nts)==0)
then
619 dtdia = dt_dyn*min(nts,n_max-(n-1))
620 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dtdia, os%MOM_CSp, &
621 waves=os%Waves, do_dynamics=.false., do_thermodynamics=.true., &
622 start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
625 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dt_dyn, os%MOM_CSp, &
626 waves=os%Waves, do_dynamics=.true., do_thermodynamics=.false., &
627 start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling)
629 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dt_dyn, os%MOM_CSp, &
630 waves=os%Waves, do_dynamics=.true., do_thermodynamics=.false., &
631 start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
633 step_thermo = .false.
634 if (thermo_does_span_coupling)
then
636 step_thermo = mom_state_is_synchronized(os%MOM_CSp, adv_dyn=.true.)
637 elseif ((modulo(n,nts)==0) .or. (n==n_max))
then
638 dtdia = dt_dyn*(n - n_last_thermo)
643 if (step_thermo)
then
645 time2 = time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5)))
646 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dtdia, os%MOM_CSp, &
647 waves=os%Waves, do_dynamics=.false., do_thermodynamics=.true., &
648 start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling)
652 t_elapsed_seg = t_elapsed_seg + dt_dyn
653 time2 = time1 + set_time(int(floor(t_elapsed_seg + 0.5)))
657 os%Time = master_time + ocean_coupling_time_step
658 os%nstep = os%nstep + 1
660 call mech_forcing_diags(os%forces, dt_coupling, os%grid, os%Time, os%diag, os%forcing_CSp%handles)
662 if (os%fluxes%fluxes_used)
then
663 call forcing_diagnostics(os%fluxes, os%sfc_state, os%grid, os%US, os%Time, os%diag, os%forcing_CSp%handles)
670 call coupler_type_send_data(ocean_sfc%fields, os%Time)
679 character(len=*),
optional,
intent(in) :: timestamp
681 character(len=*),
optional,
intent(in) :: restartname
685 if (.not.mom_state_is_synchronized(os%MOM_CSp)) &
686 call mom_error(warning,
"End of MOM_main reached with inconsistent "//&
687 "dynamics and advective times. Additional restart fields "//&
688 "that have not been coded yet would be required for reproducibility.")
689 if (.not.os%fluxes%fluxes_used)
call mom_error(fatal,
"ocean_model_restart "//&
690 "was called with unused buoyancy fluxes. For conservation, the ocean "//&
691 "restart files can only be created after the buoyancy forcing is applied.")
693 if (
present(restartname))
then
694 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
695 os%restart_CSp, gv=os%GV, filename=restartname)
697 os%dirs%restart_output_dir)
698 if (os%use_ice_shelf)
then
700 os%dirs%restart_output_dir)
703 if (btest(os%Restart_control,1))
then
704 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
705 os%restart_CSp, .true., gv=os%GV)
707 os%dirs%restart_output_dir, .true.)
708 if (os%use_ice_shelf)
then
712 if (btest(os%Restart_control,0))
then
713 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
714 os%restart_CSp, gv=os%GV)
716 os%dirs%restart_output_dir)
717 if (os%use_ice_shelf)
then
734 type(time_type),
intent(in) :: time
740 call mom_end(ocean_state%MOM_CSp)
741 if (ocean_state%use_ice_shelf)
call ice_shelf_end(ocean_state%Ice_shelf_CSp)
749 type(time_type),
intent(in) :: time
750 character(len=*),
optional,
intent(in) :: directory
752 character(len=*),
optional,
intent(in) :: filename_suffix
757 character(len=200) :: restart_dir
759 if (.not.mom_state_is_synchronized(os%MOM_CSp)) &
760 call mom_error(warning,
"ocean_model_save_restart called with inconsistent "//&
761 "dynamics and advective times. Additional restart fields "//&
762 "that have not been coded yet would be required for reproducibility.")
763 if (.not.os%fluxes%fluxes_used)
call mom_error(fatal,
"ocean_model_save_restart "//&
764 "was called with unused buoyancy fluxes. For conservation, the ocean "//&
765 "restart files can only be created after the buoyancy forcing is applied.")
767 if (
present(directory))
then ; restart_dir = directory
768 else ; restart_dir = os%dirs%restart_output_dir ;
endif
770 call save_restart(restart_dir, time, os%grid, os%restart_CSp, gv=os%GV)
774 if (os%use_ice_shelf)
then
783 type(domain2d),
intent(in) :: input_domain
788 logical,
dimension(:,:), &
789 optional,
intent(in) :: maskmap
791 type(coupler_1d_bc_type), &
792 optional,
intent(in) :: gas_fields_ocn
796 integer :: xsz, ysz, layout(2)
799 integer :: isc, iec, jsc, jec
801 call mpp_get_layout(input_domain,layout)
802 call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz)
803 if(
PRESENT(maskmap))
then
804 call mpp_define_domains((/1,xsz,1,ysz/),layout,ocean_sfc%Domain, maskmap=maskmap)
806 call mpp_define_domains((/1,xsz,1,ysz/),layout,ocean_sfc%Domain)
808 call mpp_get_compute_domain(ocean_sfc%Domain, isc, iec, jsc, jec)
810 allocate (ocean_sfc%t_surf (isc:iec,jsc:jec), &
811 ocean_sfc%s_surf (isc:iec,jsc:jec), &
812 ocean_sfc%u_surf (isc:iec,jsc:jec), &
813 ocean_sfc%v_surf (isc:iec,jsc:jec), &
814 ocean_sfc%sea_lev(isc:iec,jsc:jec), &
815 ocean_sfc%area (isc:iec,jsc:jec), &
816 ocean_sfc%OBLD (isc:iec,jsc:jec), &
817 ocean_sfc%melt_potential(isc:iec,jsc:jec), &
818 ocean_sfc%frazil (isc:iec,jsc:jec))
820 ocean_sfc%t_surf = 0.0
821 ocean_sfc%s_surf = 0.0
822 ocean_sfc%u_surf = 0.0
823 ocean_sfc%v_surf = 0.0
824 ocean_sfc%sea_lev = 0.0
825 ocean_sfc%frazil = 0.0
826 ocean_sfc%melt_potential = 0.0
829 ocean_sfc%axes = diag%axesT1%handles
831 if (
present(gas_fields_ocn))
then
832 call coupler_type_spawn(gas_fields_ocn, ocean_sfc%fields, (/isc,isc,iec,iec/), &
833 (/jsc,jsc,jec,jec/), suffix =
'_ocn', as_needed=.true.)
847 target,
intent(inout) :: Ocean_sfc
852 real,
optional,
intent(in) :: patm(:,:)
853 real,
optional,
intent(in) :: press_to_z
858 character(len=48) :: val_str
859 integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
860 integer :: i, j, i0, j0, is, ie, js, je
862 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
865 call mpp_get_compute_domain(ocean_sfc%Domain, isc_bnd, iec_bnd, &
867 if (
present(patm))
then
869 if (.not.
present(press_to_z))
call mom_error(fatal, &
870 'convert_state_to_ocean_type: press_to_z must be present if patm is.')
873 i0 = is - isc_bnd ; j0 = js - jsc_bnd
874 if (sfc_state%T_is_conT)
then
876 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
877 ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(sfc_state%SSS(i+i0,j+j0), &
881 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
885 if (sfc_state%S_is_absS)
then
887 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
888 ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(sfc_state%SSS(i+i0,j+j0))
891 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
892 ocean_sfc%s_surf(i,j) = sfc_state%SSS(i+i0,j+j0)
896 if (
present(patm))
then
897 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
898 ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z
899 ocean_sfc%area(i,j) = us%L_to_m**2*g%areaT(i+i0,j+j0)
902 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
903 ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0)
904 ocean_sfc%area(i,j) = us%L_to_m**2*g%areaT(i+i0,j+j0)
908 if (
associated(sfc_state%frazil))
then
909 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
910 ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0)
914 if (
allocated(sfc_state%melt_potential))
then
915 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
916 ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0)
920 if (
allocated(sfc_state%Hml))
then
921 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
922 ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0)
926 if (ocean_sfc%stagger == agrid)
then
927 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
928 ocean_sfc%u_surf(i,j) = g%mask2dT(i+i0,j+j0) * &
929 0.5*(sfc_state%u(i+i0,j+j0)+sfc_state%u(i-1+i0,j+j0))
930 ocean_sfc%v_surf(i,j) = g%mask2dT(i+i0,j+j0) * &
931 0.5*(sfc_state%v(i+i0,j+j0)+sfc_state%v(i+i0,j-1+j0))
933 elseif (ocean_sfc%stagger == bgrid_ne)
then
934 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
935 ocean_sfc%u_surf(i,j) = g%mask2dBu(i+i0,j+j0) * &
936 0.5*(sfc_state%u(i+i0,j+j0)+sfc_state%u(i+i0,j+j0+1))
937 ocean_sfc%v_surf(i,j) = g%mask2dBu(i+i0,j+j0) * &
938 0.5*(sfc_state%v(i+i0,j+j0)+sfc_state%v(i+i0+1,j+j0))
940 elseif (ocean_sfc%stagger == cgrid_ne)
then
941 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
942 ocean_sfc%u_surf(i,j) = g%mask2dCu(i+i0,j+j0)*sfc_state%u(i+i0,j+j0)
943 ocean_sfc%v_surf(i,j) = g%mask2dCv(i+i0,j+j0)*sfc_state%v(i+i0,j+j0)
946 write(val_str,
'(I8)') ocean_sfc%stagger
947 call mom_error(fatal,
"convert_state_to_ocean_type: "//&
948 "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str))
951 if (coupler_type_initialized(sfc_state%tr_fields))
then
952 if (.not.coupler_type_initialized(ocean_sfc%fields))
then
953 call mom_error(fatal,
"convert_state_to_ocean_type: "//&
954 "Ocean_sfc%fields has not been initialized.")
956 call coupler_type_copy_data(sfc_state%tr_fields, ocean_sfc%fields)
970 integer :: is, ie, js, je
972 is = os%grid%isc ; ie = os%grid%iec ; js = os%grid%jsc ; je = os%grid%jec
973 call coupler_type_spawn(ocean_sfc%fields, os%sfc_state%tr_fields, &
974 (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
976 call extract_surface_state(os%MOM_CSp, os%sfc_state)
990 integer,
optional,
intent(in) :: verbosity
995 os_is_set = .false. ;
if (
present(os)) os_is_set =
associated(os)
998 verbose = 5 ;
if (os_is_set) verbose = 3
999 if (
present(verbosity)) verbose = verbosity
1009 use stock_constants_mod,
only : istock_water, istock_heat,istock_salt
1012 integer,
intent(in) :: index
1013 real,
intent(out) ::
value
1014 integer,
optional,
intent(in) :: time_index
1024 if (.not.
associated(os))
return
1025 if (.not.os%is_ocean_pe)
return
1029 if (os%GV%Boussinesq)
then
1032 call get_ocean_stocks(os%MOM_CSp, mass=
value, salt=salt, on_pe_only=.true.)
1033 value =
value - salt
1039 case default ;
value = 0.0
1050 character(len=*),
intent(in) :: id
1051 integer,
intent(in) :: timestep
1054 integer :: n, m, outunit
1058 write(outunit,*)
"BEGIN CHECKSUM(ocean_type):: ", id, timestep
1059 write(outunit,100)
'ocean%t_surf ',mpp_chksum(ocn%t_surf )
1060 write(outunit,100)
'ocean%s_surf ',mpp_chksum(ocn%s_surf )
1061 write(outunit,100)
'ocean%u_surf ',mpp_chksum(ocn%u_surf )
1062 write(outunit,100)
'ocean%v_surf ',mpp_chksum(ocn%v_surf )
1063 write(outunit,100)
'ocean%sea_lev ',mpp_chksum(ocn%sea_lev)
1064 write(outunit,100)
'ocean%frazil ',mpp_chksum(ocn%frazil )
1065 write(outunit,100)
'ocean%melt_potential ',mpp_chksum(ocn%melt_potential)
1067 call coupler_type_write_chksums(ocn%fields, outunit,
'ocean%')
1068 100
FORMAT(
" CHECKSUM::",a20,
" = ",z20)