Skip to content

Commit

Permalink
Attempt to pass new seaice_melt field through the GFDL MOM6-SIS2 coupler
Browse files Browse the repository at this point in the history
See companion commit NOAA-GFDL/SIS2@1c8dc7e
  • Loading branch information
Henri Drake committed Aug 15, 2024
1 parent 9b45087 commit 7233f33
Show file tree
Hide file tree
Showing 3 changed files with 22 additions and 12 deletions.
20 changes: 15 additions & 5 deletions config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90
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
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,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
Expand Down
Original file line number Diff line number Diff line change
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
12 changes: 6 additions & 6 deletions config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
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,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)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 7233f33

Please sign in to comment.