From aeb6a55c12909ddb3b3e396d80c194ec70f4d37a Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 24 Sep 2018 09:36:48 -0600 Subject: [PATCH 01/41] implement groundwater irrigation and drip/sprinkler irrigation application methods --- src/biogeophys/BalanceCheckMod.F90 | 32 +++-- src/biogeophys/CanopyHydrologyMod.F90 | 43 +++---- src/biogeophys/HydrologyDrainageMod.F90 | 35 +++--- src/biogeophys/HydrologyNoDrainageMod.F90 | 2 +- src/biogeophys/IrrigationMod.F90 | 139 ++++++++++++++++++--- src/biogeophys/SoilHydrologyMod.F90 | 68 ++++++++-- src/biogeophys/WaterDiagnosticBulkType.F90 | 12 +- src/biogeophys/WaterFluxType.F90 | 87 +++++++++++-- src/biogeophys/WaterStateType.F90 | 2 +- src/main/clm_driver.F90 | 6 +- src/main/clm_initializeMod.F90 | 5 +- src/main/clm_varsur.F90 | 5 + src/main/lnd2atmMod.F90 | 3 +- src/main/surfrdMod.F90 | 26 +++- 14 files changed, 366 insertions(+), 99 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index a5d0938aca..84f35aa4c7 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -78,15 +78,6 @@ subroutine BeginWaterBalance(bounds, & begwb => waterbalancebulk_inst%begwb_col & ! Output: [real(r8) (:) ] water mass begining of the time step ) - do fc = 1, num_nolakec - c = filter_nolakec(fc) - if (col%hydrologically_active(c)) then - if(zwt(c) <= zi(c,nlevsoi)) then - wa(c) = aquifer_water_baseline - end if - end if - end do - call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstatebulk_inst, waterdiagnosticbulk_inst, begwb(bounds%begc:bounds%endc)) @@ -199,7 +190,11 @@ subroutine BalanceCheck( bounds, & snow_sources => waterfluxbulk_inst%snow_sources_col , & ! Output: [real(r8) (:) ] snow sources (mm H2O /s) snow_sinks => waterfluxbulk_inst%snow_sinks_col , & ! Output: [real(r8) (:) ] snow sinks (mm H2O /s) - qflx_irrig => waterfluxbulk_inst%qflx_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) + qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) + qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! Input: [real(r8) (:) ] groundwater irrigation flux (mm H2O /s) + qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col , & ! Input: [real(r8) (:) ] groundwater irrigation flux (mm H2O /s) + qflx_irrig_drip => waterfluxbulk_inst%qflx_irrig_drip_col , & ! Input: [real(r8) (:) ] drip irrigation flux (mm H2O /s) + qflx_irrig_sprinkler => waterfluxbulk_inst%qflx_irrig_sprinkler_col , & ! Input: [real(r8) (:) ] sprinkler irrigation flux (mm H2O /s) qflx_glcice_dyn_water_flux => waterfluxbulk_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) @@ -272,7 +267,10 @@ subroutine BalanceCheck( bounds, & - (forc_rain_col(c) & + forc_snow_col(c) & + qflx_floodc(c) & - + qflx_irrig(c) & + + qflx_irrig_drip(c) & + + qflx_irrig_sprinkler(c) & + - qflx_gw_uncon_irrig(c) & + - qflx_gw_con_irrig(c) & + qflx_glcice_dyn_water_flux(c) & - qflx_evap_tot(c) & - qflx_surf(c) & @@ -321,7 +319,11 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'endwb = ',endwb(indexc) write(iulog,*)'begwb = ',begwb(indexc) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc)*dtime + write(iulog,*)'qflx_irrig_drip = ',qflx_irrig_drip(indexc)*dtime + write(iulog,*)'qflx_irrig_sprinkler = ',qflx_irrig_sprinkler(indexc)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime + write(iulog,*)'qflx_gw_uncon_irrig = ',qflx_gw_uncon_irrig(indexc)*dtime + write(iulog,*)'qflx_gw_con_irrig = ',qflx_gw_con_irrig(indexc)*dtime write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime @@ -351,7 +353,11 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'begwb = ',begwb(indexc) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_irrig = ',qflx_irrig(indexc)*dtime + write(iulog,*)'qflx_irrig_drip = ',qflx_irrig_drip(indexc)*dtime + write(iulog,*)'qflx_irrig_sprinkler = ',qflx_irrig_sprinkler(indexc)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime + write(iulog,*)'qflx_gw_uncon_irrig = ',qflx_gw_uncon_irrig(indexc)*dtime + write(iulog,*)'qflx_gw_con_irrig = ',qflx_gw_con_irrig(indexc)*dtime write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime diff --git a/src/biogeophys/CanopyHydrologyMod.F90 b/src/biogeophys/CanopyHydrologyMod.F90 index 398d37e8cb..19574c8586 100644 --- a/src/biogeophys/CanopyHydrologyMod.F90 +++ b/src/biogeophys/CanopyHydrologyMod.F90 @@ -21,10 +21,10 @@ module CanopyHydrologyMod use AerosolMod , only : aerosol_type use CanopyStateType , only : canopystate_type use TemperatureType , only : temperature_type - use WaterFluxBulkType , only : waterfluxbulk_type - use Wateratm2lndBulkType , only : wateratm2lndbulk_type - use WaterStateBulkType , only : waterstatebulk_type - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use ColumnType , only : col use PatchType , only : patch ! @@ -176,10 +176,10 @@ subroutine CanopyHydrology(bounds, & type(canopystate_type) , intent(in) :: canopystate_inst type(temperature_type) , intent(inout) :: temperature_inst type(aerosol_type) , intent(inout) :: aerosol_inst - type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst - type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst - type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst - type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst + type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst + type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst ! ! !LOCAL VARIABLES: integer :: f ! filter index @@ -267,13 +267,14 @@ subroutine CanopyHydrology(bounds, & qflx_prec_intr => waterfluxbulk_inst%qflx_prec_intr_patch , & ! Output: [real(r8) (:) ] interception of precipitation [mm/s] qflx_prec_grnd => waterfluxbulk_inst%qflx_prec_grnd_patch , & ! Output: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 s)] qflx_rain_grnd => waterfluxbulk_inst%qflx_rain_grnd_patch , & ! Output: [real(r8) (:) ] rain on ground after interception (mm H2O/s) [+] - qflx_irrig => waterfluxbulk_inst%qflx_irrig_patch , & ! Input: [real(r8) (:) ] irrigation amount (mm/s) + qflx_irrig_drip => waterfluxbulk_inst%qflx_irrig_drip_patch , & ! Input: [real(r8) (:) ] drip irrigation amount (mm/s) + qflx_irrig_sprinkler => waterfluxbulk_inst%qflx_irrig_sprinkler_patch , & ! Input: [real(r8) (:) ] sprinkler irrigation amount (mm/s) + qflx_snowindunload => waterfluxbulk_inst%qflx_snowindunload_patch , & ! Output: [real(r8) (:) ] canopy snow unloading from wind [mm/s] qflx_snotempunload => waterfluxbulk_inst%qflx_snotempunload_patch & ! Output: [real(r8) (:) ] canopy snow unloading from temp. [mm/s] ) ! Compute time step - dtime = get_step_size() ! Set status of snowveg_flag @@ -287,7 +288,7 @@ subroutine CanopyHydrology(bounds, & g = patch%gridcell(p) l = patch%landunit(p) c = patch%column(p) - + ! Canopy interception and precipitation onto ground surface ! Add precipitation to leaf water @@ -309,8 +310,9 @@ subroutine CanopyHydrology(bounds, & if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then - if (frac_veg_nosno(p) == 1 .and. (forc_rain(c) + forc_snow(c)) > 0._r8) then - + ! irrigation may occur if forc_precip = 0 + if (frac_veg_nosno(p) == 1 .and. (forc_rain(c) + forc_snow(c) + qflx_irrig_sprinkler(p)) > 0._r8) then + ! determine fraction of input precipitation that is snow and rain fracsnow(p) = forc_snow(c)/(forc_snow(c) + forc_rain(c)) fracrain(p) = forc_rain(c)/(forc_snow(c) + forc_rain(c)) @@ -339,21 +341,20 @@ subroutine CanopyHydrology(bounds, & ! Direct throughfall qflx_through_snow(p) = forc_snow(c) * (1._r8-fpi) end if - ! Direct throughfall - qflx_through_rain(p) = forc_rain(c) * (1._r8-fpi) + qflx_through_rain(p) = (forc_rain(c) + qflx_irrig_sprinkler(p)) * (1._r8-fpi) if (snowveg_on .or. snowveg_onrad) then ! Intercepted precipitation [mm/s] - qflx_prec_intr(p) = forc_snow(c)*fpisnow + forc_rain(c)*fpi + qflx_prec_intr(p) = forc_snow(c)*fpisnow + (forc_rain(c) + qflx_irrig_sprinkler(p))*fpi ! storage of intercepted snowfall, rain, and dew snocan(p) = max(0._r8, snocan(p) + dtime*forc_snow(c)*fpisnow) - liqcan(p) = max(0._r8, liqcan(p) + dtime*forc_rain(c)*fpi) + liqcan(p) = max(0._r8, liqcan(p) + dtime*(forc_rain(c) + qflx_irrig_sprinkler(p))*fpi) else ! Intercepted precipitation [mm/s] - qflx_prec_intr(p) = (forc_snow(c) + forc_rain(c)) * fpi + qflx_prec_intr(p) = (forc_snow(c) + forc_rain(c) + qflx_irrig_sprinkler(p)) * fpi end if - + ! Water storage of intercepted precipitation and dew h2ocan(p) = max(0._r8, h2ocan(p) + dtime*qflx_prec_intr(p)) @@ -452,8 +453,8 @@ subroutine CanopyHydrology(bounds, & ! Add irrigation water directly onto ground (bypassing canopy interception) ! Note that it's still possible that (some of) this irrigation water will runoff (as runoff is computed later) - qflx_prec_grnd_rain(p) = qflx_prec_grnd_rain(p) + qflx_irrig(p) - + qflx_prec_grnd_rain(p) = qflx_prec_grnd_rain(p) + qflx_irrig_drip(p) + qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) qflx_snow_grnd_patch(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) diff --git a/src/biogeophys/HydrologyDrainageMod.F90 b/src/biogeophys/HydrologyDrainageMod.F90 index b8e26c4909..da6ed0b83a 100644 --- a/src/biogeophys/HydrologyDrainageMod.F90 +++ b/src/biogeophys/HydrologyDrainageMod.F90 @@ -85,14 +85,15 @@ subroutine HydrologyDrainage(bounds, & real(r8) :: dtime ! land model time step (sec) !----------------------------------------------------------------------- - associate( & ! Input: layer thickness depth (m) - dz => col%dz , & ! Input: column type - ctype => col%itype , & ! Input: gridcell flux of flood water from RTM - qflx_floodg => wateratm2lndbulk_inst%forc_flood_grc , & ! Input: rain rate [mm/s] + associate( & ! Input: layer thickness depth (m) + dz => col%dz , & ! Input: column type + ctype => col%itype , & ! Input: gridcell flux of flood water from RTM + qflx_floodg => wateratm2lndbulk_inst%forc_flood_grc , & ! Input: rain rate [mm/s] forc_rain => wateratm2lndbulk_inst%forc_rain_downscaled_col , & ! Input: snow rate [mm/s] forc_snow => wateratm2lndbulk_inst%forc_snow_downscaled_col , & ! Input: water mass begining of the time step - begwb => waterbalancebulk_inst%begwb_col , & ! Output:water mass end of the time step - endwb => waterbalancebulk_inst%endwb_col , & ! Output:water mass end of the time step + wa => waterstatebulk_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + begwb => waterbalancebulk_inst%begwb_col , & ! Output:water mass end of the time step + endwb => waterbalancebulk_inst%endwb_col , & ! Output:water mass end of the time step h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: ice lens (kg/m2) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: liquid water (kg/m2) h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Output: volumetric soil water @@ -112,13 +113,12 @@ subroutine HydrologyDrainage(bounds, & qflx_surf => waterfluxbulk_inst%qflx_surf_col , & ! surface runoff (mm H2O /s) qflx_infl => waterfluxbulk_inst%qflx_infl_col , & ! infiltration (mm H2O /s) qflx_qrgwl => waterfluxbulk_inst%qflx_qrgwl_col , & ! qflx_surf at glaciers, wetlands, lakes - qflx_runoff => waterfluxbulk_inst%qflx_runoff_col , & ! total runoff - ! (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + qflx_runoff => waterfluxbulk_inst%qflx_runoff_col , & ! total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) qflx_runoff_u => waterfluxbulk_inst%qflx_runoff_u_col , & ! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) - qflx_runoff_r => waterfluxbulk_inst%qflx_runoff_r_col , & ! Rural total runoff - ! (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + qflx_runoff_r => waterfluxbulk_inst%qflx_runoff_r_col , & ! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) qflx_ice_runoff_snwcp => waterfluxbulk_inst%qflx_ice_runoff_snwcp_col, & ! solid runoff from snow capping (mm H2O /s) - qflx_irrig => waterfluxbulk_inst%qflx_irrig_col & ! irrigation flux (mm H2O /s) + qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! surface irrigation flux (mm H2O /s) + qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col & ! confined groundwater irrigation flux (mm H2O /s) ) ! Determine time step and step size @@ -161,12 +161,17 @@ subroutine HydrologyDrainage(bounds, & end do end do + ! remove groundwater irrigation from aquifer + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then + wa(c) = wa(c) - qflx_gw_con_irrig(c) * dtime + endif + enddo + call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstatebulk_inst, waterdiagnosticbulk_inst, endwb(bounds%begc:bounds%endc)) - - - ! Determine wetland and land ice hydrology (must be placed here ! since need snow updated from CombineSnowLayers) @@ -212,7 +217,7 @@ subroutine HydrologyDrainage(bounds, & qflx_runoff(c) = qflx_drain(c) + qflx_surf(c) + qflx_qrgwl(c) + qflx_drain_perched(c) if ((lun%itype(l)==istsoil .or. lun%itype(l)==istcrop) .and. col%active(c)) then - qflx_runoff(c) = qflx_runoff(c) - qflx_irrig(c) + qflx_runoff(c) = qflx_runoff(c) - qflx_sfc_irrig(c) end if if (lun%urbpoi(l)) then qflx_runoff_u(c) = qflx_runoff(c) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index e03fd6b116..264afe11ab 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -249,7 +249,7 @@ subroutine HydrologyNoDrainage(bounds, & call ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - waterstatebulk_inst, waterfluxbulk_inst) + waterstatebulk_inst, waterfluxbulk_inst, waterdiagnosticbulk_inst) call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc,& diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 64f4cecce7..8d0ce67c3a 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -47,11 +47,12 @@ module IrrigationMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog - use clm_varcon , only : isecspday, degpsec, denh2o, spval, namec + use clm_varcon , only : isecspday, degpsec, denh2o, spval, ispval, namec use clm_varpar , only : nlevsoi, nlevgrnd use clm_time_manager , only : get_step_size use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type - use WaterFluxBulkType , only : waterfluxbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch @@ -114,7 +115,6 @@ module IrrigationMod end type irrigation_params_type - type, public :: irrigation_type private @@ -128,9 +128,13 @@ module IrrigationMod ! Private data members; time-varying: real(r8), pointer :: irrig_rate_patch (:) ! current irrigation rate [mm/s] real(r8), pointer :: irrig_rate_demand_patch (:) ! current irrigation rate, neglecting surface water source limitation [mm/s] + real(r8), pointer :: gw_uncon_irrig_rate_patch (:) ! current unconfined groundwater irrigation rate [mm/s] + real(r8), pointer :: gw_con_irrig_rate_patch (:) ! current confined groundwater irrigation rate [mm/s] integer , pointer :: n_irrig_steps_left_patch (:) ! number of time steps for which we still need to irrigate today (if 0, ignore) real(r8), pointer :: qflx_irrig_demand_patch (:) ! irrigation flux neglecting surface water source limitation [mm/s] + integer , pointer :: irrig_method_patch (:) ! patch irrigation application method + contains ! Public routines ! COMPILER_BUG(wjs, 2014-10-15, pgi 14.7) Add an "Irrigation" prefix to some generic routines like "Init" @@ -172,6 +176,12 @@ module IrrigationMod ! Conversion factors real(r8), parameter :: m3_over_km2_to_mm = 1.e-3_r8 + + ! Irrigation methods + ! Drip is defined here as irrigation applied directly to soil surface + integer, parameter, private :: irrig_method_drip = 1 + ! Sprinkler is applied directly to canopy + integer, parameter, private :: irrig_method_sprinkler = 2 character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -499,12 +509,15 @@ subroutine IrrigationInitAllocate(this, bounds) begp = bounds%begp; endp= bounds%endp begc = bounds%begc; endc= bounds%endc - allocate(this%qflx_irrig_demand_patch (begp:endp)) ; this%qflx_irrig_demand_patch (:) = nan - allocate(this%relsat_wilting_point_col (begc:endc,nlevsoi)) ; this%relsat_wilting_point_col (:,:) = nan - allocate(this%relsat_target_col (begc:endc,nlevsoi)) ; this%relsat_target_col (:,:) = nan - allocate(this%irrig_rate_patch (begp:endp)) ; this%irrig_rate_patch (:) = nan - allocate(this%irrig_rate_demand_patch (begp:endp)) ; this%irrig_rate_demand_patch (:) = nan - allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 + allocate(this%qflx_irrig_demand_patch (begp:endp)) ; this%qflx_irrig_demand_patch (:) = nan + allocate(this%relsat_wilting_point_col (begc:endc,nlevsoi)) ; this%relsat_wilting_point_col (:,:) = nan + allocate(this%relsat_target_col (begc:endc,nlevsoi)) ; this%relsat_target_col (:,:) = nan + allocate(this%irrig_rate_patch (begp:endp)) ; this%irrig_rate_patch (:) = nan + allocate(this%irrig_rate_demand_patch (begp:endp)) ; this%irrig_rate_demand_patch (:) = nan + allocate(this%gw_uncon_irrig_rate_patch (begp:endp)) ; this%gw_uncon_irrig_rate_patch (:) = nan + allocate(this%gw_con_irrig_rate_patch (begp:endp)) ; this%gw_con_irrig_rate_patch (:) = nan + allocate(this%irrig_method_patch (begp:endp)) ; this%irrig_method_patch (:) = ispval + allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 end subroutine IrrigationInitAllocate @@ -544,6 +557,8 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention ! ! !USES: use SoilStateType , only : soilstate_type + use clm_instur , only : irrig_method + use pftconMod , only : pftcon ! ! !ARGUMENTS: class(irrigation_type) , intent(inout) :: this @@ -552,7 +567,10 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve ! ! !LOCAL VARIABLES: + integer :: m ! dummy index + integer :: p ! patch index integer :: c ! col index + integer :: g ! gridcell index integer :: j ! level index character(len=*), parameter :: subname = 'InitCold' @@ -589,6 +607,14 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention end do end do + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + if (pftcon%irrigated(patch%itype(p)) == 1._r8) then + m = patch%itype(p) + this%irrig_method_patch(p) = irrig_method(g,m) + end if + end do + this%dtime = get_step_size() this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(this%dtime) @@ -702,7 +728,19 @@ subroutine Restart(this, bounds, ncid, flag) long_name='irrigation rate demand, neglecting surface water source limitation', & units='mm/s', & interpinic_flag='interp', readvar=readvar, data=this%irrig_rate_demand_patch) + call restartvar(ncid=ncid, flag=flag, varname='gw_uncon_irrig_rate:irrig_rate', & + xtype=ncd_double, & + dim1name='pft', & + long_name='unconfined groundwater irrigation rate', & + units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%gw_uncon_irrig_rate_patch) + call restartvar(ncid=ncid, flag=flag, varname='gw_con_irrig_rate:irrig_rate', & + xtype=ncd_double, & + dim1name='pft', & + long_name='confined groundwater irrigation rate', & + units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%gw_con_irrig_rate_patch) end subroutine Restart !----------------------------------------------------------------------- @@ -724,6 +762,9 @@ subroutine IrrigationClean(this) deallocate(this%relsat_target_col) deallocate(this%irrig_rate_patch) deallocate(this%irrig_rate_demand_patch) + deallocate(this%gw_uncon_irrig_rate_patch) + deallocate(this%gw_con_irrig_rate_patch) + deallocate(this%irrig_method_patch) deallocate(this%n_irrig_steps_left_patch) end subroutine IrrigationClean @@ -762,27 +803,69 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) ! works correctly. associate( & - qflx_irrig_patch => waterfluxbulk_inst%qflx_irrig_patch , & ! Output: [real(r8) (:)] patch irrigation flux (mm H2O/s) - qflx_irrig_col => waterfluxbulk_inst%qflx_irrig_col & ! Output: [real(r8) (:)] col irrigation flux (mm H2O/s) + qflx_sfc_irrig_patch => waterfluxbulk_inst%qflx_sfc_irrig_patch , & ! Output: [real(r8) (:)] patch irrigation flux (mm H2O/s) + qflx_sfc_irrig_col => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! Output: [real(r8) (:)] col irrigation flux (mm H2O/s) + qflx_gw_uncon_irrig_patch => waterfluxbulk_inst%qflx_gw_uncon_irrig_patch , & ! Output: [real(r8) (:)] patch unconfined groundwater irrigation flux (mm H2O/s) + qflx_gw_uncon_irrig_col => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! Output: [real(r8) (:)] col unconfined groundwater irrigation flux (mm H2O/s) + qflx_gw_con_irrig_patch => waterfluxbulk_inst%qflx_gw_con_irrig_patch , & ! Output: [real(r8) (:)] patch confined groundwater irrigation flux (mm H2O/s) + qflx_gw_con_irrig_col => waterfluxbulk_inst%qflx_gw_con_irrig_col , & ! Output: [real(r8) (:)] col confined groundwater irrigation flux (mm H2O/s) + qflx_irrig_drip_patch => waterfluxbulk_inst%qflx_irrig_drip_patch , & ! Output: [real(r8) (:)] patch drip irrigation flux (mm H2O/s) + qflx_irrig_drip_col => waterfluxbulk_inst%qflx_irrig_drip_col , & ! Output: [real(r8) (:)] col drip irrigation flux (mm H2O/s) + qflx_irrig_sprinkler_patch=> waterfluxbulk_inst%qflx_irrig_sprinkler_patch, & ! Output: [real(r8) (:)] patch sprinkler irrigation flux (mm H2O/s) + qflx_irrig_sprinkler_col => waterfluxbulk_inst%qflx_irrig_sprinkler_col & ! Output: [real(r8) (:)] col sprinkler irrigation flux (mm H2O/s) ) do p = bounds%begp, bounds%endp - g = patch%gridcell(p) if (this%n_irrig_steps_left_patch(p) > 0) then - qflx_irrig_patch(p) = this%irrig_rate_patch(p) + qflx_sfc_irrig_patch(p) = this%irrig_rate_patch(p) this%qflx_irrig_demand_patch(p) = this%irrig_rate_demand_patch(p) + qflx_gw_uncon_irrig_patch(p) = this%gw_uncon_irrig_rate_patch(p) + qflx_gw_con_irrig_patch(p) = this%gw_con_irrig_rate_patch(p) this%n_irrig_steps_left_patch(p) = this%n_irrig_steps_left_patch(p) - 1 else - qflx_irrig_patch(p) = 0._r8 - this%qflx_irrig_demand_patch(p) = 0._r8 + qflx_sfc_irrig_patch(p) = 0._r8 + this%qflx_irrig_demand_patch(p) = 0._r8 + qflx_gw_uncon_irrig_patch(p) = 0._r8 + qflx_gw_con_irrig_patch(p) = 0._r8 end if + ! Set drip/sprinkler irrigation based on irrigation method from input data + qflx_irrig_drip_patch(p) = 0._r8 + qflx_irrig_sprinkler_patch(p) = 0._r8 + + if(this%irrig_method_patch(p) == irrig_method_drip) then + qflx_irrig_drip_patch(p) = qflx_sfc_irrig_patch(p) + qflx_gw_uncon_irrig_patch(p) + qflx_gw_con_irrig_patch(p) + endif + if(this%irrig_method_patch(p) == irrig_method_sprinkler) then + qflx_irrig_sprinkler_patch(p) = qflx_sfc_irrig_patch(p) + qflx_gw_uncon_irrig_patch(p) + qflx_gw_con_irrig_patch(p) + endif + end do call p2c (bounds = bounds, & - parr = qflx_irrig_patch(bounds%begp:bounds%endp), & - carr = qflx_irrig_col(bounds%begc:bounds%endc), & + parr = qflx_sfc_irrig_patch(bounds%begp:bounds%endp), & + carr = qflx_sfc_irrig_col(bounds%begc:bounds%endc), & + p2c_scale_type = 'unity') + + call p2c (bounds = bounds, & + parr = qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), & + carr = qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), & + p2c_scale_type = 'unity') + + call p2c (bounds = bounds, & + parr = qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), & + carr = qflx_gw_con_irrig_col(bounds%begc:bounds%endc), & + p2c_scale_type = 'unity') + + call p2c (bounds = bounds, & + parr = qflx_irrig_drip_patch(bounds%begp:bounds%endp), & + carr = qflx_irrig_drip_col(bounds%begc:bounds%endc), & + p2c_scale_type = 'unity') + + call p2c (bounds = bounds, & + parr = qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), & + carr = qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), & p2c_scale_type = 'unity') end associate @@ -792,7 +875,7 @@ end subroutine ApplyIrrigation !----------------------------------------------------------------------- subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedvegp, & - time_prev, elai, t_soisno, eff_porosity, h2osoi_liq, volr, rof_prognostic) + time_prev, elai, t_soisno, eff_porosity, h2osoi_liq, volr, rof_prognostic, available_gw_uncon) ! ! !DESCRIPTION: ! Calculate whether and how much irrigation is needed for each column. However, this @@ -833,6 +916,9 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg ! whether we can limit irrigation based on river volume. logical, intent(in) :: rof_prognostic + ! column available water in saturated zone (kg/m2) + real(r8), intent(in) :: available_gw_uncon( bounds%begc:) + ! ! !LOCAL VARIABLES: integer :: fp ! patch filter index @@ -1011,12 +1097,29 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg c = patch%column(p) if (check_for_irrig_patch(p)) then + ! Convert units from mm to mm/sec this%irrig_rate_patch(p) = deficit_volr_limited(c) / & (this%dtime*this%irrig_nsteps_per_day) this%irrig_rate_demand_patch(p) = deficit(c) / & (this%dtime*this%irrig_nsteps_per_day) + ! groundwater irrigation will supply remaining deficit + ! first take from unconfined aquifer, then confined aquifer + if((deficit(c) - deficit_volr_limited(c)) <= available_gw_uncon(c)) then + this%gw_uncon_irrig_rate_patch(p) = & + (deficit(c) - deficit_volr_limited(c)) / & + (this%dtime*this%irrig_nsteps_per_day) + this%gw_con_irrig_rate_patch(p) = 0._r8 + else + this%gw_uncon_irrig_rate_patch(p) = & + available_gw_uncon(c) / & + (this%dtime*this%irrig_nsteps_per_day) + this%gw_con_irrig_rate_patch(p) = & + (deficit(c) - deficit_volr_limited(c) - available_gw_uncon(c)) / & + (this%dtime*this%irrig_nsteps_per_day) + endif + ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 ! in this case, we'll irrigate by 0 for the given number of time steps this%n_irrig_steps_left_patch(p) = this%irrig_nsteps_per_day diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index eddb872df1..96df214d98 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -1984,7 +1984,7 @@ end subroutine PerchedLateralFlow !----------------------------------------------------------------------- subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - waterstatebulk_inst, waterfluxbulk_inst) + waterstatebulk_inst, waterfluxbulk_inst, waterdiagnosticbulk_inst) ! ! !DESCRIPTION: ! Calculate watertable, considering aquifer recharge but no drainage. @@ -2001,15 +2001,20 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points type(soilhydrology_type) , intent(inout) :: soilhydrology_inst type(soilstate_type) , intent(in) :: soilstate_inst - type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst - type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst ! ! !LOCAL VARIABLES: + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) integer :: c,j,fc,i ! indices integer :: k,k_zwt real(r8) :: sat_lev real(r8) :: s1,s2,m,b ! temporary variables used to interpolate theta integer :: sat_flag + real(r8) :: s_y + real(r8) :: available_water_layer + !----------------------------------------------------------------------- associate( & @@ -2020,8 +2025,11 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) - zwt => soilhydrology_inst%zwt_col & ! Output: [real(r8) (:) ] water table depth (m) + zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) + available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/ms) ) ! calculate water table based on soil moisture state @@ -2072,11 +2080,42 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & end do + ! calculate amount of water in saturated zone that + ! is available for groundwater irrigation + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + available_gw_uncon(c) = 0._r8 + + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + do j = jwt(c)+1, nbedrock(c) + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + + if (j==jwt(c)+1) then + available_water_layer=max(0._r8,(s_y*(zi(c,j) - zwt(c))*1.e3)) + else + available_water_layer=max(0._r8,(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) + endif +! if((jwt(c)+1) < nbedrock(c)) write(iulog,*) 'availwater: ', j,jwt(c), nbedrock(c), available_water_layer + + available_gw_uncon(c) = available_gw_uncon(c) & + + available_water_layer + enddo + enddo + end associate end subroutine ThetaBasedWaterTable - !#6 !----------------------------------------------------------------------- subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & @@ -2184,6 +2223,8 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) qflx_qrgwl => waterfluxbulk_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes (mm H2O /s) qflx_rsub_sat => waterfluxbulk_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] + qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! unconfined groundwater irrigation flux (mm H2O /s) + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) ) @@ -2252,8 +2293,10 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & rsub_top(c) = 0._r8 endif + ! add groundwater irrigation flux to subsurface drainage flux !-- Now remove water via rsub_top - rsub_top_tot = - rsub_top(c) * dtime + rsub_top_tot = - (rsub_top(c) + qflx_gw_uncon_irrig(c))* dtime + !should never be positive... but include for completeness if(rsub_top_tot > 0.) then !rising water table @@ -2265,13 +2308,16 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & s_y = watsat(c,j) & * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) s_y=max(s_y,0.02_r8) - - rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) + if (j==jwt(c)+1) then + rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) + else + rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) + endif rsub_top_layer=min(rsub_top_layer,0._r8) h2osoi_liq(c,j) = h2osoi_liq(c,j) + rsub_top_layer rsub_top_tot = rsub_top_tot - rsub_top_layer - + if (rsub_top_tot >= 0.) then zwt(c) = zwt(c) - rsub_top_layer/s_y/1000._r8 @@ -2281,9 +2327,9 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & endif enddo - !-- remove residual rsub_top --------------------------------------------- + !-- remove residual rsub_top -------------------------------- ! make sure no extra water removed from soil column - rsub_top(c) = rsub_top(c) - rsub_top_tot/dtime + rsub_top(c) = rsub_top(c) + rsub_top_tot/dtime endif zwt(c) = max(0.0_r8,zwt(c)) diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 1fea963eda..022cd5c6ee 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -71,6 +71,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: frac_h2osfc_nosnow_col (:) ! col fractional area with surface water greater than zero (if no snow present) real(r8), pointer :: wf_col (:) ! col soil water as frac. of whc for top 0.05 m (0-1) real(r8), pointer :: wf2_col (:) ! col soil water as frac. of whc for top 0.17 m (0-1) + real(r8), pointer :: available_gw_uncon_col (:) ! col available water in the unconfined saturated zone real(r8), pointer :: fwet_patch (:) ! patch canopy fraction that is wet (0 to 1) real(r8), pointer :: fcansno_patch (:) ! patch canopy fraction that is snow covered (0 to 1) real(r8), pointer :: fdry_patch (:) ! patch canopy fraction of foliage that is green and dry [-] (new) @@ -176,6 +177,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%frac_h2osfc_nosnow_col (begc:endc)) ; this%frac_h2osfc_nosnow_col (:) = nan allocate(this%wf_col (begc:endc)) ; this%wf_col (:) = nan allocate(this%wf2_col (begc:endc)) ; + allocate(this%available_gw_uncon_col (begc:endc)) ; this%available_gw_uncon_col (:) = nan allocate(this%fwet_patch (begp:endp)) ; this%fwet_patch (:) = nan allocate(this%fcansno_patch (begp:endp)) ; this%fcansno_patch (:) = nan allocate(this%fdry_patch (begp:endp)) ; this%fdry_patch (:) = nan @@ -392,7 +394,15 @@ subroutine InitBulkHistory(this, bounds) ptr_col=this%wf_col, default='inactive') end if - this%h2osno_top_col(begc:endc) = spval + this%available_gw_uncon_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('GW_AVAILABLE'), & + units='kg/m2', & + avgflag='A', & + long_name=this%info%lname('available water in the unconfined saturated zone'), & + ptr_col=this%available_gw_uncon_col, default='inactive') + + this%h2osno_top_col(begc:endc) = spval call hist_addfld1d ( & fname=this%info%fname('H2OSNO_TOP'), & units='kg/m2', & diff --git a/src/biogeophys/WaterFluxType.F90 b/src/biogeophys/WaterFluxType.F90 index c1fe47354a..8b24d44125 100644 --- a/src/biogeophys/WaterFluxType.F90 +++ b/src/biogeophys/WaterFluxType.F90 @@ -85,13 +85,18 @@ module WaterFluxType real(r8), pointer :: qflx_liq_dynbal_grc (:) ! grc liq dynamic land cover change conversion runoff flux real(r8), pointer :: qflx_ice_dynbal_grc (:) ! grc ice dynamic land cover change conversion runoff flux - real(r8), pointer :: qflx_irrig_patch (:) ! patch irrigation flux (mm H2O/s) [+] - real(r8), pointer :: qflx_irrig_col (:) ! col irrigation flux (mm H2O/s) [+] - + real(r8), pointer :: qflx_sfc_irrig_patch (:) ! patch surface irrigation flux (mm H2O/s) [+] + real(r8), pointer :: qflx_sfc_irrig_col (:) ! col surface irrigation flux (mm H2O/s) [+] + real(r8), pointer :: qflx_gw_uncon_irrig_patch (:) ! patch unconfined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_gw_uncon_irrig_col (:) ! col unconfined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_gw_con_irrig_patch (:) ! patch confined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_gw_con_irrig_col (:) ! col confined groundwater irrigation flux (mm H2O/s) + real(r8), pointer :: qflx_irrig_drip_patch (:) ! patch drip irrigation + real(r8), pointer :: qflx_irrig_drip_col (:) ! col drip irrigation + real(r8), pointer :: qflx_irrig_sprinkler_patch(:) ! patch sprinkler irrigation + real(r8), pointer :: qflx_irrig_sprinkler_col (:) ! col sprinkler irrigation contains - - procedure, public :: Init procedure, public :: Restart @@ -287,13 +292,41 @@ subroutine InitAllocate(this, bounds, tracer_vars) container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) - call AllocateVar1d(var = this%qflx_irrig_patch, name = 'qflx_irrig_patch', & + call AllocateVar1d(var = this%qflx_sfc_irrig_patch, name = 'qflx_sfc_irrig_patch', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_PATCH) + call AllocateVar1d(var = this%qflx_sfc_irrig_col, name = 'qflx_sfc_irrig_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + + call AllocateVar1d(var = this%qflx_gw_uncon_irrig_patch, name = 'qflx_gw_uncon_irrig_patch', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_PATCH) - call AllocateVar1d(var = this%qflx_irrig_col, name = 'qflx_irrig_col', & + call AllocateVar1d(var = this%qflx_gw_uncon_irrig_col, name = 'qflx_gw_uncon_irrig_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%qflx_gw_con_irrig_patch, name = 'qflx_gw_con_irrig_patch', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_PATCH) + call AllocateVar1d(var = this%qflx_gw_con_irrig_col, name = 'qflx_gw_con_irrig_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + + call AllocateVar1d(var = this%qflx_irrig_drip_patch, name = 'qflx_irrig_drip_patch', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_PATCH) + call AllocateVar1d(var = this%qflx_irrig_drip_col, name = 'qflx_irrig_drip_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + + call AllocateVar1d(var = this%qflx_irrig_sprinkler_patch, name = 'qflx_irrig_sprinkler_patch', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_PATCH) + call AllocateVar1d(var = this%qflx_irrig_sprinkler_col, name = 'qflx_irrig_sprinkler_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + end subroutine InitAllocate !------------------------------------------------------------------------ @@ -636,13 +669,45 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('saturation excess drainage'), & ptr_col=this%qflx_rsub_sat_col, c2l_scale_type='urbanf') - this%qflx_irrig_patch(begp:endp) = spval + this%qflx_sfc_irrig_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('QIRRIG_FROM_SURFACE'), & + units='mm/s', & + avgflag='A', & + long_name=this%info%lname('water added through surface water irrigation'), & + ptr_patch=this%qflx_sfc_irrig_patch) + + this%qflx_gw_uncon_irrig_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('QIRRIG_FROM_GW_UNCONFINED'), & + units='mm/s', & + avgflag='A', & + long_name=this%info%lname('water added through unconfined groundwater irrigation'), & + ptr_patch=this%qflx_gw_uncon_irrig_patch) + + this%qflx_gw_con_irrig_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('QIRRIG_FROM_GW_CONFINED'), & + units='mm/s', & + avgflag='A', & + long_name=this%info%lname('water added through confined groundwater irrigation'), & + ptr_patch=this%qflx_gw_con_irrig_patch) + + this%qflx_irrig_drip_patch(begp:endp) = spval + call hist_addfld1d ( & + fname=this%info%fname('QIRRIG_DRIP'), & + units='mm/s', & + avgflag='A', & + long_name=this%info%lname('water added via drip irrigation'), & + ptr_patch=this%qflx_irrig_drip_patch, default='inactive') + + this%qflx_irrig_sprinkler_patch(begp:endp) = spval call hist_addfld1d ( & - fname=this%info%fname('QIRRIG'), & + fname=this%info%fname('QIRRIG_SPRINKLER'), & units='mm/s', & avgflag='A', & - long_name=this%info%lname('water added through irrigation'), & - ptr_patch=this%qflx_irrig_patch) + long_name=this%info%lname('water added via sprinkler irrigation'), & + ptr_patch=this%qflx_irrig_sprinkler_patch, default='inactive') end subroutine InitHistory diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index ab62bf141f..4d0f178d6c 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -39,7 +39,7 @@ module WaterStateType real(r8), pointer :: snocan_patch (:) ! patch canopy snow water (mm H2O) real(r8), pointer :: liqcan_patch (:) ! patch canopy liquid water (mm H2O) - real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) + real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) contains diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 61d1402c74..0360f9461b 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -449,7 +449,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro filter(nc)%num_nolakep, filter(nc)%nolakep, & atm2lnd_inst, canopystate_inst, temperature_inst, & aerosol_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterfluxbulk_inst, & + water_inst%waterdiagnosticbulk_inst, & + water_inst%waterfluxbulk_inst, & water_inst%wateratm2lndbulk_inst) call t_stopf('canhydro') @@ -621,7 +622,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro h2osoi_liq = water_inst%waterstatebulk_inst%h2osoi_liq_col& (bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & volr = water_inst%wateratm2lndbulk_inst%volrmch_grc(bounds_clump%begg:bounds_clump%endg), & - rof_prognostic = rof_prognostic) + rof_prognostic = rof_prognostic, & + available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col) call t_stopf('irrigationneeded') ! ============================================================================ diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index d19d8ce5f8..1db4a7f5c1 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -13,7 +13,7 @@ module clm_initializeMod use clm_varctl , only : is_cold_start, is_interpolated_start use clm_varctl , only : iulog use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates - use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft, wt_glc_mec, topo_glc_mec + use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft, irrig_method, wt_glc_mec, topo_glc_mec use perf_mod , only : t_startf, t_stopf use readParamsMod , only : readParameters use ncdio_pio , only : file_desc_t @@ -159,6 +159,7 @@ subroutine initialize1( ) allocate (wt_nat_patch (begg:endg, natpft_lb:natpft_ub )) allocate (wt_cft (begg:endg, cft_lb:cft_ub )) allocate (fert_cft (begg:endg, cft_lb:cft_ub )) + allocate (irrig_method (begg:endg, cft_lb:cft_ub )) allocate (wt_glc_mec (begg:endg, maxpatch_glcmec)) allocate (topo_glc_mec(begg:endg, maxpatch_glcmec)) @@ -663,7 +664,7 @@ subroutine initialize2( ) ! initialize2 because it is used to initialize other variables; now it can be ! deallocated - deallocate(topo_glc_mec, fert_cft) + deallocate(topo_glc_mec, fert_cft, irrig_method) !------------------------------------------------------------ ! Write log output for end of initialization diff --git a/src/main/clm_varsur.F90 b/src/main/clm_varsur.F90 index a9b32dab30..cd3bacc87a 100644 --- a/src/main/clm_varsur.F90 +++ b/src/main/clm_varsur.F90 @@ -34,6 +34,11 @@ module clm_instur ! (second dimension goes cft_lb:cft_ub) real(r8), pointer :: fert_cft(:,:) + ! for each cft on the crop landunit, specify irrigation application + ! method (even non-irrigated) + ! (second dimension goes cft_lb:cft_ub) + integer, pointer :: irrig_method(:,:) + ! for glc_mec landunits, weight of glacier in each elevation class (adds to 1.0 on the ! landunit for all grid cells, even those without any glacier) real(r8), pointer :: wt_glc_mec(:,:) diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index 71d3909515..c9f29ade18 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -374,8 +374,9 @@ subroutine lnd2atm(bounds, & water_inst%waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & - water_inst%waterfluxbulk_inst%qflx_irrig_col (bounds%begc:bounds%endc), & + water_inst%waterfluxbulk_inst%qflx_sfc_irrig_col (bounds%begc:bounds%endc), & water_inst%waterlnd2atmbulk_inst%qirrig_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index ef593b1a6e..7cbb88235c 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -595,7 +595,7 @@ subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size ) ! Handle generic crop types for file format where they are on their own ! crop landunit and read in as Crop Function Types. ! !USES: - use clm_instur , only : fert_cft, wt_nat_patch + use clm_instur , only : fert_cft, wt_nat_patch, irrig_method use clm_varpar , only : cft_size, cft_lb, natpft_lb ! !ARGUMENTS: implicit none @@ -634,6 +634,18 @@ subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size ) fert_cft = 0.0_r8 end if + if ( cft_size > 0 )then + call ncd_io(ncid=ncid, varname='irrigation_method', flag='read', data=irrig_method, & + dim1name=grlnd, readvar=readvar) + if (.not. readvar) then + if ( masterproc ) & + write(iulog,*) ' WARNING: irrigation_method NOT on surfdata file zero out' + irrig_method = 0 + end if + else + irrig_method = 0 + end if + allocate( array2D(begg:endg,1:natpft_size) ) call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=array2D, & dim1name=grlnd, readvar=readvar) @@ -650,7 +662,7 @@ subroutine surfrd_pftformat( begg, endg, ncid ) ! Handle generic crop types for file format where they are part of the ! natural vegetation landunit. ! !USES: - use clm_instur , only : fert_cft, wt_nat_patch + use clm_instur , only : fert_cft, irrig_method, wt_nat_patch use clm_varpar , only : natpft_size, cft_size, natpft_lb ! !ARGUMENTS: implicit none @@ -688,6 +700,16 @@ subroutine surfrd_pftformat( begg, endg, ncid ) end if fert_cft = 0.0_r8 + call ncd_io(ncid=ncid, varname='irrigation_method', flag='read', data=irrig_method, & + dim1name=grlnd, readvar=readvar) + if (readvar) then + call endrun( msg= ' ERROR: unexpectedly found irrigation_method on dataset when cft_size=0'// & + ' (if the surface dataset has a separate crop landunit, then the code'// & + ' must also have a separate crop landunit, and vice versa)'//& + errMsg(sourcefile, __LINE__)) + end if + irrig_method = 0 + call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=wt_nat_patch, & dim1name=grlnd, readvar=readvar) if (.not. readvar) call endrun( msg=' ERROR: PCT_NAT_PFT NOT on surfdata file'//errMsg(sourcefile, __LINE__)) From bb594070d1696df1c967b35a18f5658542a420d1 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 27 Sep 2018 09:16:29 -0600 Subject: [PATCH 02/41] add namelist variables for groundwater irrigation and crop fsat = 0 --- bld/CLMBuildNamelist.pm | 5 +- .../namelist_defaults_clm4_5.xml | 6 +++ .../namelist_definition_clm4_5.xml | 13 +++++- src/biogeophys/HydrologyNoDrainageMod.F90 | 2 +- src/biogeophys/IrrigationMod.F90 | 46 ++++++++++++------- src/biogeophys/SaturatedExcessRunoffMod.F90 | 20 ++++++-- src/main/clm_varctl.F90 | 3 ++ src/main/controlMod.F90 | 8 +++- src/main/histFileMod.F90 | 29 ++++++++++-- 9 files changed, 103 insertions(+), 29 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 71a2eb79f6..541040aca5 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2184,7 +2184,8 @@ sub setup_logic_crop { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, "initial_seed_at_planting", 'use_crop'=>$nl->get_value('use_crop') ); } else { - error_if_set( $nl, "Can NOT be set without crop on", "baset_mapping", "baset_latvary_slope", "baset_latvary_intercept" ); + error_if_set( $nl, "Can NOT be set without crop on", "baset_mapping", "baset_latvary_slope", "baset_latvary_intercept" ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'crop_fsat_equals_zero' ); } } } @@ -2768,7 +2769,7 @@ sub setup_logic_irrigation_parameters { my $var; foreach $var ("irrig_min_lai", "irrig_start_time", "irrig_length", "irrig_target_smp", "irrig_depth", "irrig_threshold_fraction", - "limit_irrigation_if_rof_enabled") { + "limit_irrigation_if_rof_enabled","use_groundwater_irrigation") { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var); } diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index eafeabc76e..e8f34013ca 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -93,6 +93,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. + +.false. + 0 1 @@ -273,6 +276,9 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .false. +.false. + + OFF ON_RAD diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index cb5a6929f7..8b680f2674 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -115,11 +115,12 @@ Otherwise use the fraction straight up (the default for CLM5.0) + group="clm_inparm" valid_values="10SL_3.5m,23SL_3.5m,49SL_10m,20SL_8.5m,22SL_50m" > 10SL_3.5m = standard CLM4 and CLM4.5 version 23SL_3.5m = more vertical layers for permafrost simulations 49SL_10m = 49 layer soil column, 10m of soil, 5 bedrock layers 20SL_8.5m = 20 layer soil column, 8m of soil, 5 bedrock layers +22SL_50m = 22 layer soil column, 8m of soil, 2 variable thickness layers, 5 bedrock layers + +If TRUE, supply irrigation from groundwater (in addition to surface water). + + If TRUE, irrigation will be active. + +If TRUE, fsat will be set to zero for crop columns. + + Number of multiple elevation classes over glacier points. diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 264afe11ab..5b24a89c4f 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -190,7 +190,7 @@ subroutine HydrologyNoDrainage(bounds, & soilhydrology_inst, soilstate_inst, waterstatebulk_inst) call saturated_excess_runoff_inst%SaturatedExcessRunoff(& - bounds, num_hydrologyc, filter_hydrologyc, col, & + bounds, num_hydrologyc, filter_hydrologyc, lun, col, & soilhydrology_inst, soilstate_inst, waterfluxbulk_inst) call SetQflxInputs(bounds, num_hydrologyc, filter_hydrologyc, & diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 8d0ce67c3a..8cf93651ac 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -113,6 +113,9 @@ module IrrigationMod ! regardless of the value of this flag. logical :: limit_irrigation_if_rof_enabled + ! use groundwater supply for irrigation (in addition to surface water) + logical :: use_groundwater_irrigation + end type irrigation_params_type type, public :: irrigation_type @@ -197,7 +200,7 @@ function irrigation_params_constructor(irrig_min_lai, & irrig_start_time, irrig_length, & irrig_target_smp, & irrig_depth, irrig_threshold_fraction, irrig_river_volume_threshold, & - limit_irrigation_if_rof_enabled) & + limit_irrigation_if_rof_enabled, use_groundwater_irrigation) & result(this) ! ! !DESCRIPTION: @@ -215,6 +218,7 @@ function irrigation_params_constructor(irrig_min_lai, & real(r8), intent(in) :: irrig_threshold_fraction real(r8), intent(in) :: irrig_river_volume_threshold logical , intent(in) :: limit_irrigation_if_rof_enabled + logical , intent(in) :: use_groundwater_irrigation ! ! !LOCAL VARIABLES: @@ -229,6 +233,7 @@ function irrigation_params_constructor(irrig_min_lai, & this%irrig_threshold_fraction = irrig_threshold_fraction this%irrig_river_volume_threshold = irrig_river_volume_threshold this%limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled + this%use_groundwater_irrigation = use_groundwater_irrigation end function irrigation_params_constructor @@ -317,6 +322,7 @@ subroutine ReadNamelist(this, NLFilename) real(r8) :: irrig_threshold_fraction real(r8) :: irrig_river_volume_threshold logical :: limit_irrigation_if_rof_enabled + logical :: use_groundwater_irrigation integer :: ierr ! error code integer :: unitn ! unit for namelist file @@ -327,8 +333,9 @@ subroutine ReadNamelist(this, NLFilename) namelist /irrigation_inparm/ irrig_min_lai, irrig_start_time, irrig_length, & irrig_target_smp, irrig_depth, irrig_threshold_fraction, & - irrig_river_volume_threshold, limit_irrigation_if_rof_enabled - + irrig_river_volume_threshold, limit_irrigation_if_rof_enabled, & + use_groundwater_irrigation + ! Initialize options to garbage defaults, forcing all to be specified explicitly in ! order to get reasonable results irrig_min_lai = nan @@ -339,6 +346,7 @@ subroutine ReadNamelist(this, NLFilename) irrig_threshold_fraction = nan irrig_river_volume_threshold = nan limit_irrigation_if_rof_enabled = .false. + use_groundwater_irrigation = .false. if (masterproc) then unitn = getavu() @@ -364,6 +372,7 @@ subroutine ReadNamelist(this, NLFilename) call shr_mpi_bcast(irrig_threshold_fraction, mpicom) call shr_mpi_bcast(irrig_river_volume_threshold, mpicom) call shr_mpi_bcast(limit_irrigation_if_rof_enabled, mpicom) + call shr_mpi_bcast(use_groundwater_irrigation, mpicom) this%params = irrigation_params_type( & irrig_min_lai = irrig_min_lai, & @@ -373,7 +382,8 @@ subroutine ReadNamelist(this, NLFilename) irrig_depth = irrig_depth, & irrig_threshold_fraction = irrig_threshold_fraction, & irrig_river_volume_threshold = irrig_river_volume_threshold, & - limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled) + limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled, & + use_groundwater_irrigation = use_groundwater_irrigation) if (masterproc) then write(iulog,*) ' ' @@ -387,6 +397,7 @@ subroutine ReadNamelist(this, NLFilename) write(iulog,*) 'irrig_depth = ', irrig_depth write(iulog,*) 'irrig_threshold_fraction = ', irrig_threshold_fraction write(iulog,*) 'limit_irrigation_if_rof_enabled = ', limit_irrigation_if_rof_enabled + write(iulog,*) 'use_groundwate_irrigation = ', use_groundwater_irrigation if (limit_irrigation_if_rof_enabled) then write(iulog,*) 'irrig_river_volume_threshold = ', irrig_river_volume_threshold end if @@ -426,6 +437,7 @@ subroutine CheckNamelistValidity(this) irrig_depth => this%params%irrig_depth, & irrig_threshold_fraction => this%params%irrig_threshold_fraction, & irrig_river_volume_threshold => this%params%irrig_river_volume_threshold, & + use_groundwater_irrigation => this%params%use_groundwater_irrigation, & limit_irrigation_if_rof_enabled => this%params%limit_irrigation_if_rof_enabled) if (irrig_min_lai < 0._r8) then @@ -1106,18 +1118,20 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg ! groundwater irrigation will supply remaining deficit ! first take from unconfined aquifer, then confined aquifer - if((deficit(c) - deficit_volr_limited(c)) <= available_gw_uncon(c)) then - this%gw_uncon_irrig_rate_patch(p) = & - (deficit(c) - deficit_volr_limited(c)) / & - (this%dtime*this%irrig_nsteps_per_day) - this%gw_con_irrig_rate_patch(p) = 0._r8 - else - this%gw_uncon_irrig_rate_patch(p) = & - available_gw_uncon(c) / & - (this%dtime*this%irrig_nsteps_per_day) - this%gw_con_irrig_rate_patch(p) = & - (deficit(c) - deficit_volr_limited(c) - available_gw_uncon(c)) / & - (this%dtime*this%irrig_nsteps_per_day) + if(this%params%use_groundwater_irrigation) then + if((deficit(c) - deficit_volr_limited(c)) <= available_gw_uncon(c)) then + this%gw_uncon_irrig_rate_patch(p) = & + (deficit(c) - deficit_volr_limited(c)) / & + (this%dtime*this%irrig_nsteps_per_day) + this%gw_con_irrig_rate_patch(p) = 0._r8 + else + this%gw_uncon_irrig_rate_patch(p) = & + available_gw_uncon(c) / & + (this%dtime*this%irrig_nsteps_per_day) + this%gw_con_irrig_rate_patch(p) = & + (deficit(c) - deficit_volr_limited(c) - available_gw_uncon(c)) / & + (this%dtime*this%irrig_nsteps_per_day) + endif endif ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 diff --git a/src/biogeophys/SaturatedExcessRunoffMod.F90 b/src/biogeophys/SaturatedExcessRunoffMod.F90 index 1b38593430..2aa0c99810 100644 --- a/src/biogeophys/SaturatedExcessRunoffMod.F90 +++ b/src/biogeophys/SaturatedExcessRunoffMod.F90 @@ -12,8 +12,10 @@ module SaturatedExcessRunoffMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : iulog, use_vichydro + use clm_varctl , only : iulog, use_vichydro, crop_fsat_equals_zero use clm_varcon , only : spval + use LandunitType , only : landunit_type + use landunit_varcon , only : istcrop use ColumnType , only : column_type use SoilHydrologyType, only : soilhydrology_type use SoilStateType, only : soilstate_type @@ -173,7 +175,7 @@ end subroutine InitCold !----------------------------------------------------------------------- subroutine SaturatedExcessRunoff (this, bounds, num_hydrologyc, filter_hydrologyc, & - col, soilhydrology_inst, soilstate_inst, waterfluxbulk_inst) + lun, col, soilhydrology_inst, soilstate_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Calculate surface runoff due to saturated surface @@ -185,13 +187,14 @@ subroutine SaturatedExcessRunoff (this, bounds, num_hydrologyc, filter_hydrology type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(landunit_type) , intent(in) :: lun type(column_type) , intent(in) :: col type(soilhydrology_type) , intent(inout) :: soilhydrology_inst type(soilstate_type) , intent(in) :: soilstate_inst type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: - integer :: fc, c + integer :: fc, c, l character(len=*), parameter :: subname = 'SaturatedExcessRunoff' !----------------------------------------------------------------------- @@ -228,6 +231,17 @@ subroutine SaturatedExcessRunoff (this, bounds, num_hydrologyc, filter_hydrology call endrun(subname//' ERROR: Unrecognized fsat_method') end select + ! ------------------------------------------------------------------------ + ! Set fsat to zero for crop columns + ! ------------------------------------------------------------------------ + if (crop_fsat_equals_zero) then + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + l = col%landunit(c) + if(lun%itype(l) == istcrop) fsat(c) = 0._r8 + end do + endif + ! ------------------------------------------------------------------------ ! Compute qflx_sat_excess_surf ! diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 938155c5dd..d93038eb85 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -126,6 +126,9 @@ module clm_varctl ! do not irrigate by default logical, public :: irrigate = .false. + ! set saturated excess runoff to zero for crops + logical, public :: crop_fsat_equals_zero = .false. + !---------------------------------------------------------- ! Other subgrid logic !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ae9c2fcafe..12c2de4826 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,8 +202,9 @@ subroutine control_init( ) clump_pproc, wrtdia, & create_crop_landunit, nsegspc, co2_ppmv, override_nsrest, & albice, soil_layerstruct, subgridflag, & - irrigate, run_zero_weight_urban, all_active - + irrigate, run_zero_weight_urban, all_active, & + crop_fsat_equals_zero + ! vertical soil mixing variables namelist /clm_inparm/ & som_adv_flux, max_depth_cryoturb @@ -602,6 +603,9 @@ subroutine control_spmd() ! Irrigation call mpi_bcast(irrigate, 1, MPI_LOGICAL, 0, mpicom, ier) + ! Crop saturated excess runoff + call mpi_bcast(crop_fsat_equals_zero, 1, MPI_LOGICAL, 0, mpicom, ier) + ! Landunit generation call mpi_bcast(create_crop_landunit, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 8899917c5f..622f032169 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -16,6 +16,7 @@ module histFileMod use clm_varcon , only : spval, ispval, dzsoi_decomp use clm_varcon , only : grlnd, nameg, namel, namec, namep, nameCohort use decompMod , only : get_proc_bounds, get_proc_global, bounds_type + use GetGlobalValuesMod , only : GetGlobalIndex use GridcellType , only : grc use LandunitType , only : lun use ColumnType , only : col @@ -3093,6 +3094,10 @@ subroutine hfields_1dinfo(t, mode) ! long_name='1d landunit index of corresponding column', ncid=ncid) ! ---------------------------------------------------------------- + call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name=namec, & + long_name='1d landunit index of corresponding column', ncid=ncid) + + call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, & long_name='column weight relative to corresponding gridcell', ncid=ncid) @@ -3134,7 +3139,10 @@ subroutine hfields_1dinfo(t, mode) ! long_name='1d column index of corresponding pft', ncid=ncid) ! ---------------------------------------------------------------- - call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & + call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name=namep, & + long_name='1d column index of corresponding pft', ncid=ncid) + + call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & long_name='pft weight relative to corresponding gridcell', ncid=ncid) call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, & @@ -3239,6 +3247,11 @@ subroutine hfields_1dinfo(t, mode) !call ncd_io(varname='cols1d_gi' , data=col%gridcell, dim1name=namec, ncid=ncid, flag='write') !call ncd_io(varname='cols1d_li' , data=col%landunit, dim1name=namec, ncid=ncid, flag='write') ! ---------------------------------------------------------------- + do c = bounds%begc,bounds%endc + icarr(c) = GetGlobalIndex(decomp_index=col%landunit(c), clmlevel=namel) + enddo + call ncd_io(varname='cols1d_li', data=icarr , dim1name=namec, ncid=ncid, flag='write') + call ncd_io(varname='cols1d_wtgcell', data=col%wtgcell , dim1name=namec, ncid=ncid, flag='write') call ncd_io(varname='cols1d_wtlunit', data=col%wtlunit , dim1name=namec, ncid=ncid, flag='write') call ncd_io(varname='cols1d_itype_col', data=col%itype , dim1name=namec, ncid=ncid, flag='write') @@ -3273,7 +3286,11 @@ subroutine hfields_1dinfo(t, mode) !call ncd_io(varname='pfts1d_li' , data=patch%landunit, dim1name=namep, ncid=ncid, flag='write') !call ncd_io(varname='pfts1d_ci' , data=patch%column , dim1name=namep, ncid=ncid, flag='write') ! ---------------------------------------------------------------- - call ncd_io(varname='pfts1d_wtgcell' , data=patch%wtgcell , dim1name=namep, ncid=ncid, flag='write') + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%column(p), clmlevel=namec) + enddo + call ncd_io(varname='pfts1d_ci' , data=iparr , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtlunit' , data=patch%wtlunit , dim1name=namep, ncid=ncid, flag='write') call ncd_io(varname='pfts1d_wtcol' , data=patch%wtcol , dim1name=namep, ncid=ncid, flag='write') call ncd_io(varname='pfts1d_itype_veg', data=patch%itype , dim1name=namep, ncid=ncid, flag='write') @@ -3426,7 +3443,9 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call htape_timeconst(t, mode='define') ! Define 3D time-constant field variables only to first primary tape - if ( do_3Dtconst .and. t == 1 ) then +!scs if ( do_3Dtconst .and. t == 1 ) then +! try to get z,dz on second history tape + if ( do_3Dtconst) then call htape_timeconst3D(t, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='define') TimeConst3DVars_Filename = trim(locfnh(t)) @@ -3445,7 +3464,9 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & call htape_timeconst(t, mode='write') ! Write 3D time constant history variables only to first primary tape - if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then +!scs if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then +! write to all history tapes + if ( do_3Dtconst .and. tape(t)%ntimes == 1 )then call htape_timeconst3D(t, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='write') do_3Dtconst = .false. From 448f1e7b2279b0b10bdad2a593a453225b669487 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 27 Sep 2018 09:57:21 -0600 Subject: [PATCH 03/41] add default irrigation method behavior --- src/biogeophys/IrrigationMod.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 8cf93651ac..869aae09bf 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -624,6 +624,10 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention if (pftcon%irrigated(patch%itype(p)) == 1._r8) then m = patch%itype(p) this%irrig_method_patch(p) = irrig_method(g,m) + ! ensure irrig_method is valid; if not, revert to drip + if(irrig_method(g,m) /= irrig_method_drip .and. irrig_method(g,m) /= irrig_method_sprinkler) then + this%irrig_method_patch(p) = irrig_method_drip + endif end if end do From a784d4a455d65b47c37dbc6da270bd6732902e24 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 09:13:15 -0600 Subject: [PATCH 04/41] remove 22sl_8.5m soil layer structure --- bld/namelist_files/namelist_definition_clm4_5.xml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index 8b680f2674..cfb0d290cb 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -115,12 +115,11 @@ Otherwise use the fraction straight up (the default for CLM5.0) + group="clm_inparm" valid_values="10SL_3.5m,23SL_3.5m,49SL_10m,20SL_8.5m" > 10SL_3.5m = standard CLM4 and CLM4.5 version 23SL_3.5m = more vertical layers for permafrost simulations 49SL_10m = 49 layer soil column, 10m of soil, 5 bedrock layers 20SL_8.5m = 20 layer soil column, 8m of soil, 5 bedrock layers -22SL_50m = 22 layer soil column, 8m of soil, 2 variable thickness layers, 5 bedrock layers Date: Mon, 8 Oct 2018 09:14:35 -0600 Subject: [PATCH 05/41] add bounds to available_gw_uncon in clm_driver --- src/main/clm_driver.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 0360f9461b..f8013003c0 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -623,7 +623,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro (bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & volr = water_inst%wateratm2lndbulk_inst%volrmch_grc(bounds_clump%begg:bounds_clump%endg), & rof_prognostic = rof_prognostic, & - available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col) + available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col(bounds_clump%begc:bounds_clump%endc)) call t_stopf('irrigationneeded') ! ============================================================================ From 0e6817da66168170701ea276f11e9ae3ed92e68f Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 09:37:21 -0600 Subject: [PATCH 06/41] fix vector output of l/c/p indices --- src/main/histFileMod.F90 | 71 +++++++++++++++++++--------------------- 1 file changed, 33 insertions(+), 38 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 622f032169..c2e700b029 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3057,10 +3057,8 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, & long_name='2d latitude index of corresponding landunit', ncid=ncid) - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 - !call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', & - ! long_name='1d grid index of corresponding landunit', ncid=ncid) - ! ---------------------------------------------------------------- + call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', & + long_name='1d grid index of corresponding landunit', ncid=ncid) call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, & long_name='landunit weight relative to corresponding gridcell', ncid=ncid) @@ -3086,13 +3084,11 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, & long_name='2d latitude index of corresponding column', ncid=ncid) - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 - !call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', & - ! long_name='1d grid index of corresponding column', ncid=ncid) + call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', & + long_name='1d grid index of corresponding column', ncid=ncid) - !call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', & - ! long_name='1d landunit index of corresponding column', ncid=ncid) - ! ---------------------------------------------------------------- + call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', & + long_name='1d landunit index of corresponding column', ncid=ncid) call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name=namec, & long_name='1d landunit index of corresponding column', ncid=ncid) @@ -3128,21 +3124,19 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, & long_name='2d latitude index of corresponding pft', ncid=ncid) - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 - !call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', & - ! long_name='1d grid index of corresponding pft', ncid=ncid) + call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', & + long_name='1d grid index of corresponding pft', ncid=ncid) - !call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', & - ! long_name='1d landunit index of corresponding pft', ncid=ncid) + call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', & + long_name='1d landunit index of corresponding pft', ncid=ncid) - !call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', & - ! long_name='1d column index of corresponding pft', ncid=ncid) - ! ---------------------------------------------------------------- + call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', & + long_name='1d column index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name=namep, & + call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name=namep, & long_name='1d column index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & + call ncd_defvar(varname='pfts1d_wtgcell', xtype=ncd_double, dim1name=namep, & long_name='pft weight relative to corresponding gridcell', ncid=ncid) call ncd_defvar(varname='pfts1d_wtlunit', xtype=ncd_double, dim1name=namep, & @@ -3218,9 +3212,10 @@ subroutine hfields_1dinfo(t, mode) ilarr(l) = (ldecomp%gdc2glo(lun%gridcell(l))-1)/ldomain%ni + 1 enddo call ncd_io(varname='land1d_jxy' , data=ilarr , dim1name=namel, ncid=ncid, flag='write') - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 - !call ncd_io(varname='land1d_gi' , data=lun%gridcell, dim1name=namel, ncid=ncid, flag='write') - ! ---------------------------------------------------------------- + do l=bounds%begl,bounds%endl + ilarr(l) = GetGlobalIndex(decomp_index=lun%gridcell(l), clmlevel=nameg) + end do + call ncd_io(varname='land1d_gi' , data=ilarr, dim1name=namel, ncid=ncid, flag='write') call ncd_io(varname='land1d_wtgcell' , data=lun%wtgcell , dim1name=namel, ncid=ncid, flag='write') call ncd_io(varname='land1d_ityplunit', data=lun%itype , dim1name=namel, ncid=ncid, flag='write') call ncd_io(varname='land1d_active' , data=lun%active , dim1name=namel, ncid=ncid, flag='write') @@ -3243,10 +3238,10 @@ subroutine hfields_1dinfo(t, mode) icarr(c) = (ldecomp%gdc2glo(col%gridcell(c))-1)/ldomain%ni + 1 enddo call ncd_io(varname='cols1d_jxy' , data=icarr ,dim1name=namec, ncid=ncid, flag='write') - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 Bug 1310 - !call ncd_io(varname='cols1d_gi' , data=col%gridcell, dim1name=namec, ncid=ncid, flag='write') - !call ncd_io(varname='cols1d_li' , data=col%landunit, dim1name=namec, ncid=ncid, flag='write') - ! ---------------------------------------------------------------- + do c = bounds%begc,bounds%endc + icarr(c) = GetGlobalIndex(decomp_index=col%gridcell(c), clmlevel=namel) + enddo + call ncd_io(varname='cols1d_gi' , data=icarr, dim1name=namec, ncid=ncid, flag='write') do c = bounds%begc,bounds%endc icarr(c) = GetGlobalIndex(decomp_index=col%landunit(c), clmlevel=namel) enddo @@ -3281,11 +3276,15 @@ subroutine hfields_1dinfo(t, mode) iparr(p) = (ldecomp%gdc2glo(patch%gridcell(p))-1)/ldomain%ni + 1 enddo call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag='write') - ! --- EBK Do NOT write out indices that are incorrect 4/1/2011 --- Bug 1310 - !call ncd_io(varname='pfts1d_gi' , data=patch%gridcell, dim1name=namep, ncid=ncid, flag='write') - !call ncd_io(varname='pfts1d_li' , data=patch%landunit, dim1name=namep, ncid=ncid, flag='write') - !call ncd_io(varname='pfts1d_ci' , data=patch%column , dim1name=namep, ncid=ncid, flag='write') - ! ---------------------------------------------------------------- + + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%gridcell(p), clmlevel=namec) + enddo + call ncd_io(varname='pfts1d_gi' , data=iparr, dim1name=namep, ncid=ncid, flag='write') + do p=bounds%begp,bounds%endp + iparr(p) = GetGlobalIndex(decomp_index=patch%landunit(p), clmlevel=namec) + enddo + call ncd_io(varname='pfts1d_li' , data=iparr, dim1name=namep, ncid=ncid, flag='write') do p=bounds%begp,bounds%endp iparr(p) = GetGlobalIndex(decomp_index=patch%column(p), clmlevel=namec) enddo @@ -3442,9 +3441,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Define time-constant field variables call htape_timeconst(t, mode='define') - ! Define 3D time-constant field variables only to first primary tape -!scs if ( do_3Dtconst .and. t == 1 ) then -! try to get z,dz on second history tape + ! Define 3D time-constant field variables on first history tapes if ( do_3Dtconst) then call htape_timeconst3D(t, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='define') @@ -3463,9 +3460,7 @@ subroutine hist_htapes_wrapup( rstwr, nlend, bounds, & ! Write time constant history variables call htape_timeconst(t, mode='write') - ! Write 3D time constant history variables only to first primary tape -!scs if ( do_3Dtconst .and. t == 1 .and. tape(t)%ntimes == 1 )then -! write to all history tapes + ! Write 3D time constant history variables to first history tapes if ( do_3Dtconst .and. tape(t)%ntimes == 1 )then call htape_timeconst3D(t, & bounds, watsat_col, sucsat_col, bsw_col, hksat_col, mode='write') From cfcc84d2dd2787b5c1ed3f3de4209465f667edad Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 10:05:49 -0600 Subject: [PATCH 07/41] add irrig_method_unset, fix handling of invalid irrig_method values --- src/biogeophys/IrrigationMod.F90 | 20 +++++++++++++------- src/main/surfrdMod.F90 | 5 +++-- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 869aae09bf..6c72344acc 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -47,12 +47,11 @@ module IrrigationMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog - use clm_varcon , only : isecspday, degpsec, denh2o, spval, ispval, namec + use clm_varcon , only : isecspday, degpsec, denh2o, spval, ispval, namec, nameg use clm_varpar , only : nlevsoi, nlevgrnd use clm_time_manager , only : get_step_size use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use WaterFluxBulkType , only : waterfluxbulk_type - use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type use GridcellType , only : grc use ColumnType , only : col use PatchType , only : patch @@ -181,6 +180,7 @@ module IrrigationMod real(r8), parameter :: m3_over_km2_to_mm = 1.e-3_r8 ! Irrigation methods + integer, parameter, public :: irrig_method_unset = 0 ! Drip is defined here as irrigation applied directly to soil surface integer, parameter, private :: irrig_method_drip = 1 ! Sprinkler is applied directly to canopy @@ -624,10 +624,14 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention if (pftcon%irrigated(patch%itype(p)) == 1._r8) then m = patch%itype(p) this%irrig_method_patch(p) = irrig_method(g,m) - ! ensure irrig_method is valid; if not, revert to drip - if(irrig_method(g,m) /= irrig_method_drip .and. irrig_method(g,m) /= irrig_method_sprinkler) then + ! ensure irrig_method is valid; if not set, use drip irrigation + if(irrig_method(g,m) == irrig_method_unset) then this%irrig_method_patch(p) = irrig_method_drip - endif + else if (irrig_method(g,m) /= irrig_method_drip .and. irrig_method(g,m) /= irrig_method_sprinkler) then + write(iulog,*) subname //' invalid irrigation method specified' + call endrun(decomp_index=g, clmlevel=nameg, msg='bad irrig_method '// & + errMsg(sourcefile, __LINE__)) + end if end if end do @@ -852,9 +856,11 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) if(this%irrig_method_patch(p) == irrig_method_drip) then qflx_irrig_drip_patch(p) = qflx_sfc_irrig_patch(p) + qflx_gw_uncon_irrig_patch(p) + qflx_gw_con_irrig_patch(p) - endif - if(this%irrig_method_patch(p) == irrig_method_sprinkler) then + else if(this%irrig_method_patch(p) == irrig_method_sprinkler) then qflx_irrig_sprinkler_patch(p) = qflx_sfc_irrig_patch(p) + qflx_gw_uncon_irrig_patch(p) + qflx_gw_con_irrig_patch(p) + else + call endrun(msg=' ERROR: irrig_method_patch set to invalid value ' // & + errMsg(sourcefile, __LINE__)) endif end do diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index 7cbb88235c..6c05f99871 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -597,6 +597,7 @@ subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size ) ! !USES: use clm_instur , only : fert_cft, wt_nat_patch, irrig_method use clm_varpar , only : cft_size, cft_lb, natpft_lb + use IrrigationMod , only : irrig_method_unset ! !ARGUMENTS: implicit none type(file_desc_t), intent(inout) :: ncid ! netcdf id @@ -640,10 +641,10 @@ subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size ) if (.not. readvar) then if ( masterproc ) & write(iulog,*) ' WARNING: irrigation_method NOT on surfdata file zero out' - irrig_method = 0 + irrig_method = irrig_method_unset end if else - irrig_method = 0 + irrig_method = irrig_method_unset end if allocate( array2D(begg:endg,1:natpft_size) ) From 0879727a88196b9836f996c5d81f54d2380168b9 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 10:08:36 -0600 Subject: [PATCH 08/41] remove col%itype check --- src/biogeophys/HydrologyDrainageMod.F90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/biogeophys/HydrologyDrainageMod.F90 b/src/biogeophys/HydrologyDrainageMod.F90 index da6ed0b83a..f5f4ee0c0d 100644 --- a/src/biogeophys/HydrologyDrainageMod.F90 +++ b/src/biogeophys/HydrologyDrainageMod.F90 @@ -164,9 +164,7 @@ subroutine HydrologyDrainage(bounds, & ! remove groundwater irrigation from aquifer do fc = 1, num_nolakec c = filter_nolakec(fc) - if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then - wa(c) = wa(c) - qflx_gw_con_irrig(c) * dtime - endif + wa(c) = wa(c) - qflx_gw_con_irrig(c) * dtime enddo call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & From cedea6775747295d604352c3d35c9f9d554bca0d Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 10:36:17 -0600 Subject: [PATCH 09/41] add qflx_liq_above_canopy --- src/biogeophys/CanopyHydrologyMod.F90 | 20 +++++++++++--------- src/biogeophys/IrrigationMod.F90 | 3 +-- src/biogeophys/SoilHydrologyMod.F90 | 3 +-- src/biogeophys/WaterDiagnosticBulkType.F90 | 2 +- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/biogeophys/CanopyHydrologyMod.F90 b/src/biogeophys/CanopyHydrologyMod.F90 index 19574c8586..b4c85495fb 100644 --- a/src/biogeophys/CanopyHydrologyMod.F90 +++ b/src/biogeophys/CanopyHydrologyMod.F90 @@ -209,6 +209,7 @@ subroutine CanopyHydrology(bounds, & real(r8) :: qflx_through_snow(bounds%begp:bounds%endp) ! direct snow throughfall [mm/s] real(r8) :: qflx_prec_grnd_snow(bounds%begp:bounds%endp) ! snow precipitation incident on ground [mm/s] real(r8) :: qflx_prec_grnd_rain(bounds%begp:bounds%endp) ! rain precipitation incident on ground [mm/s] + real(r8) :: qflx_liq_above_canopy(bounds%begp:bounds%endp) ! liquid water input above canopy (rain plus irrigation) [mm/s] real(r8) :: z_avg ! grid cell average snow depth real(r8) :: rho_avg ! avg density of snow column real(r8) :: temp_snow_depth,temp_intsnow ! temporary variables @@ -309,13 +310,14 @@ subroutine CanopyHydrology(bounds, & if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then - - ! irrigation may occur if forc_precip = 0 if (frac_veg_nosno(p) == 1 .and. (forc_rain(c) + forc_snow(c) + qflx_irrig_sprinkler(p)) > 0._r8) then - + + ! total liquid water inputs above canopy + qflx_liq_above_canopy(p) = forc_rain(c)+ qflx_irrig_sprinkler(p) + ! determine fraction of input precipitation that is snow and rain - fracsnow(p) = forc_snow(c)/(forc_snow(c) + forc_rain(c)) - fracrain(p) = forc_rain(c)/(forc_snow(c) + forc_rain(c)) + fracsnow(p) = forc_snow(c)/(forc_snow(c) + qflx_liq_above_canopy(p)) + fracrain(p) = forc_rain(c)/(forc_snow(c) + qflx_liq_above_canopy(p)) ! The leaf water capacities for solid and liquid are different, ! generally double for snow, but these are of somewhat less @@ -342,17 +344,17 @@ subroutine CanopyHydrology(bounds, & qflx_through_snow(p) = forc_snow(c) * (1._r8-fpi) end if ! Direct throughfall - qflx_through_rain(p) = (forc_rain(c) + qflx_irrig_sprinkler(p)) * (1._r8-fpi) + qflx_through_rain(p) = qflx_liq_above_canopy(p) * (1._r8-fpi) if (snowveg_on .or. snowveg_onrad) then ! Intercepted precipitation [mm/s] qflx_prec_intr(p) = forc_snow(c)*fpisnow + (forc_rain(c) + qflx_irrig_sprinkler(p))*fpi ! storage of intercepted snowfall, rain, and dew snocan(p) = max(0._r8, snocan(p) + dtime*forc_snow(c)*fpisnow) - liqcan(p) = max(0._r8, liqcan(p) + dtime*(forc_rain(c) + qflx_irrig_sprinkler(p))*fpi) + liqcan(p) = max(0._r8, liqcan(p) + dtime*qflx_liq_above_canopy(p)*fpi) else ! Intercepted precipitation [mm/s] - qflx_prec_intr(p) = (forc_snow(c) + forc_rain(c) + qflx_irrig_sprinkler(p)) * fpi + qflx_prec_intr(p) = (forc_snow(c) + qflx_liq_above_canopy(p)) * fpi end if ! Water storage of intercepted precipitation and dew @@ -420,7 +422,7 @@ subroutine CanopyHydrology(bounds, & if (col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall) then if (frac_veg_nosno(p) == 0) then qflx_prec_grnd_snow(p) = forc_snow(c) - qflx_prec_grnd_rain(p) = forc_rain(c) + qflx_prec_grnd_rain(p) = forc_rain(c) + qflx_irrig_sprinkler(p) else if (snowveg_on .or. snowveg_onrad) then qflx_snowindunload(p)=0._r8 diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 6c72344acc..dd1ea0ba0b 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -126,6 +126,7 @@ module IrrigationMod integer :: irrig_nsteps_per_day ! number of time steps per day in which we irrigate real(r8), pointer :: relsat_wilting_point_col(:,:) ! relative saturation at which smp = wilting point [col, nlevsoi] real(r8), pointer :: relsat_target_col(:,:) ! relative saturation at which smp is at the irrigation target [col, nlevsoi] + integer , pointer :: irrig_method_patch (:) ! patch irrigation application method ! Private data members; time-varying: real(r8), pointer :: irrig_rate_patch (:) ! current irrigation rate [mm/s] @@ -135,8 +136,6 @@ module IrrigationMod integer , pointer :: n_irrig_steps_left_patch (:) ! number of time steps for which we still need to irrigate today (if 0, ignore) real(r8), pointer :: qflx_irrig_demand_patch (:) ! irrigation flux neglecting surface water source limitation [mm/s] - integer , pointer :: irrig_method_patch (:) ! patch irrigation application method - contains ! Public routines ! COMPILER_BUG(wjs, 2014-10-15, pgi 14.7) Add an "Irrigation" prefix to some generic routines like "Init" diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 96df214d98..c6ed6b562c 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2029,7 +2029,7 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) - available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/ms) + available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/m2) ) ! calculate water table based on soil moisture state @@ -2105,7 +2105,6 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & else available_water_layer=max(0._r8,(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) endif -! if((jwt(c)+1) < nbedrock(c)) write(iulog,*) 'availwater: ', j,jwt(c), nbedrock(c), available_water_layer available_gw_uncon(c) = available_gw_uncon(c) & + available_water_layer diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 022cd5c6ee..62ed772306 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -402,7 +402,7 @@ subroutine InitBulkHistory(this, bounds) long_name=this%info%lname('available water in the unconfined saturated zone'), & ptr_col=this%available_gw_uncon_col, default='inactive') - this%h2osno_top_col(begc:endc) = spval + this%h2osno_top_col(begc:endc) = spval call hist_addfld1d ( & fname=this%info%fname('H2OSNO_TOP'), & units='kg/m2', & From 4640cc1442efb69b264a8a4ccd6b57399c2e4a44 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 10:40:02 -0600 Subject: [PATCH 10/41] change irrig_rate_patch to sfc_irrig_rate_patch --- src/biogeophys/IrrigationMod.F90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index dd1ea0ba0b..80b44b99f2 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -129,7 +129,7 @@ module IrrigationMod integer , pointer :: irrig_method_patch (:) ! patch irrigation application method ! Private data members; time-varying: - real(r8), pointer :: irrig_rate_patch (:) ! current irrigation rate [mm/s] + real(r8), pointer :: sfc_irrig_rate_patch (:) ! current irrigation rate [mm/s] real(r8), pointer :: irrig_rate_demand_patch (:) ! current irrigation rate, neglecting surface water source limitation [mm/s] real(r8), pointer :: gw_uncon_irrig_rate_patch (:) ! current unconfined groundwater irrigation rate [mm/s] real(r8), pointer :: gw_con_irrig_rate_patch (:) ! current confined groundwater irrigation rate [mm/s] @@ -523,7 +523,7 @@ subroutine IrrigationInitAllocate(this, bounds) allocate(this%qflx_irrig_demand_patch (begp:endp)) ; this%qflx_irrig_demand_patch (:) = nan allocate(this%relsat_wilting_point_col (begc:endc,nlevsoi)) ; this%relsat_wilting_point_col (:,:) = nan allocate(this%relsat_target_col (begc:endc,nlevsoi)) ; this%relsat_target_col (:,:) = nan - allocate(this%irrig_rate_patch (begp:endp)) ; this%irrig_rate_patch (:) = nan + allocate(this%sfc_irrig_rate_patch (begp:endp)) ; this%sfc_irrig_rate_patch (:) = nan allocate(this%irrig_rate_demand_patch (begp:endp)) ; this%irrig_rate_demand_patch (:) = nan allocate(this%gw_uncon_irrig_rate_patch (begp:endp)) ; this%gw_uncon_irrig_rate_patch (:) = nan allocate(this%gw_con_irrig_rate_patch (begp:endp)) ; this%gw_con_irrig_rate_patch (:) = nan @@ -729,11 +729,11 @@ subroutine Restart(this, bounds, ncid, flag) if (do_io) then call restartvar(ncid=ncid, flag=flag, varname='irrig_rate', xtype=ncd_double, & dim1name='pft', & - long_name='irrigation rate', units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%irrig_rate_patch) + long_name='surface irrigation rate', units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%sfc_irrig_rate_patch) end if if (flag=='read' .and. .not. readvar) then - this%irrig_rate_patch = 0.0_r8 + this%sfc_irrig_rate_patch = 0.0_r8 end if ! BACKWARDS_COMPATIBILITY(wjs, 2016-11-23) To support older restart files without an @@ -779,7 +779,7 @@ subroutine IrrigationClean(this) deallocate(this%qflx_irrig_demand_patch) deallocate(this%relsat_wilting_point_col) deallocate(this%relsat_target_col) - deallocate(this%irrig_rate_patch) + deallocate(this%sfc_irrig_rate_patch) deallocate(this%irrig_rate_demand_patch) deallocate(this%gw_uncon_irrig_rate_patch) deallocate(this%gw_con_irrig_rate_patch) @@ -837,7 +837,7 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) do p = bounds%begp, bounds%endp if (this%n_irrig_steps_left_patch(p) > 0) then - qflx_sfc_irrig_patch(p) = this%irrig_rate_patch(p) + qflx_sfc_irrig_patch(p) = this%sfc_irrig_rate_patch(p) this%qflx_irrig_demand_patch(p) = this%irrig_rate_demand_patch(p) qflx_gw_uncon_irrig_patch(p) = this%gw_uncon_irrig_rate_patch(p) qflx_gw_con_irrig_patch(p) = this%gw_con_irrig_rate_patch(p) @@ -1120,7 +1120,7 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg if (check_for_irrig_patch(p)) then ! Convert units from mm to mm/sec - this%irrig_rate_patch(p) = deficit_volr_limited(c) / & + this%sfc_irrig_rate_patch(p) = deficit_volr_limited(c) / & (this%dtime*this%irrig_nsteps_per_day) this%irrig_rate_demand_patch(p) = deficit(c) / & (this%dtime*this%irrig_nsteps_per_day) @@ -1141,6 +1141,9 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg (deficit(c) - deficit_volr_limited(c) - available_gw_uncon(c)) / & (this%dtime*this%irrig_nsteps_per_day) endif + else + this%gw_uncon_irrig_rate_patch(p) = 0._r8 + this%gw_con_irrig_rate_patch(p) = 0._r8 endif ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 From 457fc54c3011233a45c0559da9a4202177858519 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Mon, 8 Oct 2018 14:58:43 -0600 Subject: [PATCH 11/41] move calculation of available_gw_uncon out of thetabasedwatertable into new routine CalcAvailableUnconfinedAquifer --- .../namelist_definition_clm4_5.xml | 1 + src/biogeophys/BalanceCheckMod.F90 | 16 +++ src/biogeophys/HydrologyNoDrainageMod.F90 | 2 +- src/biogeophys/IrrigationMod.F90 | 5 +- src/biogeophys/SoilHydrologyMod.F90 | 115 ++++++++++++------ src/main/clm_driver.F90 | 6 + 6 files changed, 105 insertions(+), 40 deletions(-) diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index cfb0d290cb..4a1e06eab6 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -440,6 +440,7 @@ is turned off regardless of the setting of this namelist variable. If TRUE, supply irrigation from groundwater (in addition to surface water). + waterbalancebulk_inst%begwb_col & ! Output: [real(r8) (:) ] water mass begining of the time step ) + if(use_aquifer_layer()) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%hydrologically_active(c)) then + if(zwt(c) <= zi(c,nlevsoi)) then + wa(c) = aquifer_water_baseline + end if + end if + end do + endif + call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstatebulk_inst, waterdiagnosticbulk_inst, begwb(bounds%begc:bounds%endc)) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 5b24a89c4f..e76ce32eb3 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -249,7 +249,7 @@ subroutine HydrologyNoDrainage(bounds, & call ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - waterstatebulk_inst, waterfluxbulk_inst, waterdiagnosticbulk_inst) + waterstatebulk_inst, waterfluxbulk_inst) call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc,& diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 80b44b99f2..dd06d1c196 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -747,14 +747,14 @@ subroutine Restart(this, bounds, ncid, flag) long_name='irrigation rate demand, neglecting surface water source limitation', & units='mm/s', & interpinic_flag='interp', readvar=readvar, data=this%irrig_rate_demand_patch) - call restartvar(ncid=ncid, flag=flag, varname='gw_uncon_irrig_rate:irrig_rate', & + call restartvar(ncid=ncid, flag=flag, varname='gw_uncon_irrig_rate', & xtype=ncd_double, & dim1name='pft', & long_name='unconfined groundwater irrigation rate', & units='mm/s', & interpinic_flag='interp', readvar=readvar, data=this%gw_uncon_irrig_rate_patch) - call restartvar(ncid=ncid, flag=flag, varname='gw_con_irrig_rate:irrig_rate', & + call restartvar(ncid=ncid, flag=flag, varname='gw_con_irrig_rate', & xtype=ncd_double, & dim1name='pft', & long_name='confined groundwater irrigation rate', & @@ -998,6 +998,7 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg SHR_ASSERT_ALL((ubound(eff_porosity) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__)) SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__)) SHR_ASSERT_ALL((ubound(volr) == (/bounds%endg/)), errMsg(sourcefile, __LINE__)) + SHR_ASSERT_ALL((ubound(available_gw_uncon) == (/bounds%endc/)), errMsg(sourcefile, __LINE__)) ! Determine if irrigation is needed (over irrigated soil columns) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index c6ed6b562c..ae87782fbd 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -50,7 +50,8 @@ module SoilHydrologyMod public :: ThetaBasedWaterTable ! Calculate water table from soil moisture state public :: LateralFlowPowerLaw ! Calculate lateral flow based on power law drainage function public :: RenewCondensation ! Misc. corrections - + public :: CalcAvailableUnconfinedAquifer ! Calculate water in unconfined aquifer available for groundwater irrigation use + ! !PRIVATE MEMBER FUNCTIONS: private :: QflxH2osfcSurf ! Compute qflx_h2osfc_surf private :: QflxH2osfcDrain ! Compute qflx_h2osfc_drain @@ -1984,7 +1985,7 @@ end subroutine PerchedLateralFlow !----------------------------------------------------------------------- subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & - waterstatebulk_inst, waterfluxbulk_inst, waterdiagnosticbulk_inst) + waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Calculate watertable, considering aquifer recharge but no drainage. @@ -2003,7 +2004,6 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & type(soilstate_type) , intent(in) :: soilstate_inst type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst - type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst ! ! !LOCAL VARIABLES: integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) @@ -2028,8 +2028,7 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) - zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) - available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/m2) + zwt => soilhydrology_inst%zwt_col & ! Output: [real(r8) (:) ] water table depth (m) ) ! calculate water table based on soil moisture state @@ -2080,37 +2079,6 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & end do - ! calculate amount of water in saturated zone that - ! is available for groundwater irrigation - - do fc = 1, num_hydrologyc - c = filter_hydrologyc(fc) - available_gw_uncon(c) = 0._r8 - - jwt(c) = nlevsoi - ! allow jwt to equal zero when zwt is in top layer - do j = 1,nlevsoi - if(zwt(c) <= zi(c,j)) then - jwt(c) = j-1 - exit - end if - enddo - do j = jwt(c)+1, nbedrock(c) - s_y = watsat(c,j) & - * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) - s_y=max(s_y,0.02_r8) - - if (j==jwt(c)+1) then - available_water_layer=max(0._r8,(s_y*(zi(c,j) - zwt(c))*1.e3)) - else - available_water_layer=max(0._r8,(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) - endif - - available_gw_uncon(c) = available_gw_uncon(c) & - + available_water_layer - enddo - enddo - end associate end subroutine ThetaBasedWaterTable @@ -2222,7 +2190,7 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) qflx_qrgwl => waterfluxbulk_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes (mm H2O /s) qflx_rsub_sat => waterfluxbulk_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] - qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! unconfined groundwater irrigation flux (mm H2O /s) + qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! Input: [real(r8) (:) unconfined groundwater irrigation flux (mm H2O /s) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) @@ -2535,6 +2503,79 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & end associate end subroutine RenewCondensation +!#8 + !----------------------------------------------------------------------- + subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, soilstate_inst, waterdiagnosticbulk_inst) + ! + ! !DESCRIPTION: + ! Calculate water in unconfined aquifer (i.e. soil column) that + ! is available for groundwater recharge. + ! + ! !USES: + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst + ! + ! !LOCAL VARIABLES: + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + integer :: c,j,fc ! indices + real(r8) :: s_y + real(r8) :: available_water_layer + + !----------------------------------------------------------------------- + + associate( & + nbedrock => col%nbedrock , & ! Input: [real(r8) (:,:) ] depth to bedrock (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) + available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/m2) + ) + + ! calculate amount of water in saturated zone that + ! is available for groundwater irrigation + + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + available_gw_uncon(c) = 0._r8 + + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo + do j = jwt(c)+1, nbedrock(c) + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + + if (j==jwt(c)+1) then + available_water_layer=max(0._r8,(s_y*(zi(c,j) - zwt(c))*1.e3)) + else + available_water_layer=max(0._r8,(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) + endif + + available_gw_uncon(c) = available_gw_uncon(c) & + + available_water_layer + enddo + enddo + + end associate + + end subroutine CalcAvailableUnconfinedAquifer + !#0 end module SoilHydrologyMod diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index f8013003c0..8db630a9a8 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -42,6 +42,7 @@ module clm_driver use HydrologyDrainageMod , only : HydrologyDrainage ! (formerly Hydrology2Mod) use CanopyHydrologyMod , only : CanopyHydrology ! (formerly Hydrology1Mod) use LakeHydrologyMod , only : LakeHydrology + use SoilHydrologyMod , only : CalcAvailableUnconfinedAquifer ! use AerosolMod , only : AerosolMasses use SnowSnicarMod , only : SnowAge_grain @@ -430,6 +431,11 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call setExposedvegpFilter(bounds_clump, & canopystate_inst%frac_veg_nosno_patch(bounds_clump%begp:bounds_clump%endp)) + ! Amount of water available for groundwater irrigation + call CalcAvailableUnconfinedAquifer(bounds_clump, filter(nc)%num_hydrologyc, & + filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & + water_inst%waterdiagnosticbulk_inst) + ! Irrigation flux ! input is main channel storage call irrigation_inst%ApplyIrrigation(bounds_clump, water_inst%waterfluxbulk_inst) From e0a16d548c595e88ea993dd4233aaf1ee716d610 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 9 Oct 2018 10:55:27 -0600 Subject: [PATCH 12/41] Move groundwater irrigation division to ApplyIrrigation. Use filter loops in ApplyIrrigation, this requires initializing some variables. --- src/biogeophys/IrrigationMod.F90 | 136 ++++++++++++---------------- src/biogeophys/SoilHydrologyMod.F90 | 8 +- src/biogeophys/WaterFluxType.F90 | 19 +++- src/main/clm_driver.F90 | 8 +- 4 files changed, 80 insertions(+), 91 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index dd06d1c196..03c0cf200b 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -131,8 +131,6 @@ module IrrigationMod ! Private data members; time-varying: real(r8), pointer :: sfc_irrig_rate_patch (:) ! current irrigation rate [mm/s] real(r8), pointer :: irrig_rate_demand_patch (:) ! current irrigation rate, neglecting surface water source limitation [mm/s] - real(r8), pointer :: gw_uncon_irrig_rate_patch (:) ! current unconfined groundwater irrigation rate [mm/s] - real(r8), pointer :: gw_con_irrig_rate_patch (:) ! current confined groundwater irrigation rate [mm/s] integer , pointer :: n_irrig_steps_left_patch (:) ! number of time steps for which we still need to irrigate today (if 0, ignore) real(r8), pointer :: qflx_irrig_demand_patch (:) ! irrigation flux neglecting surface water source limitation [mm/s] @@ -525,8 +523,6 @@ subroutine IrrigationInitAllocate(this, bounds) allocate(this%relsat_target_col (begc:endc,nlevsoi)) ; this%relsat_target_col (:,:) = nan allocate(this%sfc_irrig_rate_patch (begp:endp)) ; this%sfc_irrig_rate_patch (:) = nan allocate(this%irrig_rate_demand_patch (begp:endp)) ; this%irrig_rate_demand_patch (:) = nan - allocate(this%gw_uncon_irrig_rate_patch (begp:endp)) ; this%gw_uncon_irrig_rate_patch (:) = nan - allocate(this%gw_con_irrig_rate_patch (begp:endp)) ; this%gw_con_irrig_rate_patch (:) = nan allocate(this%irrig_method_patch (begp:endp)) ; this%irrig_method_patch (:) = ispval allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 @@ -637,6 +633,8 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention this%dtime = get_step_size() this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(this%dtime) + this%qflx_irrig_demand_patch(bounds%begp:bounds%endp) = 0._r8 + end subroutine IrrigationInitCold !----------------------------------------------------------------------- @@ -747,19 +745,6 @@ subroutine Restart(this, bounds, ncid, flag) long_name='irrigation rate demand, neglecting surface water source limitation', & units='mm/s', & interpinic_flag='interp', readvar=readvar, data=this%irrig_rate_demand_patch) - call restartvar(ncid=ncid, flag=flag, varname='gw_uncon_irrig_rate', & - xtype=ncd_double, & - dim1name='pft', & - long_name='unconfined groundwater irrigation rate', & - units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%gw_uncon_irrig_rate_patch) - - call restartvar(ncid=ncid, flag=flag, varname='gw_con_irrig_rate', & - xtype=ncd_double, & - dim1name='pft', & - long_name='confined groundwater irrigation rate', & - units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%gw_con_irrig_rate_patch) end subroutine Restart !----------------------------------------------------------------------- @@ -781,8 +766,6 @@ subroutine IrrigationClean(this) deallocate(this%relsat_target_col) deallocate(this%sfc_irrig_rate_patch) deallocate(this%irrig_rate_demand_patch) - deallocate(this%gw_uncon_irrig_rate_patch) - deallocate(this%gw_con_irrig_rate_patch) deallocate(this%irrig_method_patch) deallocate(this%n_irrig_steps_left_patch) @@ -794,7 +777,8 @@ end subroutine IrrigationClean ! ======================================================================== !----------------------------------------------------------------------- - subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) + subroutine ApplyIrrigation(this, bounds, num_soilc, & + filter_soilc, num_soilp, filter_soilp, waterfluxbulk_inst, available_gw_uncon) ! ! !DESCRIPTION: ! Apply the irrigation computed by CalcIrrigationNeeded to qflx_irrig. @@ -808,15 +792,27 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) ! !ARGUMENTS: class(irrigation_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds + ! number of points in filter_soilc + integer, intent(in) :: num_soilc + ! column filter for soil + integer, intent(in) :: filter_soilc(:) + ! number of points in filter_soilp + integer, intent(in) :: num_soilp + ! patch filter for soil + integer, intent(in) :: filter_soilp(:) type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + ! column available water in saturated zone (kg/m2) + real(r8), intent(in) :: available_gw_uncon( bounds%begc:) ! ! !LOCAL VARIABLES: - integer :: p ! patch index - integer :: g ! grid cell index + integer :: p,fp ! patch indices + integer :: c,fc ! column indices + integer :: g ! grid cell index character(len=*), parameter :: subname = 'ApplyIrrigation' !----------------------------------------------------------------------- + SHR_ASSERT_ALL((ubound(available_gw_uncon) == (/bounds%endc/)), errMsg(sourcefile, __LINE__)) ! This should be called exactly once per time step, so that the counter decrease ! works correctly. @@ -833,14 +829,28 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) qflx_irrig_sprinkler_patch=> waterfluxbulk_inst%qflx_irrig_sprinkler_patch, & ! Output: [real(r8) (:)] patch sprinkler irrigation flux (mm H2O/s) qflx_irrig_sprinkler_col => waterfluxbulk_inst%qflx_irrig_sprinkler_col & ! Output: [real(r8) (:)] col sprinkler irrigation flux (mm H2O/s) ) - - do p = bounds%begp, bounds%endp - + + do fp = 1, num_soilp + p = filter_soilp(fp) + if (this%n_irrig_steps_left_patch(p) > 0) then qflx_sfc_irrig_patch(p) = this%sfc_irrig_rate_patch(p) this%qflx_irrig_demand_patch(p) = this%irrig_rate_demand_patch(p) - qflx_gw_uncon_irrig_patch(p) = this%gw_uncon_irrig_rate_patch(p) - qflx_gw_con_irrig_patch(p) = this%gw_con_irrig_rate_patch(p) + + ! groundwater irrigation will supply remaining deficit + ! first take from unconfined aquifer, then confined aquifer + if(this%params%use_groundwater_irrigation) then + c = patch%column(p) + ! use fluxes, get column index + if(((this%qflx_irrig_demand_patch(p) - qflx_sfc_irrig_patch(p))*this%dtime) <= available_gw_uncon(c)) then + qflx_gw_uncon_irrig_patch(p) = (this%qflx_irrig_demand_patch(p) - qflx_sfc_irrig_patch(p)) + qflx_gw_con_irrig_patch(p) = 0._r8 + else + qflx_gw_uncon_irrig_patch(p) = available_gw_uncon(c) / this%dtime + qflx_gw_con_irrig_patch(p) = (this%qflx_irrig_demand_patch(p) - qflx_sfc_irrig_patch(p) - qflx_gw_uncon_irrig_patch(p)) + endif + endif + this%n_irrig_steps_left_patch(p) = this%n_irrig_steps_left_patch(p) - 1 else qflx_sfc_irrig_patch(p) = 0._r8 @@ -864,31 +874,26 @@ subroutine ApplyIrrigation(this, bounds, waterfluxbulk_inst) end do - call p2c (bounds = bounds, & - parr = qflx_sfc_irrig_patch(bounds%begp:bounds%endp), & - carr = qflx_sfc_irrig_col(bounds%begc:bounds%endc), & - p2c_scale_type = 'unity') - - call p2c (bounds = bounds, & - parr = qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), & - carr = qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), & - p2c_scale_type = 'unity') - - call p2c (bounds = bounds, & - parr = qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), & - carr = qflx_gw_con_irrig_col(bounds%begc:bounds%endc), & - p2c_scale_type = 'unity') - - call p2c (bounds = bounds, & - parr = qflx_irrig_drip_patch(bounds%begp:bounds%endp), & - carr = qflx_irrig_drip_col(bounds%begc:bounds%endc), & - p2c_scale_type = 'unity') - - call p2c (bounds = bounds, & - parr = qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), & - carr = qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), & - p2c_scale_type = 'unity') - + call p2c (bounds, num_soilc, filter_soilc, & + patcharr = qflx_sfc_irrig_patch(bounds%begp:bounds%endp), & + colarr = qflx_sfc_irrig_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_soilc, filter_soilc, & + patcharr = qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), & + colarr = qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_soilc, filter_soilc, & + patcharr = qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), & + colarr = qflx_gw_con_irrig_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_soilc, filter_soilc, & + patcharr = qflx_irrig_drip_patch(bounds%begp:bounds%endp), & + colarr = qflx_irrig_drip_col(bounds%begc:bounds%endc)) + + call p2c (bounds, num_soilc, filter_soilc, & + patcharr = qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), & + colarr = qflx_irrig_sprinkler_col(bounds%begc:bounds%endc)) + end associate end subroutine ApplyIrrigation @@ -896,7 +901,7 @@ end subroutine ApplyIrrigation !----------------------------------------------------------------------- subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedvegp, & - time_prev, elai, t_soisno, eff_porosity, h2osoi_liq, volr, rof_prognostic, available_gw_uncon) + time_prev, elai, t_soisno, eff_porosity, h2osoi_liq, volr, rof_prognostic) ! ! !DESCRIPTION: ! Calculate whether and how much irrigation is needed for each column. However, this @@ -937,9 +942,6 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg ! whether we can limit irrigation based on river volume. logical, intent(in) :: rof_prognostic - ! column available water in saturated zone (kg/m2) - real(r8), intent(in) :: available_gw_uncon( bounds%begc:) - ! ! !LOCAL VARIABLES: integer :: fp ! patch filter index @@ -998,7 +1000,6 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg SHR_ASSERT_ALL((ubound(eff_porosity) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__)) SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevgrnd/)), errMsg(sourcefile, __LINE__)) SHR_ASSERT_ALL((ubound(volr) == (/bounds%endg/)), errMsg(sourcefile, __LINE__)) - SHR_ASSERT_ALL((ubound(available_gw_uncon) == (/bounds%endc/)), errMsg(sourcefile, __LINE__)) ! Determine if irrigation is needed (over irrigated soil columns) @@ -1126,27 +1127,6 @@ subroutine CalcIrrigationNeeded(this, bounds, num_exposedvegp, filter_exposedveg this%irrig_rate_demand_patch(p) = deficit(c) / & (this%dtime*this%irrig_nsteps_per_day) - ! groundwater irrigation will supply remaining deficit - ! first take from unconfined aquifer, then confined aquifer - if(this%params%use_groundwater_irrigation) then - if((deficit(c) - deficit_volr_limited(c)) <= available_gw_uncon(c)) then - this%gw_uncon_irrig_rate_patch(p) = & - (deficit(c) - deficit_volr_limited(c)) / & - (this%dtime*this%irrig_nsteps_per_day) - this%gw_con_irrig_rate_patch(p) = 0._r8 - else - this%gw_uncon_irrig_rate_patch(p) = & - available_gw_uncon(c) / & - (this%dtime*this%irrig_nsteps_per_day) - this%gw_con_irrig_rate_patch(p) = & - (deficit(c) - deficit_volr_limited(c) - available_gw_uncon(c)) / & - (this%dtime*this%irrig_nsteps_per_day) - endif - else - this%gw_uncon_irrig_rate_patch(p) = 0._r8 - this%gw_con_irrig_rate_patch(p) = 0._r8 - endif - ! n_irrig_steps_left(p) > 0 is ok even if irrig_rate(p) ends up = 0 ! in this case, we'll irrigate by 0 for the given number of time steps this%n_irrig_steps_left_patch(p) = this%irrig_nsteps_per_day diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index ae87782fbd..417cbff0f3 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2275,11 +2275,7 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & s_y = watsat(c,j) & * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) s_y=max(s_y,0.02_r8) - if (j==jwt(c)+1) then - rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) - else - rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zi(c,j-1))*1.e3)) - endif + rsub_top_layer=max(rsub_top_tot,-(s_y*(zi(c,j) - zwt(c))*1.e3)) rsub_top_layer=min(rsub_top_layer,0._r8) h2osoi_liq(c,j) = h2osoi_liq(c,j) + rsub_top_layer @@ -2296,7 +2292,7 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & !-- remove residual rsub_top -------------------------------- ! make sure no extra water removed from soil column - rsub_top(c) = rsub_top(c) + rsub_top_tot/dtime + rsub_top(c) = rsub_top(c) - rsub_top_tot/dtime endif zwt(c) = max(0.0_r8,zwt(c)) diff --git a/src/biogeophys/WaterFluxType.F90 b/src/biogeophys/WaterFluxType.F90 index 8b24d44125..42e3086e8e 100644 --- a/src/biogeophys/WaterFluxType.F90 +++ b/src/biogeophys/WaterFluxType.F90 @@ -728,10 +728,21 @@ subroutine InitCold(this, bounds) integer :: p,c,l !----------------------------------------------------------------------- - this%qflx_evap_grnd_patch(bounds%begp:bounds%endp) = 0.0_r8 - this%qflx_dew_grnd_patch (bounds%begp:bounds%endp) = 0.0_r8 - this%qflx_dew_snow_patch (bounds%begp:bounds%endp) = 0.0_r8 - + this%qflx_evap_grnd_patch(bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_dew_grnd_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_dew_snow_patch (bounds%begp:bounds%endp) = 0.0_r8 + + this%qflx_sfc_irrig_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_sfc_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_gw_uncon_irrig_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_gw_uncon_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_gw_con_irrig_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_gw_con_irrig_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_irrig_drip_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_irrig_drip_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_irrig_sprinkler_patch (bounds%begp:bounds%endp) = 0.0_r8 + this%qflx_irrig_sprinkler_col (bounds%begc:bounds%endc) = 0.0_r8 + this%qflx_evap_grnd_col(bounds%begc:bounds%endc) = 0.0_r8 this%qflx_dew_grnd_col (bounds%begc:bounds%endc) = 0.0_r8 this%qflx_dew_snow_col (bounds%begc:bounds%endc) = 0.0_r8 diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 8db630a9a8..9a66ce6a56 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -438,7 +438,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! Irrigation flux ! input is main channel storage - call irrigation_inst%ApplyIrrigation(bounds_clump, water_inst%waterfluxbulk_inst) + call irrigation_inst%ApplyIrrigation(bounds_clump, filter(nc)%num_soilc, & + filter(nc)%soilc, filter(nc)%num_soilp, filter(nc)%soilp, & + water_inst%waterfluxbulk_inst, & + available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col(bounds_clump%begc:bounds_clump%endc)) call t_stopf('drvinit') ! ============================================================================ @@ -628,8 +631,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro h2osoi_liq = water_inst%waterstatebulk_inst%h2osoi_liq_col& (bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & volr = water_inst%wateratm2lndbulk_inst%volrmch_grc(bounds_clump%begg:bounds_clump%endg), & - rof_prognostic = rof_prognostic, & - available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col(bounds_clump%begc:bounds_clump%endc)) + rof_prognostic = rof_prognostic) call t_stopf('irrigationneeded') ! ============================================================================ From 0d5c887f28516e6c344535dfc6b7eee394cdf567 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Tue, 9 Oct 2018 12:22:56 -0600 Subject: [PATCH 13/41] add validity check for use_aquifer_layer case --- src/biogeophys/IrrigationMod.F90 | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 03c0cf200b..974bf0a425 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -417,6 +417,7 @@ subroutine CheckNamelistValidity(this) ! tasks. ! ! !USES: + use SoilWaterMovementMod , only : use_aquifer_layer ! ! !ARGUMENTS: class(irrigation_type), intent(in) :: this @@ -490,6 +491,12 @@ subroutine CheckNamelistValidity(this) end if end if + if (use_aquifer_layer() .and. use_groundwater_irrigation) then + write(iulog,*) ' ERROR: use_groundwater_irrigation and use_aquifer_layer may not be used simultaneously' + call endrun(msg=' ERROR: use_groundwater_irrigation and use_aquifer_layer cannot both be set to true' // & + errMsg(sourcefile, __LINE__)) + end if + end associate end subroutine CheckNamelistValidity From d7c8b8d3d36233e78a2b5135769924005172ee1e Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Wed, 10 Oct 2018 09:10:29 -0600 Subject: [PATCH 14/41] remove irrigation from unconfined aquifer after baseflow --- src/biogeophys/IrrigationMod.F90 | 4 +++- src/biogeophys/SoilHydrologyMod.F90 | 17 ++++++++++++----- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 974bf0a425..b2df937d52 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -528,7 +528,7 @@ subroutine IrrigationInitAllocate(this, bounds) allocate(this%qflx_irrig_demand_patch (begp:endp)) ; this%qflx_irrig_demand_patch (:) = nan allocate(this%relsat_wilting_point_col (begc:endc,nlevsoi)) ; this%relsat_wilting_point_col (:,:) = nan allocate(this%relsat_target_col (begc:endc,nlevsoi)) ; this%relsat_target_col (:,:) = nan - allocate(this%sfc_irrig_rate_patch (begp:endp)) ; this%sfc_irrig_rate_patch (:) = nan + allocate(this%sfc_irrig_rate_patch (begp:endp)) ; this%sfc_irrig_rate_patch (:) = nan allocate(this%irrig_rate_demand_patch (begp:endp)) ; this%irrig_rate_demand_patch (:) = nan allocate(this%irrig_method_patch (begp:endp)) ; this%irrig_method_patch (:) = ispval allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 @@ -634,6 +634,8 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention call endrun(decomp_index=g, clmlevel=nameg, msg='bad irrig_method '// & errMsg(sourcefile, __LINE__)) end if + else + this%irrig_method_patch(p) = irrig_method_drip end if end do diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 417cbff0f3..c031bce071 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2038,7 +2038,7 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & do fc = 1, num_hydrologyc c = filter_hydrologyc(fc) -! initialize to depth of bottom of lowest layer + ! initialize to depth of bottom of lowest layer zwt(c)=zi(c,nlevsoi) ! locate water table from bottom up starting at bottom of soil column @@ -2076,7 +2076,6 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & else zwt(c)=zi(c,nbedrock(c)) endif - end do end associate @@ -2260,10 +2259,9 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & rsub_top(c) = 0._r8 endif - ! add groundwater irrigation flux to subsurface drainage flux !-- Now remove water via rsub_top - rsub_top_tot = - (rsub_top(c) + qflx_gw_uncon_irrig(c))* dtime - + rsub_top_tot = - (rsub_top(c)* dtime) + !should never be positive... but include for completeness if(rsub_top_tot > 0.) then !rising water table @@ -2294,6 +2292,15 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & ! make sure no extra water removed from soil column rsub_top(c) = rsub_top(c) - rsub_top_tot/dtime endif + + ! remove groundwater irrigation from deepest layer + rsub_top_layer = qflx_gw_uncon_irrig(c)* dtime + h2osoi_liq(c,nbedrock(c)) = h2osoi_liq(c,nbedrock(c)) - rsub_top_layer + s_y = watsat(c,nbedrock(c)) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,nbedrock(c)))**(-1./bsw(c,nbedrock(c)))) + s_y=max(s_y,0.02_r8) + zwt(c) = zwt(c) + rsub_top_layer/s_y/1000._r8 + zwt(c) = min(zi(c,nbedrock(c)),zwt(c)) zwt(c) = max(0.0_r8,zwt(c)) zwt(c) = min(80._r8,zwt(c)) From e516e6e9c109780138fdf5ba746e992b0d5b44e6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 8 Nov 2018 15:02:22 -0700 Subject: [PATCH 15/41] Remove unnecessary use statement that was causing circular dependencies --- src/biogeophys/SoilWaterMovementMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/biogeophys/SoilWaterMovementMod.F90 b/src/biogeophys/SoilWaterMovementMod.F90 index 6fc51f08e1..05be0685f4 100644 --- a/src/biogeophys/SoilWaterMovementMod.F90 +++ b/src/biogeophys/SoilWaterMovementMod.F90 @@ -10,7 +10,6 @@ module SoilWaterMovementMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush - use clm_instMod , only : clm_fates ! implicit none From 5971ade253cdc8b66214594e79f94497175c528d Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 8 Nov 2018 15:13:18 -0700 Subject: [PATCH 16/41] collect and move groundwater irrigation removal --- src/biogeophys/HydrologyDrainageMod.F90 | 9 +- src/biogeophys/SoilHydrologyMod.F90 | 110 +++++++++++++++++++++--- src/main/clm_driver.F90 | 7 ++ 3 files changed, 106 insertions(+), 20 deletions(-) diff --git a/src/biogeophys/HydrologyDrainageMod.F90 b/src/biogeophys/HydrologyDrainageMod.F90 index f5f4ee0c0d..c832bebf6a 100644 --- a/src/biogeophys/HydrologyDrainageMod.F90 +++ b/src/biogeophys/HydrologyDrainageMod.F90 @@ -117,8 +117,7 @@ subroutine HydrologyDrainage(bounds, & qflx_runoff_u => waterfluxbulk_inst%qflx_runoff_u_col , & ! Urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) qflx_runoff_r => waterfluxbulk_inst%qflx_runoff_r_col , & ! Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) qflx_ice_runoff_snwcp => waterfluxbulk_inst%qflx_ice_runoff_snwcp_col, & ! solid runoff from snow capping (mm H2O /s) - qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! surface irrigation flux (mm H2O /s) - qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col & ! confined groundwater irrigation flux (mm H2O /s) + qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col & ! surface irrigation flux (mm H2O /s) ) ! Determine time step and step size @@ -161,12 +160,6 @@ subroutine HydrologyDrainage(bounds, & end do end do - ! remove groundwater irrigation from aquifer - do fc = 1, num_nolakec - c = filter_nolakec(fc) - wa(c) = wa(c) - qflx_gw_con_irrig(c) * dtime - enddo - call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstatebulk_inst, waterdiagnosticbulk_inst, endwb(bounds%begc:bounds%endc)) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index c031bce071..2c76f265bc 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -51,6 +51,7 @@ module SoilHydrologyMod public :: LateralFlowPowerLaw ! Calculate lateral flow based on power law drainage function public :: RenewCondensation ! Misc. corrections public :: CalcAvailableUnconfinedAquifer ! Calculate water in unconfined aquifer available for groundwater irrigation use + public :: WithdrawGroundwaterIrrigation ! Remove groundwater irrigation from unconfined and confined aquifers ! !PRIVATE MEMBER FUNCTIONS: private :: QflxH2osfcSurf ! Compute qflx_h2osfc_surf @@ -2189,8 +2190,6 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) qflx_qrgwl => waterfluxbulk_inst%qflx_qrgwl_col , & ! Output: [real(r8) (:) ] qflx_surf at glaciers, wetlands, lakes (mm H2O /s) qflx_rsub_sat => waterfluxbulk_inst%qflx_rsub_sat_col , & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] - qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! Input: [real(r8) (:) unconfined groundwater irrigation flux (mm H2O /s) - h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) ) @@ -2292,19 +2291,9 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & ! make sure no extra water removed from soil column rsub_top(c) = rsub_top(c) - rsub_top_tot/dtime endif - - ! remove groundwater irrigation from deepest layer - rsub_top_layer = qflx_gw_uncon_irrig(c)* dtime - h2osoi_liq(c,nbedrock(c)) = h2osoi_liq(c,nbedrock(c)) - rsub_top_layer - s_y = watsat(c,nbedrock(c)) & - * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,nbedrock(c)))**(-1./bsw(c,nbedrock(c)))) - s_y=max(s_y,0.02_r8) - zwt(c) = zwt(c) + rsub_top_layer/s_y/1000._r8 - zwt(c) = min(zi(c,nbedrock(c)),zwt(c)) zwt(c) = max(0.0_r8,zwt(c)) zwt(c) = min(80._r8,zwt(c)) - end do ! excessive water above saturation added to the above unsaturated layer like a bucket @@ -2578,6 +2567,103 @@ subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrolo end associate end subroutine CalcAvailableUnconfinedAquifer +!#9 + !----------------------------------------------------------------------- + subroutine WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + waterstatebulk_inst, waterfluxbulk_inst) + ! + ! !DESCRIPTION: + ! Remove groundwater irrigation from unconfined and confined aquifers + ! + ! !USES: + + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'WithdrawGroundwaterIrrigation' ! subroutine name + integer :: c,j,fc ! indices + real(r8) :: dtime ! land model time step (sec) + integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) + real(r8) :: s_y + real(r8) :: irrig_total + real(r8) :: irrig_layer + !----------------------------------------------------------------------- + + associate( & + nbedrock => col%nbedrock , & ! Input: [real(r8) (:,:) ] depth to bedrock (m) + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + hksat => soilstate_inst%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + + qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col, & ! Input: [real(r8) (:) unconfined groundwater irrigation flux (mm H2O /s) + qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col , & ! confined groundwater irrigation flux (mm H2O /s) + wa => waterstatebulk_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) + + + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + ) + + ! Get time step + + dtime = get_step_size() + + !-- Remove groundwater from unconfined aquifer ----------- + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + irrig_total = qflx_gw_uncon_irrig(c)*dtime + + ! should never be negative... but include for completeness + if(irrig_total < 0.) then + + call endrun(msg="negative groundwater irrigation!"//errmsg(sourcefile, __LINE__)) + + else + do j = jwt(c)+1, nbedrock(c) + ! use analytical expression for specific yield + s_y = watsat(c,j) & + * ( 1. - (1.+1.e3*zwt(c)/sucsat(c,j))**(-1./bsw(c,j))) + s_y=max(s_y,0.02_r8) + irrig_layer=min(irrig_total,(s_y*(zi(c,j) - zwt(c))*1.e3)) + irrig_layer=max(irrig_layer,0._r8) + h2osoi_liq(c,j) = h2osoi_liq(c,j) - irrig_layer + + irrig_total = irrig_total - irrig_layer + + if (irrig_total <= 0.) then + exit + endif + enddo + endif + end do + + ! zwt is not being updated, as it will be updated + ! after HydrologyNoDrainage + + !-- Remove groundwater from confined aquifer ----------- + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + wa(c) = wa(c) - qflx_gw_con_irrig(c) * dtime + enddo + + end associate + + end subroutine WithdrawGroundwaterIrrigation !#0 diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 9a66ce6a56..71e6190178 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -43,6 +43,7 @@ module clm_driver use CanopyHydrologyMod , only : CanopyHydrology ! (formerly Hydrology1Mod) use LakeHydrologyMod , only : LakeHydrology use SoilHydrologyMod , only : CalcAvailableUnconfinedAquifer + use SoilHydrologyMod , only : WithdrawGroundwaterIrrigation ! use AerosolMod , only : AerosolMasses use SnowSnicarMod , only : SnowAge_grain @@ -444,6 +445,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col(bounds_clump%begc:bounds_clump%endc)) call t_stopf('drvinit') + ! Remove groundwater irrigation + call WithdrawGroundwaterIrrigation(bounds_clump, filter(nc)%num_hydrologyc, & + filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & + water_inst%waterstatebulk_inst, & + water_inst%waterfluxbulk_inst) + ! ============================================================================ ! Canopy Hydrology ! (1) water storage of intercepted precipitation From e77b77851909029a6bd014ba02f2c11ffcbb4497 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 9 Nov 2018 06:47:00 -0700 Subject: [PATCH 17/41] Reduce dependencies for the sake of the unit test build SoilWaterMovementMod drags along all sorts of dependencies that I don't want to deal with right now. Reduce dependencies by passing use_aquifer_layer in to the routines that need it. --- src/biogeophys/BalanceCheckMod.F90 | 17 +++++++---------- src/biogeophys/IrrigationMod.F90 | 23 ++++++++++++----------- src/main/clm_driver.F90 | 4 +++- src/main/clm_instMod.F90 | 4 +++- 4 files changed, 25 insertions(+), 23 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 6775cc4b67..3b268f7fa6 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -117,15 +117,11 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- subroutine BeginWaterBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & - soilhydrology_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterbalancebulk_inst) + soilhydrology_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterbalancebulk_inst, & + use_aquifer_layer) ! ! !DESCRIPTION: ! Initialize column-level water balance at beginning of time step - - ! - ! !USES: - use SoilWaterMovementMod , only : use_aquifer_layer - ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -134,9 +130,10 @@ subroutine BeginWaterBalance(bounds, & integer , intent(in) :: num_lakec ! number of column lake points in column filter integer , intent(in) :: filter_lakec(:) ! column filter for lake points type(soilhydrology_type) , intent(inout) :: soilhydrology_inst - type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst - type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst - type(waterbalance_type) , intent(inout) :: waterbalancebulk_inst + type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst + type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst + type(waterbalance_type) , intent(inout) :: waterbalancebulk_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: c, j, fc ! indices @@ -149,7 +146,7 @@ subroutine BeginWaterBalance(bounds, & begwb => waterbalancebulk_inst%begwb_col & ! Output: [real(r8) (:) ] water mass begining of the time step ) - if(use_aquifer_layer()) then + if(use_aquifer_layer) then do fc = 1, num_nolakec c = filter_nolakec(fc) if (col%hydrologically_active(c)) then diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index c15acbe520..4394d979b1 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -241,7 +241,8 @@ end function irrigation_params_constructor !------------------------------------------------------------------------ subroutine IrrigationInit(this, bounds, NLFilename, & - soilstate_inst, soil_water_retention_curve) + soilstate_inst, soil_water_retention_curve, & + use_aquifer_layer) use SoilStateType , only : soilstate_type class(irrigation_type) , intent(inout) :: this @@ -249,8 +250,9 @@ subroutine IrrigationInit(this, bounds, NLFilename, & character(len=*) , intent(in) :: NLFilename ! Namelist filename type(soilstate_type) , intent(in) :: soilstate_inst class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run - call this%ReadNamelist(NLFilename) + call this%ReadNamelist(NLFilename, use_aquifer_layer) call this%InitAllocate(bounds) call this%InitHistory(bounds) call this%InitCold(bounds, soilstate_inst, soil_water_retention_curve) @@ -292,7 +294,7 @@ subroutine InitForTesting(this, bounds, params, dtime, & end subroutine InitForTesting !----------------------------------------------------------------------- - subroutine ReadNamelist(this, NLFilename) + subroutine ReadNamelist(this, NLFilename, use_aquifer_layer) ! ! !DESCRIPTION: ! Read the irrigation namelist @@ -305,8 +307,9 @@ subroutine ReadNamelist(this, NLFilename) use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) ! ! !ARGUMENTS: - character(len=*), intent(in) :: NLFilename ! Namelist filename class(irrigation_type) , intent(inout) :: this + character(len=*), intent(in) :: NLFilename ! Namelist filename + logical, intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: @@ -394,19 +397,19 @@ subroutine ReadNamelist(this, NLFilename) write(iulog,*) 'irrig_depth = ', irrig_depth write(iulog,*) 'irrig_threshold_fraction = ', irrig_threshold_fraction write(iulog,*) 'limit_irrigation_if_rof_enabled = ', limit_irrigation_if_rof_enabled - write(iulog,*) 'use_groundwate_irrigation = ', use_groundwater_irrigation + write(iulog,*) 'use_groundwater_irrigation = ', use_groundwater_irrigation if (limit_irrigation_if_rof_enabled) then write(iulog,*) 'irrig_river_volume_threshold = ', irrig_river_volume_threshold end if write(iulog,*) ' ' - call this%CheckNamelistValidity() + call this%CheckNamelistValidity(use_aquifer_layer) end if end subroutine ReadNamelist !----------------------------------------------------------------------- - subroutine CheckNamelistValidity(this) + subroutine CheckNamelistValidity(this, use_aquifer_layer) ! ! !DESCRIPTION: ! Check for validity of input parameters. @@ -416,11 +419,9 @@ subroutine CheckNamelistValidity(this) ! Only needs to be called by the master task, since parameters are the same for all ! tasks. ! - ! !USES: - use SoilWaterMovementMod , only : use_aquifer_layer - ! ! !ARGUMENTS: class(irrigation_type), intent(in) :: this + logical, intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: @@ -491,7 +492,7 @@ subroutine CheckNamelistValidity(this) end if end if - if (use_aquifer_layer() .and. use_groundwater_irrigation) then + if (use_aquifer_layer .and. use_groundwater_irrigation) then write(iulog,*) ' ERROR: use_groundwater_irrigation and use_aquifer_layer may not be used simultaneously' call endrun(msg=' ERROR: use_groundwater_irrigation and use_aquifer_layer cannot both be set to true' // & errMsg(sourcefile, __LINE__)) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 931705e096..d23cd4d377 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -44,6 +44,7 @@ module clm_driver use LakeHydrologyMod , only : LakeHydrology use SoilHydrologyMod , only : CalcAvailableUnconfinedAquifer use SoilHydrologyMod , only : WithdrawGroundwaterIrrigation + use SoilWaterMovementMod , only : use_aquifer_layer ! use AerosolMod , only : AerosolMasses use SnowSnicarMod , only : SnowAge_grain @@ -341,7 +342,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & soilhydrology_inst, water_inst%waterstatebulk_inst, & - water_inst%waterdiagnosticbulk_inst, water_inst%waterbalancebulk_inst) + water_inst%waterdiagnosticbulk_inst, water_inst%waterbalancebulk_inst, & + use_aquifer_layer = use_aquifer_layer()) call t_stopf('begwbal') diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index 23a431e581..f9fdafb816 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -82,6 +82,7 @@ module clm_instMod use SurfaceAlbedoMod , only : SurfaceAlbedoInitTimeConst use LakeCon , only : LakeConInit use SoilBiogeochemPrecisionControlMod, only: SoilBiogeochemPrecisionControlInit + use SoilWaterMovementMod , only : use_aquifer_layer ! implicit none public ! By default everything is public @@ -324,7 +325,8 @@ subroutine clm_instInit(bounds) allocate(soil_water_retention_curve, & source=create_soil_water_retention_curve()) - call irrigation_inst%init(bounds, nlfilename, soilstate_inst, soil_water_retention_curve) + call irrigation_inst%init(bounds, nlfilename, soilstate_inst, soil_water_retention_curve, & + use_aquifer_layer = use_aquifer_layer()) call topo_inst%Init(bounds) From cc565a0db4038e4b3b247d01173c3627bb2777a1 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 9 Nov 2018 06:51:56 -0700 Subject: [PATCH 18/41] Remove notes that are no longer relevant --- src/biogeophys/test/Irrigation_test/README | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/README b/src/biogeophys/test/Irrigation_test/README index 3619bfddba..240a541f49 100644 --- a/src/biogeophys/test/Irrigation_test/README +++ b/src/biogeophys/test/Irrigation_test/README @@ -52,17 +52,3 @@ test. This is important because, if an assertion fails, a test immediately exits. That means that manual teardown is skipped, whereas this automatic teardown still happens. This, in turn, is important so that the remaining tests can still run properly. - ---- Notes about separation into multiple files --- - -I have separated tests based on what needs to be done for the setup and teardown -of each test. Tests that need identical setup and teardown (or lack thereof) are -grouped together. - -IrrigationWrapperMod contains routines that are used by both the singlepatch and -multipatch tests. In terms of setup and teardown: I have put setup stuff in here -that is in common for both the singlepatch and multipatch tests. I then do the -symmetrical teardown here, as well (e.g., if a variable foo is allocated in -IrrigationWrapperMod, I also deallocate it in the teardown routine in -IrrigationWrapperMod). The setup done in the .pf files themselves is stuff that -differs between singlepatch and multipatch (or between individual tests). From 073e067dae861304c5ef06d7b53d597ebb38ab09 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 9 Nov 2018 06:52:09 -0700 Subject: [PATCH 19/41] Remove unused arguments --- src/biogeophys/SoilHydrologyMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 2c76f265bc..ba58c09a15 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2570,7 +2570,7 @@ end subroutine CalcAvailableUnconfinedAquifer !#9 !----------------------------------------------------------------------- subroutine WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, filter_hydrologyc, & - num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + soilhydrology_inst, soilstate_inst, & waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: From 3430e42f236d501809b6e902660a018c7ab83f84 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 9 Nov 2018 07:49:41 -0700 Subject: [PATCH 20/41] add UseGroundwaterIrrigation conditional, clean up water balance check --- src/biogeophys/BalanceCheckMod.F90 | 20 ++------------------ src/biogeophys/IrrigationMod.F90 | 18 ++++++++++++++++++ src/biogeophys/SoilHydrologyMod.F90 | 21 +++++++++++++++------ src/main/clm_driver.F90 | 12 +++++++----- 4 files changed, 42 insertions(+), 29 deletions(-) diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index 6775cc4b67..57e1171d74 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -272,12 +272,7 @@ subroutine BalanceCheck( bounds, & snow_sources => waterfluxbulk_inst%snow_sources_col , & ! Output: [real(r8) (:) ] snow sources (mm H2O /s) snow_sinks => waterfluxbulk_inst%snow_sinks_col , & ! Output: [real(r8) (:) ] snow sinks (mm H2O /s) - qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) - qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col , & ! Input: [real(r8) (:) ] groundwater irrigation flux (mm H2O /s) - qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col , & ! Input: [real(r8) (:) ] groundwater irrigation flux (mm H2O /s) - qflx_irrig_drip => waterfluxbulk_inst%qflx_irrig_drip_col , & ! Input: [real(r8) (:) ] drip irrigation flux (mm H2O /s) - qflx_irrig_sprinkler => waterfluxbulk_inst%qflx_irrig_sprinkler_col , & ! Input: [real(r8) (:) ] sprinkler irrigation flux (mm H2O /s) - + qflx_sfc_irrig => waterfluxbulk_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) qflx_glcice_dyn_water_flux => waterfluxbulk_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) @@ -349,10 +344,7 @@ subroutine BalanceCheck( bounds, & - (forc_rain_col(c) & + forc_snow_col(c) & + qflx_floodc(c) & - + qflx_irrig_drip(c) & - + qflx_irrig_sprinkler(c) & - - qflx_gw_uncon_irrig(c) & - - qflx_gw_con_irrig(c) & + + qflx_sfc_irrig(c) & + qflx_glcice_dyn_water_flux(c) & - qflx_evap_tot(c) & - qflx_surf(c) & @@ -401,11 +393,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'endwb = ',endwb(indexc) write(iulog,*)'begwb = ',begwb(indexc) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_irrig_drip = ',qflx_irrig_drip(indexc)*dtime - write(iulog,*)'qflx_irrig_sprinkler = ',qflx_irrig_sprinkler(indexc)*dtime write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime - write(iulog,*)'qflx_gw_uncon_irrig = ',qflx_gw_uncon_irrig(indexc)*dtime - write(iulog,*)'qflx_gw_con_irrig = ',qflx_gw_con_irrig(indexc)*dtime write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime @@ -435,11 +423,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'begwb = ',begwb(indexc) write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_irrig_drip = ',qflx_irrig_drip(indexc)*dtime - write(iulog,*)'qflx_irrig_sprinkler = ',qflx_irrig_sprinkler(indexc)*dtime write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime - write(iulog,*)'qflx_gw_uncon_irrig = ',qflx_gw_uncon_irrig(indexc)*dtime - write(iulog,*)'qflx_gw_con_irrig = ',qflx_gw_con_irrig(indexc)*dtime write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index c15acbe520..43bae94886 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -147,6 +147,7 @@ module IrrigationMod ! Public simply to support unit testing; should not be used from CLM code procedure, public :: InitForTesting ! version of Init meant for unit testing procedure, public :: RelsatToH2osoi ! convert from relative saturation to kg/m2 water for a single column and layer + procedure, public :: UseGroundwaterIrrigation ! Returns true if groundwater irrigation enabled ! Private routines procedure, private :: ReadNamelist @@ -1308,4 +1309,21 @@ pure function RelsatToH2osoi(this, relsat, eff_porosity, dz) result(h2osoi_liq) end function RelsatToH2osoi + !----------------------------------------------------------------------- + function UseGroundwaterIrrigation(this) + ! + ! !DESCRIPTION: + ! Returns true if we're using groundwater irrigation in this run + ! + ! !ARGUMENTS: + implicit none + class(irrigation_type), intent(in) :: this + + logical :: UseGroundwaterIrrigation ! function result + !----------------------------------------------------------------------- + + UseGroundwaterIrrigation = this%params%use_groundwater_irrigation + + end function UseGroundwaterIrrigation + end module IrrigationMod diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 2c76f265bc..94035d0fa0 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2502,7 +2502,7 @@ subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrolo ! ! !DESCRIPTION: ! Calculate water in unconfined aquifer (i.e. soil column) that - ! is available for groundwater recharge. + ! is available for groundwater withdrawal. ! ! !USES: ! @@ -2569,12 +2569,15 @@ subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrolo end subroutine CalcAvailableUnconfinedAquifer !#9 !----------------------------------------------------------------------- - subroutine WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, filter_hydrologyc, & - num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & + subroutine WithdrawGroundwaterIrrigation(bounds, & + num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, soilstate_inst, & waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Remove groundwater irrigation from unconfined and confined aquifers + ! This routine is called when use_groundwater_irrigation = .true. + ! It is not compatible with use_aquifer_layer ! ! !USES: @@ -2611,9 +2614,7 @@ subroutine WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, filter_hydrolog qflx_gw_uncon_irrig => waterfluxbulk_inst%qflx_gw_uncon_irrig_col, & ! Input: [real(r8) (:) unconfined groundwater irrigation flux (mm H2O /s) qflx_gw_con_irrig => waterfluxbulk_inst%qflx_gw_con_irrig_col , & ! confined groundwater irrigation flux (mm H2O /s) - wa => waterstatebulk_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) - - + wa => waterstatebulk_inst%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) ) @@ -2634,6 +2635,14 @@ subroutine WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, filter_hydrolog call endrun(msg="negative groundwater irrigation!"//errmsg(sourcefile, __LINE__)) else + jwt(c) = nlevsoi + ! allow jwt to equal zero when zwt is in top layer + do j = 1,nlevsoi + if(zwt(c) <= zi(c,j)) then + jwt(c) = j-1 + exit + end if + enddo do j = jwt(c)+1, nbedrock(c) ! use analytical expression for specific yield s_y = watsat(c,j) & diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 931705e096..84d0d5b80a 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -439,11 +439,13 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('drvinit') ! Remove groundwater irrigation - call WithdrawGroundwaterIrrigation(bounds_clump, filter(nc)%num_hydrologyc, & - filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & - water_inst%waterstatebulk_inst, & - water_inst%waterfluxbulk_inst) - + if (irrigation_inst%UseGroundwaterIrrigation()) then + call WithdrawGroundwaterIrrigation(bounds_clump, filter(nc)%num_hydrologyc, & + filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & + water_inst%waterstatebulk_inst, & + water_inst%waterfluxbulk_inst) + endif + ! ============================================================================ ! Canopy Hydrology ! (1) water storage of intercepted precipitation From e309a6300200b944b985372a6c2fbe18e9b83755 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 9 Nov 2018 12:12:05 -0700 Subject: [PATCH 21/41] a few clean up items --- src/biogeophys/CanopyHydrologyMod.F90 | 4 ++-- src/biogeophys/IrrigationMod.F90 | 2 +- src/biogeophys/SoilHydrologyMod.F90 | 7 +------ src/main/surfrdMod.F90 | 3 ++- 4 files changed, 6 insertions(+), 10 deletions(-) diff --git a/src/biogeophys/CanopyHydrologyMod.F90 b/src/biogeophys/CanopyHydrologyMod.F90 index 1be6c0c887..0cfb2eeaab 100644 --- a/src/biogeophys/CanopyHydrologyMod.F90 +++ b/src/biogeophys/CanopyHydrologyMod.F90 @@ -316,7 +316,7 @@ subroutine CanopyHydrology(bounds, & ! determine fraction of input precipitation that is snow and rain fracsnow(p) = forc_snow(c)/(forc_snow(c) + qflx_liq_above_canopy(p)) - fracrain(p) = forc_rain(c)/(forc_snow(c) + qflx_liq_above_canopy(p)) + fracrain(p) = qflx_liq_above_canopy(p)/(forc_snow(c) + qflx_liq_above_canopy(p)) ! The leaf water capacities for solid and liquid are different, ! generally double for snow, but these are of somewhat less @@ -347,7 +347,7 @@ subroutine CanopyHydrology(bounds, & if (snowveg_on .or. snowveg_onrad) then ! Intercepted precipitation [mm/s] - qflx_prec_intr(p) = forc_snow(c)*fpisnow + (forc_rain(c) + qflx_irrig_sprinkler(p))*fpi + qflx_prec_intr(p) = forc_snow(c)*fpisnow + qflx_liq_above_canopy(p)*fpi ! storage of intercepted snowfall, rain, and dew snocan(p) = max(0._r8, snocan(p) + dtime*forc_snow(c)*fpisnow) liqcan(p) = max(0._r8, liqcan(p) + dtime*qflx_liq_above_canopy(p)*fpi) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 90cd3e21d7..ac6c77a213 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -129,7 +129,7 @@ module IrrigationMod integer , pointer :: irrig_method_patch (:) ! patch irrigation application method ! Private data members; time-varying: - real(r8), pointer :: sfc_irrig_rate_patch (:) ! current irrigation rate [mm/s] + real(r8), pointer :: sfc_irrig_rate_patch (:) ! current irrigation rate from surface water [mm/s] real(r8), pointer :: irrig_rate_demand_patch (:) ! current irrigation rate, neglecting surface water source limitation [mm/s] integer , pointer :: n_irrig_steps_left_patch (:) ! number of time steps for which we still need to irrigate today (if 0, ignore) real(r8), pointer :: qflx_irrig_demand_patch (:) ! irrigation flux neglecting surface water source limitation [mm/s] diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 94035d0fa0..ad1bf60f3b 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2007,14 +2007,11 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: - integer :: jwt(bounds%begc:bounds%endc) ! index of the soil layer right above the water table (-) integer :: c,j,fc,i ! indices integer :: k,k_zwt real(r8) :: sat_lev real(r8) :: s1,s2,m,b ! temporary variables used to interpolate theta integer :: sat_flag - real(r8) :: s_y - real(r8) :: available_water_layer !----------------------------------------------------------------------- @@ -2026,8 +2023,6 @@ subroutine ThetaBasedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] - bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" - sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) zwt => soilhydrology_inst%zwt_col & ! Output: [real(r8) (:) ] water table depth (m) ) @@ -2259,7 +2254,7 @@ subroutine LateralFlowPowerLaw(bounds, num_hydrologyc, filter_hydrologyc, & endif !-- Now remove water via rsub_top - rsub_top_tot = - (rsub_top(c)* dtime) + rsub_top_tot = - rsub_top(c)* dtime !should never be positive... but include for completeness if(rsub_top_tot > 0.) then !rising water table diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index ee48318025..b9d4eaa32d 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -644,6 +644,7 @@ subroutine surfrd_pftformat( begg, endg, ncid ) ! !USES: use clm_instur , only : fert_cft, irrig_method, wt_nat_patch use clm_varpar , only : natpft_size, cft_size, natpft_lb + use IrrigationMod , only : irrig_method_unset ! !ARGUMENTS: implicit none integer, intent(in) :: begg, endg @@ -688,7 +689,7 @@ subroutine surfrd_pftformat( begg, endg, ncid ) ' must also have a separate crop landunit, and vice versa)'//& errMsg(sourcefile, __LINE__)) end if - irrig_method = 0 + irrig_method = irrig_method_unset call ncd_io(ncid=ncid, varname='PCT_NAT_PFT', flag='read', data=wt_nat_patch, & dim1name=grlnd, readvar=readvar) From 12e87b5de10733c30250c498318aa26d6f8d8dbe Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Fri, 9 Nov 2018 13:52:19 -0700 Subject: [PATCH 22/41] fix histFileMod --- src/main/histFileMod.F90 | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index cd27d61448..0b79cb0244 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3086,16 +3086,12 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='cols1d_jxy', xtype=ncd_int, dim1name=namec, & long_name='2d latitude index of corresponding column', ncid=ncid) - call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name='column', & + call ncd_defvar(varname='cols1d_gi', xtype=ncd_int, dim1name=namec, & long_name='1d grid index of corresponding column', ncid=ncid) - call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name='column', & - long_name='1d landunit index of corresponding column', ncid=ncid) - call ncd_defvar(varname='cols1d_li', xtype=ncd_int, dim1name=namec, & long_name='1d landunit index of corresponding column', ncid=ncid) - call ncd_defvar(varname='cols1d_wtgcell', xtype=ncd_double, dim1name=namec, & long_name='column weight relative to corresponding gridcell', ncid=ncid) @@ -3126,15 +3122,12 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='pfts1d_jxy', xtype=ncd_int, dim1name=namep, & long_name='2d latitude index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name='pft', & + call ncd_defvar(varname='pfts1d_gi', xtype=ncd_int, dim1name=namep, & long_name='1d grid index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name='pft', & + call ncd_defvar(varname='pfts1d_li', xtype=ncd_int, dim1name=namep, & long_name='1d landunit index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name='pft', & - long_name='1d column index of corresponding pft', ncid=ncid) - call ncd_defvar(varname='pfts1d_ci', xtype=ncd_int, dim1name=namep, & long_name='1d column index of corresponding pft', ncid=ncid) From 2b33248d3e954c89ce39f7da7e2937708b10dcdd Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 9 Nov 2018 15:41:27 -0700 Subject: [PATCH 23/41] Add consistency check for use_groundwater_irrigation --- bld/CLMBuildNamelist.pm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 853d8e167f..8bd59d2802 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2784,6 +2784,11 @@ sub setup_logic_irrigation_parameters { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var); } + my $lower = $nl->get_value( 'lower_boundary_condition' ); + if ( ($lower == 3 || $lower == 4) && (&value_is_true($nl->get_value( 'use_groundwater_irrigation' ))) ) { + $log->fatal_error("use_groundwater_irrigation can only be used when lower_boundary_condition is NOT 3 or 4"); + } + $var = "irrig_river_volume_threshold"; if ( &value_is_true($nl->get_value("limit_irrigation_if_rof_enabled")) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var); From 2e53b7f7081e569d208110e46054e31a688ebca4 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 12 Nov 2018 12:46:52 -0700 Subject: [PATCH 24/41] Get irrigation unit tests passing --- src/biogeophys/IrrigationMod.F90 | 68 ++-- .../test/Irrigation_test/test_irrigation.pf | 344 ++++++++++++++++-- 2 files changed, 349 insertions(+), 63 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index ac6c77a213..5327f04fde 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -46,6 +46,8 @@ module IrrigationMod use decompMod , only : bounds_type, get_proc_global use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun + use clm_instur , only : irrig_method + use pftconMod , only : pftcon use clm_varctl , only : iulog use clm_varcon , only : isecspday, denh2o, spval, ispval, namec, nameg use clm_varpar , only : nlevsoi, nlevgrnd @@ -156,6 +158,7 @@ module IrrigationMod procedure, private :: InitHistory => IrrigationInitHistory procedure, private :: InitCold => IrrigationInitCold procedure, private :: CalcIrrigNstepsPerDay ! given dtime, calculate irrig_nsteps_per_day + procedure, private :: SetIrrigMethod ! set irrig_method_patch based on surface dataset procedure, private :: PointNeedsCheckForIrrig ! whether a given point needs to be checked for irrigation now procedure, private :: CalcDeficitVolrLimited ! calculate deficit limited by river volume for each patch end type irrigation_type @@ -180,9 +183,9 @@ module IrrigationMod ! Irrigation methods integer, parameter, public :: irrig_method_unset = 0 ! Drip is defined here as irrigation applied directly to soil surface - integer, parameter, private :: irrig_method_drip = 1 + integer, parameter, public :: irrig_method_drip = 1 ! Sprinkler is applied directly to canopy - integer, parameter, private :: irrig_method_sprinkler = 2 + integer, parameter, public :: irrig_method_sprinkler = 2 character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -288,6 +291,7 @@ subroutine InitForTesting(this, bounds, params, dtime, & call this%InitAllocate(bounds) this%params = params this%dtime = dtime + call this%SetIrrigMethod(bounds) this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(dtime) this%relsat_wilting_point_col(:,:) = relsat_wilting_point(:,:) this%relsat_target_col(:,:) = relsat_target(:,:) @@ -573,8 +577,6 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention ! ! !USES: use SoilStateType , only : soilstate_type - use clm_instur , only : irrig_method - use pftconMod , only : pftcon ! ! !ARGUMENTS: class(irrigation_type) , intent(inout) :: this @@ -583,10 +585,7 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve ! ! !LOCAL VARIABLES: - integer :: m ! dummy index - integer :: p ! patch index integer :: c ! col index - integer :: g ! gridcell index integer :: j ! level index character(len=*), parameter :: subname = 'InitCold' @@ -623,23 +622,7 @@ subroutine IrrigationInitCold(this, bounds, soilstate_inst, soil_water_retention end do end do - do p = bounds%begp,bounds%endp - g = patch%gridcell(p) - if (pftcon%irrigated(patch%itype(p)) == 1._r8) then - m = patch%itype(p) - this%irrig_method_patch(p) = irrig_method(g,m) - ! ensure irrig_method is valid; if not set, use drip irrigation - if(irrig_method(g,m) == irrig_method_unset) then - this%irrig_method_patch(p) = irrig_method_drip - else if (irrig_method(g,m) /= irrig_method_drip .and. irrig_method(g,m) /= irrig_method_sprinkler) then - write(iulog,*) subname //' invalid irrigation method specified' - call endrun(decomp_index=g, clmlevel=nameg, msg='bad irrig_method '// & - errMsg(sourcefile, __LINE__)) - end if - else - this%irrig_method_patch(p) = irrig_method_drip - end if - end do + call this%SetIrrigMethod(bounds) this%dtime = get_step_size() this%irrig_nsteps_per_day = this%CalcIrrigNstepsPerDay(this%dtime) @@ -670,6 +653,43 @@ pure function CalcIrrigNstepsPerDay(this, dtime) result(irrig_nsteps_per_day) end function CalcIrrigNstepsPerDay + !----------------------------------------------------------------------- + subroutine SetIrrigMethod(this, bounds) + ! + ! !DESCRIPTION: + ! Set this%irrig_method_patch based on surface dataset + ! + ! !ARGUMENTS: + class(irrigation_type) , intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p ! patch index + integer :: g ! gridcell index + integer :: m ! patch itype + + character(len=*), parameter :: subname = 'SetIrrigMethod' + !----------------------------------------------------------------------- + + do p = bounds%begp,bounds%endp + g = patch%gridcell(p) + if (pftcon%irrigated(patch%itype(p)) == 1._r8) then + m = patch%itype(p) + this%irrig_method_patch(p) = irrig_method(g,m) + ! ensure irrig_method is valid; if not set, use drip irrigation + if(irrig_method(g,m) == irrig_method_unset) then + this%irrig_method_patch(p) = irrig_method_drip + else if (irrig_method(g,m) /= irrig_method_drip .and. irrig_method(g,m) /= irrig_method_sprinkler) then + write(iulog,*) subname //' invalid irrigation method specified' + call endrun(decomp_index=g, clmlevel=nameg, msg='bad irrig_method '// & + errMsg(sourcefile, __LINE__)) + end if + else + this%irrig_method_patch(p) = irrig_method_drip + end if + end do + + end subroutine SetIrrigMethod !----------------------------------------------------------------------- diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index 39af7d35d4..11f2cc76bb 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -8,7 +8,9 @@ module test_irrigation use unittestTimeManagerMod, only : unittest_timemgr_set_curr_date use clm_time_manager, only: advance_timestep use IrrigationMod, only : irrigation_type, irrigation_params_type + use IrrigationMod, only : irrig_method_drip, irrig_method_sprinkler use shr_kind_mod, only : r8 => shr_kind_r8 + use clm_instur, only : irrig_method use clm_varpar, only : nlevsoi, nlevgrnd use landunit_varcon, only : istsoil use WaterFluxBulkType, only : waterfluxbulk_type @@ -44,6 +46,7 @@ module test_irrigation real(r8), allocatable :: relsat_wilting_point(:,:) real(r8), allocatable :: relsat_target(:,:) real(r8), allocatable :: volr(:) + real(r8), allocatable :: available_gw_uncon(:) contains procedure :: setUp @@ -58,6 +61,34 @@ module test_irrigation ! Wrapper that calls both CalcIrrigationNeeded and ApplyIrrigation procedure :: calculateAndApplyIrrigation + + ! Return total irrigation withdrawal for a given patch + procedure :: totalIrrigationWithdrawal + + ! Return total irrigation application for a given patch + procedure :: totalIrrigationApplication + + ! Return total irrigation withdrawal for a given column + procedure :: totalIrrigationWithdrawalCol + + ! Return total irrigation application for a given column + procedure :: totalIrrigationApplicationCol + + ! Assert that total irrigation withdrawal and application both equal expected for a + ! given patch + procedure :: assertTotalIrrigationEquals + + ! Assert that total irrigation withdrawal and application both equal expected for a + ! given column + procedure :: assertTotalIrrigationEqualsCol + + ! Assert that total irrigation withdrawal and application are both exactly zero for a + ! given patch + procedure :: assertTotalIrrigationZero + + ! Assert that total irrigation withdrawal and application are both greater than zero + ! for a given patch + procedure :: assertTotalIrrigationGreaterThanZero end type TestIrrigation real(r8), parameter :: mm_times_km2_to_m3 = 1.e3_r8 @@ -94,8 +125,16 @@ contains call unittest_timemgr_teardown() call this%irrigation%Clean() - deallocate(this%waterflux%qflx_irrig_patch) - deallocate(this%waterflux%qflx_irrig_col) + deallocate(this%waterflux%qflx_sfc_irrig_patch) + deallocate(this%waterflux%qflx_sfc_irrig_col) + deallocate(this%waterflux%qflx_gw_uncon_irrig_patch) + deallocate(this%waterflux%qflx_gw_uncon_irrig_col) + deallocate(this%waterflux%qflx_gw_con_irrig_patch) + deallocate(this%waterflux%qflx_gw_con_irrig_col) + deallocate(this%waterflux%qflx_irrig_drip_patch) + deallocate(this%waterflux%qflx_irrig_drip_col) + deallocate(this%waterflux%qflx_irrig_sprinkler_patch) + deallocate(this%waterflux%qflx_irrig_sprinkler_col) call this%teardownEnvironment() call unittest_subgrid_teardown() end subroutine tearDown @@ -121,8 +160,12 @@ contains ! at every level EXCEPT for relsat_wilting_point and relsat_target, which vary ! linearly by level and col number. ! + ! Irrigation method is set up to be drip + ! ! volr is set up to be non-limiting ! + ! Set up to *not* do groundwater irrigation by default + ! ! Assumes that nlevgrnd and nlevsoi have been set, and that all necessary subgrid ! setup has been completed. ! @@ -188,11 +231,21 @@ contains irrig_depth = irrig_depth, & irrig_threshold_fraction = 0.5_r8, & irrig_river_volume_threshold = l_irrig_river_volume_threshold, & - limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled) - - ! Allocate fluxes output from irrigation routines - allocate(this%waterflux%qflx_irrig_patch(bounds%begp:bounds%endp)) - allocate(this%waterflux%qflx_irrig_col(bounds%begc:bounds%endc)) + limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled, & + use_groundwater_irrigation = .false.) + + ! Allocate fluxes output from irrigation routines. Note that, in the production code, + ! these are initialized to 0 in InitCold. + allocate(this%waterflux%qflx_sfc_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_sfc_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_gw_con_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_irrig_drip_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_irrig_drip_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), source=0._r8) ! Set inputs to irrigation routines allocate(this%elai(bounds%begp:bounds%endp), source=10._r8) @@ -204,6 +257,9 @@ contains ! By default, volr will be very limiting... but this should have no effect if ! limit_irrigation_if_rof_enabled is false (the default) allocate(this%volr(bounds%begg:bounds%endg), source=0._r8) + ! By default, available_gw_uncon is very limiting... but this should have no effect + ! if use_groundwater_irrigation is false (the default) + allocate(this%available_gw_uncon(bounds%begc:bounds%endc), source=0._r8) do j = 1, nlevsoi do c = bounds%begc, bounds%endc @@ -230,6 +286,8 @@ contains ! Assumes nlevgrnd and nlevsoi have been set, and that all necessary subgrid setup has ! been completed. ! + ! Sets up irrigation method to be drip by default + ! ! !ARGUMENTS: class(TestIrrigation), intent(in) :: this integer, intent(in) :: maxpft ! max pft type that needs to be supported @@ -240,6 +298,10 @@ contains allocate(pftcon%irrigated(0:maxpft), source=1.0_r8) + ! In the production code, irrig_method goes cft_lb:cft_ub; but it's safe to allocate + ! more space than we really need here. + allocate(irrig_method(bounds%begg:bounds%endg, 0:maxpft), source=irrig_method_drip) + col%dz(:,1:nlevgrnd) = 1.0_r8 do j = 1, nlevgrnd do c = bounds%begc, bounds%endc @@ -276,6 +338,7 @@ contains !----------------------------------------------------------------------- deallocate(pftcon%irrigated) + deallocate(irrig_method) end subroutine teardownEnvironment @@ -332,6 +395,10 @@ contains class(TestIrrigation), intent(inout) :: this ! ! !LOCAL VARIABLES: + integer :: apply_nump + integer, allocatable :: apply_filterp(:) + integer :: apply_numc + integer, allocatable :: apply_filterc(:) character(len=*), parameter :: subname = 'calculateAndApplyIrrigation' !----------------------------------------------------------------------- @@ -346,11 +413,210 @@ contains h2osoi_liq = this%h2osoi_liq, & volr = this%volr, & rof_prognostic = .true.) - - call this%irrigation%ApplyIrrigation(bounds, this%waterflux) + + ! The expectation is that the filter used in CalcIrrigationNeeded is a subset of the + ! filter used in ApplyIrrigation. In order to (a) keep the unit tests simpler, and (b) + ! ensure that it works for the ApplyIrrigation filter to have points not in the + ! CalcIrrigationNeededFilter, we send ApplyIrrigation a filter that includes all + ! points. (The one situation where the ApplyIrrigation filter might include points not + ! in the CalcIrrigationNeeded filter is if a point that was inactive at the time of + ! the CalcIrrigationNeeded call has become active for the ApplyIrrigation call; in + ! this case, if there were still some irrigation time steps left when it had become + ! inactive, then ApplyIrrigation might start re-irrigating there. But this behavior + ! is probably okay; in any case, it doesn't seem worth testing for.) + call filter_from_range(start=bounds%begp, end=bounds%endp, & + numf=apply_nump, filter=apply_filterp) + call filter_from_range(start=bounds%begc, end=bounds%endc, & + numf=apply_numc, filter=apply_filterc) + + call this%irrigation%ApplyIrrigation( & + bounds = bounds, & + num_soilc = apply_numc, & + filter_soilc = apply_filterc, & + num_soilp = apply_nump, & + filter_soilp = apply_filterp, & + waterfluxbulk_inst = this%waterflux, & + available_gw_uncon = this%available_gw_uncon) end subroutine calculateAndApplyIrrigation + !----------------------------------------------------------------------- + function totalIrrigationWithdrawal(this, p) result(total_withdrawal) + ! + ! !DESCRIPTION: + ! Return total irrigation withdrawal for patch p + ! + ! !ARGUMENTS: + real(r8), allocatable :: total_withdrawal ! function result + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: p ! patch index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'totalIrrigationWithdrawal' + !----------------------------------------------------------------------- + + total_withdrawal = & + this%waterflux%qflx_sfc_irrig_patch(p) + & + this%waterflux%qflx_gw_uncon_irrig_patch(p) + & + this%waterflux%qflx_gw_con_irrig_patch(p) + + end function totalIrrigationWithdrawal + + !----------------------------------------------------------------------- + function totalIrrigationApplication(this, p) result(total_application) + ! + ! !DESCRIPTION: + ! Return total irrigation application for patch p + ! + ! !ARGUMENTS: + real(r8), allocatable :: total_application ! function result + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: p ! patch index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'totalIrrigationApplication' + !----------------------------------------------------------------------- + + total_application = & + this%waterflux%qflx_irrig_drip_patch(p) + & + this%waterflux%qflx_irrig_sprinkler_patch(p) + + end function totalIrrigationApplication + + !----------------------------------------------------------------------- + function totalIrrigationWithdrawalCol(this, c) result(total_withdrawal) + ! + ! !DESCRIPTION: + ! Return total irrigation withdrawal for column c + ! + ! !ARGUMENTS: + real(r8), allocatable :: total_withdrawal ! function result + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: c ! column index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'totalIrrigationWithdrawalCol' + !----------------------------------------------------------------------- + + total_withdrawal = & + this%waterflux%qflx_sfc_irrig_col(c) + & + this%waterflux%qflx_gw_uncon_irrig_col(c) + & + this%waterflux%qflx_gw_con_irrig_col(c) + + end function totalIrrigationWithdrawalCol + + !----------------------------------------------------------------------- + function totalIrrigationApplicationCol(this, c) result(total_application) + ! + ! !DESCRIPTION: + ! Return total irrigation application for column c + ! + ! !ARGUMENTS: + real(r8), allocatable :: total_application ! function result + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: c ! column index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'totalIrrigationApplicationCol' + !----------------------------------------------------------------------- + + total_application = & + this%waterflux%qflx_irrig_drip_col(c) + & + this%waterflux%qflx_irrig_sprinkler_col(c) + + end function totalIrrigationApplicationCol + + !----------------------------------------------------------------------- + subroutine assertTotalIrrigationEquals(this, p, expected) + ! + ! !DESCRIPTION: + ! Assert that total irrigation withdrawal and application both equal expected for a + ! given patch + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: p ! patch index + real(r8), intent(in) :: expected + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'assertTotalIrrigationEquals' + !----------------------------------------------------------------------- + + @assertEqual(expected, this%totalIrrigationWithdrawal(p), tolerance=tol) + @assertEqual(expected, this%totalIrrigationApplication(p), tolerance=tol) + + end subroutine assertTotalIrrigationEquals + + !----------------------------------------------------------------------- + subroutine assertTotalIrrigationEqualsCol(this, c, expected) + ! + ! !DESCRIPTION: + ! Assert that total irrigation withdrawal and application both equal expected for a + ! given column + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: c ! column index + real(r8), intent(in) :: expected + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'assertTotalIrrigationEqualsCol' + !----------------------------------------------------------------------- + + @assertEqual(expected, this%totalIrrigationWithdrawalCol(c), tolerance=tol) + @assertEqual(expected, this%totalIrrigationApplicationCol(c), tolerance=tol) + + end subroutine assertTotalIrrigationEqualsCol + + !----------------------------------------------------------------------- + subroutine assertTotalIrrigationZero(this, p) + ! + ! !DESCRIPTION: + ! Assert that total irrigation withdrawal and application are both exactly zero for a + ! given patch + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: p ! patch index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'assertTotalIrrigationZero' + !----------------------------------------------------------------------- + + @assertEqual(0._r8, this%totalIrrigationWithdrawal(p)) + @assertEqual(0._r8, this%totalIrrigationApplication(p)) + + end subroutine assertTotalIrrigationZero + + !----------------------------------------------------------------------- + subroutine assertTotalIrrigationGreaterThanZero(this, p) + ! + ! !DESCRIPTION: + ! Assert that total irrigation withdrawal and application are both greater than zero + ! for a given patch + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(in) :: this + integer, intent(in) :: p ! patch index + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'assertTotalIrrigationGreaterThanZero' + !----------------------------------------------------------------------- + + @assertLessThan(0._r8, this%totalIrrigationWithdrawal(p)) + @assertLessThan(0._r8, this%totalIrrigationApplication(p)) + + end subroutine assertTotalIrrigationGreaterThanZero + + ! ======================================================================== ! Begin actual tests ! ======================================================================== @@ -375,7 +641,7 @@ contains ! Check result call this%computeDeficits(deficits) expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_flux_is_correct @@ -392,7 +658,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_wet_soil @Test @@ -422,7 +688,7 @@ contains ! This first assertion makes sure the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here is the main assertion: - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine surplus_offsets_deficit @Test @@ -440,7 +706,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_unirrigated_pfts @@ -457,7 +723,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_lai0 @@ -484,7 +750,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_soil_moisture_above_threshold @Test @@ -501,7 +767,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_at_wrong_time @@ -533,7 +799,7 @@ contains ! Check result expected = total_deficit / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine unlimited_irrigation_for_non_limiting_volr @Test @@ -566,7 +832,7 @@ contains expected = ((this%volr(begg) * (1._r8 - irrig_river_volume_threshold)) & / grc%area(begg) * m3_over_km2_to_mm) / & this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine limited_irrigation_for_limiting_volr @Test @@ -590,7 +856,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps @@ -613,11 +879,11 @@ contains call this%calculateAndApplyIrrigation() call advance_timestep() end do - @assertTrue(this%waterflux%qflx_irrig_patch(bounds%begp) > 0._r8) + call this%assertTotalIrrigationGreaterThanZero(bounds%begp) ! Ensure that irrigation flux goes to 0 in the following time step call this%calculateAndApplyIrrigation() - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine irrigation_continues_for_correct_number_of_time_steps @@ -644,7 +910,7 @@ contains call advance_timestep() end do ! The following assertion is mainly here to make sure the test is working as intended - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) ! Now reset time, change soil moisture, and make sure that irrigation happens as expected call unittest_timemgr_set_curr_date(yr=5, mon=1, day=1, tod=irrig_start+dtime) @@ -655,7 +921,7 @@ contains ! Make sure that the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here's the main assertion: - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_flux_is_correct_on_second_day @@ -678,7 +944,7 @@ contains call this%computeDeficits(deficits) ! Now on to the real assertion expected = sum(deficits(bounds%begp,1:nlevirrig)) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_excludes_deep_layers @Test @@ -699,7 +965,7 @@ contains ! Check result call this%computeDeficits(deficits) expected = sum(deficits(bounds%begp,1:(nlevsoi-1))) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_excludes_bedrock_layers @Test @@ -715,7 +981,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_frozen_soil @@ -737,7 +1003,7 @@ contains call this%computeDeficits(deficits) ! Only include deficit from top layer, since 2nd layer is frozen expected = deficits(bounds%begp, 1) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine no_irrigation_below_frozen_soil_layer @@ -774,9 +1040,9 @@ contains ! Check result call this%computeDeficits(deficits) expected1 = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length - @assertEqual(expected1, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected1) expected2 = sum(deficits(bounds%endp,1:nlevsoi)) / this%irrigation_params%irrig_length - @assertEqual(expected2, this%waterflux%qflx_irrig_patch(bounds%endp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%endp, expected2) ! Make sure this test had some power, by ensuring that the two points differ: @assertTrue(expected1 /= expected2) @@ -821,7 +1087,7 @@ contains total_deficit = sum(deficits(bounds%begp+1, 1:nlevsoi)) col_total_deficit = total_deficit * wt_irrig expected_col_flux = col_total_deficit / this%irrigation_params%irrig_length - @assertEqual(expected_col_flux, this%waterflux%qflx_irrig_col(bounds%begc), tolerance=tol) + call this%assertTotalIrrigationEqualsCol(bounds%begc, expected_col_flux) end subroutine multiple_patches_per_column @Test @@ -851,10 +1117,10 @@ contains ! Check result ! Irrigation happens within filter - @assertTrue(this%waterflux%qflx_irrig_patch(bounds%begp + 1) > 0._r8) + call this%assertTotalIrrigationGreaterThanZero((bounds%begp + 1)) ! Irrigation does NOT happen outside filter - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%endp)) + call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(bounds%endp) end subroutine irrigation_only_happens_within_filter @@ -895,13 +1161,13 @@ contains ! Check result call this%computeDeficits(deficits) ! First patch should have no irrigation, because soil is all frozen - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp)) + call this%assertTotalIrrigationZero(bounds%begp) ! Second patch should have irrigation just based on top layer, because 2nd layer is frozen expected = deficits(bounds%begp+1, 1) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%begp+1), tolerance=tol) + call this%assertTotalIrrigationEquals((bounds%begp+1), expected) ! Third patch should have irrigation from all layers expected = sum(deficits(bounds%endp,1:nlevsoi)) / this%irrigation_params%irrig_length - @assertEqual(expected, this%waterflux%qflx_irrig_patch(bounds%endp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%endp, expected) end subroutine test_multiple_patches_with_different_frozen_soil @@ -956,12 +1222,12 @@ contains ! Check result expected1 = total_deficit1*volr_fraction / this%irrigation_params%irrig_length - @assertEqual(expected1, this%waterflux%qflx_irrig_patch(bounds%begp), tolerance=tol) + call this%assertTotalIrrigationEquals(bounds%begp, expected1) expected2 = total_deficit2*volr_fraction / this%irrigation_params%irrig_length - @assertEqual(expected2, this%waterflux%qflx_irrig_patch(bounds%begp+1), tolerance=tol) + call this%assertTotalIrrigationEquals((bounds%begp+1), expected2) ! Check of unirrigated patch isn't central to this test, but we might as well check ! it while we're at it: - @assertEqual(0._r8, this%waterflux%qflx_irrig_patch(bounds%begp+2)) + call this%assertTotalIrrigationZero((bounds%begp+2)) end subroutine volr_limiting_with_multiple_columns end module test_irrigation From b0cabacff8217cd8214d0bf5caaffbb4931b6253 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 13 Nov 2018 13:38:41 -0700 Subject: [PATCH 25/41] Add unit tests covering new irrigation behavior Confirm that different withdrawal and application options set the correct fluxes --- .../test/Irrigation_test/test_irrigation.pf | 285 ++++++++++++++++-- 1 file changed, 263 insertions(+), 22 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index 11f2cc76bb..2db769e3e3 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -27,6 +27,7 @@ module test_irrigation real(r8), parameter :: tol = 1.e-13_r8 integer , parameter :: dtime = 1800 ! model time step, seconds integer , parameter :: irrig_start = 21600 + integer , parameter :: pft_type = 1 ! pft type in target patch for single-patch tests @TestCase type, extends(TestCase) :: TestIrrigation @@ -56,6 +57,9 @@ module test_irrigation procedure :: setupEnvironment procedure :: teardownEnvironment + ! Set volr for a gridcell and return volr-limited irrigation rate + procedure :: setVolr + ! Computes irrigation deficit for every patch and level procedure :: computeDeficits @@ -143,13 +147,13 @@ contains ! Sets up grid with single veg patch; also sets up this%filter appropriately class(TestIrrigation), intent(inout) :: this - call setup_single_veg_patch(pft_type=1) + call setup_single_veg_patch(pft_type=pft_type) call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) end subroutine setupSinglePatch !----------------------------------------------------------------------- subroutine setupIrrigation(this, maxpft, test_limit_irrigation, nlevirrig, & - irrig_river_volume_threshold) + irrig_river_volume_threshold, use_groundwater_irrigation, my_irrig_method) ! ! !DESCRIPTION: ! Do the setup needed for most tests. @@ -160,7 +164,7 @@ contains ! at every level EXCEPT for relsat_wilting_point and relsat_target, which vary ! linearly by level and col number. ! - ! Irrigation method is set up to be drip + ! Irrigation method is set up to be drip by default ! ! volr is set up to be non-limiting ! @@ -187,6 +191,12 @@ contains ! not given, defaults to 0.1 real(r8), intent(in), optional :: irrig_river_volume_threshold + ! Whether to use groundwater irrigation (false by default) + logical, intent(in), optional :: use_groundwater_irrigation + + ! Irrigation method (drip by default); just set for the module-level pft_type parameter + integer, intent(in), optional :: my_irrig_method + ! ! !LOCAL VARIABLES: integer :: c,j @@ -195,6 +205,7 @@ contains integer :: l_nlevirrig real(r8) :: irrig_depth real(r8) :: l_irrig_river_volume_threshold + logical :: l_use_groundwater_irrigation !----------------------------------------------------------------------- limit_irrigation_if_rof_enabled = .false. @@ -217,7 +228,12 @@ contains l_irrig_river_volume_threshold = irrig_river_volume_threshold end if - call this%setupEnvironment(maxpft=l_maxpft) + l_use_groundwater_irrigation = .false. + if (present(use_groundwater_irrigation)) then + l_use_groundwater_irrigation = use_groundwater_irrigation + end if + + call this%setupEnvironment(maxpft=l_maxpft, my_irrig_method=my_irrig_method) ! Set the irrigation depth to be just barely big enough to include the desired layers irrig_depth = col%z(bounds%begc,l_nlevirrig) + 1.e-9_r8 @@ -232,7 +248,7 @@ contains irrig_threshold_fraction = 0.5_r8, & irrig_river_volume_threshold = l_irrig_river_volume_threshold, & limit_irrigation_if_rof_enabled = limit_irrigation_if_rof_enabled, & - use_groundwater_irrigation = .false.) + use_groundwater_irrigation = l_use_groundwater_irrigation) ! Allocate fluxes output from irrigation routines. Note that, in the production code, ! these are initialized to 0 in InitCold. @@ -277,7 +293,7 @@ contains end subroutine setupIrrigation !----------------------------------------------------------------------- - subroutine setupEnvironment(this, maxpft) + subroutine setupEnvironment(this, maxpft, my_irrig_method) ! ! !DESCRIPTION: ! Sets up the external environment used by Irrigation - i.e., things accessed via @@ -291,16 +307,37 @@ contains ! !ARGUMENTS: class(TestIrrigation), intent(in) :: this integer, intent(in) :: maxpft ! max pft type that needs to be supported + + ! Irrigation method (drip by default); just set for the module-level pft_type parameter + integer, intent(in), optional :: my_irrig_method + ! + ! !LOCAL VARIABLES: integer :: c,j + integer :: l_my_irrig_method + integer :: different_irrig_method !----------------------------------------------------------------------- + l_my_irrig_method = irrig_method_drip + if (present(my_irrig_method)) then + l_my_irrig_method = my_irrig_method + end if + allocate(pftcon%irrigated(0:maxpft), source=1.0_r8) ! In the production code, irrig_method goes cft_lb:cft_ub; but it's safe to allocate ! more space than we really need here. - allocate(irrig_method(bounds%begg:bounds%endg, 0:maxpft), source=irrig_method_drip) + allocate(irrig_method(bounds%begg:bounds%endg, 0:maxpft)) + ! To help ensure that we read irrig_method from the correct index, set everything + ! except the desired index to a different method + if (l_my_irrig_method == irrig_method_drip) then + different_irrig_method = irrig_method_sprinkler + else + different_irrig_method = irrig_method_drip + end if + irrig_method(:,:) = different_irrig_method + irrig_method(bounds%begg:bounds%endg, pft_type) = l_my_irrig_method col%dz(:,1:nlevgrnd) = 1.0_r8 do j = 1, nlevgrnd @@ -342,6 +379,48 @@ contains end subroutine teardownEnvironment + !----------------------------------------------------------------------- + subroutine setVolr(this, g, irrig_deficit, irrig_river_volume_threshold, & + volr_diff_from_threshold, volr_limited_irrig_rate) + ! + ! !DESCRIPTION: + ! Set volr for a gridcell and return the volr-limited irrigation rate + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(inout) :: this + + ! Gridcell index + integer, intent(in) :: g + + ! Irrigation deficit for this grid cell (kg m-2) (i.e., mm) + real(r8), intent(in) :: irrig_deficit + + ! Parameter used in IrrigationMod (fraction) + real(r8), intent(in) :: irrig_river_volume_threshold + + ! Amount above (positive) or below (negative) the threshold point to set volr (m^3) + real(r8), intent(in) :: volr_diff_from_threshold + + ! Computed volr-limited irrigation rate (kg m-2 s-1) (i.e., mm/s) + real(r8), intent(out) :: volr_limited_irrig_rate + + ! + ! !LOCAL VARIABLES: + real(r8) :: volr_threshold ! m3 + + character(len=*), parameter :: subname = 'setVolr' + !----------------------------------------------------------------------- + + volr_threshold = (irrig_deficit * grc%area(g) * mm_times_km2_to_m3) / & + (1._r8 - irrig_river_volume_threshold) + this%volr(g) = volr_threshold + volr_diff_from_threshold + + volr_limited_irrig_rate = ((this%volr(g) * (1._r8 - irrig_river_volume_threshold)) & + / grc%area(g) * m3_over_km2_to_mm) / & + this%irrigation_params%irrig_length + + end subroutine setVolr + !----------------------------------------------------------------------- subroutine computeDeficits(this, deficits) ! @@ -645,6 +724,56 @@ contains end subroutine irrigation_flux_is_correct + @Test + subroutine drip(this) + ! Make sure that, if a point is set up for drip irrigation, then all irrigation comes + ! from drip + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call this%setupSinglePatch() + call this%setupIrrigation(my_irrig_method = irrig_method_drip) + + ! Call irrigation routines + call this%calculateAndApplyIrrigation() + + ! Check result + call this%computeDeficits(deficits) + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) + ! Make sure all irrigation comes from drip (both patch and column-level) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(bounds%begc), tolerance=tol) + + end subroutine drip + + @Test + subroutine sprinkler(this) + ! Make sure that, if a point is set up for drip irrigation, then all irrigation comes + ! from drip + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8) :: expected + + ! Setup + call this%setupSinglePatch() + call this%setupIrrigation(my_irrig_method = irrig_method_sprinkler) + + ! Call irrigation routines + call this%calculateAndApplyIrrigation() + + ! Check result + call this%computeDeficits(deficits) + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) + ! Make sure all irrigation comes from sprinkler (both patch and column-level) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(bounds%begc), tolerance=tol) + + end subroutine sprinkler + @Test subroutine no_irrigation_for_wet_soil(this) class(TestIrrigation), intent(inout) :: this @@ -778,7 +907,7 @@ contains real(r8), allocatable :: deficits(:,:) real(r8), parameter :: irrig_river_volume_threshold = 0.1_r8 real(r8) :: total_deficit ! kg m-2 (i.e., mm) - real(r8) :: volr_threshold ! m3 + real(r8) :: volr_limited_irrig_rate ! (unused) real(r8) :: expected ! Setup @@ -790,9 +919,11 @@ contains total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be just above the limiting amount - volr_threshold = (total_deficit * grc%area(begg) * mm_times_km2_to_m3) / & - (1._r8 - irrig_river_volume_threshold) - this%volr(begg) = volr_threshold + 10._r8 + call this%setVolr(g = begg, & + irrig_deficit = total_deficit, & + irrig_river_volume_threshold = irrig_river_volume_threshold, & + volr_diff_from_threshold = 10._r8, & + volr_limited_irrig_rate = volr_limited_irrig_rate) ! Call irrigation routines call this%calculateAndApplyIrrigation() @@ -800,40 +931,148 @@ contains ! Check result expected = total_deficit / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(bounds%begp, expected) + ! Make sure that all irrigation comes as surface irrigation (patch and column-level) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) end subroutine unlimited_irrigation_for_non_limiting_volr @Test - subroutine limited_irrigation_for_limiting_volr(this) + subroutine limited_irrigation_for_limiting_volr_no_groundwater(this) + ! liming volr with no groundwater irrigation use GridcellType, only : grc class(TestIrrigation), intent(inout) :: this real(r8), allocatable :: deficits(:,:) real(r8), parameter :: irrig_river_volume_threshold = 0.1_r8 real(r8) :: total_deficit ! kg m-2 (i.e., mm) - real(r8) :: volr_threshold ! m3 real(r8) :: expected ! Setup call this%setupSinglePatch() call this%setupIrrigation(test_limit_irrigation=.true., & - irrig_river_volume_threshold=irrig_river_volume_threshold) + irrig_river_volume_threshold=irrig_river_volume_threshold, & + use_groundwater_irrigation = .false.) call this%computeDeficits(deficits) total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - volr_threshold = (total_deficit * grc%area(begg) * mm_times_km2_to_m3) / & - (1._r8 - irrig_river_volume_threshold) - this%volr(begg) = volr_threshold - 10._r8 + call this%setVolr(g = begg, & + irrig_deficit = total_deficit, & + irrig_river_volume_threshold = irrig_river_volume_threshold, & + volr_diff_from_threshold = -10._r8, & + volr_limited_irrig_rate = expected) ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - expected = ((this%volr(begg) * (1._r8 - irrig_river_volume_threshold)) & - / grc%area(begg) * m3_over_km2_to_mm) / & - this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(bounds%begp, expected) - end subroutine limited_irrigation_for_limiting_volr + ! Make sure that all irrigation comes as surface irrigation (patch and column-level) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + end subroutine limited_irrigation_for_limiting_volr_no_groundwater + + @Test + subroutine limiting_volr_with_groundwater_uncon(this) + ! limiting volr, with the difference made up by groundwater from the unconfined aquifer + use GridcellType, only : grc + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8), parameter :: irrig_river_volume_threshold = 0.1_r8 + real(r8) :: total_deficit ! kg m-2 (i.e., mm) + real(r8) :: volr_limited_irrig_rate + real(r8) :: expected_total + real(r8) :: expected_gw_uncon ! expected rate from the unconfined aquifer + + ! Setup + call this%setupSinglePatch() + call this%setupIrrigation(test_limit_irrigation=.true., & + irrig_river_volume_threshold=irrig_river_volume_threshold, & + use_groundwater_irrigation = .true.) + this%available_gw_uncon(bounds%begc) = huge(1._r8) + + call this%computeDeficits(deficits) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + + ! Set volr to be somewhat below the limiting amount + call this%setVolr(g = begg, & + irrig_deficit = total_deficit, & + irrig_river_volume_threshold = irrig_river_volume_threshold, & + volr_diff_from_threshold = -10._r8, & + volr_limited_irrig_rate = volr_limited_irrig_rate) + + ! Call irrigation routines + call this%calculateAndApplyIrrigation() + + ! Check result + expected_total = total_deficit / this%irrigation_params%irrig_length + expected_gw_uncon = expected_total - volr_limited_irrig_rate + call this%assertTotalIrrigationEquals(bounds%begp, expected_total) + ! Make sure that irrigation is properly divided into surface and groundwater (both + ! patch and column-level) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) + end subroutine limiting_volr_with_groundwater_uncon + + @Test + subroutine limiting_volr_with_groundwater_uncon_and_con(this) + ! limiting volr, with the difference made up by groundwater from both the unconfined + ! and confined aquifer + use GridcellType, only : grc + class(TestIrrigation), intent(inout) :: this + real(r8), allocatable :: deficits(:,:) + real(r8), parameter :: irrig_river_volume_threshold = 0.1_r8 + real(r8) :: total_deficit ! kg m-2 (i.e., mm) + real(r8) :: volr_limited_irrig_rate + real(r8) :: expected_total ! expected total rate + real(r8) :: expected_gw ! expected total rate from groundwater + real(r8) :: expected_gw_uncon ! expected rate from the unconfined aquifer + real(r8) :: expected_gw_con ! expected rate from the confined aquifer + + ! Setup + call this%setupSinglePatch() + call this%setupIrrigation(test_limit_irrigation=.true., & + irrig_river_volume_threshold=irrig_river_volume_threshold, & + use_groundwater_irrigation = .true.) + + call this%computeDeficits(deficits) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + + ! Set volr to be somewhat below the limiting amount + call this%setVolr(g = begg, & + irrig_deficit = total_deficit, & + irrig_river_volume_threshold = irrig_river_volume_threshold, & + volr_diff_from_threshold = -10._r8, & + volr_limited_irrig_rate = volr_limited_irrig_rate) + + ! Set available_gw_uncon to be 1/4 of the non-river-supplied irrigation + expected_total = total_deficit / this%irrigation_params%irrig_length + expected_gw = expected_total - volr_limited_irrig_rate + this%available_gw_uncon(bounds%begc) = expected_gw * dtime / 4._r8 + expected_gw_uncon = expected_gw / 4._r8 + expected_gw_con = expected_gw - expected_gw_uncon + + ! Call irrigation routines + call this%calculateAndApplyIrrigation() + + ! Check result + ! First make sure the test is set up reasonably + @assertGreaterThan(expected_total, 0._r8) + @assertGreaterThan(expected_gw_uncon, 0._r8) + @assertGreaterThan(expected_gw_con, 0._r8) + ! Now do the actual assertions on the irrigation routine + call this%assertTotalIrrigationEquals(bounds%begp, expected_total) + ! Make sure that irrigation is properly divided into surface and groundwater (both + ! patch and column-level) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(bounds%begc), tolerance=tol) + end subroutine limiting_volr_with_groundwater_uncon_and_con @Test subroutine irrigation_continues_at_same_rate_for_multiple_time_steps(this) @@ -1205,8 +1444,10 @@ contains ! Other setup ! Keep irrig_river_volume_threshold set to 0 to simplify the calculations here + ! Set use_groundwater_irrigation to false to simplify things, too call this%setupIrrigation(maxpft=2, test_limit_irrigation=.true., & - irrig_river_volume_threshold=0._r8) + irrig_river_volume_threshold=0._r8, & + use_groundwater_irrigation = .false.) ! The first 2 patches are irrigated, the 3rd is unirrigated pftcon%irrigated(1:2) = [1.0, 0.0] From e6942dc77aa330dbcc9567ff9e84d3a8feb9faec Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 13 Nov 2018 14:26:23 -0700 Subject: [PATCH 26/41] Add single_p, single_c and single_g variables for single-point tests This provides only minimal benefit for these single-point tests, but will provide benefit when I switch the single-point tests to actually have multiple points. --- .../test/Irrigation_test/test_irrigation.pf | 150 +++++++++--------- 1 file changed, 78 insertions(+), 72 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index 2db769e3e3..8dec49c131 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -31,6 +31,9 @@ module test_irrigation @TestCase type, extends(TestCase) :: TestIrrigation + integer :: single_p ! for single-point tests: patch of interest (for non-single-point tests, this is undefined) + integer :: single_c ! for single-point tests: column of interest (for non-single-point tests, this is undefined) + integer :: single_g ! for single-point tests: gridcell of interest (for non-single-point tests, this is undefined) integer :: numf integer, allocatable :: filter(:) type(irrigation_type) :: irrigation @@ -148,6 +151,9 @@ contains class(TestIrrigation), intent(inout) :: this call setup_single_veg_patch(pft_type=pft_type) + this%single_p = bounds%begp + this%single_c = bounds%begc + this%single_g = bounds%begg call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) end subroutine setupSinglePatch @@ -719,8 +725,8 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine irrigation_flux_is_correct @@ -741,11 +747,11 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) ! Make sure all irrigation comes from drip (both patch and column-level) - @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(bounds%begp), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(bounds%begc), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(this%single_p), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(this%single_c), tolerance=tol) end subroutine drip @@ -766,11 +772,11 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) ! Make sure all irrigation comes from sprinkler (both patch and column-level) - @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(bounds%begc), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(this%single_p), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(this%single_c), tolerance=tol) end subroutine sprinkler @@ -787,7 +793,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_for_wet_soil @Test @@ -803,21 +809,21 @@ contains call this%setupSinglePatch() call this%setupIrrigation() h2osoi_target_layer1 = this%irrigation%RelsatToH2osoi( & - relsat = this%relsat_target(bounds%begc,1), & - eff_porosity = this%eff_porosity(bounds%begc,1), & - dz = col%dz(bounds%begc,1)) - this%h2osoi_liq(bounds%begc,1) = h2osoi_target_layer1 + surplus + relsat = this%relsat_target(this%single_c,1), & + eff_porosity = this%eff_porosity(this%single_c,1), & + dz = col%dz(this%single_c,1)) + this%h2osoi_liq(this%single_c,1) = h2osoi_target_layer1 + surplus ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result call this%computeDeficits(deficits) - expected = (sum(deficits(bounds%begp,2:nlevsoi)) - surplus) / this%irrigation_params%irrig_length + expected = (sum(deficits(this%single_p,2:nlevsoi)) - surplus) / this%irrigation_params%irrig_length ! This first assertion makes sure the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here is the main assertion: - call this%assertTotalIrrigationEquals(bounds%begp, expected) + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine surplus_offsets_deficit @Test @@ -828,14 +834,14 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation(maxpft=2) - patch%itype(bounds%begp) = 2 + patch%itype(this%single_p) = 2 pftcon%irrigated(1:2) = [1.0, 0.0] ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_for_unirrigated_pfts @@ -846,13 +852,13 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%elai(bounds%begp) = 0._r8 + this%elai(this%single_p) = 0._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_for_lai0 @@ -869,17 +875,17 @@ contains ! assumption that this will make it fall above the threshold for triggering irrigation do j = 1, nlevsoi h2osoi_target = this%irrigation%RelsatToH2osoi( & - relsat = this%relsat_target(bounds%begc,j), & - eff_porosity = this%eff_porosity(bounds%begc,j), & - dz = col%dz(bounds%begc,j)) - this%h2osoi_liq(bounds%begc,j) = h2osoi_target * 0.99_r8 + relsat = this%relsat_target(this%single_c,j), & + eff_porosity = this%eff_porosity(this%single_c,j), & + dz = col%dz(this%single_c,j)) + this%h2osoi_liq(this%single_c,j) = h2osoi_target * 0.99_r8 end do ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_for_soil_moisture_above_threshold @Test @@ -896,7 +902,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_at_wrong_time @@ -916,10 +922,10 @@ contains irrig_river_volume_threshold=irrig_river_volume_threshold) call this%computeDeficits(deficits) - total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + total_deficit = sum(deficits(this%single_p,1:nlevsoi)) ! Set volr to be just above the limiting amount - call this%setVolr(g = begg, & + call this%setVolr(g = this%single_g, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = 10._r8, & @@ -930,10 +936,10 @@ contains ! Check result expected = total_deficit / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + call this%assertTotalIrrigationEquals(this%single_p, expected) ! Make sure that all irrigation comes as surface irrigation (patch and column-level) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) end subroutine unlimited_irrigation_for_non_limiting_volr @Test @@ -953,10 +959,10 @@ contains use_groundwater_irrigation = .false.) call this%computeDeficits(deficits) - total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + total_deficit = sum(deficits(this%single_p,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = begg, & + call this%setVolr(g = this%single_g, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -966,10 +972,10 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationEquals(bounds%begp, expected) + call this%assertTotalIrrigationEquals(this%single_p, expected) ! Make sure that all irrigation comes as surface irrigation (patch and column-level) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) end subroutine limited_irrigation_for_limiting_volr_no_groundwater @Test @@ -989,13 +995,13 @@ contains call this%setupIrrigation(test_limit_irrigation=.true., & irrig_river_volume_threshold=irrig_river_volume_threshold, & use_groundwater_irrigation = .true.) - this%available_gw_uncon(bounds%begc) = huge(1._r8) + this%available_gw_uncon(this%single_c) = huge(1._r8) call this%computeDeficits(deficits) - total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + total_deficit = sum(deficits(this%single_p,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = begg, & + call this%setVolr(g = this%single_g, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -1007,13 +1013,13 @@ contains ! Check result expected_total = total_deficit / this%irrigation_params%irrig_length expected_gw_uncon = expected_total - volr_limited_irrig_rate - call this%assertTotalIrrigationEquals(bounds%begp, expected_total) + call this%assertTotalIrrigationEquals(this%single_p, expected_total) ! Make sure that irrigation is properly divided into surface and groundwater (both ! patch and column-level) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) end subroutine limiting_volr_with_groundwater_uncon @Test @@ -1038,10 +1044,10 @@ contains use_groundwater_irrigation = .true.) call this%computeDeficits(deficits) - total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) + total_deficit = sum(deficits(this%single_p,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = begg, & + call this%setVolr(g = this%single_g, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -1050,7 +1056,7 @@ contains ! Set available_gw_uncon to be 1/4 of the non-river-supplied irrigation expected_total = total_deficit / this%irrigation_params%irrig_length expected_gw = expected_total - volr_limited_irrig_rate - this%available_gw_uncon(bounds%begc) = expected_gw * dtime / 4._r8 + this%available_gw_uncon(this%single_c) = expected_gw * dtime / 4._r8 expected_gw_uncon = expected_gw / 4._r8 expected_gw_con = expected_gw - expected_gw_uncon @@ -1063,15 +1069,15 @@ contains @assertGreaterThan(expected_gw_uncon, 0._r8) @assertGreaterThan(expected_gw_con, 0._r8) ! Now do the actual assertions on the irrigation routine - call this%assertTotalIrrigationEquals(bounds%begp, expected_total) + call this%assertTotalIrrigationEquals(this%single_p, expected_total) ! Make sure that irrigation is properly divided into surface and groundwater (both ! patch and column-level) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) - @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(bounds%begp), tolerance=tol) - @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(this%single_p), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(this%single_c), tolerance=tol) end subroutine limiting_volr_with_groundwater_uncon_and_con @Test @@ -1089,13 +1095,13 @@ contains ! adjust the soil water amount. Irrigation should continue at the original rate. call this%calculateAndApplyIrrigation() call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length call advance_timestep() this%h2osoi_liq = 100._r8 call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationEquals(bounds%begp, expected) + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps @@ -1118,11 +1124,11 @@ contains call this%calculateAndApplyIrrigation() call advance_timestep() end do - call this%assertTotalIrrigationGreaterThanZero(bounds%begp) + call this%assertTotalIrrigationGreaterThanZero(this%single_p) ! Ensure that irrigation flux goes to 0 in the following time step call this%calculateAndApplyIrrigation() - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine irrigation_continues_for_correct_number_of_time_steps @@ -1149,18 +1155,18 @@ contains call advance_timestep() end do ! The following assertion is mainly here to make sure the test is working as intended - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) ! Now reset time, change soil moisture, and make sure that irrigation happens as expected call unittest_timemgr_set_curr_date(yr=5, mon=1, day=1, tod=irrig_start+dtime) this%h2osoi_liq(:,:) = 100._r8 call this%calculateAndApplyIrrigation() call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length ! Make sure that the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here's the main assertion: - call this%assertTotalIrrigationEquals(bounds%begp, expected) + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine irrigation_flux_is_correct_on_second_day @@ -1182,8 +1188,8 @@ contains ! Check result call this%computeDeficits(deficits) ! Now on to the real assertion - expected = sum(deficits(bounds%begp,1:nlevirrig)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = sum(deficits(this%single_p,1:nlevirrig)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine irrigation_excludes_deep_layers @Test @@ -1196,15 +1202,15 @@ contains call this%setupSinglePatch() call this%setupIrrigation() ! Make the last layer a bedrock layer: - col%nbedrock(bounds%begc) = nlevsoi - 1 + col%nbedrock(this%single_c) = nlevsoi - 1 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(bounds%begp,1:(nlevsoi-1))) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = sum(deficits(this%single_p,1:(nlevsoi-1))) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine irrigation_excludes_bedrock_layers @Test @@ -1214,13 +1220,13 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%t_soisno(bounds%begc, :) = 272._r8 + this%t_soisno(this%single_c, :) = 272._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(bounds%begp) + call this%assertTotalIrrigationZero(this%single_p) end subroutine no_irrigation_for_frozen_soil @@ -1233,7 +1239,7 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%t_soisno(bounds%begc, 2) = 272._r8 + this%t_soisno(this%single_c, 2) = 272._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() @@ -1241,8 +1247,8 @@ contains ! Check result call this%computeDeficits(deficits) ! Only include deficit from top layer, since 2nd layer is frozen - expected = deficits(bounds%begp, 1) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(bounds%begp, expected) + expected = deficits(this%single_p, 1) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(this%single_p, expected) end subroutine no_irrigation_below_frozen_soil_layer From 3a43fbd3ed4e82f686cb541754055453501af2ee Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 13 Nov 2018 15:16:42 -0700 Subject: [PATCH 27/41] Make "single-point" tests actually include multiple points Include three points, where point 2 is the point of interest and points 1 and 3 just exist to give some (but not complete) assurance that we don't accidentally do whole-array assignments (foo = bar(p)) where we meant to do single-element assignments (foo(p) = bar(p)) (because, if we did such an assignment, this would overwrite the values in points 1 and 3, which otherwise should remain unchanged). --- src/biogeophys/test/Irrigation_test/README | 10 +- .../test/Irrigation_test/test_irrigation.pf | 160 ++++++++++++++---- 2 files changed, 138 insertions(+), 32 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/README b/src/biogeophys/test/Irrigation_test/README index 240a541f49..c141280d91 100644 --- a/src/biogeophys/test/Irrigation_test/README +++ b/src/biogeophys/test/Irrigation_test/README @@ -20,9 +20,15 @@ set up these tests: Because of these considerations, it was not straightforward to pull out routines that could operate on a single point, and just do the testing on these single-point routines. So instead, I am just testing the public, multi-point -routines. However, for simplicity, most of my tests just use a single point in +routines. But for simplicity, most of my tests just focus on a single point in the arrays - and then I have just enough multi-point tests to ensure that the -routines truly do work with multiple points. +routines truly do work with multiple points. However, even the "single-point" +tests actually include three points, where point 2 is the point of interest and +points 1 and 3 just exist to give some (but not complete) assurance that we +don't accidentally do whole-array assignments (foo = bar(p)) where we meant to +do single-element assignments (foo(p) = bar(p)) (because, if we did such an +assignment, this would overwrite the values in points 1 and 3, which otherwise +should remain unchanged). Furthermore, I have been influenced lately by advice to "test behavior, not methods", and to test through the public interface. And in this case, it diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index 8dec49c131..a1650882b4 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -18,7 +18,7 @@ module test_irrigation use ColumnType , only : col use GridcellType , only : grc use pftconMod , only : pftcon - use unittestSimpleSubgridSetupsMod, only : setup_single_veg_patch + use unittestSimpleSubgridSetupsMod, only : setup_ncells_single_veg_patch use unittestFilterBuilderMod, only : filter_from_range implicit none @@ -28,9 +28,11 @@ module test_irrigation integer , parameter :: dtime = 1800 ! model time step, seconds integer , parameter :: irrig_start = 21600 integer , parameter :: pft_type = 1 ! pft type in target patch for single-patch tests + real(r8), parameter :: flux_uninit = 12345._r8 @TestCase type, extends(TestCase) :: TestIrrigation + logical :: is_single_point = .false. ! true if this is a single-point test (and so single_p, single_c and single_g are defined) integer :: single_p ! for single-point tests: patch of interest (for non-single-point tests, this is undefined) integer :: single_c ! for single-point tests: column of interest (for non-single-point tests, this is undefined) integer :: single_g ! for single-point tests: gridcell of interest (for non-single-point tests, this is undefined) @@ -96,6 +98,10 @@ module test_irrigation ! Assert that total irrigation withdrawal and application are both greater than zero ! for a given patch procedure :: assertTotalIrrigationGreaterThanZero + + ! In a single-point test, assert that the fluxes in the non-points-of-interest + ! remain unchanged from their initial values + procedure :: assertOtherPointsUnchanged end type TestIrrigation real(r8), parameter :: mm_times_km2_to_m3 = 1.e3_r8 @@ -147,14 +153,18 @@ contains end subroutine tearDown subroutine setupSinglePatch(this) - ! Sets up grid with single veg patch; also sets up this%filter appropriately + ! Sets up a grid for testing a single veg patch. This actually sets up three grid + ! cells, each with a single veg patch; the 2nd grid cell / patch is the point of + ! interest. Also sets up this%filter to just include the 2nd patch. This way, we can + ! ensure that values in points 1 and 3 remain unchanged. class(TestIrrigation), intent(inout) :: this - call setup_single_veg_patch(pft_type=pft_type) - this%single_p = bounds%begp - this%single_c = bounds%begc - this%single_g = bounds%begg - call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) + call setup_ncells_single_veg_patch(ncells=3, pft_type=pft_type) + this%is_single_point = .true. + this%single_p = bounds%begp + 1 + this%single_c = bounds%begc + 1 + this%single_g = bounds%begg + 1 + call filter_from_range(start=this%single_p, end=this%single_p, numf=this%numf, filter=this%filter) end subroutine setupSinglePatch !----------------------------------------------------------------------- @@ -206,6 +216,8 @@ contains ! ! !LOCAL VARIABLES: integer :: c,j + real(r8) :: flux_init_p(bounds%begp:bounds%endp) + real(r8) :: flux_init_c(bounds%begc:bounds%endc) logical :: limit_irrigation_if_rof_enabled integer :: l_maxpft integer :: l_nlevirrig @@ -258,16 +270,25 @@ contains ! Allocate fluxes output from irrigation routines. Note that, in the production code, ! these are initialized to 0 in InitCold. - allocate(this%waterflux%qflx_sfc_irrig_patch(bounds%begp:bounds%endp), source=0._r8) - allocate(this%waterflux%qflx_sfc_irrig_col(bounds%begc:bounds%endc), source=0._r8) - allocate(this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), source=0._r8) - allocate(this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), source=0._r8) - allocate(this%waterflux%qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), source=0._r8) - allocate(this%waterflux%qflx_gw_con_irrig_col(bounds%begc:bounds%endc), source=0._r8) - allocate(this%waterflux%qflx_irrig_drip_patch(bounds%begp:bounds%endp), source=0._r8) - allocate(this%waterflux%qflx_irrig_drip_col(bounds%begc:bounds%endc), source=0._r8) - allocate(this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), source=0._r8) - allocate(this%waterflux%qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), source=0._r8) + if (this%is_single_point) then + flux_init_p(:) = flux_uninit + flux_init_p(this%single_p) = 0._r8 + flux_init_c(:) = flux_uninit + flux_init_c(this%single_c) = 0._r8 + else + flux_init_p(:) = 0._r8 + flux_init_c(:) = 0._r8 + end if + allocate(this%waterflux%qflx_sfc_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) + allocate(this%waterflux%qflx_sfc_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) + allocate(this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) + allocate(this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) + allocate(this%waterflux%qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) + allocate(this%waterflux%qflx_gw_con_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) + allocate(this%waterflux%qflx_irrig_drip_patch(bounds%begp:bounds%endp), source=flux_init_p) + allocate(this%waterflux%qflx_irrig_drip_col(bounds%begc:bounds%endc), source=flux_init_c) + allocate(this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), source=flux_init_p) + allocate(this%waterflux%qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), source=flux_init_c) ! Set inputs to irrigation routines allocate(this%elai(bounds%begp:bounds%endp), source=10._r8) @@ -500,19 +521,32 @@ contains rof_prognostic = .true.) ! The expectation is that the filter used in CalcIrrigationNeeded is a subset of the - ! filter used in ApplyIrrigation. In order to (a) keep the unit tests simpler, and (b) - ! ensure that it works for the ApplyIrrigation filter to have points not in the + ! filter used in ApplyIrrigation. (The one situation where the ApplyIrrigation filter + ! might include points not in the CalcIrrigationNeeded filter is if a point that was + ! inactive at the time of the CalcIrrigationNeeded call has become active for the + ! ApplyIrrigation call; in this case, if there were still some irrigation time steps + ! left when it had become inactive, then ApplyIrrigation might start re-irrigating + ! there. But this behavior is probably okay; in any case, it doesn't seem worth + ! testing for.) + ! + ! In order to (a) keep the unit tests simpler, and (b) ensure that it + ! works for the ApplyIrrigation filter to have points not in the ! CalcIrrigationNeededFilter, we send ApplyIrrigation a filter that includes all - ! points. (The one situation where the ApplyIrrigation filter might include points not - ! in the CalcIrrigationNeeded filter is if a point that was inactive at the time of - ! the CalcIrrigationNeeded call has become active for the ApplyIrrigation call; in - ! this case, if there were still some irrigation time steps left when it had become - ! inactive, then ApplyIrrigation might start re-irrigating there. But this behavior - ! is probably okay; in any case, it doesn't seem worth testing for.) - call filter_from_range(start=bounds%begp, end=bounds%endp, & - numf=apply_nump, filter=apply_filterp) - call filter_from_range(start=bounds%begc, end=bounds%endc, & - numf=apply_numc, filter=apply_filterc) + ! points. However, for "single-point" tests, we just use the single actual point, to + ! avoid resetting fluxes outside the point-of-interest to 0 (because the tests of + ! maintaining the original value in those points are slightly stronger if we use + ! non-zero values). + if (this%is_single_point) then + call filter_from_range(start=this%single_p, end=this%single_p, & + numf=apply_nump, filter=apply_filterp) + call filter_from_range(start=this%single_c, end=this%single_c, & + numf=apply_numc, filter=apply_filterc) + else + call filter_from_range(start=bounds%begp, end=bounds%endp, & + numf=apply_nump, filter=apply_filterp) + call filter_from_range(start=bounds%begc, end=bounds%endc, & + numf=apply_numc, filter=apply_filterc) + end if call this%irrigation%ApplyIrrigation( & bounds = bounds, & @@ -701,13 +735,59 @@ contains end subroutine assertTotalIrrigationGreaterThanZero + !----------------------------------------------------------------------- + subroutine assertOtherPointsUnchanged(this) + ! + ! !DESCRIPTION: + ! In a single-point test, assert that the fluxes in the non-points-of-interest remain + ! unchanged from their initial values. + ! + ! This provides some (though not complete) measure of assurance that we do not have + ! code that sets whole arrays when we mean to just assign to a given element - i.e., + ! that we do not have: + ! foo = bar(p) + ! when we mean: + ! foo(p) = bar(p) + ! + ! !ARGUMENTS: + class(TestIrrigation), intent(in) :: this + ! + ! !LOCAL VARIABLES: + integer :: p + + character(len=*), parameter :: subname = 'assertOtherPointsUnchanged' + !----------------------------------------------------------------------- + + ! This should only be called in a "single-point" test + @assertTrue(this%is_single_point) + + ! It's enough to check the patch values, since the column values are set from the + ! patch values + do p = bounds%begp, bounds%endp + if (p == this%single_p) then + cycle + end if + @assertEqual(flux_uninit, this%waterflux%qflx_sfc_irrig_patch(p)) + @assertEqual(flux_uninit, this%waterflux%qflx_gw_uncon_irrig_patch(p)) + @assertEqual(flux_uninit, this%waterflux%qflx_gw_con_irrig_patch(p)) + + @assertEqual(flux_uninit, this%waterflux%qflx_irrig_drip_patch(p)) + @assertEqual(flux_uninit, this%waterflux%qflx_irrig_sprinkler_patch(p)) + end do + + end subroutine assertOtherPointsUnchanged ! ======================================================================== ! Begin actual tests ! ======================================================================== ! ------------------------------------------------------------------------ - ! Tests on a single patch + ! Tests on a single patch. + ! + ! Note that these actually use three grid cells, where grid cell #2 is the grid cell of + ! interest, and the other two just serve to help ensure that we don't have code that + ! assigns to whole arrays (foo = bar(p)) when we really mean to just assign to a single + ! element (foo(p) = bar(p)). ! ------------------------------------------------------------------------ @Test @@ -727,6 +807,7 @@ contains call this%computeDeficits(deficits) expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine irrigation_flux_is_correct @@ -752,6 +833,7 @@ contains ! Make sure all irrigation comes from drip (both patch and column-level) @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine drip @@ -777,6 +859,7 @@ contains ! Make sure all irrigation comes from sprinkler (both patch and column-level) @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine sprinkler @@ -794,6 +877,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_wet_soil @Test @@ -824,6 +908,7 @@ contains @assertLessThan(0._r8, expected) ! Here is the main assertion: call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine surplus_offsets_deficit @Test @@ -842,6 +927,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_unirrigated_pfts @@ -859,6 +945,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_lai0 @@ -886,6 +973,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_soil_moisture_above_threshold @Test @@ -903,6 +991,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_at_wrong_time @@ -940,6 +1029,7 @@ contains ! Make sure that all irrigation comes as surface irrigation (patch and column-level) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine unlimited_irrigation_for_non_limiting_volr @Test @@ -976,6 +1066,7 @@ contains ! Make sure that all irrigation comes as surface irrigation (patch and column-level) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine limited_irrigation_for_limiting_volr_no_groundwater @Test @@ -1020,6 +1111,7 @@ contains @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine limiting_volr_with_groundwater_uncon @Test @@ -1078,6 +1170,7 @@ contains @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(this%single_c), tolerance=tol) + call this%assertOtherPointsUnchanged() end subroutine limiting_volr_with_groundwater_uncon_and_con @Test @@ -1102,6 +1195,7 @@ contains ! Check result call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps @@ -1129,6 +1223,7 @@ contains ! Ensure that irrigation flux goes to 0 in the following time step call this%calculateAndApplyIrrigation() call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine irrigation_continues_for_correct_number_of_time_steps @@ -1167,6 +1262,7 @@ contains @assertLessThan(0._r8, expected) ! Here's the main assertion: call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine irrigation_flux_is_correct_on_second_day @@ -1190,6 +1286,7 @@ contains ! Now on to the real assertion expected = sum(deficits(this%single_p,1:nlevirrig)) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine irrigation_excludes_deep_layers @Test @@ -1211,6 +1308,7 @@ contains call this%computeDeficits(deficits) expected = sum(deficits(this%single_p,1:(nlevsoi-1))) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine irrigation_excludes_bedrock_layers @Test @@ -1227,6 +1325,7 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_frozen_soil @@ -1249,6 +1348,7 @@ contains ! Only include deficit from top layer, since 2nd layer is frozen expected = deficits(this%single_p, 1) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertOtherPointsUnchanged() end subroutine no_irrigation_below_frozen_soil_layer From 291893a835b827370f07d468fe8afb3123f0d151 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 14 Nov 2018 11:07:54 -0700 Subject: [PATCH 28/41] Revert "Make "single-point" tests actually include multiple points" This reverts commit 3a43fbd3ed4e82f686cb541754055453501af2ee. I've decided that this adds complexity without providing huge benefit (it gives more of a false confidence than any huge benefit). I'm planning to go with a strategy of having as much code as possible covered by ERP system tests, and not trying to rely on unit tests to test multi-point behavior. --- src/biogeophys/test/Irrigation_test/README | 10 +- .../test/Irrigation_test/test_irrigation.pf | 160 ++++-------------- 2 files changed, 32 insertions(+), 138 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/README b/src/biogeophys/test/Irrigation_test/README index c141280d91..240a541f49 100644 --- a/src/biogeophys/test/Irrigation_test/README +++ b/src/biogeophys/test/Irrigation_test/README @@ -20,15 +20,9 @@ set up these tests: Because of these considerations, it was not straightforward to pull out routines that could operate on a single point, and just do the testing on these single-point routines. So instead, I am just testing the public, multi-point -routines. But for simplicity, most of my tests just focus on a single point in +routines. However, for simplicity, most of my tests just use a single point in the arrays - and then I have just enough multi-point tests to ensure that the -routines truly do work with multiple points. However, even the "single-point" -tests actually include three points, where point 2 is the point of interest and -points 1 and 3 just exist to give some (but not complete) assurance that we -don't accidentally do whole-array assignments (foo = bar(p)) where we meant to -do single-element assignments (foo(p) = bar(p)) (because, if we did such an -assignment, this would overwrite the values in points 1 and 3, which otherwise -should remain unchanged). +routines truly do work with multiple points. Furthermore, I have been influenced lately by advice to "test behavior, not methods", and to test through the public interface. And in this case, it diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index a1650882b4..8dec49c131 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -18,7 +18,7 @@ module test_irrigation use ColumnType , only : col use GridcellType , only : grc use pftconMod , only : pftcon - use unittestSimpleSubgridSetupsMod, only : setup_ncells_single_veg_patch + use unittestSimpleSubgridSetupsMod, only : setup_single_veg_patch use unittestFilterBuilderMod, only : filter_from_range implicit none @@ -28,11 +28,9 @@ module test_irrigation integer , parameter :: dtime = 1800 ! model time step, seconds integer , parameter :: irrig_start = 21600 integer , parameter :: pft_type = 1 ! pft type in target patch for single-patch tests - real(r8), parameter :: flux_uninit = 12345._r8 @TestCase type, extends(TestCase) :: TestIrrigation - logical :: is_single_point = .false. ! true if this is a single-point test (and so single_p, single_c and single_g are defined) integer :: single_p ! for single-point tests: patch of interest (for non-single-point tests, this is undefined) integer :: single_c ! for single-point tests: column of interest (for non-single-point tests, this is undefined) integer :: single_g ! for single-point tests: gridcell of interest (for non-single-point tests, this is undefined) @@ -98,10 +96,6 @@ module test_irrigation ! Assert that total irrigation withdrawal and application are both greater than zero ! for a given patch procedure :: assertTotalIrrigationGreaterThanZero - - ! In a single-point test, assert that the fluxes in the non-points-of-interest - ! remain unchanged from their initial values - procedure :: assertOtherPointsUnchanged end type TestIrrigation real(r8), parameter :: mm_times_km2_to_m3 = 1.e3_r8 @@ -153,18 +147,14 @@ contains end subroutine tearDown subroutine setupSinglePatch(this) - ! Sets up a grid for testing a single veg patch. This actually sets up three grid - ! cells, each with a single veg patch; the 2nd grid cell / patch is the point of - ! interest. Also sets up this%filter to just include the 2nd patch. This way, we can - ! ensure that values in points 1 and 3 remain unchanged. + ! Sets up grid with single veg patch; also sets up this%filter appropriately class(TestIrrigation), intent(inout) :: this - call setup_ncells_single_veg_patch(ncells=3, pft_type=pft_type) - this%is_single_point = .true. - this%single_p = bounds%begp + 1 - this%single_c = bounds%begc + 1 - this%single_g = bounds%begg + 1 - call filter_from_range(start=this%single_p, end=this%single_p, numf=this%numf, filter=this%filter) + call setup_single_veg_patch(pft_type=pft_type) + this%single_p = bounds%begp + this%single_c = bounds%begc + this%single_g = bounds%begg + call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) end subroutine setupSinglePatch !----------------------------------------------------------------------- @@ -216,8 +206,6 @@ contains ! ! !LOCAL VARIABLES: integer :: c,j - real(r8) :: flux_init_p(bounds%begp:bounds%endp) - real(r8) :: flux_init_c(bounds%begc:bounds%endc) logical :: limit_irrigation_if_rof_enabled integer :: l_maxpft integer :: l_nlevirrig @@ -270,25 +258,16 @@ contains ! Allocate fluxes output from irrigation routines. Note that, in the production code, ! these are initialized to 0 in InitCold. - if (this%is_single_point) then - flux_init_p(:) = flux_uninit - flux_init_p(this%single_p) = 0._r8 - flux_init_c(:) = flux_uninit - flux_init_c(this%single_c) = 0._r8 - else - flux_init_p(:) = 0._r8 - flux_init_c(:) = 0._r8 - end if - allocate(this%waterflux%qflx_sfc_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) - allocate(this%waterflux%qflx_sfc_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) - allocate(this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) - allocate(this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) - allocate(this%waterflux%qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), source=flux_init_p) - allocate(this%waterflux%qflx_gw_con_irrig_col(bounds%begc:bounds%endc), source=flux_init_c) - allocate(this%waterflux%qflx_irrig_drip_patch(bounds%begp:bounds%endp), source=flux_init_p) - allocate(this%waterflux%qflx_irrig_drip_col(bounds%begc:bounds%endc), source=flux_init_c) - allocate(this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), source=flux_init_p) - allocate(this%waterflux%qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), source=flux_init_c) + allocate(this%waterflux%qflx_sfc_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_sfc_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_gw_con_irrig_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_gw_con_irrig_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_irrig_drip_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_irrig_drip_col(bounds%begc:bounds%endc), source=0._r8) + allocate(this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp:bounds%endp), source=0._r8) + allocate(this%waterflux%qflx_irrig_sprinkler_col(bounds%begc:bounds%endc), source=0._r8) ! Set inputs to irrigation routines allocate(this%elai(bounds%begp:bounds%endp), source=10._r8) @@ -521,32 +500,19 @@ contains rof_prognostic = .true.) ! The expectation is that the filter used in CalcIrrigationNeeded is a subset of the - ! filter used in ApplyIrrigation. (The one situation where the ApplyIrrigation filter - ! might include points not in the CalcIrrigationNeeded filter is if a point that was - ! inactive at the time of the CalcIrrigationNeeded call has become active for the - ! ApplyIrrigation call; in this case, if there were still some irrigation time steps - ! left when it had become inactive, then ApplyIrrigation might start re-irrigating - ! there. But this behavior is probably okay; in any case, it doesn't seem worth - ! testing for.) - ! - ! In order to (a) keep the unit tests simpler, and (b) ensure that it - ! works for the ApplyIrrigation filter to have points not in the + ! filter used in ApplyIrrigation. In order to (a) keep the unit tests simpler, and (b) + ! ensure that it works for the ApplyIrrigation filter to have points not in the ! CalcIrrigationNeededFilter, we send ApplyIrrigation a filter that includes all - ! points. However, for "single-point" tests, we just use the single actual point, to - ! avoid resetting fluxes outside the point-of-interest to 0 (because the tests of - ! maintaining the original value in those points are slightly stronger if we use - ! non-zero values). - if (this%is_single_point) then - call filter_from_range(start=this%single_p, end=this%single_p, & - numf=apply_nump, filter=apply_filterp) - call filter_from_range(start=this%single_c, end=this%single_c, & - numf=apply_numc, filter=apply_filterc) - else - call filter_from_range(start=bounds%begp, end=bounds%endp, & - numf=apply_nump, filter=apply_filterp) - call filter_from_range(start=bounds%begc, end=bounds%endc, & - numf=apply_numc, filter=apply_filterc) - end if + ! points. (The one situation where the ApplyIrrigation filter might include points not + ! in the CalcIrrigationNeeded filter is if a point that was inactive at the time of + ! the CalcIrrigationNeeded call has become active for the ApplyIrrigation call; in + ! this case, if there were still some irrigation time steps left when it had become + ! inactive, then ApplyIrrigation might start re-irrigating there. But this behavior + ! is probably okay; in any case, it doesn't seem worth testing for.) + call filter_from_range(start=bounds%begp, end=bounds%endp, & + numf=apply_nump, filter=apply_filterp) + call filter_from_range(start=bounds%begc, end=bounds%endc, & + numf=apply_numc, filter=apply_filterc) call this%irrigation%ApplyIrrigation( & bounds = bounds, & @@ -735,59 +701,13 @@ contains end subroutine assertTotalIrrigationGreaterThanZero - !----------------------------------------------------------------------- - subroutine assertOtherPointsUnchanged(this) - ! - ! !DESCRIPTION: - ! In a single-point test, assert that the fluxes in the non-points-of-interest remain - ! unchanged from their initial values. - ! - ! This provides some (though not complete) measure of assurance that we do not have - ! code that sets whole arrays when we mean to just assign to a given element - i.e., - ! that we do not have: - ! foo = bar(p) - ! when we mean: - ! foo(p) = bar(p) - ! - ! !ARGUMENTS: - class(TestIrrigation), intent(in) :: this - ! - ! !LOCAL VARIABLES: - integer :: p - - character(len=*), parameter :: subname = 'assertOtherPointsUnchanged' - !----------------------------------------------------------------------- - - ! This should only be called in a "single-point" test - @assertTrue(this%is_single_point) - - ! It's enough to check the patch values, since the column values are set from the - ! patch values - do p = bounds%begp, bounds%endp - if (p == this%single_p) then - cycle - end if - @assertEqual(flux_uninit, this%waterflux%qflx_sfc_irrig_patch(p)) - @assertEqual(flux_uninit, this%waterflux%qflx_gw_uncon_irrig_patch(p)) - @assertEqual(flux_uninit, this%waterflux%qflx_gw_con_irrig_patch(p)) - - @assertEqual(flux_uninit, this%waterflux%qflx_irrig_drip_patch(p)) - @assertEqual(flux_uninit, this%waterflux%qflx_irrig_sprinkler_patch(p)) - end do - - end subroutine assertOtherPointsUnchanged ! ======================================================================== ! Begin actual tests ! ======================================================================== ! ------------------------------------------------------------------------ - ! Tests on a single patch. - ! - ! Note that these actually use three grid cells, where grid cell #2 is the grid cell of - ! interest, and the other two just serve to help ensure that we don't have code that - ! assigns to whole arrays (foo = bar(p)) when we really mean to just assign to a single - ! element (foo(p) = bar(p)). + ! Tests on a single patch ! ------------------------------------------------------------------------ @Test @@ -807,7 +727,6 @@ contains call this%computeDeficits(deficits) expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine irrigation_flux_is_correct @@ -833,7 +752,6 @@ contains ! Make sure all irrigation comes from drip (both patch and column-level) @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine drip @@ -859,7 +777,6 @@ contains ! Make sure all irrigation comes from sprinkler (both patch and column-level) @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine sprinkler @@ -877,7 +794,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_wet_soil @Test @@ -908,7 +824,6 @@ contains @assertLessThan(0._r8, expected) ! Here is the main assertion: call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine surplus_offsets_deficit @Test @@ -927,7 +842,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_unirrigated_pfts @@ -945,7 +859,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_lai0 @@ -973,7 +886,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_soil_moisture_above_threshold @Test @@ -991,7 +903,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_at_wrong_time @@ -1029,7 +940,6 @@ contains ! Make sure that all irrigation comes as surface irrigation (patch and column-level) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine unlimited_irrigation_for_non_limiting_volr @Test @@ -1066,7 +976,6 @@ contains ! Make sure that all irrigation comes as surface irrigation (patch and column-level) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine limited_irrigation_for_limiting_volr_no_groundwater @Test @@ -1111,7 +1020,6 @@ contains @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine limiting_volr_with_groundwater_uncon @Test @@ -1170,7 +1078,6 @@ contains @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(this%single_p), tolerance=tol) @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(this%single_c), tolerance=tol) - call this%assertOtherPointsUnchanged() end subroutine limiting_volr_with_groundwater_uncon_and_con @Test @@ -1195,7 +1102,6 @@ contains ! Check result call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps @@ -1223,7 +1129,6 @@ contains ! Ensure that irrigation flux goes to 0 in the following time step call this%calculateAndApplyIrrigation() call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine irrigation_continues_for_correct_number_of_time_steps @@ -1262,7 +1167,6 @@ contains @assertLessThan(0._r8, expected) ! Here's the main assertion: call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine irrigation_flux_is_correct_on_second_day @@ -1286,7 +1190,6 @@ contains ! Now on to the real assertion expected = sum(deficits(this%single_p,1:nlevirrig)) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine irrigation_excludes_deep_layers @Test @@ -1308,7 +1211,6 @@ contains call this%computeDeficits(deficits) expected = sum(deficits(this%single_p,1:(nlevsoi-1))) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine irrigation_excludes_bedrock_layers @Test @@ -1325,7 +1227,6 @@ contains ! Check result call this%assertTotalIrrigationZero(this%single_p) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_for_frozen_soil @@ -1348,7 +1249,6 @@ contains ! Only include deficit from top layer, since 2nd layer is frozen expected = deficits(this%single_p, 1) / this%irrigation_params%irrig_length call this%assertTotalIrrigationEquals(this%single_p, expected) - call this%assertOtherPointsUnchanged() end subroutine no_irrigation_below_frozen_soil_layer From 9aa547c73f2a60687c00555fc910de28f7da5383 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 14 Nov 2018 11:10:06 -0700 Subject: [PATCH 29/41] Revert "Add single_p, single_c and single_g variables for single-point tests" This reverts commit e6942dc77aa330dbcc9567ff9e84d3a8feb9faec. Since I'm not turning all of my single-point tests into multi-point tests after all, this isn't necessary. --- .../test/Irrigation_test/test_irrigation.pf | 150 +++++++++--------- 1 file changed, 72 insertions(+), 78 deletions(-) diff --git a/src/biogeophys/test/Irrigation_test/test_irrigation.pf b/src/biogeophys/test/Irrigation_test/test_irrigation.pf index 8dec49c131..2db769e3e3 100644 --- a/src/biogeophys/test/Irrigation_test/test_irrigation.pf +++ b/src/biogeophys/test/Irrigation_test/test_irrigation.pf @@ -31,9 +31,6 @@ module test_irrigation @TestCase type, extends(TestCase) :: TestIrrigation - integer :: single_p ! for single-point tests: patch of interest (for non-single-point tests, this is undefined) - integer :: single_c ! for single-point tests: column of interest (for non-single-point tests, this is undefined) - integer :: single_g ! for single-point tests: gridcell of interest (for non-single-point tests, this is undefined) integer :: numf integer, allocatable :: filter(:) type(irrigation_type) :: irrigation @@ -151,9 +148,6 @@ contains class(TestIrrigation), intent(inout) :: this call setup_single_veg_patch(pft_type=pft_type) - this%single_p = bounds%begp - this%single_c = bounds%begc - this%single_g = bounds%begg call filter_from_range(start=bounds%begp, end=bounds%endp, numf=this%numf, filter=this%filter) end subroutine setupSinglePatch @@ -725,8 +719,8 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_flux_is_correct @@ -747,11 +741,11 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) ! Make sure all irrigation comes from drip (both patch and column-level) - @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(this%single_p), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(this%single_c), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_drip_col(bounds%begc), tolerance=tol) end subroutine drip @@ -772,11 +766,11 @@ contains ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) ! Make sure all irrigation comes from sprinkler (both patch and column-level) - @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(this%single_p), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(this%single_c), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_irrig_sprinkler_col(bounds%begc), tolerance=tol) end subroutine sprinkler @@ -793,7 +787,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_wet_soil @Test @@ -809,21 +803,21 @@ contains call this%setupSinglePatch() call this%setupIrrigation() h2osoi_target_layer1 = this%irrigation%RelsatToH2osoi( & - relsat = this%relsat_target(this%single_c,1), & - eff_porosity = this%eff_porosity(this%single_c,1), & - dz = col%dz(this%single_c,1)) - this%h2osoi_liq(this%single_c,1) = h2osoi_target_layer1 + surplus + relsat = this%relsat_target(bounds%begc,1), & + eff_porosity = this%eff_porosity(bounds%begc,1), & + dz = col%dz(bounds%begc,1)) + this%h2osoi_liq(bounds%begc,1) = h2osoi_target_layer1 + surplus ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result call this%computeDeficits(deficits) - expected = (sum(deficits(this%single_p,2:nlevsoi)) - surplus) / this%irrigation_params%irrig_length + expected = (sum(deficits(bounds%begp,2:nlevsoi)) - surplus) / this%irrigation_params%irrig_length ! This first assertion makes sure the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here is the main assertion: - call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine surplus_offsets_deficit @Test @@ -834,14 +828,14 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation(maxpft=2) - patch%itype(this%single_p) = 2 + patch%itype(bounds%begp) = 2 pftcon%irrigated(1:2) = [1.0, 0.0] ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_unirrigated_pfts @@ -852,13 +846,13 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%elai(this%single_p) = 0._r8 + this%elai(bounds%begp) = 0._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_lai0 @@ -875,17 +869,17 @@ contains ! assumption that this will make it fall above the threshold for triggering irrigation do j = 1, nlevsoi h2osoi_target = this%irrigation%RelsatToH2osoi( & - relsat = this%relsat_target(this%single_c,j), & - eff_porosity = this%eff_porosity(this%single_c,j), & - dz = col%dz(this%single_c,j)) - this%h2osoi_liq(this%single_c,j) = h2osoi_target * 0.99_r8 + relsat = this%relsat_target(bounds%begc,j), & + eff_porosity = this%eff_porosity(bounds%begc,j), & + dz = col%dz(bounds%begc,j)) + this%h2osoi_liq(bounds%begc,j) = h2osoi_target * 0.99_r8 end do ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_soil_moisture_above_threshold @Test @@ -902,7 +896,7 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_at_wrong_time @@ -922,10 +916,10 @@ contains irrig_river_volume_threshold=irrig_river_volume_threshold) call this%computeDeficits(deficits) - total_deficit = sum(deficits(this%single_p,1:nlevsoi)) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be just above the limiting amount - call this%setVolr(g = this%single_g, & + call this%setVolr(g = begg, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = 10._r8, & @@ -936,10 +930,10 @@ contains ! Check result expected = total_deficit / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertTotalIrrigationEquals(bounds%begp, expected) ! Make sure that all irrigation comes as surface irrigation (patch and column-level) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) end subroutine unlimited_irrigation_for_non_limiting_volr @Test @@ -959,10 +953,10 @@ contains use_groundwater_irrigation = .false.) call this%computeDeficits(deficits) - total_deficit = sum(deficits(this%single_p,1:nlevsoi)) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = this%single_g, & + call this%setVolr(g = begg, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -972,10 +966,10 @@ contains call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertTotalIrrigationEquals(bounds%begp, expected) ! Make sure that all irrigation comes as surface irrigation (patch and column-level) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) end subroutine limited_irrigation_for_limiting_volr_no_groundwater @Test @@ -995,13 +989,13 @@ contains call this%setupIrrigation(test_limit_irrigation=.true., & irrig_river_volume_threshold=irrig_river_volume_threshold, & use_groundwater_irrigation = .true.) - this%available_gw_uncon(this%single_c) = huge(1._r8) + this%available_gw_uncon(bounds%begc) = huge(1._r8) call this%computeDeficits(deficits) - total_deficit = sum(deficits(this%single_p,1:nlevsoi)) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = this%single_g, & + call this%setVolr(g = begg, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -1013,13 +1007,13 @@ contains ! Check result expected_total = total_deficit / this%irrigation_params%irrig_length expected_gw_uncon = expected_total - volr_limited_irrig_rate - call this%assertTotalIrrigationEquals(this%single_p, expected_total) + call this%assertTotalIrrigationEquals(bounds%begp, expected_total) ! Make sure that irrigation is properly divided into surface and groundwater (both ! patch and column-level) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) end subroutine limiting_volr_with_groundwater_uncon @Test @@ -1044,10 +1038,10 @@ contains use_groundwater_irrigation = .true.) call this%computeDeficits(deficits) - total_deficit = sum(deficits(this%single_p,1:nlevsoi)) + total_deficit = sum(deficits(bounds%begp,1:nlevsoi)) ! Set volr to be somewhat below the limiting amount - call this%setVolr(g = this%single_g, & + call this%setVolr(g = begg, & irrig_deficit = total_deficit, & irrig_river_volume_threshold = irrig_river_volume_threshold, & volr_diff_from_threshold = -10._r8, & @@ -1056,7 +1050,7 @@ contains ! Set available_gw_uncon to be 1/4 of the non-river-supplied irrigation expected_total = total_deficit / this%irrigation_params%irrig_length expected_gw = expected_total - volr_limited_irrig_rate - this%available_gw_uncon(this%single_c) = expected_gw * dtime / 4._r8 + this%available_gw_uncon(bounds%begc) = expected_gw * dtime / 4._r8 expected_gw_uncon = expected_gw / 4._r8 expected_gw_con = expected_gw - expected_gw_uncon @@ -1069,15 +1063,15 @@ contains @assertGreaterThan(expected_gw_uncon, 0._r8) @assertGreaterThan(expected_gw_con, 0._r8) ! Now do the actual assertions on the irrigation routine - call this%assertTotalIrrigationEquals(this%single_p, expected_total) + call this%assertTotalIrrigationEquals(bounds%begp, expected_total) ! Make sure that irrigation is properly divided into surface and groundwater (both ! patch and column-level) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(this%single_c), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(this%single_c), tolerance=tol) - @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(this%single_p), tolerance=tol) - @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(this%single_c), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(volr_limited_irrig_rate, this%waterflux%qflx_sfc_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_uncon, this%waterflux%qflx_gw_uncon_irrig_col(bounds%begc), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_patch(bounds%begp), tolerance=tol) + @assertEqual(expected_gw_con, this%waterflux%qflx_gw_con_irrig_col(bounds%begc), tolerance=tol) end subroutine limiting_volr_with_groundwater_uncon_and_con @Test @@ -1095,13 +1089,13 @@ contains ! adjust the soil water amount. Irrigation should continue at the original rate. call this%calculateAndApplyIrrigation() call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length call advance_timestep() this%h2osoi_liq = 100._r8 call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_continues_at_same_rate_for_multiple_time_steps @@ -1124,11 +1118,11 @@ contains call this%calculateAndApplyIrrigation() call advance_timestep() end do - call this%assertTotalIrrigationGreaterThanZero(this%single_p) + call this%assertTotalIrrigationGreaterThanZero(bounds%begp) ! Ensure that irrigation flux goes to 0 in the following time step call this%calculateAndApplyIrrigation() - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine irrigation_continues_for_correct_number_of_time_steps @@ -1155,18 +1149,18 @@ contains call advance_timestep() end do ! The following assertion is mainly here to make sure the test is working as intended - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) ! Now reset time, change soil moisture, and make sure that irrigation happens as expected call unittest_timemgr_set_curr_date(yr=5, mon=1, day=1, tod=irrig_start+dtime) this%h2osoi_liq(:,:) = 100._r8 call this%calculateAndApplyIrrigation() call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:nlevsoi)) / this%irrigation_params%irrig_length + expected = sum(deficits(bounds%begp,1:nlevsoi)) / this%irrigation_params%irrig_length ! Make sure that the test has been set up reasonably - to give a net deficit @assertLessThan(0._r8, expected) ! Here's the main assertion: - call this%assertTotalIrrigationEquals(this%single_p, expected) + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_flux_is_correct_on_second_day @@ -1188,8 +1182,8 @@ contains ! Check result call this%computeDeficits(deficits) ! Now on to the real assertion - expected = sum(deficits(this%single_p,1:nlevirrig)) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = sum(deficits(bounds%begp,1:nlevirrig)) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_excludes_deep_layers @Test @@ -1202,15 +1196,15 @@ contains call this%setupSinglePatch() call this%setupIrrigation() ! Make the last layer a bedrock layer: - col%nbedrock(this%single_c) = nlevsoi - 1 + col%nbedrock(bounds%begc) = nlevsoi - 1 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result call this%computeDeficits(deficits) - expected = sum(deficits(this%single_p,1:(nlevsoi-1))) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = sum(deficits(bounds%begp,1:(nlevsoi-1))) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine irrigation_excludes_bedrock_layers @Test @@ -1220,13 +1214,13 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%t_soisno(this%single_c, :) = 272._r8 + this%t_soisno(bounds%begc, :) = 272._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() ! Check result - call this%assertTotalIrrigationZero(this%single_p) + call this%assertTotalIrrigationZero(bounds%begp) end subroutine no_irrigation_for_frozen_soil @@ -1239,7 +1233,7 @@ contains ! Setup call this%setupSinglePatch() call this%setupIrrigation() - this%t_soisno(this%single_c, 2) = 272._r8 + this%t_soisno(bounds%begc, 2) = 272._r8 ! Call irrigation routines call this%calculateAndApplyIrrigation() @@ -1247,8 +1241,8 @@ contains ! Check result call this%computeDeficits(deficits) ! Only include deficit from top layer, since 2nd layer is frozen - expected = deficits(this%single_p, 1) / this%irrigation_params%irrig_length - call this%assertTotalIrrigationEquals(this%single_p, expected) + expected = deficits(bounds%begp, 1) / this%irrigation_params%irrig_length + call this%assertTotalIrrigationEquals(bounds%begp, expected) end subroutine no_irrigation_below_frozen_soil_layer From 31c56da57cc15f1c39c5e20687a9b3b815a0f54f Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 14 Nov 2018 12:43:02 -0700 Subject: [PATCH 30/41] Add an irrig_method_default namelist option This is used to set the irrigation method if it is not specified on the surface dataset. This is particularly useful for testing, until we can rely on having this on all surface datasets. --- bld/CLMBuildNamelist.pm | 3 +- .../namelist_defaults_clm4_5.xml | 1 + .../namelist_definition_clm4_5.xml | 5 +++ src/biogeophys/IrrigationMod.F90 | 42 ++++++++++++++++--- .../test/Irrigation_test/test_irrigation.pf | 3 +- 5 files changed, 46 insertions(+), 8 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 8bd59d2802..2ceb95c3bd 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2780,7 +2780,8 @@ sub setup_logic_irrigation_parameters { my $var; foreach $var ("irrig_min_lai", "irrig_start_time", "irrig_length", "irrig_target_smp", "irrig_depth", "irrig_threshold_fraction", - "limit_irrigation_if_rof_enabled","use_groundwater_irrigation") { + "limit_irrigation_if_rof_enabled","use_groundwater_irrigation", + "irrig_method_default") { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var); } diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index c79ca138fc..97dc6a9171 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -278,6 +278,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. +drip OFF diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index 9e4525c9f1..52b61099db 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -440,7 +440,12 @@ is turned off regardless of the setting of this namelist variable. If TRUE, supply irrigation from groundwater (in addition to surface water). + + +Irrigation method used if not specified on surface dataset Date: Wed, 14 Nov 2018 14:01:22 -0700 Subject: [PATCH 31/41] Add more error checking on use_groundwater_irrigation use_groundwater_irrigation only makes sense if limit_irrigation_if_rof_enabled is set (if limit_irrigation_if_rof_enabled is .false., then groundwater extraction will never be invoked). --- bld/CLMBuildNamelist.pm | 5 +++++ bld/namelist_files/namelist_definition_clm4_5.xml | 5 +++++ src/biogeophys/IrrigationMod.F90 | 7 +++++++ 3 files changed, 17 insertions(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 2ceb95c3bd..0943cae0d6 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2785,6 +2785,11 @@ sub setup_logic_irrigation_parameters { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var); } + if ( &value_is_true($nl->get_value('use_groundwater_irrigation')) && + ! &value_is_true($nl->get_value('limit_irrigation_if_rof_enabled'))) { + $log->fatal_error("use_groundwater_irrigation only makes sense if limit_irrigation_if_rof_enabled is set. (If limit_irrigation_if_rof_enabled is .false., then groundwater extraction will never be invoked.)") + } + my $lower = $nl->get_value( 'lower_boundary_condition' ); if ( ($lower == 3 || $lower == 4) && (&value_is_true($nl->get_value( 'use_groundwater_irrigation' ))) ) { $log->fatal_error("use_groundwater_irrigation can only be used when lower_boundary_condition is NOT 3 or 4"); diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index 52b61099db..51428e8c2c 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -440,6 +440,11 @@ is turned off regardless of the setting of this namelist variable. If TRUE, supply irrigation from groundwater (in addition to surface water). + +Can only be set if limit_irrigation_if_rof_enabled is true (otherwise +groundwater extraction is never invoked). + +Cannot be combined with lower_boundary_condition = 3 or 4 Date: Wed, 14 Nov 2018 14:31:43 -0700 Subject: [PATCH 32/41] Add tests covering the new irrigation options --- cime_config/testdefs/testlist_clm.xml | 20 +++++++++++++++++++ .../testmods_dirs/clm/_includes/README | 9 +++++++++ .../clm/_includes/irrig_alternate/user_nl_clm | 5 +++++ .../clm/irrig_alternate/include_user_mods | 2 ++ .../irrig_alternate_monthly/include_user_mods | 2 ++ 5 files changed, 38 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/_includes/README create mode 100644 cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm create mode 100644 cime_config/testdefs/testmods_dirs/clm/irrig_alternate/include_user_mods create mode 100644 cime_config/testdefs/testmods_dirs/clm/irrig_alternate_monthly/include_user_mods diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 7433eb9e30..3de3406207 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -760,6 +760,16 @@ + + + + + + + + + + @@ -1785,6 +1795,16 @@ + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/clm/_includes/README b/cime_config/testdefs/testmods_dirs/clm/_includes/README new file mode 100644 index 0000000000..3eaf50affa --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/_includes/README @@ -0,0 +1,9 @@ +This directory contains testmods directories that are meant to be +included in other testmods directories, not used directly. + +One reason for doing this is so that we can have testmods here that +apply science settings without including one of the testmods that is +typically included for setting output frequency (e.g., 'default' or +'monthly'). Then the testmods here can be included in other testmods +that use different output frequencies (e.g., daily vs. monthly) while +having the same science options. diff --git a/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm new file mode 100644 index 0000000000..2d3b194d60 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm @@ -0,0 +1,5 @@ + +! Settings from irrig_alternate: test some non-default irrigation options +limit_irrigation_if_rof_enabled = .true. +use_groundwater_irrigation = .true. +irrig_method_default = 'sprinkler' diff --git a/cime_config/testdefs/testmods_dirs/clm/irrig_alternate/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/irrig_alternate/include_user_mods new file mode 100644 index 0000000000..224c74adfc --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/irrig_alternate/include_user_mods @@ -0,0 +1,2 @@ +../_includes/irrig_alternate +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/irrig_alternate_monthly/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/irrig_alternate_monthly/include_user_mods new file mode 100644 index 0000000000..a2d9575131 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/irrig_alternate_monthly/include_user_mods @@ -0,0 +1,2 @@ +../_includes/irrig_alternate +../monthly From 454cedf533d42761c23e6b05c24590b200c5ac81 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Wed, 14 Nov 2018 14:45:07 -0700 Subject: [PATCH 33/41] Tweak test output for new qirrig fields --- .../testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm | 1 + .../testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm | 3 +-- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm index 2d3b194d60..a5b850669b 100644 --- a/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/_includes/irrig_alternate/user_nl_clm @@ -3,3 +3,4 @@ limit_irrigation_if_rof_enabled = .true. use_groundwater_irrigation = .true. irrig_method_default = 'sprinkler' +hist_fincl1 += 'QIRRIG_DEMAND','QIRRIG_DRIP','QIRRIG_SPRINKLER' diff --git a/cime_config/testdefs/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm index ee85bb983a..5356104bd8 100644 --- a/cime_config/testdefs/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/irrigOn_reduceOutput/user_nl_clm @@ -1,5 +1,4 @@ -hist_fincl1 += 'QIRRIG','QIRRIG_DEMAND' -hist_fincl2 += 'QIRRIG' +hist_fincl1 += 'QIRRIG_FROM_SURFACE','QIRRIG_FROM_GW_UNCONFINED','QIRRIG_FROM_GW_CONFINED','QIRRIG_DRIP','QIRRIG_SPRINKLER','QIRRIG_DEMAND' hist_dov2xy = .true.,.false. hist_nhtfrq = 0, -8760 hist_mfilt = 1,1 From 09cb145352dc2d80cb1708f10079203ebab80913 Mon Sep 17 00:00:00 2001 From: Sean Swenson Date: Thu, 15 Nov 2018 07:30:11 -0700 Subject: [PATCH 34/41] correct indices in histfileMod --- src/main/histFileMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 0b79cb0244..c2814247e5 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3059,7 +3059,7 @@ subroutine hfields_1dinfo(t, mode) call ncd_defvar(varname='land1d_jxy', xtype=ncd_int, dim1name=namel, & long_name='2d latitude index of corresponding landunit', ncid=ncid) - call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name='landunit', & + call ncd_defvar(varname='land1d_gi', xtype=ncd_int, dim1name=namel, & long_name='1d grid index of corresponding landunit', ncid=ncid) call ncd_defvar(varname='land1d_wtgcell', xtype=ncd_double, dim1name=namel, & @@ -3234,7 +3234,7 @@ subroutine hfields_1dinfo(t, mode) enddo call ncd_io(varname='cols1d_jxy' , data=icarr ,dim1name=namec, ncid=ncid, flag='write') do c = bounds%begc,bounds%endc - icarr(c) = GetGlobalIndex(decomp_index=col%gridcell(c), clmlevel=namel) + icarr(c) = GetGlobalIndex(decomp_index=col%gridcell(c), clmlevel=nameg) enddo call ncd_io(varname='cols1d_gi' , data=icarr, dim1name=namec, ncid=ncid, flag='write') do c = bounds%begc,bounds%endc @@ -3273,11 +3273,11 @@ subroutine hfields_1dinfo(t, mode) call ncd_io(varname='pfts1d_jxy' , data=iparr , dim1name=namep, ncid=ncid, flag='write') do p=bounds%begp,bounds%endp - iparr(p) = GetGlobalIndex(decomp_index=patch%gridcell(p), clmlevel=namec) + iparr(p) = GetGlobalIndex(decomp_index=patch%gridcell(p), clmlevel=nameg) enddo call ncd_io(varname='pfts1d_gi' , data=iparr, dim1name=namep, ncid=ncid, flag='write') do p=bounds%begp,bounds%endp - iparr(p) = GetGlobalIndex(decomp_index=patch%landunit(p), clmlevel=namec) + iparr(p) = GetGlobalIndex(decomp_index=patch%landunit(p), clmlevel=namel) enddo call ncd_io(varname='pfts1d_li' , data=iparr, dim1name=namep, ncid=ncid, flag='write') do p=bounds%begp,bounds%endp From b6f60d161be13a1da06153d83ae81033dae2bf3e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 10:50:09 -0700 Subject: [PATCH 35/41] Extract routine calling three related routines for irrigation withdrawal Point is to reduced complexity in the main driver --- src/biogeophys/HydrologyNoDrainageMod.F90 | 61 ++++++++++++++++++++++- src/biogeophys/SoilHydrologyMod.F90 | 6 +-- src/main/clm_driver.F90 | 42 ++++++++-------- 3 files changed, 83 insertions(+), 26 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index e76ce32eb3..164685dca4 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -18,6 +18,7 @@ Module HydrologyNoDrainageMod use SoilStateType , only : soilstate_type use SaturatedExcessRunoffMod, only : saturated_excess_runoff_type use InfiltrationExcessRunoffMod, only : infiltration_excess_runoff_type + use IrrigationMod, only : irrigation_type use WaterFluxBulkType , only : waterfluxbulk_type use WaterStateBulkType , only : waterstatebulk_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -31,11 +32,69 @@ Module HydrologyNoDrainageMod save ! ! !PUBLIC MEMBER FUNCTIONS: - public :: HydrologyNoDrainage ! Calculates soil/snow hydrology without drainage + public :: IrrigationWithdrawals ! Calculates irrigation withdrawal fluxes and withdraws from groundwater + public :: HydrologyNoDrainage ! Calculates soil/snow hydrology without drainage !----------------------------------------------------------------------- contains + !----------------------------------------------------------------------- + subroutine IrrigationWithdrawals(bounds, & + num_hydrologyc, filter_hydrologyc, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + soilhydrology_inst, soilstate_inst, & + irrigation_inst, & + waterdiagnosticbulk_inst, waterfluxbulk_inst, waterstatebulk_inst) + ! + ! !DESCRIPTION: + ! Calculates irrigation withdrawal fluxes and withdraws from groundwater + ! + ! !USES: + use SoilHydrologyMod , only : CalcAvailableUnconfinedAquifer + use SoilHydrologyMod , only : WithdrawGroundwaterIrrigation + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of points in filter_hydrologyc + integer , intent(in) :: filter_hydrologyc(:) ! column filter for hydrologically-active points + integer , intent(in) :: num_soilc ! number of points in filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter for soil points + integer , intent(in) :: num_soilp ! number of points in filter_soilp + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(soilhydrology_type) , intent(in) :: soilhydrology_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(irrigation_type) , intent(inout) :: irrigation_inst + type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst + type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst + type(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'IrrigationWithdrawals' + !----------------------------------------------------------------------- + + ! Calculate amount of water available for groundwater irrigation + call CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, & + filter_hydrologyc, soilhydrology_inst, soilstate_inst, & + waterdiagnosticbulk_inst) + + ! Calculate irrigation flux + call irrigation_inst%ApplyIrrigation(bounds, num_soilc, & + filter_soilc, num_soilp, filter_soilp, & + waterfluxbulk_inst, & + available_gw_uncon = waterdiagnosticbulk_inst%available_gw_uncon_col(bounds%begc:bounds%endc)) + + ! Remove groundwater irrigation + if (irrigation_inst%UseGroundwaterIrrigation()) then + call WithdrawGroundwaterIrrigation(bounds, num_hydrologyc, & + filter_hydrologyc, soilhydrology_inst, soilstate_inst, & + waterstatebulk_inst, & + waterfluxbulk_inst) + endif + + end subroutine IrrigationWithdrawals + !----------------------------------------------------------------------- subroutine HydrologyNoDrainage(bounds, & num_nolakec, filter_nolakec, & diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index ad1bf60f3b..fcb8f03577 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -2505,7 +2505,7 @@ subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrolo type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points - type(soilhydrology_type) , intent(inout) :: soilhydrology_inst + type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(soilstate_type) , intent(in) :: soilstate_inst type(waterdiagnosticbulk_type), intent(inout) :: waterdiagnosticbulk_inst ! @@ -2524,8 +2524,8 @@ subroutine CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, filter_hydrolo bsw => soilstate_inst%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" sucsat => soilstate_inst%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) watsat => soilstate_inst%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) - zwt => soilhydrology_inst%zwt_col , & ! Output: [real(r8) (:) ] water table depth (m) - available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/m2) + zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + available_gw_uncon => waterdiagnosticbulk_inst%available_gw_uncon_col & ! Output: [real(r8) (:) ] available water in the unconfined saturated zone (kg/m2) ) ! calculate amount of water in saturated zone that diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index c41d55d39c..cdac18e585 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -38,12 +38,10 @@ module clm_driver use UrbanFluxesMod , only : UrbanFluxes use LakeFluxesMod , only : LakeFluxes ! - use HydrologyNoDrainageMod , only : HydrologyNoDrainage ! (formerly Hydrology2Mod) + use HydrologyNoDrainageMod , only : IrrigationWithdrawals, HydrologyNoDrainage ! (formerly Hydrology2Mod) use HydrologyDrainageMod , only : HydrologyDrainage ! (formerly Hydrology2Mod) use CanopyHydrologyMod , only : CanopyHydrology ! (formerly Hydrology1Mod) use LakeHydrologyMod , only : LakeHydrology - use SoilHydrologyMod , only : CalcAvailableUnconfinedAquifer - use SoilHydrologyMod , only : WithdrawGroundwaterIrrigation use SoilWaterMovementMod , only : use_aquifer_layer ! use AerosolMod , only : AerosolMasses @@ -427,27 +425,27 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call setExposedvegpFilter(bounds_clump, & canopystate_inst%frac_veg_nosno_patch(bounds_clump%begp:bounds_clump%endp)) - ! Amount of water available for groundwater irrigation - call CalcAvailableUnconfinedAquifer(bounds_clump, filter(nc)%num_hydrologyc, & - filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & - water_inst%waterdiagnosticbulk_inst) - - ! Irrigation flux - ! input is main channel storage - call irrigation_inst%ApplyIrrigation(bounds_clump, filter(nc)%num_soilc, & - filter(nc)%soilc, filter(nc)%num_soilp, filter(nc)%soilp, & - water_inst%waterfluxbulk_inst, & - available_gw_uncon = water_inst%waterdiagnosticbulk_inst%available_gw_uncon_col(bounds_clump%begc:bounds_clump%endc)) call t_stopf('drvinit') - ! Remove groundwater irrigation - if (irrigation_inst%UseGroundwaterIrrigation()) then - call WithdrawGroundwaterIrrigation(bounds_clump, filter(nc)%num_hydrologyc, & - filter(nc)%hydrologyc, soilhydrology_inst, soilstate_inst, & - water_inst%waterstatebulk_inst, & - water_inst%waterfluxbulk_inst) - endif - + call t_startf('irrigationwithdraw') + + call IrrigationWithdrawals( & + bounds = bounds_clump, & + num_hydrologyc = filter(nc)%num_hydrologyc, & + filter_hydrologyc = filter(nc)%hydrologyc, & + num_soilc = filter(nc)%num_soilc, & + filter_soilc = filter(nc)%soilc, & + num_soilp = filter(nc)%num_soilp, & + filter_soilp = filter(nc)%soilp, & + soilhydrology_inst = soilhydrology_inst, & + soilstate_inst = soilstate_inst, & + irrigation_inst = irrigation_inst, & + waterdiagnosticbulk_inst = water_inst%waterdiagnosticbulk_inst, & + waterfluxbulk_inst = water_inst%waterfluxbulk_inst, & + waterstatebulk_inst = water_inst%waterstatebulk_inst) + + call t_stopf('irrigationwithdraw') + ! ============================================================================ ! Canopy Hydrology ! (1) water storage of intercepted precipitation From 0c9c8757ca54fc89f82b9a088237dccabccae5a6 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 11:31:23 -0700 Subject: [PATCH 36/41] Only do some irrigation calls if needed Avoid doing some unnecessary work if various conditionals are false --- src/biogeophys/HydrologyNoDrainageMod.F90 | 10 +-- src/biogeophys/IrrigationMod.F90 | 3 + src/main/clm_driver.F90 | 86 +++++++++++++---------- 3 files changed, 56 insertions(+), 43 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 164685dca4..d823c0f73c 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -75,9 +75,11 @@ subroutine IrrigationWithdrawals(bounds, & !----------------------------------------------------------------------- ! Calculate amount of water available for groundwater irrigation - call CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, & - filter_hydrologyc, soilhydrology_inst, soilstate_inst, & - waterdiagnosticbulk_inst) + if (irrigation_inst%UseGroundwaterIrrigation()) then + call CalcAvailableUnconfinedAquifer(bounds, num_hydrologyc, & + filter_hydrologyc, soilhydrology_inst, soilstate_inst, & + waterdiagnosticbulk_inst) + end if ! Calculate irrigation flux call irrigation_inst%ApplyIrrigation(bounds, num_soilc, & @@ -91,7 +93,7 @@ subroutine IrrigationWithdrawals(bounds, & filter_hydrologyc, soilhydrology_inst, soilstate_inst, & waterstatebulk_inst, & waterfluxbulk_inst) - endif + end if end subroutine IrrigationWithdrawals diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index bdb0f80e5f..20ab50c060 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -855,6 +855,9 @@ subroutine ApplyIrrigation(this, bounds, num_soilc, & ! ! Should be called once, AND ONLY ONCE, per time step. ! + ! It is acceptable for available_gw_uncon to be undefined if + ! this%UseGroundwaterIrrigation is .false. + ! ! !USES: ! ! !ARGUMENTS: diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index cdac18e585..0b91a4e879 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -11,7 +11,7 @@ module clm_driver use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : wrtdia, iulog, use_fates use clm_varctl , only : use_cn, use_lch4, use_noio, use_c13, use_c14 - use clm_varctl , only : use_crop, ndep_from_cpl + use clm_varctl , only : use_crop, irrigate, ndep_from_cpl use clm_time_manager , only : get_nstep, is_beg_curr_day use clm_time_manager , only : get_prev_date, is_first_step use clm_varpar , only : nlevsno, nlevgrnd @@ -427,24 +427,28 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('drvinit') - call t_startf('irrigationwithdraw') - - call IrrigationWithdrawals( & - bounds = bounds_clump, & - num_hydrologyc = filter(nc)%num_hydrologyc, & - filter_hydrologyc = filter(nc)%hydrologyc, & - num_soilc = filter(nc)%num_soilc, & - filter_soilc = filter(nc)%soilc, & - num_soilp = filter(nc)%num_soilp, & - filter_soilp = filter(nc)%soilp, & - soilhydrology_inst = soilhydrology_inst, & - soilstate_inst = soilstate_inst, & - irrigation_inst = irrigation_inst, & - waterdiagnosticbulk_inst = water_inst%waterdiagnosticbulk_inst, & - waterfluxbulk_inst = water_inst%waterfluxbulk_inst, & - waterstatebulk_inst = water_inst%waterstatebulk_inst) + if (irrigate) then + + call t_startf('irrigationwithdraw') + + call IrrigationWithdrawals( & + bounds = bounds_clump, & + num_hydrologyc = filter(nc)%num_hydrologyc, & + filter_hydrologyc = filter(nc)%hydrologyc, & + num_soilc = filter(nc)%num_soilc, & + filter_soilc = filter(nc)%soilc, & + num_soilp = filter(nc)%num_soilp, & + filter_soilp = filter(nc)%soilp, & + soilhydrology_inst = soilhydrology_inst, & + soilstate_inst = soilstate_inst, & + irrigation_inst = irrigation_inst, & + waterdiagnosticbulk_inst = water_inst%waterdiagnosticbulk_inst, & + waterfluxbulk_inst = water_inst%waterfluxbulk_inst, & + waterstatebulk_inst = water_inst%waterstatebulk_inst) - call t_stopf('irrigationwithdraw') + call t_stopf('irrigationwithdraw') + + end if ! ============================================================================ ! Canopy Hydrology @@ -612,28 +616,32 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro humanindex_inst) call t_stopf('bgplake') - ! ============================================================================ - ! Determine irrigation needed for future time steps - ! ============================================================================ + if (irrigate) then - ! NOTE(wjs, 2016-09-08) The placement of this call in the driver is historical: it - ! used to be that it had to come after btran was computed. Now it no longer depends - ! on btran, so it could be moved earlier in the driver loop - possibly even - ! immediately before ApplyIrrigation, which would be a more clear place to put it. - - call t_startf('irrigationneeded') - call irrigation_inst%CalcIrrigationNeeded( & - bounds = bounds_clump, & - num_exposedvegp = filter(nc)%num_exposedvegp, & - filter_exposedvegp = filter(nc)%exposedvegp, & - elai = canopystate_inst%elai_patch(bounds_clump%begp:bounds_clump%endp), & - t_soisno = temperature_inst%t_soisno_col(bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & - eff_porosity = soilstate_inst%eff_porosity_col(bounds_clump%begc:bounds_clump%endc, 1:nlevgrnd), & - h2osoi_liq = water_inst%waterstatebulk_inst%h2osoi_liq_col& - (bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & - volr = water_inst%wateratm2lndbulk_inst%volrmch_grc(bounds_clump%begg:bounds_clump%endg), & - rof_prognostic = rof_prognostic) - call t_stopf('irrigationneeded') + ! ============================================================================ + ! Determine irrigation needed for future time steps + ! ============================================================================ + + ! NOTE(wjs, 2016-09-08) The placement of this call in the driver is historical: it + ! used to be that it had to come after btran was computed. Now it no longer depends + ! on btran, so it could be moved earlier in the driver loop - possibly even + ! immediately before ApplyIrrigation, which would be a more clear place to put it. + + call t_startf('irrigationneeded') + call irrigation_inst%CalcIrrigationNeeded( & + bounds = bounds_clump, & + num_exposedvegp = filter(nc)%num_exposedvegp, & + filter_exposedvegp = filter(nc)%exposedvegp, & + elai = canopystate_inst%elai_patch(bounds_clump%begp:bounds_clump%endp), & + t_soisno = temperature_inst%t_soisno_col(bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & + eff_porosity = soilstate_inst%eff_porosity_col(bounds_clump%begc:bounds_clump%endc, 1:nlevgrnd), & + h2osoi_liq = water_inst%waterstatebulk_inst%h2osoi_liq_col& + (bounds_clump%begc:bounds_clump%endc , 1:nlevgrnd), & + volr = water_inst%wateratm2lndbulk_inst%volrmch_grc(bounds_clump%begg:bounds_clump%endg), & + rof_prognostic = rof_prognostic) + call t_stopf('irrigationneeded') + + end if ! ============================================================================ ! DUST and VOC emissions From dc72f0e3ccf0fe2679be3f2220de36840b8cd6bf Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 13:43:02 -0700 Subject: [PATCH 37/41] Restore accidentally-deleted line --- src/main/histFileMod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index c2814247e5..da3a6004d0 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -3285,6 +3285,7 @@ subroutine hfields_1dinfo(t, mode) enddo call ncd_io(varname='pfts1d_ci' , data=iparr , dim1name=namep, ncid=ncid, flag='write') + call ncd_io(varname='pfts1d_wtgcell' , data=patch%wtgcell , dim1name=namep, ncid=ncid, flag='write') call ncd_io(varname='pfts1d_wtlunit' , data=patch%wtlunit , dim1name=namep, ncid=ncid, flag='write') call ncd_io(varname='pfts1d_wtcol' , data=patch%wtcol , dim1name=namep, ncid=ncid, flag='write') call ncd_io(varname='pfts1d_itype_veg', data=patch%itype , dim1name=namep, ncid=ncid, flag='write') From 23645cbe6b8f3eda1113f851906eb2383242f020 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 13:52:35 -0700 Subject: [PATCH 38/41] Fix history field name in usermod --- cime_config/usermods_dirs/_includes/output_base/user_nl_clm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm index 8ed36a1fa3..5282916827 100644 --- a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm +++ b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm @@ -46,7 +46,7 @@ hist_mfilt(3) = 1 hist_dov2xy(3) = .false. hist_nhtfrq(3) = 0 hist_type1d_pertape(3) = 'LAND' -hist_fincl3 += 'FSR', 'H2OSNO', 'Q2M', 'SNOWDP', 'TSA', 'TREFMNAV', 'TREFMXAV', 'TG', 'QRUNOFF', 'FSH', 'FIRE', 'FIRA', 'FGR', 'EFLX_LH_TOT', 'RH2M', 'TLAI', 'SOILWATER_10CM', 'TOTSOILLIQ', 'TOTSOILICE', 'U10', 'TSOI_10CM', 'QIRRIG', 'URBAN_HEAT', 'WASTEHEAT', 'TSKIN' +hist_fincl3 += 'FSR', 'H2OSNO', 'Q2M', 'SNOWDP', 'TSA', 'TREFMNAV', 'TREFMXAV', 'TG', 'QRUNOFF', 'FSH', 'FIRE', 'FIRA', 'FGR', 'EFLX_LH_TOT', 'RH2M', 'TLAI', 'SOILWATER_10CM', 'TOTSOILLIQ', 'TOTSOILICE', 'U10', 'TSOI_10CM', 'QIRRIG_FROM_SURFACE', 'URBAN_HEAT', 'WASTEHEAT', 'TSKIN' ! h3 stream (yearly average, gridcell-level) ! Eyr From 21616fcd24664ca1cf5eb4c5e6c2fe88ff3b15f8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 16:04:43 -0700 Subject: [PATCH 39/41] Only try to access irrig_method for CFTs Without this, in runs with create_crop_landunit false, we run into problems trying to access irrig_method for the irrigated generic crop, which falls outside the bounds of clm_varsur's irrig_method array: at /gpfs/fs1/work/sacks/ctsm_code/current_branch1/src/biogeophys/IrrigationMod.F90:715 Fortran runtime error: Index '16' of dimension 2 of array 'irrig_method' below lower bound of 17 I'm not sure we want this check long-term, but we need it at least until the code for irrig_method is generalized to work with create_crop_landunit false. --- src/biogeophys/IrrigationMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 20ab50c060..54bf047221 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -50,7 +50,7 @@ module IrrigationMod use pftconMod , only : pftcon use clm_varctl , only : iulog use clm_varcon , only : isecspday, denh2o, spval, ispval, namec, nameg - use clm_varpar , only : nlevsoi, nlevgrnd + use clm_varpar , only : nlevsoi, nlevgrnd, cft_lb, cft_ub use clm_time_manager , only : get_step_size use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use WaterFluxBulkType , only : waterfluxbulk_type @@ -710,8 +710,8 @@ subroutine SetIrrigMethod(this, bounds) do p = bounds%begp,bounds%endp g = patch%gridcell(p) - if (pftcon%irrigated(patch%itype(p)) == 1._r8) then - m = patch%itype(p) + m = patch%itype(p) + if (m >= cft_lb .and. m <= cft_ub .and. pftcon%irrigated(m) == 1._r8) then this%irrig_method_patch(p) = irrig_method(g,m) ! ensure irrig_method is valid; if not set, use drip irrigation if(irrig_method(g,m) == irrig_method_unset) then From 1074092b73c161ff6c47336d584ec879d7123bd8 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Thu, 15 Nov 2018 16:11:34 -0700 Subject: [PATCH 40/41] Better method for only accessing irrig_method for CFTs This is an improvement over the previous commit in that (1) it is more general, in case we change how clm_varsur's irrig_method is allocated, and (2) it works for the unit tests. --- src/biogeophys/IrrigationMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/IrrigationMod.F90 b/src/biogeophys/IrrigationMod.F90 index 54bf047221..4b5c3011bd 100644 --- a/src/biogeophys/IrrigationMod.F90 +++ b/src/biogeophys/IrrigationMod.F90 @@ -50,7 +50,7 @@ module IrrigationMod use pftconMod , only : pftcon use clm_varctl , only : iulog use clm_varcon , only : isecspday, denh2o, spval, ispval, namec, nameg - use clm_varpar , only : nlevsoi, nlevgrnd, cft_lb, cft_ub + use clm_varpar , only : nlevsoi, nlevgrnd use clm_time_manager , only : get_step_size use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type use WaterFluxBulkType , only : waterfluxbulk_type @@ -711,7 +711,8 @@ subroutine SetIrrigMethod(this, bounds) do p = bounds%begp,bounds%endp g = patch%gridcell(p) m = patch%itype(p) - if (m >= cft_lb .and. m <= cft_ub .and. pftcon%irrigated(m) == 1._r8) then + if (m >= lbound(irrig_method, 2) .and. m <= ubound(irrig_method, 2) & + .and. pftcon%irrigated(m) == 1._r8) then this%irrig_method_patch(p) = irrig_method(g,m) ! ensure irrig_method is valid; if not set, use drip irrigation if(irrig_method(g,m) == irrig_method_unset) then From 6a7b0a11ee10c5f734d9da634ded1094c92a45b0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 16 Nov 2018 06:05:22 -0700 Subject: [PATCH 41/41] Minor cleanup --- src/biogeophys/HydrologyDrainageMod.F90 | 1 - src/main/surfrdMod.F90 | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/biogeophys/HydrologyDrainageMod.F90 b/src/biogeophys/HydrologyDrainageMod.F90 index c832bebf6a..1fb66cc80e 100644 --- a/src/biogeophys/HydrologyDrainageMod.F90 +++ b/src/biogeophys/HydrologyDrainageMod.F90 @@ -91,7 +91,6 @@ subroutine HydrologyDrainage(bounds, & qflx_floodg => wateratm2lndbulk_inst%forc_flood_grc , & ! Input: rain rate [mm/s] forc_rain => wateratm2lndbulk_inst%forc_rain_downscaled_col , & ! Input: snow rate [mm/s] forc_snow => wateratm2lndbulk_inst%forc_snow_downscaled_col , & ! Input: water mass begining of the time step - wa => waterstatebulk_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) begwb => waterbalancebulk_inst%begwb_col , & ! Output:water mass end of the time step endwb => waterbalancebulk_inst%endwb_col , & ! Output:water mass end of the time step h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: ice lens (kg/m2) diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index b9d4eaa32d..cd6789b957 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -619,7 +619,7 @@ subroutine surfrd_cftformat( ncid, begg, endg, wt_cft, cftsize, natpft_size ) dim1name=grlnd, readvar=readvar) if (.not. readvar) then if ( masterproc ) & - write(iulog,*) ' WARNING: irrigation_method NOT on surfdata file zero out' + write(iulog,*) ' WARNING: irrigation_method NOT on surfdata file; using default' irrig_method = irrig_method_unset end if else