From 7233f3324009dd4730c1503ac1616bc86e59693b Mon Sep 17 00:00:00 2001 From: Henri Drake Date: Wed, 14 Aug 2024 17:07:28 -0700 Subject: [PATCH] Attempt to pass new seaice_melt field through the GFDL MOM6-SIS2 coupler See companion commit https://github.com/NOAA-GFDL/SIS2/pull/214/commits/1c8dc7e8f73aba6ba5109524fbd455c44b1ea2e7 --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 20 ++++++++++++++----- .../STALE_mct_cap/mom_surface_forcing_mct.F90 | 2 +- .../nuopc_cap/mom_surface_forcing_nuopc.F90 | 12 +++++------ 3 files changed, 22 insertions(+), 12 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 825f0cc29a..3e467dd043 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -184,10 +184,11 @@ module MOM_surface_forcing_gfdl real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W m-2] real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W m-2] real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W m-2] - real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg m-2 s-1] - real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg m-2 s-1] - real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg m-2 s-1] - real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg m-2 s-1] + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg m-2 s-1] + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg m-2 s-1] + real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< mass flux of melted sea ice [kg m-2 s-1] + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg m-2 s-1] + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg m-2 s-1] real, pointer, dimension(:,:) :: stress_mag =>NULL() !< The time-mean magnitude of the stress on the ocean [Pa] real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m s-1] real, pointer, dimension(:,:) :: area_berg =>NULL() !< fractional area covered by icebergs [m2 m-2] @@ -446,6 +447,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call check_mask_val_consistency(IOB%fprec(i-i0,j-j0), G%mask2dT(i,j), i, j, 'fprec', G) endif + if (associated(IOB%seaice_melt)) then + fluxes%seaice_melt(i,j) = kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) * G%mask2dT(i,j) + if (CS%check_no_land_fluxes) & + call check_mask_val_consistency(IOB%seaice_melt(i-i0,j-j0), G%mask2dT(i,j), i, j, 'seaice_melt', G) + endif + if (associated(IOB%q_flux)) then fluxes%evap(i,j) = - kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) if (CS%check_no_land_fluxes) & @@ -604,7 +611,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (CS%use_net_FW_adjustment_sign_bug) sign_for_net_FW_bug = -1. do j=js,je ; do i=is,ie net_FW(i,j) = US%RZ_T_to_kg_m2s* & - (((fluxes%lprec(i,j) + fluxes%fprec(i,j)) + & + (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * US%L_to_m**2*G%areaT(i,j) ! The following contribution appears to be calculating the volume flux of sea-ice @@ -828,6 +835,8 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%lprec(i-i0,j-j0) if (associated(IOB%fprec)) & net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) + if (associated(IOB%seaice_melt)) & + net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) if (associated(IOB%runoff)) & net_mass_src(i,j) = net_mass_src(i,j) + kg_m2_s_conversion * IOB%runoff(i-i0,j-j0) if (associated(IOB%calving)) & @@ -1787,6 +1796,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%sw_flux_nir_dif) ; if (root) write(outunit,100) 'iobt%sw_flux_nir_dif', chks chks = field_chksum( iobt%lprec ) ; if (root) write(outunit,100) 'iobt%lprec ', chks chks = field_chksum( iobt%fprec ) ; if (root) write(outunit,100) 'iobt%fprec ', chks + chks = field_chksum( iobt%seaice_melt ) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks chks = field_chksum( iobt%runoff ) ; if (root) write(outunit,100) 'iobt%runoff ', chks chks = field_chksum( iobt%calving ) ; if (root) write(outunit,100) 'iobt%calving ', chks chks = field_chksum( iobt%p ) ; if (root) write(outunit,100) 'iobt%p ', chks diff --git a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 index bb57810f5b..88ba576cb6 100644 --- a/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 +++ b/config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90 @@ -1402,7 +1402,6 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%t_flux ) ; if (root) write(outunit,100) 'iobt%t_flux ', chks chks = field_chksum( iobt%q_flux ) ; if (root) write(outunit,100) 'iobt%q_flux ', chks chks = field_chksum( iobt%seaice_melt_heat); if (root) write(outunit,100) 'iobt%seaice_melt_heat', chks - chks = field_chksum( iobt%seaice_melt) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks chks = field_chksum( iobt%salt_flux ) ; if (root) write(outunit,100) 'iobt%salt_flux ', chks chks = field_chksum( iobt%lw_flux ) ; if (root) write(outunit,100) 'iobt%lw_flux ', chks chks = field_chksum( iobt%sw_flux_vis_dir) ; if (root) write(outunit,100) 'iobt%sw_flux_vis_dir', chks @@ -1411,6 +1410,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%sw_flux_nir_dif) ; if (root) write(outunit,100) 'iobt%sw_flux_nir_dif', chks chks = field_chksum( iobt%lprec ) ; if (root) write(outunit,100) 'iobt%lprec ', chks chks = field_chksum( iobt%fprec ) ; if (root) write(outunit,100) 'iobt%fprec ', chks + chks = field_chksum( iobt%seaice_melt) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks chks = field_chksum( iobt%rofl_flux ) ; if (root) write(outunit,100) 'rofl_flux ', chks chks = field_chksum( iobt%rofi_flux ) ; if (root) write(outunit,100) 'rofi_flux ', chks chks = field_chksum( iobt%p ) ; if (root) write(outunit,100) 'iobt%p ', chks diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index e7d6c9abc6..d6e7922f68 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -165,7 +165,6 @@ module MOM_surface_forcing_nuopc real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s] real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s] real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2] - real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2] real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2] real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2] @@ -173,6 +172,7 @@ module MOM_surface_forcing_nuopc real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W/m2] real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg/m2/s] real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg/m2/s] + real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s] real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) @@ -459,6 +459,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%fprec)) & fluxes%fprec(i,j) = kg_m2_s_conversion * IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) + ! water flux due to sea ice and snow melt [kg/m2/s] + if (associated(IOB%seaice_melt)) & + fluxes%seaice_melt(i,j) = kg_m2_s_conversion * G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + if (associated(IOB%q_flux)) & fluxes%evap(i,j) = kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -491,10 +495,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (associated(IOB%seaice_melt_heat)) & fluxes%seaice_melt_heat(i,j) = US%W_m2_to_QRZ_T * G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) - ! water flux due to sea ice and snow melt [kg/m2/s] - if (associated(IOB%seaice_melt)) & - fluxes%seaice_melt(i,j) = kg_m2_s_conversion * G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) - fluxes%latent(i,j) = 0.0 ! notice minus sign since fprec is positive into the ocean if (associated(IOB%fprec)) then @@ -1493,7 +1493,6 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%t_flux ) ; if (root) write(outunit,100) 'iobt%t_flux ', chks chks = field_chksum( iobt%q_flux ) ; if (root) write(outunit,100) 'iobt%q_flux ', chks chks = field_chksum( iobt%seaice_melt_heat); if (root) write(outunit,100) 'iobt%seaice_melt_heat', chks - chks = field_chksum( iobt%seaice_melt) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks chks = field_chksum( iobt%salt_flux ) ; if (root) write(outunit,100) 'iobt%salt_flux ', chks chks = field_chksum( iobt%lw_flux ) ; if (root) write(outunit,100) 'iobt%lw_flux ', chks chks = field_chksum( iobt%sw_flux_vis_dir) ; if (root) write(outunit,100) 'iobt%sw_flux_vis_dir', chks @@ -1502,6 +1501,7 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) chks = field_chksum( iobt%sw_flux_nir_dif) ; if (root) write(outunit,100) 'iobt%sw_flux_nir_dif', chks chks = field_chksum( iobt%lprec ) ; if (root) write(outunit,100) 'iobt%lprec ', chks chks = field_chksum( iobt%fprec ) ; if (root) write(outunit,100) 'iobt%fprec ', chks + chks = field_chksum( iobt%seaice_melt ) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks chks = field_chksum( iobt%lrunoff ) ; if (root) write(outunit,100) 'iobt%lrunoff ', chks chks = field_chksum( iobt%frunoff ) ; if (root) write(outunit,100) 'iobt%frunoff ', chks chks = field_chksum( iobt%p ) ; if (root) write(outunit,100) 'iobt%p ', chks