39 use mom_time_manager,
only :
operator(+),
operator(-),
operator(*),
operator(/)
41 use mom_time_manager,
only :
operator(<), real_to_time_type, time_type_to_real
49 use coupler_types_mod,
only : coupler_1d_bc_type, coupler_2d_bc_type
50 use coupler_types_mod,
only : coupler_type_spawn, coupler_type_write_chksums
51 use coupler_types_mod,
only : coupler_type_initialized, coupler_type_copy_data
52 use coupler_types_mod,
only : coupler_type_set_diags, coupler_type_send_data
53 use mpp_domains_mod,
only : domain2d, mpp_get_layout, mpp_get_global_domain
54 use mpp_domains_mod,
only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain
55 use fms_mod,
only : stdout
56 use mpp_mod,
only : mpp_chksum
57 use mom_eos,
only : gsw_sp_from_sr, gsw_pt_from_ct
65 #include <MOM_memory.h>
67 #ifdef _USE_GENERIC_TRACER
71 implicit none ;
private
78 public ice_ocn_bnd_type_chksum
87 type(domain2d) :: domain
88 logical :: is_ocean_pe
89 character(len=32) :: instance_name =
''
92 integer,
pointer,
dimension(:) :: pelist => null()
93 logical,
pointer,
dimension(:,:) :: maskmap =>null()
99 integer :: stagger = -999
108 real,
pointer,
dimension(:,:) :: &
117 melt_potential => null(), &
120 type(coupler_2d_bc_type) :: fields
125 integer,
dimension(2) :: axes = 0
135 logical :: is_ocean_pe = .false.
136 type(time_type) :: time
137 integer :: restart_control
145 logical :: use_ice_shelf
148 logical :: icebergs_alter_ocean
150 logical :: restore_salinity
152 logical :: restore_temp
157 logical :: offline_tracer_mode = .false.
165 logical :: single_step_call
172 logical :: thermo_spans_coupling
174 logical :: diabatic_first
200 ice_shelf_csp => null()
204 marine_ice_csp => null()
209 forcing_csp => null()
211 restart_csp => null()
225 subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file)
227 intent(inout) :: ocean_sfc
233 type(time_type),
intent(in) :: time_init
234 type(time_type),
intent(in) :: time_in
235 type(coupler_1d_bc_type), &
236 optional,
intent(in) :: gas_fields_ocn
241 character(len=*),
optional,
intent(in) :: input_restart_file
249 logical :: use_melt_pot
252 #include "version_variable.h"
253 character(len=40) :: mdl =
"ocean_model_init"
254 character(len=48) :: stagger
255 integer :: secs, days
257 logical :: use_temperature
260 if (
associated(os))
then
261 call mom_error(warning,
"ocean_model_init called with an associated "// &
262 "ocean_state_type structure. Model is already initialized.")
267 os%is_ocean_pe = ocean_sfc%is_ocean_pe
268 if (.not.os%is_ocean_pe)
return
271 call initialize_mom(os%Time, time_init, param_file, os%dirs, os%MOM_CSp, &
272 os%restart_CSp, time_in, offline_tracer_mode=os%offline_tracer_mode, &
273 input_restart_file=input_restart_file, &
274 diag_ptr=os%diag, count_calls=.true.)
275 call get_mom_state_elements(os%MOM_CSp, g=os%grid, gv=os%GV, us=os%US, c_p=os%C_p, &
276 use_temp=use_temperature)
277 os%fluxes%C_p = os%C_p
282 call get_param(param_file, mdl,
"SINGLE_STEPPING_CALL", os%single_step_call, &
283 "If true, advance the state of MOM with a single step "//&
284 "including both dynamics and thermodynamics. If false, "//&
285 "the two phases are advanced with separate calls.", default=.true.)
286 call get_param(param_file, mdl,
"DT", os%dt, &
287 "The (baroclinic) dynamics time step. The time-step that "//&
288 "is actually used will be an integer fraction of the "//&
289 "forcing time-step.", units=
"s", fail_if_missing=.true.)
290 call get_param(param_file, mdl,
"DT_THERM", os%dt_therm, &
291 "The thermodynamic and tracer advection time step. "//&
292 "Ideally DT_THERM should be an integer multiple of DT "//&
293 "and less than the forcing or coupling time-step, unless "//&
294 "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//&
295 "can be an integer multiple of the coupling timestep. By "//&
296 "default DT_THERM is set to DT.", units=
"s", default=os%dt)
297 call get_param(param_file,
"MOM",
"THERMO_SPANS_COUPLING", os%thermo_spans_coupling, &
298 "If true, the MOM will take thermodynamic and tracer "//&
299 "timesteps that can be longer than the coupling timestep. "//&
300 "The actual thermodynamic timestep that is used in this "//&
301 "case is the largest integer multiple of the coupling "//&
302 "timestep that is less than or equal to DT_THERM.", default=.false.)
303 call get_param(param_file, mdl,
"DIABATIC_FIRST", os%diabatic_first, &
304 "If true, apply diabatic and thermodynamic processes, "//&
305 "including buoyancy forcing and mass gain or loss, "//&
306 "before stepping the dynamics forward.", default=.false.)
308 call get_param(param_file, mdl,
"RESTART_CONTROL", os%Restart_control, &
309 "An integer whose bits encode which restart files are "//&
310 "written. Add 2 (bit 1) for a time-stamped file, and odd "//&
311 "(bit 0) for a non-time-stamped file. A restart file "//&
312 "will be saved at the end of the run segment for any "//&
313 "non-negative value.", default=1)
314 call get_param(param_file, mdl,
"OCEAN_SURFACE_STAGGER", stagger, &
315 "A case-insensitive character string to indicate the "//&
316 "staggering of the surface velocity field that is "//&
317 "returned to the coupler. Valid values include "//&
318 "'A', 'B', or 'C'.", default=
"C")
319 if (
uppercase(stagger(1:1)) ==
'A')
then ; ocean_sfc%stagger = agrid
320 elseif (
uppercase(stagger(1:1)) ==
'B')
then ; ocean_sfc%stagger = bgrid_ne
321 elseif (
uppercase(stagger(1:1)) ==
'C')
then ; ocean_sfc%stagger = cgrid_ne
322 else ;
call mom_error(fatal,
"ocean_model_init: OCEAN_SURFACE_STAGGER = "// &
323 trim(stagger)//
" is invalid.") ;
endif
325 call get_param(param_file, mdl,
"EPS_OMESH",os%eps_omesh, &
326 "Maximum allowable difference between ESMF mesh and "//&
327 "MOM6 domain coordinates in nuopc cap.", &
328 units=
"degrees", default=1.e-4)
329 call get_param(param_file, mdl,
"RESTORE_SALINITY",os%restore_salinity, &
330 "If true, the coupled driver will add a globally-balanced "//&
331 "fresh-water flux that drives sea-surface salinity "//&
332 "toward specified values.", default=.false.)
333 call get_param(param_file, mdl,
"RESTORE_TEMPERATURE",os%restore_temp, &
334 "If true, the coupled driver will add a "//&
335 "heat flux that drives sea-surface temperature "//&
336 "toward specified values.", default=.false.)
337 call get_param(param_file, mdl,
"RHO_0", rho0, &
338 "The mean ocean density used with BOUSSINESQ true to "//&
339 "calculate accelerations and the mass for conservation "//&
340 "properties, or with BOUSSINSEQ false to convert some "//&
341 "parameters from vertical units of m to kg m-2.", &
342 units=
"kg m-3", default=1035.0)
343 call get_param(param_file, mdl,
"G_EARTH", g_earth, &
344 "The gravitational acceleration of the Earth.", &
345 units=
"m s-2", default = 9.80)
347 call get_param(param_file, mdl,
"ICE_SHELF", os%use_ice_shelf, &
348 "If true, enables the ice shelf model.", default=.false.)
350 call get_param(param_file, mdl,
"ICEBERGS_APPLY_RIGID_BOUNDARY", os%icebergs_alter_ocean, &
351 "If true, allows icebergs to change boundary condition felt by ocean", default=.false.)
353 os%press_to_z = 1.0/(rho0*g_earth)
355 call get_param(param_file, mdl,
"HFREEZE", hfrz, &
356 "If HFREEZE > 0, melt potential will be computed. The actual depth "//&
357 "over which melt potential is computed will be min(HFREEZE, OBLD), "//&
358 "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//&
359 "melt potential will not be computed.", units=
"m", default=-1.0, do_not_log=.true.)
361 if (hfrz .gt. 0.0)
then
369 call allocate_surface_state(os%sfc_state, os%grid, use_temperature, &
370 do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot)
372 call surface_forcing_init(time_in, os%grid, os%US, param_file, os%diag, &
373 os%forcing_CSp, os%restore_salinity, os%restore_temp)
375 if (os%use_ice_shelf)
then
376 call initialize_ice_shelf(param_file, os%grid, os%Time, os%ice_shelf_CSp, &
377 os%diag, os%forces, os%fluxes)
379 if (os%icebergs_alter_ocean)
then
380 call marine_ice_init(os%Time, os%grid, param_file, os%diag, os%marine_ice_CSp)
381 if (.not. os%use_ice_shelf) &
382 call allocate_forcing_type(os%grid, os%fluxes, shelf=.true.)
385 call get_param(param_file, mdl,
"USE_WAVES", os%Use_Waves, &
386 "If true, enables surface wave modules.", default=.false.)
387 if (os%use_waves)
then
388 call mom_wave_interface_init(os%Time, os%grid, os%GV, os%US, param_file, os%Waves, os%diag)
393 if (
associated(os%grid%Domain%maskmap))
then
395 os%diag, maskmap=os%grid%Domain%maskmap, &
396 gas_fields_ocn=gas_fields_ocn)
399 os%diag, gas_fields_ocn=gas_fields_ocn)
404 if (
present(gas_fields_ocn))
then
405 call coupler_type_set_diags(ocean_sfc%fields,
"ocean_sfc", &
406 ocean_sfc%axes(1:2), time_in)
408 call extract_surface_state(os%MOM_CSp, os%sfc_state)
418 write(*,
'(/12x,a/)')
'======== COMPLETED MOM INITIALIZATION ========'
429 time_start_update, Ocean_coupling_time_step, &
430 update_dyn, update_thermo, Ocn_fluxes_used)
432 intent(in) :: ice_ocean_boundary
438 intent(inout) :: ocean_sfc
442 type(time_type),
intent(in) :: time_start_update
443 type(time_type),
intent(in) :: ocean_coupling_time_step
445 logical,
optional,
intent(in) :: update_dyn
447 logical,
optional,
intent(in) :: update_thermo
449 logical,
optional,
intent(in) :: ocn_fluxes_used
453 type(time_type) :: master_time
455 type(time_type) :: time1
457 integer :: index_bnds(4)
466 real :: t_elapsed_seg
467 integer :: n, n_max, n_last_thermo
468 type(time_type) :: time2
469 logical :: thermo_does_span_coupling
473 logical :: step_thermo
474 integer :: secs, days
475 integer :: is, ie, js, je
477 call calltree_enter(
"update_ocean_model(), MOM_ocean_model_nuopc.F90")
478 call get_time(ocean_coupling_time_step, secs, days)
479 dt_coupling = 86400.0*real(days) + real(secs)
481 if (time_start_update /= os%Time)
then
482 call mom_error(warning,
"update_ocean_model: internal clock does not "//&
483 "agree with time_start_update argument.")
485 if (.not.
associated(os))
then
486 call mom_error(fatal,
"update_ocean_model called with an unassociated "// &
487 "ocean_state_type structure. ocean_model_init must be "// &
488 "called first to allocate this structure.")
492 do_dyn = .true. ;
if (
present(update_dyn)) do_dyn = update_dyn
493 do_thermo = .true. ;
if (
present(update_thermo)) do_thermo = update_thermo
497 is = os%grid%isc ; ie = os%grid%iec ; js = os%grid%jsc ; je = os%grid%jec
498 call coupler_type_spawn(ocean_sfc%fields, os%sfc_state%tr_fields, &
499 (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
502 call mpp_get_compute_domain(ocean_sfc%Domain, index_bnds(1), index_bnds(2), &
503 index_bnds(3), index_bnds(4))
507 call convert_iob_to_forces(ice_ocean_boundary, os%forces, index_bnds, os%Time, &
508 os%grid, os%US, os%forcing_CSp)
510 if (os%fluxes%fluxes_used)
then
512 call convert_iob_to_fluxes(ice_ocean_boundary, os%fluxes, index_bnds, os%Time, dt_coupling, &
513 os%grid, os%US, os%forcing_CSp, os%sfc_state, &
514 os%restore_salinity, os%restore_temp)
517 if (os%use_ice_shelf)
then
519 call shelf_calc_flux(os%sfc_state, os%fluxes, os%Time, dt_coupling, os%Ice_shelf_CSp)
523 if (os%icebergs_alter_ocean)
then
526 os%sfc_state, dt_coupling, os%marine_ice_CSp)
528 call iceberg_fluxes(os%grid, os%US, os%fluxes, os%use_ice_shelf, &
529 os%sfc_state, dt_coupling, os%marine_ice_CSp)
533 call copy_common_forcing_fields(os%forces, os%fluxes, os%grid, skip_pres=.true.)
535 #ifdef _USE_GENERIC_TRACER
536 call enable_averaging(dt_coupling, os%Time + ocean_coupling_time_step, os%diag)
537 call mom_generic_tracer_fluxes_accumulate(os%fluxes, weight)
540 os%flux_tmp%C_p = os%fluxes%C_p
542 call convert_iob_to_fluxes(ice_ocean_boundary, os%flux_tmp, index_bnds, os%Time, dt_coupling, &
543 os%grid, os%US, os%forcing_CSp, os%sfc_state, os%restore_salinity,os%restore_temp)
545 if (os%use_ice_shelf)
then
547 call shelf_calc_flux(os%sfc_state, os%flux_tmp, os%Time, dt_coupling, os%Ice_shelf_CSp)
551 if (os%icebergs_alter_ocean)
then
554 os%sfc_state, dt_coupling, os%marine_ice_CSp)
556 call iceberg_fluxes(os%grid, os%US, os%flux_tmp, os%use_ice_shelf, &
557 os%sfc_state, dt_coupling, os%marine_ice_CSp)
560 call forcing_accumulate(os%flux_tmp, os%forces, os%fluxes, os%grid, weight)
563 call copy_back_forcing_fields(os%fluxes, os%forces, os%grid)
565 #ifdef _USE_GENERIC_TRACER
566 call mom_generic_tracer_fluxes_accumulate(os%flux_tmp, weight)
569 call set_derived_forcing_fields(os%forces, os%fluxes, os%grid, os%US, os%GV%Rho0)
570 call set_net_mass_forcing(os%fluxes, os%forces, os%grid, os%US)
572 if (os%use_waves)
then
576 if (os%nstep==0)
then
577 call finish_mom_initialization(os%Time, os%dirs, os%MOM_CSp, os%restart_CSp)
580 call disable_averaging(os%diag)
581 master_time = os%Time ; time1 = os%Time
583 if (os%offline_tracer_mode)
then
584 call step_offline(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp)
585 elseif ((.not.do_thermo) .or. (.not.do_dyn))
then
587 call step_mom(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp, &
588 waves=os%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, &
589 reset_therm=ocn_fluxes_used)
592 elseif (os%single_step_call)
then
593 call step_mom(os%forces, os%fluxes, os%sfc_state, time1, dt_coupling, os%MOM_CSp, waves=os%Waves)
595 n_max = 1 ;
if (dt_coupling > os%dt) n_max = ceiling(dt_coupling/os%dt - 0.001)
596 dt_dyn = dt_coupling / real(n_max)
597 thermo_does_span_coupling = (os%thermo_spans_coupling .and. &
598 (os%dt_therm > 1.5*dt_coupling))
600 if (thermo_does_span_coupling)
then
601 dt_therm = dt_coupling * floor(os%dt_therm / dt_coupling + 0.001)
602 nts = floor(dt_therm/dt_dyn + 0.001)
604 nts = max(1,min(n_max,floor(os%dt_therm/dt_dyn + 0.001)))
608 time2 = time1 ; t_elapsed_seg = 0.0
610 if (os%diabatic_first)
then
611 if (thermo_does_span_coupling)
call mom_error(fatal, &
612 "MOM is not yet set up to have restarts that work with "//&
613 "THERMO_SPANS_COUPLING and DIABATIC_FIRST.")
614 if (modulo(n-1,nts)==0)
then
615 dtdia = dt_dyn*min(nts,n_max-(n-1))
616 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dtdia, os%MOM_CSp, &
617 waves=os%Waves, do_dynamics=.false., do_thermodynamics=.true., &
618 start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling)
621 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dt_dyn, os%MOM_CSp, &
622 waves=os%Waves, do_dynamics=.true., do_thermodynamics=.false., &
623 start_cycle=.false., end_cycle=(n==n_max), 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=(n==1), end_cycle=.false., cycle_length=dt_coupling)
629 step_thermo = .false.
630 if (thermo_does_span_coupling)
then
632 step_thermo = mom_state_is_synchronized(os%MOM_CSp, adv_dyn=.true.)
633 elseif ((modulo(n,nts)==0) .or. (n==n_max))
then
634 dtdia = dt_dyn*(n - n_last_thermo)
639 if (step_thermo)
then
641 time2 = time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5)))
642 call step_mom(os%forces, os%fluxes, os%sfc_state, time2, dtdia, os%MOM_CSp, &
643 waves=os%Waves, do_dynamics=.false., do_thermodynamics=.true., &
644 start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling)
648 t_elapsed_seg = t_elapsed_seg + dt_dyn
649 time2 = time1 + set_time(int(floor(t_elapsed_seg + 0.5)))
653 os%Time = master_time + ocean_coupling_time_step
654 os%nstep = os%nstep + 1
656 call mech_forcing_diags(os%forces, dt_coupling, os%grid, os%Time, os%diag, os%forcing_CSp%handles)
658 if (os%fluxes%fluxes_used)
then
659 call forcing_diagnostics(os%fluxes, os%sfc_state, os%grid, os%US, os%Time, os%diag, os%forcing_CSp%handles)
666 call coupler_type_send_data(ocean_sfc%fields, os%Time)
675 character(len=*),
optional,
intent(in) :: timestamp
677 character(len=*),
optional,
intent(in) :: restartname
681 if (.not.mom_state_is_synchronized(os%MOM_CSp)) &
682 call mom_error(warning,
"End of MOM_main reached with inconsistent "//&
683 "dynamics and advective times. Additional restart fields "//&
684 "that have not been coded yet would be required for reproducibility.")
685 if (.not.os%fluxes%fluxes_used)
call mom_error(fatal,
"ocean_model_restart "//&
686 "was called with unused buoyancy fluxes. For conservation, the ocean "//&
687 "restart files can only be created after the buoyancy forcing is applied.")
689 if (
present(restartname))
then
690 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
691 os%restart_CSp, gv=os%GV, filename=restartname)
693 os%dirs%restart_output_dir)
694 if (os%use_ice_shelf)
then
696 os%dirs%restart_output_dir)
699 if (btest(os%Restart_control,1))
then
700 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
701 os%restart_CSp, .true., gv=os%GV)
703 os%dirs%restart_output_dir, .true.)
704 if (os%use_ice_shelf)
then
708 if (btest(os%Restart_control,0))
then
709 call save_restart(os%dirs%restart_output_dir, os%Time, os%grid, &
710 os%restart_CSp, gv=os%GV)
712 os%dirs%restart_output_dir)
713 if (os%use_ice_shelf)
then
724 subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time, write_restart)
730 type(time_type),
intent(in) :: time
731 logical,
intent(in) :: write_restart
735 call mom_end(ocean_state%MOM_CSp)
736 if (ocean_state%use_ice_shelf)
call ice_shelf_end(ocean_state%Ice_shelf_CSp)
744 type(time_type),
intent(in) :: time
745 character(len=*),
optional,
intent(in) :: directory
747 character(len=*),
optional,
intent(in) :: filename_suffix
752 character(len=200) :: restart_dir
754 if (.not.mom_state_is_synchronized(os%MOM_CSp)) &
755 call mom_error(warning,
"ocean_model_save_restart called with inconsistent "//&
756 "dynamics and advective times. Additional restart fields "//&
757 "that have not been coded yet would be required for reproducibility.")
758 if (.not.os%fluxes%fluxes_used)
call mom_error(fatal,
"ocean_model_save_restart "//&
759 "was called with unused buoyancy fluxes. For conservation, the ocean "//&
760 "restart files can only be created after the buoyancy forcing is applied.")
762 if (
present(directory))
then ; restart_dir = directory
763 else ; restart_dir = os%dirs%restart_output_dir ;
endif
765 call save_restart(restart_dir, time, os%grid, os%restart_CSp, gv=os%GV)
769 if (os%use_ice_shelf)
then
778 type(domain2d),
intent(in) :: input_domain
783 logical,
dimension(:,:), &
784 optional,
intent(in) :: maskmap
786 type(coupler_1d_bc_type), &
787 optional,
intent(in) :: gas_fields_ocn
792 integer :: xsz, ysz, layout(2)
795 integer :: isc, iec, jsc, jec
797 call mpp_get_layout(input_domain,layout)
798 call mpp_get_global_domain(input_domain, xsize=xsz, ysize=ysz)
799 if (
PRESENT(maskmap))
then
800 call mpp_define_domains((/1,xsz,1,ysz/),layout,ocean_sfc%Domain, maskmap=maskmap)
802 call mpp_define_domains((/1,xsz,1,ysz/),layout,ocean_sfc%Domain)
804 call mpp_get_compute_domain(ocean_sfc%Domain, isc, iec, jsc, jec)
806 allocate ( ocean_sfc%t_surf (isc:iec,jsc:jec), &
807 ocean_sfc%s_surf (isc:iec,jsc:jec), &
808 ocean_sfc%u_surf (isc:iec,jsc:jec), &
809 ocean_sfc%v_surf (isc:iec,jsc:jec), &
810 ocean_sfc%sea_lev(isc:iec,jsc:jec), &
811 ocean_sfc%area (isc:iec,jsc:jec), &
812 ocean_sfc%OBLD (isc:iec,jsc:jec), &
813 ocean_sfc%melt_potential(isc:iec,jsc:jec), &
814 ocean_sfc%frazil (isc:iec,jsc:jec))
816 ocean_sfc%t_surf = 0.0
817 ocean_sfc%s_surf = 0.0
818 ocean_sfc%u_surf = 0.0
819 ocean_sfc%v_surf = 0.0
820 ocean_sfc%sea_lev = 0.0
821 ocean_sfc%frazil = 0.0
822 ocean_sfc%melt_potential = 0.0
825 ocean_sfc%axes = diag%axesT1%handles
827 if (
present(gas_fields_ocn))
then
828 call coupler_type_spawn(gas_fields_ocn, ocean_sfc%fields, (/isc,isc,iec,iec/), &
829 (/jsc,jsc,jec,jec/), suffix =
'_ocn', as_needed=.true.)
843 target,
intent(inout) :: Ocean_sfc
848 real,
optional,
intent(in) :: patm(:,:)
849 real,
optional,
intent(in) :: press_to_z
853 character(len=48) :: val_str
854 integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd
855 integer :: i, j, i0, j0, is, ie, js, je
857 is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
858 call pass_vector(sfc_state%u, sfc_state%v, g%Domain)
860 call mpp_get_compute_domain(ocean_sfc%Domain, isc_bnd, iec_bnd, &
862 if (
present(patm))
then
864 if (.not.
present(press_to_z))
call mom_error(fatal, &
865 'convert_state_to_ocean_type: press_to_z must be present if patm is.')
868 i0 = is - isc_bnd ; j0 = js - jsc_bnd
869 if (sfc_state%T_is_conT)
then
871 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
872 ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(sfc_state%SSS(i+i0,j+j0), &
876 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
880 if (sfc_state%S_is_absS)
then
882 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
883 ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(sfc_state%SSS(i+i0,j+j0))
886 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
887 ocean_sfc%s_surf(i,j) = sfc_state%SSS(i+i0,j+j0)
891 if (
present(patm))
then
892 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
893 ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z
894 ocean_sfc%area(i,j) = us%L_to_m**2*g%areaT(i+i0,j+j0)
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)
899 ocean_sfc%area(i,j) = us%L_to_m**2*g%areaT(i+i0,j+j0)
903 if (
associated(sfc_state%frazil))
then
904 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
905 ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0)
909 if (
allocated(sfc_state%melt_potential))
then
910 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
911 ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0)
915 if (
allocated(sfc_state%Hml))
then
916 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
917 ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0)
921 if (ocean_sfc%stagger == agrid)
then
922 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
923 ocean_sfc%u_surf(i,j) = g%mask2dT(i+i0,j+j0) * &
924 0.5*(sfc_state%u(i+i0,j+j0)+sfc_state%u(i-1+i0,j+j0))
925 ocean_sfc%v_surf(i,j) = g%mask2dT(i+i0,j+j0) * &
926 0.5*(sfc_state%v(i+i0,j+j0)+sfc_state%v(i+i0,j-1+j0))
928 elseif (ocean_sfc%stagger == bgrid_ne)
then
929 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
930 ocean_sfc%u_surf(i,j) = g%mask2dBu(i+i0,j+j0) * &
931 0.5*(sfc_state%u(i+i0,j+j0)+sfc_state%u(i+i0,j+j0+1))
932 ocean_sfc%v_surf(i,j) = g%mask2dBu(i+i0,j+j0) * &
933 0.5*(sfc_state%v(i+i0,j+j0)+sfc_state%v(i+i0+1,j+j0))
935 elseif (ocean_sfc%stagger == cgrid_ne)
then
936 do j=jsc_bnd,jec_bnd ;
do i=isc_bnd,iec_bnd
937 ocean_sfc%u_surf(i,j) = g%mask2dCu(i+i0,j+j0)*sfc_state%u(i+i0,j+j0)
938 ocean_sfc%v_surf(i,j) = g%mask2dCv(i+i0,j+j0)*sfc_state%v(i+i0,j+j0)
941 write(val_str,
'(I8)') ocean_sfc%stagger
942 call mom_error(fatal,
"convert_state_to_ocean_type: "//&
943 "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str))
946 if (coupler_type_initialized(sfc_state%tr_fields))
then
947 if (.not.coupler_type_initialized(ocean_sfc%fields))
then
948 call mom_error(fatal,
"convert_state_to_ocean_type: "//&
949 "Ocean_sfc%fields has not been initialized.")
951 call coupler_type_copy_data(sfc_state%tr_fields, ocean_sfc%fields)
965 integer :: is, ie, js, je
967 is = os%grid%isc ; ie = os%grid%iec ; js = os%grid%jsc ; je = os%grid%jec
968 call coupler_type_spawn(ocean_sfc%fields, os%sfc_state%tr_fields, &
969 (/is,is,ie,ie/), (/js,js,je,je/), as_needed=.true.)
971 call extract_surface_state(os%MOM_CSp, os%sfc_state)
985 integer,
optional,
intent(in) :: verbosity
990 os_is_set = .false. ;
if (
present(os)) os_is_set =
associated(os)
993 verbose = 5 ;
if (os_is_set) verbose = 3
994 if (
present(verbosity)) verbose = verbosity
1004 use stock_constants_mod,
only : istock_water, istock_heat,istock_salt
1007 integer,
intent(in) :: index
1008 real,
intent(out) ::
value
1009 integer,
optional,
intent(in) :: time_index
1019 if (.not.
associated(os))
return
1020 if (.not.os%is_ocean_pe)
return
1024 if (os%GV%Boussinesq)
then
1027 call get_ocean_stocks(os%MOM_CSp, mass=
value, salt=salt, on_pe_only=.true.)
1028 value =
value - salt
1034 case default ;
value = 0.0
1045 character(len=*),
intent(in) :: id
1046 integer,
intent(in) :: timestep
1049 integer :: n, m, outunit
1053 write(outunit,*)
"BEGIN CHECKSUM(ocean_type):: ", id, timestep
1054 write(outunit,100)
'ocean%t_surf ',mpp_chksum(ocn%t_surf )
1055 write(outunit,100)
'ocean%s_surf ',mpp_chksum(ocn%s_surf )
1056 write(outunit,100)
'ocean%u_surf ',mpp_chksum(ocn%u_surf )
1057 write(outunit,100)
'ocean%v_surf ',mpp_chksum(ocn%v_surf )
1058 write(outunit,100)
'ocean%sea_lev ',mpp_chksum(ocn%sea_lev)
1059 write(outunit,100)
'ocean%frazil ',mpp_chksum(ocn%frazil )
1060 write(outunit,100)
'ocean%melt_potential ',mpp_chksum(ocn%melt_potential)
1062 call coupler_type_write_chksums(ocn%fields, outunit,
'ocean%')
1063 100
FORMAT(
" CHECKSUM::",a20,
" = ",z20)