Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Pass new seaice_melt field from SIS2 to MOM6 #710

Draft
wants to merge 4 commits into
base: dev/gfdl
Choose a base branch
from
Draft

Pass new seaice_melt field from SIS2 to MOM6 #710

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
b3e65c6
Attempt to pass new seaice_melt field through the GFDL MOM6-SIS2 coupler
Aug 15, 2024
202ff90
Pass `seaice_melt` through all ice-ocean couplers
Aug 15, 2024
c8dc42e
Check if `seaice_melt` is associated before the checksum
Aug 19, 2024
13b9960
Revert changes to STALE_mct_cap and nuopc_cap
Aug 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 16 additions & 5 deletions config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down Expand Up @@ -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
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@marshallward Is this sufficient to make sure that fluxes%seaice_melt is not filled with nonsense if IOB%seaice_melt is not allocated or used by the coupler?

Copy link
Member

@marshallward marshallward Aug 19, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I wouldn't say prevent, it only ensures that the potential nonsense from IOB%seaice_melt is transferred to fluxes%seaice_melt.

The only solution I can see is for net_FW to have some awareness of the state of IOB%seaice_melt. If the coupler fills IOB%seaice_melt, then it can be used to compute new_FW (via fluxes%seaice_melt). Otherwise, it needs to be filled some other way (if at all).

Zero-initialization might get you out of this, although generally we try to avoid that solution where possible.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am guessing there is no way to check if IOB%seaice_melt has been allocated with actual values?

What if we add use_seaice_melt to IOB as a logical, default it to false and then set it to true in the coupler where IOB%seaice_melt was allocated? Then use that here to see if seaice_melt should be used or not in this routine.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

After some in preson discussion @marshallward confirmed the if associated should be enough to make sure the pointer was allocated in the coupler. There should be no need to change anything to get this working with older versions of the coupler.

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) &
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)) &
Expand Down Expand Up @@ -1787,6 +1796,8 @@ 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
! hfd/Gives error: "Program received signal SIGSEGV: Segmentation fault - invalid memory reference."
chks = field_chksum( iobt%seaice_melt ) ; if (root) write(outunit,100) 'iobt%seaice_melt ', chks
hdrake marked this conversation as resolved.
Show resolved Hide resolved
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
Expand Down
12 changes: 6 additions & 6 deletions config_src/drivers/STALE_mct_cap/mom_surface_forcing_mct.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -156,14 +156,14 @@ module MOM_surface_forcing_mct
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]
real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2]
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(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg/m2/s]
real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg/m2/s]
real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s]
Expand Down Expand Up @@ -428,6 +428,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
if (associated(IOB%seaice_melt)) &
fluxes%seaice_melt(i,j) = kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) * G%mask2dT(i,j)

! evaporation
if (associated(IOB%q_flux)) &
fluxes%evap(i,j) = kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j)
Expand Down Expand Up @@ -477,10 +481,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) = G%mask2dT(i,j) * US%W_m2_to_QRZ_T * 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) = G%mask2dT(i,j) * kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0)

! latent heat flux (W/m^2)
fluxes%latent(i,j) = 0.0
! contribution from frozen ppt (notice minus sign since fprec is positive into the ocean)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
6 changes: 3 additions & 3 deletions config_src/drivers/STALE_mct_cap/ocn_cap_methods.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,9 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit,
! frozen precipitation (snow)
ice_ocean_boundary%fprec(i,j) = x2o(ind%x2o_Faxa_snow,k)

! water flux from snow&ice melt (kg/m2/s)
ice_ocean_boundary%seaice_melt(i,j) = x2o(ind%x2o_Fioi_meltw,k)

! longwave radiation, sum up and down (W/m2)
ice_ocean_boundary%lw_flux(i,j) = (x2o(ind%x2o_Faxa_lwdn,k) + x2o(ind%x2o_Foxx_lwup,k))

Expand All @@ -74,9 +77,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit,
! snow&ice melt heat flux (W/m^2)
ice_ocean_boundary%seaice_melt_heat(i,j) = x2o(ind%x2o_Fioi_melth,k)

! water flux from snow&ice melt (kg/m2/s)
ice_ocean_boundary%seaice_melt(i,j) = x2o(ind%x2o_Fioi_meltw,k)

! liquid runoff
ice_ocean_boundary%rofl_flux(i,j) = x2o(ind%x2o_Foxx_rofl,k) * GRID%mask2dT(i,j)

Expand Down
2 changes: 1 addition & 1 deletion config_src/drivers/STALE_mct_cap/ocn_comp_mct.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -858,7 +858,6 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
IOB% v_flux (isc:iec,jsc:jec), &
IOB% t_flux (isc:iec,jsc:jec), &
IOB% seaice_melt_heat (isc:iec,jsc:jec),&
IOB% seaice_melt (isc:iec,jsc:jec), &
IOB% q_flux (isc:iec,jsc:jec), &
IOB% salt_flux (isc:iec,jsc:jec), &
IOB% lw_flux (isc:iec,jsc:jec), &
Expand All @@ -868,6 +867,7 @@ subroutine IOB_allocate(IOB, isc, iec, jsc, jec)
IOB% sw_flux_nir_dif (isc:iec,jsc:jec), &
IOB% lprec (isc:iec,jsc:jec), &
IOB% fprec (isc:iec,jsc:jec), &
IOB% seaice_melt (isc:iec,jsc:jec), &
IOB% ustar_berg (isc:iec,jsc:jec), &
IOB% area_berg (isc:iec,jsc:jec), &
IOB% mass_berg (isc:iec,jsc:jec), &
Expand Down
11 changes: 5 additions & 6 deletions config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,14 +165,14 @@ 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]
real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2]
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)
Expand Down Expand Up @@ -459,6 +459,9 @@ 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)

if (associated(IOB%seaice_melt)) &
fluxes%seaice_melt(i,j) = kg_m2_s_conversion * IOB%seaice_melt(i-i0,j-j0) * G%mask2dT(i,j)

if (associated(IOB%q_flux)) &
fluxes%evap(i,j) = kg_m2_s_conversion * IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j)

Expand Down Expand Up @@ -491,10 +494,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
Expand Down Expand Up @@ -1493,7 +1492,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
Expand All @@ -1502,6 +1500,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
Expand Down
2 changes: 2 additions & 0 deletions config_src/drivers/solo_driver/MESO_surface_forcing.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -99,6 +99,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%seaice_melt, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed)
Expand Down Expand Up @@ -142,6 +143,7 @@ subroutine MESO_buoyancy_forcing(sfc_state, fluxes, day, dt, G, US, CS)
! and are positive downward - i.e. evaporation should be negative.
fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j)
fluxes%lprec(i,j) = CS%PmE(i,j) * CS%Rho0 * G%mask2dT(i,j)
fluxes%seaice_melt(i,j) = 0.0 * G%mask2dT(i,j)

! vprec will be set later, if it is needed for salinity restoring.
fluxes%vprec(i,j) = 0.0
Expand Down
Loading