From abb0ad24f6c873c06899ed166b291090638911f3 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 14 Sep 2023 11:03:48 -0400 Subject: [PATCH 1/6] switch to cesm-style field names * two fields remain unresolved, sea_level and mass_overlying_ice --- config_src/drivers/nuopc_cap/mom_cap.F90 | 158 ++++++++-------- .../drivers/nuopc_cap/mom_cap_methods.F90 | 179 +++++++++--------- 2 files changed, 171 insertions(+), 166 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 71419ea4bf..135e7bab6b 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -724,40 +724,37 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(scalar_field_name), "will_provide") endif - !--------- import fields ------------- - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_salt_rate" , "will provide") ! from ice - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_zonal_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_merid_moment_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_sensi_heat_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_evap_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_lw_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_vis_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dir_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_net_sw_ir_dif_flx" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_prec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fprec_rate" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "inst_pres_height_surface" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff - call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") !-> ice fraction - call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m - call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fresh_water_to_ocean_rate", "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "net_heat_flx_to_ocn" , "will provide") - - if (cesm_coupled) then - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_lprec", "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_fprec", "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_evap" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_cond" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofl" , "will provide") - call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofi" , "will provide") - endif + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" , "will provide") ! from ice + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwnet" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdr" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_vdf" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idr" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_swnet_idf" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" , "will provide") !-> liquid runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff + call fld_list_add(fldsToOcn_num, fldsToOcn, "Si_ifrac" , "will provide") !-> ice fraction + call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_melth" , "will provide") + + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrain" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hsnow" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hevap" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hcond" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrofl" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_hrofi" , "will provide") if (use_waves) then if (wave_method == "EFACTOR") then - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") + call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide") else if (wave_method == "SURFACE_BANDS") then call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_x", "will provide", & ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands) @@ -769,15 +766,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) endif !--------- export fields ------------- - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_temperature" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "s_surf" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocn_current_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_zonal" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "sea_surface_slope_merid" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "freezing_melting_potential" , "will provide") - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" , "will provide") + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" , "will provide") do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, name=fldsToOcn(n)%shortname, rc=rc) @@ -1627,7 +1624,7 @@ subroutine ModelAdvance(gcomp, rc) ! Import data !--------------- - call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc=rc) + call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------- @@ -2433,7 +2430,7 @@ end subroutine shr_log_setLogUnit !! Description !! Notes !! -!! inst_pres_height_surface +!! Sa_pslv !! Pa !! p !! pressure of overlying sea ice and atmosphere @@ -2447,14 +2444,14 @@ end subroutine shr_log_setLogUnit !! !! !! -!! seaice_melt_heat +!! Fioi_melth !! W m-2 !! seaice_melt_heat !! sea ice and snow melt heat flux !! !! !! -!! seaice_melt +!! Fioi_meltw !! kg m-2 s-1 !! seaice_melt !! water flux due to sea ice and snow melting @@ -2468,138 +2465,145 @@ end subroutine shr_log_setLogUnit !! !! !! -!! mean_evap_rate +!! Foxx_evap !! kg m-2 s-1 !! q_flux !! specific humidity flux !! !! !! -!! mean_fprec_rate +!! Faxa_snow !! kg m-2 s-1 !! fprec !! mass flux of frozen precip !! !! !! -!! mean_merid_moment_flx -!! Pa -!! v_flux -!! j-directed wind stress into ocean -!! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar -!! -!! -!! mean_net_lw_flx +!! Foxx_lwnet !! W m-2 !! lw_flux !! long wave radiation !! !! !! -!! mean_net_sw_ir_dif_flx +!! Foxx_swnet_idf !! W m-2 !! sw_flux_nir_dif !! diffuse near IR shortwave radiation !! !! !! -!! mean_net_sw_ir_dir_flx +!! Foxx_swnet_idr !! W m-2 !! sw_flux_nir_dir !! direct near IR shortwave radiation !! !! !! -!! mean_net_sw_vis_dif_flx +!! Foxx_swnet_vdf !! W m-2 !! sw_flux_vis_dif !! diffuse visible shortware radiation !! !! !! -!! mean_net_sw_vis_dir_flx +!! Foxx_swnet_idr !! W m-2 !! sw_flux_vis_dir !! direct visible shortware radiation !! !! !! -!! mean_prec_rate +!! Faxa_rain !! kg m-2 s-1 !! lprec !! mass flux of liquid precip !! !! !! -!! heat_content_lprec +!! Foxx_hrain !! W m-2 !! hrain !! heat content (enthalpy) of liquid water entering the ocean !! !! !! -!! heat_content_fprec +!! Foxx_hsnow !! W m-2 !! hsnow !! heat content (enthalpy) of frozen water entering the ocean !! !! !! -!! heat_content_evap +!! Foxx_hevap !! W m-2 !! hevap !! heat content (enthalpy) of water leaving the ocean !! !! !! -!! heat_content_cond +!! Foxx_hcond !! W m-2 !! hcond !! heat content (enthalpy) of liquid water entering the ocean due to condensation !! !! !! -!! heat_content_rofl +!! Foxx_hrofl !! W m-2 !! hrofl !! heat content (enthalpy) of liquid runoff !! !! !! -!! heat_content_rofi +!! Foxx_hrofi !! W m-2 !! hrofi !! heat content (enthalpy) of frozen runoff !! !! !! -!! mean_runoff_rate +!! Foxx_rofl !! kg m-2 s-1 !! runoff !! mass flux of liquid runoff !! !! !! -!! mean_salt_rate +!! Foxx_rofi +!! kg m-2 s-1 +!! runoff +!! mass flux of frozen runoff +!! +!! +!! +!! Fioi_salt !! kg m-2 s-1 !! salt_flux !! salt flux !! !! !! -!! mean_sensi_heat_flx +!! Foxx_sen !! W m-2 !! t_flux !! sensible heat flux into ocean !! !! !! -!! mean_zonal_moment_flx +!! Foxx_taux !! Pa !! u_flux !! i-directed wind stress into ocean !! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar !! +!! +!! Foxx_tauy +!! Pa +!! v_flux +!! j-directed wind stress into ocean +!! [vector rotation] (@ref VectorRotations) applied - lat-lon to tripolar +!! !! !! !! @subsection ExportField Export Fields @@ -2616,63 +2620,63 @@ end subroutine shr_log_setLogUnit !! Notes !! !! -!! freezing_melting_potential +!! Fioo_q !! W m-2 !! combination of frazil and melt_potential !! cap converts model units (J m-2) to (W m-2) for export !! !! !! -!! ocean_mask +!! So_omask !! !! !! ocean mask !! !! !! -!! ocn_current_merid +!! So_v !! m s-1 !! v_surf !! j-directed surface velocity on u-cell !! [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! !! -!! ocn_current_zonal +!! So_u !! m s-1 !! u_surf !! i-directed surface velocity on u-cell !! [vector rotation] (@ref VectorRotations) applied - tripolar to lat-lon !! !! -!! s_surf +!! So_s !! psu !! s_surf !! sea surface salinity on t-cell !! !! !! -!! sea_surface_temperature +!! So_t !! K !! t_surf !! sea surface temperature on t-cell !! !! !! -!! sea_surface_slope_zonal +!! So_dhdx !! unitless !! created from ssh !! sea surface zonal slope !! !! !! -!! sea_surface_slope_merid +!! So_dhy !! unitless !! created from ssh !! sea surface meridional slope !! !! !! -!! so_bldepth +!! So_bldepth !! m !! obld !! ocean surface boundary layer depth diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 index db8bc33c90..f41c98b112 100644 --- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90 @@ -72,12 +72,11 @@ end subroutine mom_set_geomtype !> This function has a few purposes: !! (1) it imports surface fluxes using data from the mediator; and !! (2) it can apply restoring in SST and SSS. -subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc) +subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc) type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing - logical , intent(in) :: cesm_coupled !< Flag to check if coupled with cesm integer , intent(inout) :: rc !< Return code ! Local Variables @@ -103,43 +102,42 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! surface height pressure !---- - call state_getimport(importState, 'inst_pres_height_surface', & - isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) + call state_getimport(importState, 'Sa_pslv', isc, iec, jsc, jec, ice_ocean_boundary%p, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! near-IR, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_swnet_idr', isc, iec, jsc, jec, & + ice_ocean_boundary%sw_flux_nir_dir, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! near-IR, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_ir_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_nir_dif, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_swnet_idf', isc, iec, jsc, jec, & + ice_ocean_boundary%sw_flux_nir_dif, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! visible, direct shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dir_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dir, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_swnet_vdr', isc, iec, jsc, jec, & + ice_ocean_boundary%sw_flux_vis_dir, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! visible, diffuse shortwave (W/m2) !---- - call state_getimport(importState, 'mean_net_sw_vis_dif_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%sw_flux_vis_dif, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_swnet_vdf', isc, iec, jsc, jec, & + ice_ocean_boundary%sw_flux_vis_dif, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- ! Net longwave radiation (W/m2) ! ------- - call state_getimport(importState, 'mean_net_lw_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%lw_flux, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_lwnet', isc, iec, jsc, jec, & + ice_ocean_boundary%lw_flux, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- @@ -148,10 +146,10 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, allocate (taux(isc:iec,jsc:jec)) allocate (tauy(isc:iec,jsc:jec)) - call state_getimport(importState, 'mean_zonal_moment_flx', isc, iec, jsc, jec, taux, & + call state_getimport(importState, 'Foxx_taux', isc, iec, jsc, jec, taux, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'mean_merid_moment_flx', isc, iec, jsc, jec, tauy, & + call state_getimport(importState, 'Foxx_tauy', isc, iec, jsc, jec, tauy, & areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -172,29 +170,29 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- ! sensible heat flux (W/m2) !---- - call state_getimport(importState, 'mean_sensi_heat_flx', & - isc, iec, jsc, jec, ice_ocean_boundary%t_flux, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_sen', isc, iec, jsc, jec, & + ice_ocean_boundary%t_flux, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! evaporation flux (W/m2) !---- - call state_getimport(importState, 'mean_evap_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%q_flux, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Foxx_evap', isc, iec, jsc, jec, & + ice_ocean_boundary%q_flux, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! liquid precipitation (rain) !---- - call state_getimport(importState, 'mean_prec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%lprec, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Faxa_rain', isc, iec, jsc, jec, & + ice_ocean_boundary%lprec, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! frozen precipitation (snow) !---- - call state_getimport(importState, 'mean_fprec_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%fprec, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Faxa_snow', isc, iec, jsc, jec, & + ice_ocean_boundary%fprec, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- @@ -216,75 +214,85 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- - ! Enthalpy terms (only in CESM) + ! Enthalpy terms !---- - if (cesm_coupled) then - !---- - ! enthalpy from liquid precipitation (hrain) - !---- - call state_getimport(importState, 'heat_content_lprec', & - isc, iec, jsc, jec, ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---- - ! enthalpy from frozen precipitation (hsnow) - !---- - call state_getimport(importState, 'heat_content_fprec', & - isc, iec, jsc, jec, ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc) + !---- + ! enthalpy from liquid precipitation (hrain) + !---- + if ( associated(ice_ocean_boundary%hrain) ) then + call state_getimport(importState, 'Foxx_hrain', isc, iec, jsc, jec, & + ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---- - ! enthalpy from liquid runoff (hrofl) - !---- - call state_getimport(importState, 'heat_content_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc) + !---- + ! enthalpy from frozen precipitation (hsnow) + !---- + if ( associated(ice_ocean_boundary%hsnow) ) then + call state_getimport(importState, 'Foxx_hsnow', isc, iec, jsc, jec, & + ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---- - ! enthalpy from frozen runoff (hrofi) - !---- - call state_getimport(importState, 'heat_content_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc) + !---- + ! enthalpy from liquid runoff (hrofl) + !---- + if ( associated(ice_ocean_boundary%hrofl) ) then + call state_getimport(importState, 'Foxx_hrofl', isc, iec, jsc, jec, & + ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---- - ! enthalpy from evaporation (hevap) - !---- - call state_getimport(importState, 'heat_content_evap', & - isc, iec, jsc, jec, ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc) + !---- + ! enthalpy from frozen runoff (hrofi) + !---- + if ( associated(ice_ocean_boundary%hrofi) ) then + call state_getimport(importState, 'Foxx_hrofi', isc, iec, jsc, jec, & + ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !---- - ! enthalpy from condensation (hcond) - !---- - call state_getimport(importState, 'heat_content_cond', & - isc, iec, jsc, jec, ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc) + !---- + ! enthalpy from evaporation (hevap) + !---- + if ( associated(ice_ocean_boundary%hevap) ) then + call state_getimport(importState, 'Foxx_hevap', isc, iec, jsc, jec, & + ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !---- + ! enthalpy from condensation (hcond) + !---- + if ( associated(ice_ocean_boundary%hcond) ) then + call state_getimport(importState, 'Foxx_hcond', isc, iec, jsc, jec, & + ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---- ! salt flux from ice !---- ice_ocean_boundary%salt_flux(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_salt_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%salt_flux, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Fioi_salt', isc, iec, jsc, jec, & + ice_ocean_boundary%salt_flux, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! snow&ice melt heat flux (W/m^2) !---- ice_ocean_boundary%seaice_melt_heat(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'net_heat_flx_to_ocn', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt_heat, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Fioi_melth', isc, iec, jsc, jec, & + ice_ocean_boundary%seaice_melt_heat, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! snow&ice melt water flux (W/m^2) !---- ice_ocean_boundary%seaice_melt(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_fresh_water_to_ocean_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%seaice_melt, areacor=med2mod_areacor, rc=rc) + call state_getimport(importState, 'Fioi_meltw', isc, iec, jsc, jec, & + ice_ocean_boundary%seaice_melt, areacor=med2mod_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- @@ -293,24 +301,24 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, ! Note - preset values to 0, if field does not exist in importState, then will simply return ! and preset value will be used ice_ocean_boundary%mi(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mass_of_overlying_ice', & - isc, iec, jsc, jec, ice_ocean_boundary%mi,rc=rc) + call state_getimport(importState, 'mass_of_overlying_ice', isc, iec, jsc, jec, & + ice_ocean_boundary%mi,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! sea-ice fraction !---- ice_ocean_boundary%ice_fraction(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Si_ifrac', & - isc, iec, jsc, jec, ice_ocean_boundary%ice_fraction, rc=rc) + call state_getimport(importState, 'Si_ifrac', isc, iec, jsc, jec, & + ice_ocean_boundary%ice_fraction, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- ! 10m wind squared !---- ice_ocean_boundary%u10_sqr(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'So_duu10n', & - isc, iec, jsc, jec, ice_ocean_boundary%u10_sqr, rc=rc) + call state_getimport(importState, 'So_duu10n', isc, iec, jsc, jec, & + ice_ocean_boundary%u10_sqr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---- @@ -318,8 +326,8 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, !---- if ( associated(ice_ocean_boundary%lamult) ) then ice_ocean_boundary%lamult (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'Sw_lamult', & - isc, iec, jsc, jec, ice_ocean_boundary%lamult, rc=rc) + call state_getimport(importState, 'Sw_lamult', isc, iec, jsc, jec, & + ice_ocean_boundary%lamult, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -424,8 +432,7 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, enddo enddo - call State_SetExport(exportState, 'ocean_mask', & - isc, iec, jsc, jec, omask, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_omask', isc, iec, jsc, jec, omask, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(omask) @@ -433,15 +440,13 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- ! Sea surface temperature ! ------- - call State_SetExport(exportState, 'sea_surface_temperature', & - isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_t', isc, iec, jsc, jec, ocean_public%t_surf, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- ! Sea surface salinity ! ------- - call State_SetExport(exportState, 's_surf', & - isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_s', isc, iec, jsc, jec, ocean_public%s_surf, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------- @@ -467,12 +472,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, enddo enddo - call State_SetExport(exportState, 'ocn_current_zonal', & - isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_u', isc, iec, jsc, jec, ocz_rot, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetExport(exportState, 'ocn_current_merid', & - isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_v', isc, iec, jsc, jec, ocm_rot, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(ocz, ocm, ocz_rot, ocm_rot) @@ -482,8 +485,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, ! ------- call ESMF_StateGet(exportState, 'So_bldepth', itemFlag, rc=rc) if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then - call State_SetExport(exportState, 'So_bldepth', & - isc, iec, jsc, jec, ocean_public%obld, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_bldepth', isc, iec, jsc, jec, & + ocean_public%obld, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -506,8 +509,8 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, enddo enddo - call State_SetExport(exportState, 'freezing_melting_potential', & - isc, iec, jsc, jec, melt_potential, ocean_grid, areacor=mod2med_areacor, rc=rc) + call State_SetExport(exportState, 'Fioo_q', isc, iec, jsc, jec, & + melt_potential, ocean_grid, areacor=mod2med_areacor, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(melt_potential) @@ -620,12 +623,10 @@ subroutine mom_export(ocean_public, ocean_grid, ocean_state, exportState, clock, enddo enddo - call State_SetExport(exportState, 'sea_surface_slope_zonal', & - isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_dhdx', isc, iec, jsc, jec, dhdx_rot, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetExport(exportState, 'sea_surface_slope_merid', & - isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) + call State_SetExport(exportState, 'So_dhdy', isc, iec, jsc, jec, dhdy_rot, ocean_grid, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(ssh, dhdx, dhdy, dhdx_rot, dhdy_rot) From f4c95ec4b81e2958c151be101d2b15b0de28f910 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 14 Nov 2023 20:38:01 -0500 Subject: [PATCH 2/6] Revert post_data fix to CFC concentration The most recent NCAR -> GFDL merge created an error (courtesy of myself) which left the CFC concentration units in the post_data call, even though these are now handled at registration. This patch restores this expression and removes the unit conversion from post_data. --- src/tracer/MOM_CFC_cap.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 38777346a1..16506b41c3 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -404,8 +404,7 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C ! If needed, write out any desired diagnostics from tracer sources & sinks here. do m=1,NTR if (CS%CFC_data(m)%id_cmor > 0) & - call post_data(CS%CFC_data(m)%id_cmor, & - (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(m)%conc, CS%diag) + call post_data(CS%CFC_data(m)%id_cmor, CS%CFC_data(m)%conc, CS%diag) if (CS%CFC_data(m)%id_sfc_flux > 0) & call post_data(CS%CFC_data(m)%id_sfc_flux, CS%CFC_data(m)%sfc_flux, CS%diag) From 7ef6a57252ba9132496b4e67aafa09d47fe7eafd Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 21 Nov 2023 12:05:19 -0900 Subject: [PATCH 3/6] Fix the saltFluxAdded diagnoistic, broken in #401 --- src/core/MOM_forcing_type.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dcbf440292..b8b3174b4a 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -361,6 +361,7 @@ module MOM_forcing_type integer :: id_saltflux = -1 integer :: id_saltFluxIn = -1 integer :: id_saltFluxAdded = -1 + integer :: id_saltFluxBehind = -1 integer :: id_total_saltflux = -1 integer :: id_total_saltFluxIn = -1 @@ -2099,7 +2100,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, diag%axesT1,Time,'Salt flux into ocean at surface due to restoring or flux adjustment', & units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) - handles%id_saltFluxAdded = register_diag_field('ocean_model', 'salt_left_behind', & + handles%id_saltFluxBehind = register_diag_field('ocean_model', 'salt_left_behind', & diag%axesT1,Time,'Salt left in ocean at surface due to ice formation', & units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) @@ -3130,6 +3131,9 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h call post_data(handles%id_total_saltFluxIn, total_transport, diag) endif + if (handles%id_saltFluxBehind > 0 .and. associated(fluxes%salt_left_behind)) & + call post_data(handles%id_saltFluxBehind, fluxes%salt_left_behind, diag) + if (handles%id_saltFluxGlobalAdj > 0) & call post_data(handles%id_saltFluxGlobalAdj, fluxes%saltFluxGlobalAdj, diag) if (handles%id_vPrecGlobalAdj > 0) & From 40134ed86a10b0616134bdaef653d37f2616e873 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Mon, 4 Dec 2023 13:41:27 -0500 Subject: [PATCH 4/6] change target to pointer and check for association --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++-- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index c404e94459..3de5ad1162 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2052,7 +2052,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(diag_ctrl), target, intent(inout) :: diag !< A structure used to regulate diagnostic output. type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. - type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control structure + type(int_tide_CS), pointer :: int_tide_CSp !< Internal tide control structure integer, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. logical, intent(out) :: double_diffuse !< This indicates whether some version @@ -2097,7 +2097,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed CS%diag => diag - CS%int_tide_CSp => int_tide_CSp + if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp ! These default values always need to be set. CS%BBL_mixing_as_max = .true. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 6e53679549..31f90cdcb1 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -221,7 +221,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle - type(int_tide_CS),target, intent(in) :: int_tide_CSp !< A pointer to the internal tides control structure + type(int_tide_CS), pointer :: int_tide_CSp !< A pointer to the internal tides control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. @@ -276,7 +276,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%debug = CS%debug.and.is_root_pe() CS%diag => diag - CS%int_tide_CSp => int_tide_CSp + if (associated(int_tide_CSp)) CS%int_tide_CSp => int_tide_CSp CS%use_CVmix_tidal = use_CVmix_tidal CS%int_tide_dissipation = int_tide_dissipation From a728ceaa5b1bc27524eb9b04dc0955cc01c4e89f Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 12 Jan 2024 09:19:34 -0600 Subject: [PATCH 5/6] allow restarts to be set on non-interval hours - add restart_fh config variable and define restartfhtimes to enable restarts on non-interval hours - write info to stdout for documenting when additional restarts will or will not be written --- config_src/drivers/nuopc_cap/mom_cap.F90 | 77 ++++++++++++++++++++++-- 1 file changed, 71 insertions(+), 6 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 2fdd6f59f9..778a3486b9 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -153,6 +153,8 @@ module MOM_cap_mod character(len=16) :: inst_suffix = '' real(8) :: timere +type(ESMF_Time), allocatable :: restartFhTimes(:) + contains !> NUOPC SetService method is the only public entry point. @@ -378,6 +380,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) geomtype = ESMF_GEOMTYPE_GRID endif + end subroutine !> Called by NUOPC to advertise import and export fields. "Advertise" @@ -613,7 +616,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) open(newunit=readunit, file=rpointer_filename, form='formatted', status='old', iostat=iostat) if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_FILE_OPEN, msg=subname//' ERROR opening '//rpointer_filename, & - line=__LINE__, file=u_FILE_u, rcToReturn=rc) + line=__LINE__, file=u_FILE_u, rcToReturn=rc) return endif do @@ -1534,6 +1537,8 @@ subroutine ModelAdvance(gcomp, rc) character(len=:), allocatable :: rpointer_filename integer :: num_rest_files real(8) :: MPI_Wtime, timers + logical :: write_restart + logical :: write_restartfh rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1685,13 +1690,26 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_ClockGetAlarm(clock, alarmname='restart_alarm', alarm=restart_alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + write_restartfh = .false. + ! check if next time is == to any restartfhtime + if (allocated(RestartFhTimes)) then + do n = 1,size(RestartFhTimes) + call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (MyTime == RestartFhTimes(n)) write_restartfh = .true. + end do + end if + + write_restart = .false. if (ESMF_AlarmIsRinging(restart_alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return - + write_restart = .true. ! turn off the alarm call ESMF_AlarmRingerOff(restart_alarm, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (write_restart .or. write_restartfh) then ! determine restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1714,7 +1732,7 @@ subroutine ModelAdvance(gcomp, rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname, num_rest_files=num_rest_files) if (localPet == 0) then - ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean + ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean open(newunit=writeunit, file=rpointer_filename, form='formatted', status='unknown', iostat=iostat) if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_FILE_OPEN, & @@ -1791,25 +1809,34 @@ end subroutine ModelAdvance subroutine ModelSetRunClock(gcomp, rc) + + use ESMF, only : ESMF_TimeIntervalSet + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables + type(ESMF_VM) :: vm type(ESMF_Clock) :: mclock, dclock type(ESMF_Time) :: mcurrtime, dcurrtime type(ESMF_Time) :: mstoptime, dstoptime type(ESMF_TimeInterval) :: mtimestep, dtimestep + type(ESMF_TimeInterval) :: fhInterval character(len=128) :: mtimestring, dtimestring + character(len=256) :: timestr character(len=256) :: cvalue character(len=256) :: restart_option ! Restart option units integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) + integer :: dt_cpl ! coupling timestep type(ESMF_Alarm) :: restart_alarm type(ESMF_Alarm) :: stop_alarm logical :: isPresent, isSet logical :: first_time = .true. - character(len=*),parameter :: subname='MOM_cap:(ModelSetRunClock) ' - character(len=256) :: timestr + integer :: localPet + integer :: n, nfh + integer, allocatable :: restart_fh(:) + character(len=*),parameter :: subname='(MOM_cap:ModelSetRunClock) ' !-------------------------------- rc = ESMF_SUCCESS @@ -1825,6 +1852,11 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !-------------------------------- ! check that the current time in the model and driver are the same !-------------------------------- @@ -1948,8 +1980,41 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) - first_time = .false. + ! set up Times to write non-interval restarts + call NUOPC_CompAttributeGet(gcomp, name='restart_fh', isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call ESMF_TimeIntervalGet(dtimestep, s=dt_cpl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='restart_fh', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! convert string to a list of integer restart_fh values + nfh = 1 + count(transfer(trim(cvalue), 'a', len(cvalue)) == ",") + allocate(restart_fh(1:nfh)) + allocate(restartFhTimes(1:nfh)) + read(cvalue,*)restart_fh(1:nfh) + + ! create a list of times at each restart_fh + do n = 1,nfh + call ESMF_TimeIntervalSet(fhInterval, h=restart_fh(n), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + restartFhTimes(n) = mcurrtime + fhInterval + call ESMF_TimePrint(restartFhTimes(n), options="string", preString="Restart_Fh at ", unit=timestr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (localPet == 0) then + if (mod(3600*restart_fh(n),dt_cpl) /= 0) then + write(stdout,'(A)')trim(subname)//trim(timestr)//' will not be written' + else + write(stdout,'(A)')trim(subname)//trim(timestr)//' will be written' + end if + end if + end do + deallocate(restart_fh) + end if + + first_time = .false. endif !-------------------------------- From 6d7c00a837c0d038beec3a61627221a4863bc47e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 22 Feb 2024 13:11:05 -0500 Subject: [PATCH 6/6] Restore bit repro using FMA in selected runs This patch modifies select calculations of PR#1616 in order to preserve bit reproducibility when FMA optimization is enabled. We add parentheses and reorder terms in selected expressions which either direct or suppress FMAs, ensuring equivalence with the previous release. We address two specific equations in the PR. The first is associated with vertical friction coupling coupling coefficient. The diff is shown below. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K)) The denominator is of the form `a*b + c*d`. A compiler may favor an FMA of the form `a*b + (c*d)`. However, the modified equation is of form which favors the `a + c*d` FMA. Each form gives different results in the final bits. We resolve this by expliciting wrapping the RHS in parentheses: a_cpl(i,K) = Kv_tot(i,K) / (h_shear + (I_amax*Kv_tot(i,K))) Although this disables the FMA, it produces the same bit-equivalent answer as the original expression. ---- The second equation for TKE due to kappa shear is shown below. - tke_src = dz_Int(K) *(((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & - (TKE(k) - q0)*TKE_decay(k)) - & + tke_src = h_Int(K) * (dz_h_Int(K)*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & + (TKE(k) - q0)*TKE_decay(k)) - & ... The outer equation was of the form `b + c` but is promoted to `a*b + c`, transforming it to an FMA. We resolve this by suppressing this FMA optimization: tke_src = h_Int(K) * ((dz_h_Int(K) * ((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K))) - & (TKE(k) - q0)*TKE_decay(k)) - & ... ---- The following two changes are intended to be the smallest modification which preserves answers for known testing on target compilers. It does not encompass all equation changes in this PR. If needed, we could extend these changes to similar modifications of PR#1616. We do not expect to support bit reproducibility when FMAs are enabled. But this is an ongoing conversation, and the rules around FMAs should be expected to change as we learn more and agree on rules of reproducibility. --- src/parameterizations/vertical/MOM_kappa_shear.F90 | 2 +- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 81ab0661cc..8a1974d8ea 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1618,7 +1618,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, h_Int, dz_Int, dz_h_Int, I_L2_b ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = h_Int(K) * (dz_h_Int(K)*((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & + tke_src = h_Int(K) * ((dz_h_Int(K) * ((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K))) - & (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 8d41fcb63a..ead2cf00cf 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2116,7 +2116,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ! Calculate the coupling coefficients from the viscosities. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K)) + a_cpl(i,K) = Kv_tot(i,K) / (h_shear + (I_amax * Kv_tot(i,K))) endif ; enddo ; enddo ! i & k loops elseif (abs(CS%Kv_extra_bbl) > 0.0) then ! There is a simple enhancement of the near-bottom viscosities, but no adjustment