From 7bb80a95fe9dd7c9d051e849f7dd82ddfeb5cc8b Mon Sep 17 00:00:00 2001 From: dougiesquire Date: Fri, 16 Aug 2024 08:30:56 +1000 Subject: [PATCH] Allow generic tracers with accesscm_coupler --- exp/MOM_compile.csh | 6 +- exp/ocean_compile.csh | 4 +- .../accesscm_coupler/mom_oasis3_interface.F90 | 53 +++++-- src/access/accesscm_coupler/ocean_solo.F90 | 131 ++++++++---------- 4 files changed, 110 insertions(+), 84 deletions(-) diff --git a/exp/MOM_compile.csh b/exp/MOM_compile.csh index eff7bc2be5..3145b6b927 100755 --- a/exp/MOM_compile.csh +++ b/exp/MOM_compile.csh @@ -57,7 +57,7 @@ if ( $help ) then echo " EBM : ocean-seaice-land-atmosphere coupled model with energy balance atmosphere" echo " ACCESS-CM : ocean component of ACCESS-CM model." echo " ACCESS-OM : ocean component of ACCESS-OM model." - echo " ACCESS-ESM : ocean component of ACCESS-ESM model with CSIRO BGC (Wombat)." + echo " ACCESS-ESM : ocean component of ACCESS-ESM model with support for generic tracer WOMBATlite." echo " ACCESS-OM-BGC: ocean component of ACCESS-OM model with CSIRO BGC (Wombat). Wombat has now been" echo " implemented as a generic tracer and is available in the ACCESS-OM model type." echo " ACCESS-OM-BGC is retained only for legacy." @@ -112,7 +112,7 @@ else if( $type == ACCESS-OM-BGC ) then else if( $type == ACCESS-CM ) then set cppDefs = ( "-Duse_netCDF -Duse_libMPI -DACCESS_CM" ) else if( $type == ACCESS-ESM ) then - set cppDefs = ( "-Duse_netCDF -Duse_libMPI -DACCESS_CM -DCSIRO_BGC" ) + set cppDefs = ( "-Duse_netCDF -Duse_libMPI -DACCESS_CM -DUSE_OCEAN_BGC" ) endif if ( $unit_testing ) then @@ -256,7 +256,7 @@ else exit 1 endif -if( $type == ACCESS-OM ) then +if( $type == ACCESS-OM || $type == ACCESS-ESM) then set srcList = ( $srcList access/shared ) endif diff --git a/exp/ocean_compile.csh b/exp/ocean_compile.csh index bf7ac8eb57..fbfcd09ad4 100644 --- a/exp/ocean_compile.csh +++ b/exp/ocean_compile.csh @@ -6,9 +6,9 @@ set lib_name = "lib_ocean" if( $type == ACCESS-OM || $type == ACCESS-CM || $type == ACCESS-OM-BGC || $type == ACCESS-ESM) then set srcList = ( $srcList mom5/ocean_access ) - if( $type == ACCESS-OM-BGC || $type == ACCESS-ESM) then + if( $type == ACCESS-OM-BGC ) then set srcList = ( $srcList mom5/ocean_csiro_bgc ) - else if ( $type == ACCESS-OM ) then + else if ( $type == ACCESS-OM || $type == ACCESS-ESM ) then set srcList = ( $srcList mom5/ocean_bgc access/generic_tracers/generic_tracers access/generic_tracers/mocsy/src ) endif mkdir -p $executable:h:h/$type/$lib_name diff --git a/src/access/accesscm_coupler/mom_oasis3_interface.F90 b/src/access/accesscm_coupler/mom_oasis3_interface.F90 index d34798554e..9816ce0b63 100644 --- a/src/access/accesscm_coupler/mom_oasis3_interface.F90 +++ b/src/access/accesscm_coupler/mom_oasis3_interface.F90 @@ -94,6 +94,9 @@ module mom_oasis3_interface_mod ocean_public_type, & ocean_domain_type use time_manager_mod, only: time_type +use gtracer_flux_mod, only: set_coupler_type_data, extract_coupler_type_data +use coupler_types_mod, only: coupler_2d_bc_type, ind_pcair, ind_u10, ind_psurf, ind_csurf, ind_flux +use constants_mod, only: WTMCO2, hlv ! Timing @@ -355,7 +358,7 @@ subroutine coupler_init(Dom, Time, Time_step_coupled, Run_len, dt_cpld) mom_name_write(6)='frazil' mom_name_write(7)='dssldx' mom_name_write(8)='dssldy' - mom_name_write(9)='co2_o' + mom_name_write(9)='co2_o' ! Ocean surface pCO2 is not used by any other models mom_name_write(10)='co2fx_o' @@ -486,7 +489,7 @@ subroutine coupler_init(Dom, Time, Time_step_coupled, Run_len, dt_cpld) end subroutine coupler_init !======================================================================= -subroutine into_coupler(step, Ocean_sfc, Time, before_ocean_update) +subroutine into_coupler(step, Ocean_sfc, Ice_ocean_boundary, Time, before_ocean_update) !------------------------------------------! use ocean_operators_mod, only : GRAD_BAROTROPIC_P !GRAD_SURF_sealev @@ -496,6 +499,7 @@ subroutine into_coupler(step, Ocean_sfc, Time, before_ocean_update) implicit none type (ocean_public_type) :: Ocean_sfc +type (ice_ocean_boundary_type) :: Ice_ocean_boundary type (time_type),optional :: Time integer, intent(in) :: step @@ -561,9 +565,17 @@ subroutine into_coupler(step, Ocean_sfc, Time, before_ocean_update) case('dssldy') vtmp(iisd:iied,jjsd:jjed) = Ocean_sfc%gradient(iisd:iied,jjsd:jjed,2) case('co2_o') + ! Note, this is not actually used by the other models + ! If this is needed in the future with generic WOMBATlite, it can be calculated from the csurf + ! and alpha fields in the Ocean_sfc%fields coupler_bc_type "co2_flux" boundary condition: + ! pco2 [ppmv] = 1e6 * (co2_csurf / co2_alpha) vtmp(iisd:iied,jjsd:jjed) = Ocean_sfc%co2(iisd:iied,jjsd:jjed) case('co2fx_o') - vtmp(iisd:iied,jjsd:jjed) = Ocean_sfc%co2flux(iisd:iied,jjsd:jjed) + ! vtmp(iisd:iied,jjsd:jjed) = Ocean_sfc%co2flux(iisd:iied,jjsd:jjed) + ! Extract the flux field in the IOB%fluxes coupler_bc_type "co2_flux" boundary condition, + ! converting from [mol/m^2/s] to [kg(CO2)/m^2/s] and to positive downwards + call extract_coupler_type_data(Ice_ocean_boundary%fluxes, "co2_flux", ind_flux, vtmp, & + scale_factor=-1.e-3*WTMCO2, idim=(/iisc,iisc,iiec,iiec/), jdim=(/jjsc,jjsc,jjec,jjec/)) case DEFAULT call mpp_error(FATAL,& '==>Error from into_coupler: Unknown quantity.') @@ -611,16 +623,16 @@ subroutine into_coupler(step, Ocean_sfc, Time, before_ocean_update) end subroutine into_coupler !----------------------------------------------------------------------------------- -subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Time) +subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Atm_fields, Time) ! This is all highly user dependent. -use constants_mod, only : hlv ! 2.500e6 J/kg use auscom_ice_mod, only : chk_i2o_fields, chk_fields_period, chk_fields_start_time implicit none type (ocean_public_type) :: Ocean_sfc type (ice_ocean_boundary_type) :: Ice_ocean_boundary +type (coupler_2d_bc_type) :: Atm_fields type (time_type),optional :: Time real, dimension(isg:ieg,jsg:jeg) :: gtmp @@ -631,7 +643,7 @@ subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Time) frac_nir_dir=0.5*0.57, frac_nir_dif=0.5*0.57 ! shortwave partitioning character*80 :: fname = 'fields_i2o_in_ocn.nc' - integer :: ncid,currstep,ll,ilout + integer :: ncid,currstep,ll,ilout,n data currstep/0/ save currstep @@ -723,7 +735,11 @@ subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Time) case('wfiform') Ice_ocean_boundary%wfiform(iisc:iiec,jjsc:jjec) = vwork(iisc:iiec,jjsc:jjec) case('co2_io') - Ice_ocean_boundary%co2(iisc:iiec,jjsc:jjec) = vwork(iisc:iiec,jjsc:jjec) + ! Ice_ocean_boundary%co2(iisc:iiec,jjsc:jjec) = vwork(iisc:iiec,jjsc:jjec) + ! Set the pcair field in the Atm_fields coupler_bc_type "co2_flux" boundary condition, + ! converting from from [ppmv] to [mol/mol] + call set_coupler_type_data(vwork, "co2_flux", ind_pcair, Atm_fields, & + scale_factor=1.e-6, idim=(/iisc,iisc,iiec,iiec/), jdim=(/jjsc,jjsc,jjec,jjec/)) case('wnd_io') Ice_ocean_boundary%wnd(iisc:iiec,jjsc:jjec) = vwork(iisc:iiec,jjsc:jjec) !20171024: 2 more i2o fields: water and heat fluxes due to land ice discharge into ocean @@ -752,6 +768,18 @@ subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Time) if(jf .ne. 1) call mpp_clock_end(id_oasis_recv1) enddo !jf + + ! Set the u10 and psurf fields in the Atm_fields coupler_bc_types + do n = 1, Atm_fields%num_bcs + if ((Atm_fields%bc(n)%flux_type .eq. 'air_sea_gas_flux_generic') .or. & + (Atm_fields%bc(n)%flux_type .eq. 'air_sea_gas_flux')) then + call set_coupler_type_data(ice_ocean_boundary%wnd, Atm_fields%bc(n)%name, ind_u10, & + Atm_fields, idim=(/iisc,iisc,iiec,iiec/), jdim=(/jjsc,jjsc,jjec,jjec/)) + call set_coupler_type_data(ice_ocean_boundary%p, Atm_fields%bc(n)%name, ind_psurf, & + Atm_fields, idim=(/iisc,iisc,iiec,iiec/), jdim=(/jjsc,jjsc,jjec,jjec/)) + endif + enddo + call mpp_clock_end(id_oasis_recv) if (chk_i2o_fields .and. (mod(step, chk_fields_period) == 0) .and. (step >= chk_fields_start_time) .and. (mpp_pe() == mpp_root_pe())) then @@ -761,13 +789,14 @@ subroutine from_coupler(step,Ocean_sfc,Ice_ocean_boundary, Time) end subroutine from_coupler !----------------------------------------------------------------------------------- -subroutine write_coupler_restart(step,Ocean_sfc,write_restart) +subroutine write_coupler_restart(step,Ocean_sfc,Ice_ocean_boundary,write_restart) use auscom_ice_mod, only : auscom_ice_heatflux_new logical, intent(in) :: write_restart integer, intent(in) :: step type (ocean_public_type) :: Ocean_sfc +type (ice_ocean_boundary_type) :: Ice_ocean_boundary integer :: ncid,ll,ilout real, dimension(iisd:iied,jjsd:jjed) :: vtmp @@ -794,7 +823,13 @@ subroutine write_coupler_restart(step,Ocean_sfc,write_restart) case('dssldy'); vtmp = Ocean_sfc%gradient(iisd:iied,jjsd:jjed,2); fld_ice='ssly_i' case('frazil'); vtmp = Ocean_sfc%frazil(iisd:iied,jjsd:jjed); fld_ice='pfmice_i' case('co2_o'); vtmp = Ocean_sfc%co2(iisd:iied,jjsd:jjed); fld_ice='co2_oi' - case('co2fx_o'); vtmp = Ocean_sfc%co2flux(iisd:iied,jjsd:jjed); fld_ice='co2fx_oi' + case('co2fx_o') + ! vtmp = Ocean_sfc%co2flux(iisd:iied,jjsd:jjed); fld_ice='co2fx_oi' + ! Extract the flux field in the IOB%fluxes coupler_bc_type "co2_flux" boundary condition, + ! converting from [mol/m^2/s] to [kg(CO2)/m^2/s] and to positive downwards + call extract_coupler_type_data(Ice_ocean_boundary%fluxes, "co2_flux", ind_flux, vtmp, & + scale_factor=-1.e-3*WTMCO2, idim=(/iisc,iisc,iiec,iiec/), jdim=(/jjsc,jjsc,jjec,jjec/)) + fld_ice='co2fx_oi' end select if (parallel_coupling) then diff --git a/src/access/accesscm_coupler/ocean_solo.F90 b/src/access/accesscm_coupler/ocean_solo.F90 index 9944be7f30..4397e05675 100644 --- a/src/access/accesscm_coupler/ocean_solo.F90 +++ b/src/access/accesscm_coupler/ocean_solo.F90 @@ -154,11 +154,16 @@ program main use auscom_ice_parameters_mod, only: redsea_gulfbay_sfix, do_sfix_now, sfix_hours, int_sec + use coupler_types_mod, only: coupler_2d_bc_type, coupler_type_data_override, coupler_type_send_data + use gtracer_flux_mod, only: flux_exchange_init, atmos_ocean_fluxes_calc + use gtracer_flux_mod, only: gas_fields_restore, gas_fields_restart + implicit none type (ocean_public_type) :: Ocean_sfc type (ocean_state_type), pointer :: Ocean_state - type(ice_ocean_boundary_type), target :: Ice_ocean_boundary + type(ice_ocean_boundary_type), target :: Ice_ocean_boundary + type(coupler_2d_bc_type), target :: Atm_fields ! define some time types type(time_type) :: Time_init ! initial time for experiment @@ -171,7 +176,8 @@ program main type(time_type) :: Time_restart type(time_type) :: Time_restart_current type(time_type) :: Time_last_sfix - type(time_type) :: Time_sfix + type(time_type) :: Time_sfix + type(time_type) :: Time_next integer :: sfix_seconds character(len=17) :: calendar = 'julian' @@ -393,56 +399,13 @@ program main call data_override_init(Ocean_domain_in = Ocean_sfc%domain) override_clock = mpp_clock_id('Override', flags=flags,grain=CLOCK_COMPONENT) - - call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) - - allocate ( Ice_ocean_boundary% u_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% v_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% t_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% q_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% salt_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% lw_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_vis_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dir (isc:iec,jsc:jec), & - Ice_ocean_boundary% sw_flux_nir_dif (isc:iec,jsc:jec), & - Ice_ocean_boundary% lprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% fprec (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% aice(isc:iec,jsc:jec), & - Ice_ocean_boundary% mh_flux(isc:iec,jsc:jec), & - Ice_ocean_boundary% wfimelt(isc:iec,jsc:jec), & - Ice_ocean_boundary% wfiform(isc:iec,jsc:jec)) - allocate ( Ice_ocean_boundary%co2(isc:iec,jsc:jec), & - Ice_ocean_boundary%wnd(isc:iec,jsc:jec), & - Ice_ocean_boundary%licefw(isc:iec,jsc:jec), & - Ice_ocean_boundary%liceht(isc:iec,jsc:jec)) - - Ice_ocean_boundary%u_flux = 0.0 - Ice_ocean_boundary%v_flux = 0.0 - Ice_ocean_boundary%t_flux = 0.0 - Ice_ocean_boundary%q_flux = 0.0 - Ice_ocean_boundary%salt_flux = 0.0 - Ice_ocean_boundary%lw_flux = 0.0 - Ice_ocean_boundary%sw_flux_vis_dir = 0.0 - Ice_ocean_boundary%sw_flux_vis_dif = 0.0 - Ice_ocean_boundary%sw_flux_nir_dir = 0.0 - Ice_ocean_boundary%sw_flux_nir_dif = 0.0 - Ice_ocean_boundary%lprec = 0.0 - Ice_ocean_boundary%fprec = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%p = 0.0 - Ice_ocean_boundary%aice = 0.0 - Ice_ocean_boundary%mh_flux = 0.0 - Ice_ocean_boundary% wfimelt = 0.0 - Ice_ocean_boundary% wfiform = 0.0 - Ice_ocean_boundary%co2 = 0.0 - Ice_ocean_boundary%wnd = 0.0 - Ice_ocean_boundary%licefw = 0.0 - Ice_ocean_boundary%liceht = 0.0 + + ! Initialise the boundary values, including initialising and setting boundary values + ! in FMS coupler types + call flux_exchange_init(Time, Ocean_sfc, Ocean_state, Ice_ocean_boundary, Atm_fields) + + ! Restore ocean FMS coupler type fields from restart file + call gas_fields_restore(Ocean_sfc) coupler_init_clock = mpp_clock_id('OASIS init', grain=CLOCK_COMPONENT) call mpp_clock_begin(coupler_init_clock) @@ -452,12 +415,25 @@ program main ! loop over the coupled calls do nc=1, num_cpld_calls - call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) + call external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, Atm_fields, nc, dt_cpld ) + ! Potentially override fields from the data_table call mpp_clock_begin(override_clock) - call ice_ocn_bnd_from_data(Ice_ocean_boundary) + Time_next = Time + Time_step_coupled + call coupler_type_data_override('OCN', Atm_fields, Time_next) + call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time_next) call mpp_clock_end(override_clock) + ! Calculate the extra tracer fluxes + call mpp_get_compute_domain(Ocean_sfc%domain, isc, iec, jsc, jec) + call atmos_ocean_fluxes_calc(Atm_fields, Ocean_sfc%fields, Ice_ocean_boundary%fluxes, & + Ice_ocean_boundary%aice, isc, iec, jsc, jec) + + ! Send FMS coupler type diagnostics + call coupler_type_send_data(Ice_ocean_boundary%fluxes, Time_next) + call coupler_type_send_data(Ocean_sfc%fields, Time_next) + call coupler_type_send_data(Atm_fields, Time_next) + if (debug_this_module) then call write_boundary_chksums(Ice_ocean_boundary) endif @@ -473,24 +449,25 @@ program main call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_sfc, Time, Time_step_coupled) - Time = Time + Time_step_coupled + Time = Time_next if( Time >= Time_restart ) then - Time_restart_current = Time - Time_restart = increment_date(Time, restart_interval(1), restart_interval(2), & + Time_restart_current = Time + Time_restart = increment_date(Time, restart_interval(1), restart_interval(2), & restart_interval(3), restart_interval(4), restart_interval(5), restart_interval(6) ) - timestamp = date_to_string(time_restart_current) + timestamp = date_to_string(time_restart_current) write(stdoutunit,*) '=> NOTE from program ocean_solo: intermediate restart file is written and ', & trim(timestamp),' is appended as prefix to each restart file name' call ocean_model_restart(Ocean_state, timestamp) call ocean_solo_restart(Time, Time_restart_current, timestamp) + call gas_fields_restart(Ocean_sfc, timestamp) end if call external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nc, dt_cpld ) enddo - call external_coupler_restart( dt_cpld, num_cpld_calls, Ocean_sfc) + call external_coupler_restart( dt_cpld, num_cpld_calls, Ocean_sfc, Ice_ocean_boundary) ! close some of the main components call ocean_model_end(Ocean_sfc, Ocean_state, Time) @@ -500,8 +477,9 @@ program main ! need to reset pelist before calling mpp_clock_end ! call mpp_set_current_pelist() - ! write restart file + ! write restart files call ocean_solo_restart(Time_end, Time_restart_current) + call gas_fields_restart(Ocean_sfc) call fms_io_exit @@ -559,12 +537,13 @@ end subroutine ocean_solo_restart !==================================================================== ! get forcing data from data_overide -subroutine ice_ocn_bnd_from_data(x) +subroutine ice_ocn_bnd_from_data(x, Time_next) type (ice_ocean_boundary_type) :: x type(time_type) :: Time_next - Time_next = Time + Time_step_coupled + integer :: m, n + call data_override('OCN', 't_flux', x%t_flux , Time_next) call data_override('OCN', 'u_flux', x%u_flux , Time_next) call data_override('OCN', 'v_flux', x%v_flux , Time_next) @@ -582,12 +561,21 @@ subroutine ice_ocn_bnd_from_data(x) call data_override('OCN', 'p', x%p , Time_next) call data_override('OCN', 'aice', x%aice , Time_next) call data_override('OCN', 'mh_flux', x%mh_flux , Time_next) + + ! Overriding ice_ocean_boundary%fluxes here avoids unnecessary calculation + ! of overridden fluxes. However, we cannot use coupler_type_data_override + ! here since it does not set the override flag on overridden fields + do n = 1, x%fluxes%num_bcs + do m = 1, x%fluxes%bc(n)%num_fields + call data_override('OCN', x%fluxes%bc(n)%field(m)%name, & + x%fluxes%bc(n)%field(m)%values, Time_next, & + override=x%fluxes%bc(n)%field(m)%override) + enddo + enddo call mpp_sync() end subroutine ice_ocn_bnd_from_data - - ! Here we provide some hooks for calling an interface between the OASIS3 coupler and MOM. ! The mom_oasis3_interface module is NOT general and it is expected that the user will ! heavily modify it depending on the coupling strategy. @@ -619,7 +607,7 @@ subroutine external_coupler_sbc_init(Dom, dt_cpld, Run_len) call coupler_init(Dom, dt_cpld=dt_cpld, Run_len=Run_len) end subroutine external_coupler_sbc_init -subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) +subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, Atm_fields, nsteps, dt_cpld ) ! Perform transfers before ocean time stepping ! May need special tratment on first call. @@ -628,6 +616,7 @@ subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt implicit none type (ice_ocean_boundary_type), intent(INOUT) :: Ice_ocean_boundary type (ocean_public_type) , intent(INOUT) :: Ocean_sfc + type (coupler_2d_bc_type), intent(INOUT) :: Atm_fields integer , intent(IN) :: nsteps, dt_cpld integer :: rtimestep ! Receive timestep @@ -635,8 +624,8 @@ subroutine external_coupler_sbc_before(Ice_ocean_boundary, Ocean_sfc, nsteps, dt rtimestep = (nsteps-1) * dt_cpld ! runtime in this run segment! stimestep = rtimestep - call from_coupler( rtimestep, Ocean_sfc, Ice_ocean_boundary ) - call into_coupler( stimestep, Ocean_sfc, before_ocean_update = .true.) + call from_coupler( rtimestep, Ocean_sfc, Ice_ocean_boundary, Atm_fields ) + call into_coupler( stimestep, Ocean_sfc, Ice_ocean_boundary, before_ocean_update = .true.) end subroutine external_coupler_sbc_before subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_cpld ) @@ -652,19 +641,21 @@ subroutine external_coupler_sbc_after(Ice_ocean_boundary, Ocean_sfc, nsteps, dt_ integer :: stimestep ! Send timestep stimestep = nsteps * dt_cpld ! runtime in this run segment! - if (stimestep < num_cpld_calls*dt_cpld) call into_coupler(stimestep, Ocean_sfc, before_ocean_update = .false.) + if (stimestep < num_cpld_calls*dt_cpld) call into_coupler(stimestep, Ocean_sfc, & + Ice_ocean_boundary, before_ocean_update = .false.) end subroutine external_coupler_sbc_after -subroutine external_coupler_restart( dt_cpld, num_cpld_calls, Ocean_sfc) +subroutine external_coupler_restart( dt_cpld, num_cpld_calls, Ocean_sfc, Ice_ocean_boundary) !Clean up as appropriate and write a restart use mom_oasis3_interface_mod, only : write_coupler_restart implicit none integer, intent(in) :: dt_cpld, num_cpld_calls integer :: timestep type (ocean_public_type) :: Ocean_sfc + type (ice_ocean_boundary_type) :: Ice_ocean_boundary timestep = num_cpld_calls * dt_cpld - call write_coupler_restart(timestep, Ocean_sfc, write_restart=.true.) + call write_coupler_restart(timestep, Ocean_sfc, Ice_ocean_boundary, write_restart=.true.) end subroutine external_coupler_restart subroutine external_coupler_exit