diff --git a/config_src/nuopc_driver/mom_cap.F90 b/config_src/nuopc_driver/mom_cap.F90 index 804dacce9e..9d923bf8a3 100644 --- a/config_src/nuopc_driver/mom_cap.F90 +++ b/config_src/nuopc_driver/mom_cap.F90 @@ -41,7 +41,6 @@ module MOM_cap_mod use shr_file_mod, only: shr_file_setLogUnit, shr_file_getLogUnit #endif use time_utils_mod, only: esmf2fms_time -use data_override_mod, only: data_override_init, data_override use, intrinsic :: iso_fortran_env, only: output_unit @@ -689,11 +688,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ocean_public%is_ocean_pe = .true. call ocean_model_init(ocean_public, ocean_state, time0, time_start, input_restart_file=trim(restartfile)) -#ifndef CESMCOUPLED -! for runoff in EMC - call data_override_init(Ocean_domain_in = Ocean_public%domain) -#endif - call ocean_model_init_sfc(ocean_state, ocean_public) call mpp_get_compute_domain(ocean_public%domain, isc, iec, jsc, jec) @@ -714,12 +708,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary% seaice_melt (isc:iec,jsc:jec), & Ice_ocean_boundary% mi (isc:iec,jsc:jec), & Ice_ocean_boundary% p (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving (isc:iec,jsc:jec), & - Ice_ocean_boundary% runoff_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% calving_hflx (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofl_flux (isc:iec,jsc:jec), & - Ice_ocean_boundary% rofi_flux (isc:iec,jsc:jec)) + Ice_ocean_boundary% lrunoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% frunoff_hflx (isc:iec,jsc:jec), & + Ice_ocean_boundary% lrunoff (isc:iec,jsc:jec), & + Ice_ocean_boundary% frunoff (isc:iec,jsc:jec)) Ice_ocean_boundary%u_flux = 0.0 Ice_ocean_boundary%v_flux = 0.0 @@ -737,12 +729,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) Ice_ocean_boundary%seaice_melt_heat= 0.0 Ice_ocean_boundary%mi = 0.0 Ice_ocean_boundary%p = 0.0 - Ice_ocean_boundary%runoff = 0.0 - Ice_ocean_boundary%calving = 0.0 - Ice_ocean_boundary%runoff_hflx = 0.0 - Ice_ocean_boundary%calving_hflx = 0.0 - Ice_ocean_boundary%rofl_flux = 0.0 - Ice_ocean_boundary%rofi_flux = 0.0 + Ice_ocean_boundary%lrunoff_hflx = 0.0 + Ice_ocean_boundary%frunoff_hflx = 0.0 + Ice_ocean_boundary%lrunoff = 0.0 + Ice_ocean_boundary%frunoff = 0.0 ocean_internalstate%ptr%ocean_state_type_ptr => ocean_state call ESMF_GridCompSetInternalState(gcomp, ocean_internalstate, rc) @@ -786,11 +776,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" , "will provide") !-> ice runoff 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") - - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_rate" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") - !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") + !These are not currently used and changing requires a nuopc dictionary change + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide") + !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide") !--------- export fields ------------- call fld_list_add(fldsFrOcn_num, fldsFrOcn, "ocean_mask" , "will provide") @@ -1727,8 +1715,6 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & return ! bail out - call ice_ocn_bnd_from_data(Ice_ocean_boundary, Time, Time_step_coupled) ! for runoff - !--------------- ! Update MOM6 !--------------- @@ -2332,20 +2318,6 @@ subroutine shr_file_getLogUnit(nunit) end subroutine shr_file_getLogUnit #endif - subroutine ice_ocn_bnd_from_data(x, Time, Time_step_coupled) -! get forcing data from data_overide - type (ice_ocean_boundary_type) :: x - type(Time_type), intent(in) :: Time, Time_step_coupled - - type(Time_type) :: Time_next - character(len=*),parameter :: subname='(mom_cap:ice_ocn_bnd_from_data)' - - Time_next = Time + Time_step_coupled -! call data_override('OCN', 'runoff', x%runoff , Time_next) - call data_override('OCN', 'runoff', x%rofl_flux , Time_next) - - end subroutine ice_ocn_bnd_from_data - !> !! @page nuopc_cap NUOPC Cap !! @author Fei Liu (fei.liu@gmail.com) diff --git a/config_src/nuopc_driver/mom_cap_methods.F90 b/config_src/nuopc_driver/mom_cap_methods.F90 index 2f872c7da5..70915d0e95 100644 --- a/config_src/nuopc_driver/mom_cap_methods.F90 +++ b/config_src/nuopc_driver/mom_cap_methods.F90 @@ -214,64 +214,42 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, return ! bail out !---- - ! runoff and heat content of runoff + ! mass and heat content of liquid and frozen runoff !---- ! Note - preset values to 0, if field does not exist in importState, then will simply return ! and preset value will be used ! liquid runoff - ice_ocean_boundary%rofl_flux (:,:) = 0._ESMF_KIND_R8 + ice_ocean_boundary%lrunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofl', & - isc, iec, jsc, jec, ice_ocean_boundary%rofl_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out ! ice runoff - ice_ocean_boundary%rofi_flux (:,:) = 0._ESMF_KIND_R8 + ice_ocean_boundary%frunoff (:,:) = 0._ESMF_KIND_R8 call state_getimport(importState, 'Foxx_rofi', & - isc, iec, jsc, jec, ice_ocean_boundary%rofi_flux,rc=rc) + isc, iec, jsc, jec, ice_ocean_boundary%frunoff,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! total runoff - ice_ocean_boundary%runoff (:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff, rc=rc) + ! heat content of lrunoff + ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_runoff_heat_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - ! heat content of runoff - ice_ocean_boundary%runoff_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_runoff_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%runoff_hflx, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - !---- - ! calving rate and heat flux - !---- - ! 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%calving(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_rate', & - isc, iec, jsc, jec, ice_ocean_boundary%calving, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - - ice_ocean_boundary%calving_hflx(:,:) = 0._ESMF_KIND_R8 - call state_getimport(importState, 'mean_calving_heat_flux', & - isc, iec, jsc, jec, ice_ocean_boundary%calving_hflx, rc=rc) + ! heat content of frunoff + ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8 + call state_getimport(importState, 'mean_calving_heat_flx', & + isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & diff --git a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 index ba6760ffa4..af59d7d6ea 100644 --- a/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 +++ b/config_src/nuopc_driver/mom_surface_forcing_nuopc.F90 @@ -107,6 +107,7 @@ module MOM_surface_forcing_nuopc !! sea-ice viscosity becomes effective, in kg m-2, !! typically of order 1000 [kg m-2]. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments + logical :: liquid_runoff_from_data !< If true, use data_override to obtain liquid runoff real :: Flux_const !< piston velocity for surface restoring [m/s] logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux @@ -152,8 +153,8 @@ module MOM_surface_forcing_nuopc !> Structure corresponding to forcing, but with the elements, units, and conventions !! that exactly conform to the use for MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff [kg/m2/s] - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff [kg/m2/s] + real, pointer, dimension(:,:) :: lrunoff =>NULL() !< liquid runoff [kg/m2/s] + real, pointer, dimension(:,:) :: frunoff =>NULL() !< ice runoff [kg/m2/s] real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress [Pa] real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress [Pa] real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W/m2] @@ -168,13 +169,11 @@ 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(:,:) :: 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] real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] - real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W/m2] + real, pointer, dimension(:,:) :: lrunoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] + real, pointer, dimension(:,:) :: frunoff_hflx =>NULL() !< heat content of frozen runoff [W/m2] real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere !< on ocean surface [Pa] real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice [kg/m2] @@ -411,6 +410,13 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & enddo ; enddo endif + ! Check that liquid runoff has a place to go + if (CS%liquid_runoff_from_data .and. .not. associated(IOB%lrunoff)) then + call MOM_error(FATAL, "liquid runoff is being added via data_override but "// & + "there is no associated runoff in the IOB") + return + end if + ! obtain fluxes from IOB; note the staggering of indices i0 = is - isc_bnd ; j0 = js - jsc_bnd do j=js,je ; do i=is,ie @@ -425,17 +431,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) ! liquid runoff flux - if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) - else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%lrunoff)) then + if(CS%liquid_runoff_from_data)call data_override('OCN', 'runoff', IOB%lrunoff, Time) + fluxes%lrunoff(i,j) = IOB%lrunoff(i-i0,j-j0) * G%mask2dT(i,j) endif ! ice runoff flux - if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) - elseif (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%frunoff)) then + fluxes%frunoff(i,j) = IOB%frunoff(i-i0,j-j0) * G%mask2dT(i,j) endif if (associated(IOB%ustar_berg)) & @@ -447,11 +450,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%mass_berg)) & fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%lrunoff_hflx)) & + fluxes%heat_content_lrunoff(i,j) = IOB%lrunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) - if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%frunoff_hflx)) & + fluxes%heat_content_frunoff(i,j) = IOB%frunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -472,9 +475,9 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion endif - if (associated(IOB%calving)) then - fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion - fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%calving(i-i0,j-j0)*CS%latent_heat_fusion + if (associated(IOB%frunoff)) then + fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%frunoff(i-i0,j-j0)*CS%latent_heat_fusion + fluxes%latent_frunoff_diag(i,j) = G%mask2dT(i,j) * IOB%frunoff(i-i0,j-j0)*CS%latent_heat_fusion endif if (associated(IOB%q_flux)) then fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor @@ -1262,7 +1265,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) - if (CS%allow_flux_adjustments) then + + call get_param(param_file, mdl, "LIQUID_RUNOFF_FROM_DATA", CS%liquid_runoff_from_data, & + "If true, allows liquid river runoff to be specified via the "//& + "data_table using the component name 'OCN'.", default=.false.) + + if (CS%allow_flux_adjustments .or. CS%liquid_runoff_from_data) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) endif @@ -1352,8 +1360,8 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) write(outunit,100) 'iobt%sw_flux_nir_dif' , mpp_chksum( iobt%sw_flux_nir_dif) write(outunit,100) 'iobt%lprec ' , mpp_chksum( iobt%lprec ) write(outunit,100) 'iobt%fprec ' , mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%runoff ' , mpp_chksum( iobt%runoff ) - write(outunit,100) 'iobt%calving ' , mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%lrunoff ' , mpp_chksum( iobt%lrunoff ) + write(outunit,100) 'iobt%frunoff ' , mpp_chksum( iobt%frunoff ) write(outunit,100) 'iobt%p ' , mpp_chksum( iobt%p ) if (associated(iobt%ustar_berg)) & write(outunit,100) 'iobt%ustar_berg ' , mpp_chksum( iobt%ustar_berg )