From 58f78b9db22f0dd02338cc5de8998070e58027b0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 10 Aug 2017 08:47:26 -0600 Subject: [PATCH 1/4] Fill IOB, some fluxes still need to be checked --- config_src/mct_driver/coupler_indices.F90 | 95 +++++++++++++---------- 1 file changed, 53 insertions(+), 42 deletions(-) diff --git a/config_src/mct_driver/coupler_indices.F90 b/config_src/mct_driver/coupler_indices.F90 index 3a43f5657c..06a6040307 100644 --- a/config_src/mct_driver/coupler_indices.F90 +++ b/config_src/mct_driver/coupler_indices.F90 @@ -1,19 +1,19 @@ module coupler_indices ! MCT types - use mct_mod, only : mct_aVect + use mct_mod, only : mct_aVect ! MCT fucntions - use mct_mod, only : mct_avect_indexra, mct_aVect_init, mct_aVect_clean - use seq_flds_mod, only : seq_flds_x2o_fields, seq_flds_o2x_fields - use seq_flds_mod, only : seq_flds_i2o_per_cat, ice_ncat + use mct_mod, only : mct_avect_indexra, mct_aVect_init, mct_aVect_clean + use seq_flds_mod, only : seq_flds_x2o_fields, seq_flds_o2x_fields + use seq_flds_mod, only : seq_flds_i2o_per_cat, ice_ncat ! MOM types - use MOM_grid, only : ocean_grid_type + use MOM_grid, only : ocean_grid_type use MOM_surface_forcing, only: ice_ocean_boundary_type ! MOM functions - use MOM_domains, only : pass_var, AGRID - use ocean_model_mod, only : ocean_public_type - + use MOM_domains, only : pass_var, AGRID + use ocean_model_mod, only : ocean_public_type + use MOM_error_handler, only : MOM_error, FATAL implicit none private @@ -116,6 +116,7 @@ subroutine coupler_indices_init(ind) call mct_aVect_init(x2o, rList=seq_flds_x2o_fields, lsize=1) call mct_aVect_init(o2x, rList=seq_flds_o2x_fields, lsize=1) + ! ocean to coupler ind%o2x_So_t = mct_avect_indexra(o2x,'So_t') ind%o2x_So_u = mct_avect_indexra(o2x,'So_u') ind%o2x_So_v = mct_avect_indexra(o2x,'So_v') @@ -127,6 +128,8 @@ subroutine coupler_indices_init(ind) ind%o2x_Fioo_q = mct_avect_indexra(o2x,'Fioo_q') ind%o2x_Faoo_fco2_ocn = mct_avect_indexra(o2x,'Faoo_fco2_ocn',perrWith='quiet') ind%o2x_Faoo_fdms_ocn = mct_avect_indexra(o2x,'Faoo_fdms_ocn',perrWith='quiet') + + ! coupler to ocean ind%x2o_Si_ifrac = mct_avect_indexra(x2o,'Si_ifrac') ind%x2o_Sa_pslv = mct_avect_indexra(x2o,'Sa_pslv') ind%x2o_So_duu10n = mct_avect_indexra(x2o,'So_duu10n') @@ -134,7 +137,6 @@ subroutine coupler_indices_init(ind) ind%x2o_Sw_lamult = mct_avect_indexra(x2o,'Sw_lamult') ind%x2o_Sw_ustokes = mct_avect_indexra(x2o,'Sw_ustokes') ind%x2o_Sw_vstokes = mct_avect_indexra(x2o,'Sw_vstokes') - ind%x2o_Foxx_tauy = mct_avect_indexra(x2o,'Foxx_tauy') ind%x2o_Foxx_taux = mct_avect_indexra(x2o,'Foxx_taux') ind%x2o_Foxx_swnet = mct_avect_indexra(x2o,'Foxx_swnet') @@ -226,7 +228,8 @@ subroutine ocn_export(ind, ocn_public, grid, o2x) do i=grid%isc,grid%iec n = n+1 ig = i + grid%idg_offset - o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) + ! surface temperature in Kelvin + o2x(ind%o2x_So_t, n) = ocn_public%t_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_s, n) = ocn_public%s_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_u, n) = ocn_public%u_surf(ig,jg) * grid%mask2dT(i,j) o2x(ind%o2x_So_v, n) = ocn_public%v_surf(ig,jg) * grid%mask2dT(i,j) @@ -292,15 +295,18 @@ subroutine ocn_export(ind, ocn_public, grid, o2x) end subroutine ocn_export - subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind) - type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A type for the ice ocean boundary - type(ocean_grid_type), intent(in) :: grid - !type(mct_aVect), intent(in) :: x2o_o - real(kind=8), intent(in) :: x2o_o(:,:) - type(cpl_indices), intent(inout) :: ind + subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind, sw_decomp, c1, c2, c3, c4) + type(ice_ocean_boundary_type), intent(inout) :: ice_ocean_boundary !< A type for the ice ocean boundary + type(ocean_grid_type), intent(in) :: grid + !type(mct_aVect), intent(in) :: x2o_o + real(kind=8), intent(in) :: x2o_o(:,:) + type(cpl_indices), intent(inout) :: ind + logical, intent(in) :: sw_decomp !< controls if shortwave is decomposed + !! into four components + real(kind=8), intent(in), optional :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition ! local variables - integer :: i, j, k, ig, jg + integer :: i, j, k, ig, jg !< grid indices ! variable that are not in ice_ocean_boundary: ! latent (x2o_Foxx_lat) @@ -324,11 +330,6 @@ subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind) ! need wind_stress_multiplier? - ! Copy from x2o to ice_ocean_boundary. ice_ocean_boundary uses global indexing with no halos. - write(*,*) 'max. k is:', (grid%jec-grid%jsc+1) * (grid%iec-grid%isc+1) - ! zonal wind stress (taux) - write(*,*) 'taux', SIZE(x2o_o(ind%x2o_Foxx_taux,:)) - write(*,*) 'ice_ocean_boundary%u_flux', SIZE(ice_ocean_boundary%u_flux(:,:)) k = 0 do j = grid%jsc, grid%jec jg = j + grid%jdg_offset @@ -336,33 +337,43 @@ subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind) k = k + 1 ! Increment position within gindex ig = i + grid%idg_offset ! zonal wind stress (taux) - ice_ocean_boundary%u_flux(ig,jg) = 0.0 ! x20_o(ind%x2o_Foxx_taux,k) + ice_ocean_boundary%u_flux(ig,jg) = x2o_o(ind%x2o_Foxx_taux,k) ! meridional wind stress (tauy) - ice_ocean_boundary%v_flux(ig,jg) = 0.0 ! x20_o(ind%x2o_Foxx_tauy,k) - ! sensible heat flux - ice_ocean_boundary%t_flux(ig,jg) = 0.0 ! x20_o(ind%x2o_Foxx_sen,k) + ice_ocean_boundary%v_flux(ig,jg) = x2o_o(ind%x2o_Foxx_tauy,k) + ! sensible heat flux (W/m2) + ice_ocean_boundary%t_flux(ig,jg) = -x2o_o(ind%x2o_Foxx_sen,k) ! salt flux - ice_ocean_boundary%salt_flux(ig,jg) = 0.0 ! x20_o(ind%x2o_Fioi_salt,k) + ice_ocean_boundary%salt_flux(ig,jg) = x2o_o(ind%x2o_Fioi_salt,k) ! heat flux from snow & ice melt - ice_ocean_boundary%calving_hflx(ig,jg) = 0.0 ! x20_o(ind%x2o_Fioi_melth,k) + ice_ocean_boundary%calving_hflx(ig,jg) = x2o_o(ind%x2o_Fioi_melth,k) ! snow melt flux - ice_ocean_boundary%fprec(ig,jg) = 0.0 ! x20_o(ind%x2o_Fioi_meltw,k) + !ice_ocean_boundary%fprec(ig,jg) = x2o_o(ind%x2o_Fioi_meltw,k) ! river runoff flux - ice_ocean_boundary%runoff(ig,jg) = 0.0 ! x20_o(ind%x2o_Foxx_rofl,k) + ice_ocean_boundary%runoff(ig,jg) = x2o_o(ind%x2o_Foxx_rofl,k) ! ice runoff flux - ice_ocean_boundary%calving(ig,jg) = 0.0 ! x20_o(ind%x2o_Foxx_rofi,k) + ice_ocean_boundary%calving(ig,jg) = x2o_o(ind%x2o_Foxx_rofi,k) ! liquid precipitation (rain) - ice_ocean_boundary%lprec(ig,jg) = 0.0 ! x20_o(ind%x2o_Faxa_rain,k) - ! froze precipitation (snow) - ice_ocean_boundary%fprec(ig,jg) = 0.0 ! x20_o(ind%x2o_Faxa_snow,k) - !!!!!!! LONGWAVE NEEDS TO BE FIXED !!!!!!! - ! longwave radiation (up) - ice_ocean_boundary%lw_flux(ig,jg) = 0.0 ! x20_o(k,ind%x2o_Foxx_lwup) - ! longwave radiation (down) - ice_ocean_boundary%lw_flux(ig,jg) = 0.0 ! x20_o(k,ind%x2o_Faxa_lwdn) - !!!!!!! SHORTWAVE NEEDS TO BE COMBINED !!!!!!! - ! net short-wave heat flux - ice_ocean_boundary%u_flux(ig,jg) = 0.0 ! x20_o(k,ind%x2o_Foxx_swnet) + ice_ocean_boundary%lprec(ig,jg) = x2o_o(ind%x2o_Faxa_rain,k) + ! frozen precipitation (snow) + ice_ocean_boundary%fprec(ig,jg) = x2o_o(ind%x2o_Faxa_snow,k) + ! evaporation flux (kg/m2/s) + ice_ocean_boundary%q_flux(ig,jg) = -x2o_o(ind%x2o_Foxx_evap,k) + ! longwave radiation, sum up and down (W/m2) + ice_ocean_boundary%lw_flux(ig,jg) = x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k) + if (sw_decomp) then + ! Use runtime coefficients to decompose net short-wave heat flux into 4 components + ! 1) visible, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dir(ig,jg) = x2o_o(ind%x2o_Foxx_swnet,k)*c1 + ! 2) visible, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_vis_dif(ig,jg) = x2o_o(ind%x2o_Foxx_swnet,k)*c2 + ! 3) near-IR, direct shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dir(ig,jg) = x2o_o(ind%x2o_Foxx_swnet,k)*c3 + ! 4) near-IR, diffuse shortwave (W/m2) + ice_ocean_boundary%sw_flux_nir_dif(ig,jg) = x2o_o(ind%x2o_Foxx_swnet,k)*c4 + else + call MOM_error(FATAL,"fill_ice_ocean_bnd: this option has not been implemented yet."// & + "Shortwave must be decomposed using coeffs. c1, c2, c3, c4."); + endif enddo enddo From 2582e0a9d7ac40efaba60488ffe4bc5699b78513 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 10 Aug 2017 08:48:43 -0600 Subject: [PATCH 2/4] Adds run paramaters to control SW decomposition --- config_src/mct_driver/ocn_comp_mct.F90 | 46 +++++++++++++++++++++++--- 1 file changed, 42 insertions(+), 4 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 0dce8f407e..149f1206d7 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -33,6 +33,8 @@ module ocn_comp_mct use MOM_variables, only: surface use MOM_error_handler, only: MOM_error, FATAL, is_root_pe use MOM_time_manager, only: time_type, set_date, set_time, set_calendar_type, NOLEAP +use MOM_file_parser, only: get_param, log_version, param_file_type +use MOM_get_input, only: Get_MOM_Input, directories use coupler_indices, only: coupler_indices_init, cpl_indices use coupler_indices, only: ocn_export, fill_ice_ocean_bnd @@ -54,8 +56,10 @@ module ocn_comp_mct type(surface), pointer :: ocn_surface => NULL() !< The ocean surface state type(ice_ocean_boundary_type) :: ice_ocean_boundary !< The ice ocean boundary type type(seq_infodata_type), pointer :: infodata !< The input info type - type(cpl_indices), public :: ind !< Variable IDs - + type(cpl_indices), public :: ind !< Variable IDs + ! runtime params + logical :: sw_decomp !< Controls whether shortwave is decomposed into four components + real :: c1, c2, c3, c4 !< Coeffs. used in the shortwave decomposition end type MCT_MOM_Data type(MCT_MOM_Data) :: glb !< global structure @@ -87,6 +91,11 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) logical :: ldiag_cpl = .false. integer :: isc, iec, jsc, jec, ni, nj !< Indices for the start and end of the domain !! in the x and y dir., respectively. + ! runi-time params + type(param_file_type) :: param_file !< A structure to parse for run-time parameters + type(directories) :: dirs_tmp !< A structure containing several relevant directory paths + character(len=40) :: mdl = "ocn_comp_mct" !< This module's name. + ! mct variables (these are local for now) integer :: MOM_MCT_ID type(mct_gsMap), pointer :: MOM_MCT_gsMap => NULL() !< 2d, points to cdata @@ -181,6 +190,34 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) glb%ocn_public%pelist(:) = (/(i,i=pe0,pe0+npes)/) ! \todo Set other bits of glb$ocn_public + ! This include declares and sets the variable "version". + ! read useful runtime params + call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) + !call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SW_DECOMP", glb%sw_decomp, & + "If True, read coeffs c1, c2, c3 and c4 and decompose" // & + "the net shortwave radiation (SW) into four components:\n" // & + "visible, direct shortwave = c1 * SW \n" // & + "visible, diffuse shortwave = c2 * SW \n" // & + "near-IR, direct shortwave = c3 * SW \n" // & + "near-IR, diffuse shortwave = c4 * SW", default=.true.) + if (glb%sw_decomp) then + call get_param(param_file, mdl, "SW_c1", glb%c1, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, direct shortwave.", units="nondim", default=0.285) + call get_param(param_file, mdl, "SW_c2", glb%c2, & + "Coeff. used to convert net shortwave rad. into \n"//& + "visible, diffuse shortwave.", units="nondim", default=0.285) + call get_param(param_file, mdl, "SW_c3", glb%c3, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, direct shortwave.", units="nondim", default=0.215) + call get_param(param_file, mdl, "SW_c4", glb%c4, & + "Coeff. used to convert net shortwave rad. into \n"//& + "near-IR, diffuse shortwave.", units="nondim", default=0.215) + else + glb%c1 = 0.0; glb%c2 = 0.0; glb%c3 = 0.0; glb%c4 = 0.0 + endif + ! Initialize the MOM6 model call ocean_model_init(glb%ocn_public, glb%ocn_state, time_init, time_in) @@ -237,7 +274,7 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) ! \todo Need interface to get dt from MOM6 mom_cpl_dt = seconds_in_day / ncouple_per_day if (mom_cpl_dt /= ocn_cpl_dt) then - write(*,*) 'ERROR pop_cpl_dt and ocn_cpl_dt must be identical' + write(*,*) 'ERROR mom_cpl_dt and ocn_cpl_dt must be identical' call exit(0) end if @@ -349,7 +386,8 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) if (debug .and. is_root_pe()) write(6,*) 'ocn_run_mct, write_restart_at_eod=', write_restart_at_eod ! fill ice ocean boundary - call fill_ice_ocean_bnd(glb%ice_ocean_boundary, glb%grid, x2o_o%rattr, glb%ind) + call fill_ice_ocean_bnd(glb%ice_ocean_boundary, glb%grid, x2o_o%rattr, glb%ind, glb%sw_decomp, & + glb%c1, glb%c2, glb%c3, glb%c4) if (debug .and. is_root_pe()) write(6,*) 'fill_ice_ocean_bnd' call update_ocean_model(glb%ice_ocean_boundary, glb%ocn_state, glb%ocn_public, & From 8745b4ba570b68fa5e448659ff948c26a8c6289a Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 11 Aug 2017 14:50:51 -0600 Subject: [PATCH 3/4] Fills additional IOB fluxes --- config_src/mct_driver/coupler_indices.F90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/config_src/mct_driver/coupler_indices.F90 b/config_src/mct_driver/coupler_indices.F90 index 06a6040307..6edacac516 100644 --- a/config_src/mct_driver/coupler_indices.F90 +++ b/config_src/mct_driver/coupler_indices.F90 @@ -52,8 +52,8 @@ module coupler_indices integer :: x2o_Foxx_taux ! zonal wind stress (taux) (W/m2 ) integer :: x2o_Foxx_tauy ! meridonal wind stress (tauy) (W/m2 ) integer :: x2o_Foxx_swnet ! net short-wave heat flux (W/m2 ) - integer :: x2o_Foxx_sen ! sensible heat flux (W/m2 ) - integer :: x2o_Foxx_lat + integer :: x2o_Foxx_sen ! sensible heat flux (W/m2) + integer :: x2o_Foxx_lat ! latent heat flux (W/m2) integer :: x2o_Foxx_lwup ! longwave radiation (up) (W/m2 ) integer :: x2o_Faxa_lwdn ! longwave radiation (down) (W/m2 ) integer :: x2o_Fioi_melth ! heat flux from snow & ice melt (W/m2 ) @@ -336,6 +336,8 @@ subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind, sw_decomp, c do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex ig = i + grid%idg_offset + ! sea-level pressure (Pa) + ice_ocean_boundary%p(ig,jg) = x2o_o(ind%x2o_Sa_pslv,k) ! zonal wind stress (taux) ice_ocean_boundary%u_flux(ig,jg) = x2o_o(ind%x2o_Foxx_taux,k) ! meridional wind stress (tauy) @@ -343,9 +345,9 @@ subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind, sw_decomp, c ! sensible heat flux (W/m2) ice_ocean_boundary%t_flux(ig,jg) = -x2o_o(ind%x2o_Foxx_sen,k) ! salt flux - ice_ocean_boundary%salt_flux(ig,jg) = x2o_o(ind%x2o_Fioi_salt,k) - ! heat flux from snow & ice melt - ice_ocean_boundary%calving_hflx(ig,jg) = x2o_o(ind%x2o_Fioi_melth,k) + ice_ocean_boundary%salt_flux(ig,jg) = -x2o_o(ind%x2o_Fioi_salt,k) + ! heat content from frozen runoff + ice_ocean_boundary%calving_hflx(ig,jg) = 0.0 ! snow melt flux !ice_ocean_boundary%fprec(ig,jg) = x2o_o(ind%x2o_Fioi_meltw,k) ! river runoff flux @@ -356,7 +358,7 @@ subroutine fill_ice_ocean_bnd(ice_ocean_boundary, grid, x2o_o, ind, sw_decomp, c ice_ocean_boundary%lprec(ig,jg) = x2o_o(ind%x2o_Faxa_rain,k) ! frozen precipitation (snow) ice_ocean_boundary%fprec(ig,jg) = x2o_o(ind%x2o_Faxa_snow,k) - ! evaporation flux (kg/m2/s) + ! evaporation flux, MOM6 calls q_flux specific humidity (kg/m2/s) ice_ocean_boundary%q_flux(ig,jg) = -x2o_o(ind%x2o_Foxx_evap,k) ! longwave radiation, sum up and down (W/m2) ice_ocean_boundary%lw_flux(ig,jg) = x2o_o(ind%x2o_Faxa_lwdn,k) + x2o_o(ind%x2o_Foxx_lwup,k) From f5a8483584e07052c804314e6d96575046554393 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 11 Aug 2017 16:27:51 -0600 Subject: [PATCH 4/4] Adds option to write restart files --- config_src/mct_driver/ocn_comp_mct.F90 | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index d639329bd3..d152e34998 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -26,7 +26,7 @@ module ocn_comp_mct ! MOM6 modules use ocean_model_mod, only: ocean_state_type, ocean_public_type, ocean_model_init_sfc -use ocean_model_mod, only: ocean_model_init, get_state_pointers +use ocean_model_mod, only: ocean_model_init, get_state_pointers, ocean_model_restart use ocean_model_mod, only: ice_ocean_boundary_type, update_ocean_model use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here use MOM_grid, only: ocean_grid_type, get_global_grid_size @@ -38,7 +38,6 @@ module ocn_comp_mct use coupler_indices, only: coupler_indices_init, cpl_indices use coupler_indices, only: ocn_export, fill_ice_ocean_bnd - ! By default make data private implicit none; private ! Public member functions @@ -362,6 +361,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) type(time_type) :: time_start !< Start of coupled time interval to pass to MOM6 type(time_type) :: coupling_timestep !< Coupled time interval to pass to MOM6 character(len=128) :: err_msg + character(len=32) :: timestamp !< Name of intermediate restart file ! Compute the time at the start of this coupling interval call ESMF_ClockGet(EClock, PrevTime=time_start_ESMF, rc=rc) @@ -388,7 +388,7 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) endif ! Translate the coupling time interval - call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) + call ESMF_ClockGet(EClock, TimeStep=ocn_cpl_interval, rc=rc) call ESMF_TimeIntervalGet(ocn_cpl_interval, yy=year, mm=month, d=day, s=seconds, sn=seconds_n, sd=seconds_d, rc=rc) coupling_timestep = set_time(seconds, days=day, err_msg=err_msg) @@ -396,11 +396,6 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) ! \todo this was done in _init_, is it needed again. Does this infodata need to be in glb%? call seq_cdata_setptrs(cdata_o, infodata=glb%infodata) - ! Check alarms for flag to write restart at end of day - write_restart_at_eod = seq_timemgr_RestartAlarmIsOn(EClock) - ! \todo Let MOM6 know to write restart... - if (debug .and. is_root_pe()) write(6,*) 'ocn_run_mct, write_restart_at_eod=', write_restart_at_eod - ! fill ice ocean boundary call fill_ice_ocean_bnd(glb%ice_ocean_boundary, glb%grid, x2o_o%rattr, glb%ind, glb%sw_decomp, & glb%c1, glb%c2, glb%c3, glb%c4) @@ -409,6 +404,18 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o) call update_ocean_model(glb%ice_ocean_boundary, glb%ocn_state, glb%ocn_public, & time_start, coupling_timestep) + !--- write out intermediate restart file when needed. + ! Check alarms for flag to write restart at end of day + write_restart_at_eod = seq_timemgr_RestartAlarmIsOn(EClock) + if (debug .and. is_root_pe()) write(6,*) 'ocn_run_mct, write_restart_at_eod=', write_restart_at_eod + + if (write_restart_at_eod) then + !timestamp = date_to_string(EClock) + ! \todo add time stamp to ocean_model_restart + !call ocean_model_restart(glb%ocn_state, timestamp) + call ocean_model_restart(glb%ocn_state) + endif + end subroutine ocn_run_mct !> Finalizes MOM6