From 0fc8b9cc56e261e8b761385048a902bfb0ad8ac9 Mon Sep 17 00:00:00 2001
From: Kyle <kyle.c.klenk@gmail.com>
Date: Tue, 6 Sep 2022 21:30:21 +0000
Subject: [PATCH] updated up to soilLiqFlx in computFlux.f90
---
build/source/engine/computFlux.f90 | 309 +-
build/source/engine/read_paramActors.f90 | 5 -
build/source/engine/soilLiqFlx.f90 | 3613 +++++++++--------
build/source/engine/soilLiqFlx_old.f90 | 1759 ++++++++
build/source/engine/ssdNrgFlux.f90 | 1245 ++++--
build/source/engine/ssdNrgFlux_old.f90 | 307 ++
.../source/engine/sundials/computEnthalpy.f90 | 2 +-
.../source/engine/sundials/computHeatCap.f90 | 24 +-
.../engine/sundials/soil_utilsSundials.f90 | 7 +-
.../engine/sundials/updatStateSundials.f90 | 2 -
.../engine/sundials/updateVars4JacDAE.f90 | 2 -
.../engine/sundials/updateVarsSundials.f90 | 1 -
.../engine/sundials/varExtrSundials.f90 | 10 -
13 files changed, 5121 insertions(+), 2165 deletions(-)
mode change 100755 => 100644 build/source/engine/soilLiqFlx.f90
create mode 100755 build/source/engine/soilLiqFlx_old.f90
mode change 100755 => 100644 build/source/engine/ssdNrgFlux.f90
create mode 100755 build/source/engine/ssdNrgFlux_old.f90
diff --git a/build/source/engine/computFlux.f90 b/build/source/engine/computFlux.f90
index 319abc7..e8b3312 100755
--- a/build/source/engine/computFlux.f90
+++ b/build/source/engine/computFlux.f90
@@ -209,6 +209,9 @@ subroutine computFlux(&
logical(lgt) :: doVegNrgFlux ! flag to compute the energy flux over vegetation
real(dp),dimension(nSoil) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t matric head (s-1)
character(LEN=256) :: cmessage ! error message of downwind routine
+ real(dp) :: above_soilLiqFluxDeriv ! derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ real(dp) :: above_soildLiq_dTk ! derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ real(dp) :: above_soilFracLiq ! fraction of liquid water layer above soil (canopy or snow) (-)
! --------------------------------------------------------------
! initialize error control
err=0; message='computFlux/'
@@ -298,7 +301,9 @@ subroutine computFlux(&
scalarSoilControl => diag_data%var(iLookDIAG%scalarSoilControl )%dat(1) ,& ! intent(out): [dp] soil control on infiltration, zero or one
scalarMaxInfilRate => flux_data%var(iLookFLUX%scalarMaxInfilRate)%dat(1) ,& ! intent(out): [dp] maximum infiltration rate (m s-1)
scalarInfiltration => flux_data%var(iLookFLUX%scalarInfiltration)%dat(1) ,& ! intent(out): [dp] infiltration of water into the soil profile (m s-1)
-
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(inout): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(inout): [dp(:)] fraction of liquid water in each snow layer (-)
+
! boundary fluxes in the soil domain
scalarThroughfallRain => flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) ,& ! intent(out): [dp] rain that reaches the ground without ever touching the canopy (kg m-2 s-1)
scalarCanopyLiqDrainage => flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) ,& ! intent(out): [dp] drainage of liquid water from the vegetation canopy (kg m-2 s-1)
@@ -356,6 +361,10 @@ subroutine computFlux(&
dNrgFlux_dTempAbove => deriv_data%var(iLookDERIV%dNrgFlux_dTempAbove )%dat ,& ! intent(out): [dp(:)] derivatives in the flux w.r.t. temperature in the layer above
dNrgFlux_dTempBelow => deriv_data%var(iLookDERIV%dNrgFlux_dTempBelow )%dat ,& ! intent(out): [dp(:)] derivatives in the flux w.r.t. temperature in the layer below
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
+ dNrgFlux_dWatAbove => deriv_data%var(iLookDERIV%dNrgFlux_dWatAbove )%dat ,& ! intent(out): [dp(:)] derivatives in the flux w.r.t. water state in the layer above
+ dNrgFlux_dWatBelow => deriv_data%var(iLookDERIV%dNrgFlux_dWatBelow )%dat ,& ! intent(out): [dp(:)] derivatives in the flux w.r.t. water state in the layer below
+
! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
iLayerLiqFluxSnowDeriv => deriv_data%var(iLookDERIV%iLayerLiqFluxSnowDeriv )%dat ,& ! intent(out): [dp(:)] derivative in vertical liquid water flux at layer interfaces
@@ -363,6 +372,7 @@ subroutine computFlux(&
dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in total water content w.r.t. total water matric potential
dq_dHydStateAbove => deriv_data%var(iLookDERIV%dq_dHydStateAbove )%dat ,& ! intent(out): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
dq_dHydStateBelow => deriv_data%var(iLookDERIV%dq_dHydStateBelow )%dat ,& ! intent(out): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
+ dq_dHydStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dHydStateLayerSurfVec )%dat ,& ! intent(out): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
mLayerdTheta_dPsi => deriv_data%var(iLookDERIV%mLayerdTheta_dPsi )%dat ,& ! intent(out): [dp(:)] derivative in the soil water characteristic w.r.t. psi
mLayerdPsi_dTheta => deriv_data%var(iLookDERIV%mLayerdPsi_dTheta )%dat ,& ! intent(out): [dp(:)] derivative in the soil water characteristic w.r.t. theta
dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi )%dat ,& ! intent(out): [dp(:)] derivative in compressibility w.r.t matric head
@@ -372,8 +382,21 @@ subroutine computFlux(&
! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
dq_dNrgStateAbove => deriv_data%var(iLookDERIV%dq_dNrgStateAbove )%dat ,& ! intent(out): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
- dq_dNrgStateBelow => deriv_data%var(iLookDERIV%dq_dNrgStateBelow )%dat & ! intent(out): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
-
+ dq_dNrgStateBelow => deriv_data%var(iLookDERIV%dq_dNrgStateBelow )%dat ,& ! intent(out): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
+ dq_dNrgStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dNrgStateLayerSurfVec )%dat ,& ! intent(out): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
+
+ ! derivatives in soil transpiration w.r.t. canopy state variables
+ mLayerdTrans_dTCanair => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanair )%dat ,& !intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ mLayerdTrans_dTCanopy => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanopy )%dat ,& ! intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ mLayerdTrans_dTGround => deriv_data%var(iLookDERIV%mLayerdTrans_dTGround )%dat ,& ! intent(out): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ mLayerdTrans_dCanWat => deriv_data%var(iLookDERIV%mLayerdTrans_dCanWat )%dat ,& ! intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy total water
+
+ ! derivatives in aquifer transpiration w.r.t. canopy state variables
+ dAquiferTrans_dTCanair => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanair )%dat(1) ,& !intent(out): derivatives in the aquifer transpiration flux w.r.t. canopy air temperature
+ dAquiferTrans_dTCanopy => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanopy )%dat(1) ,& ! intent(out): derivatives in the aquifer transpiration flux w.r.t. canopy temperature
+ dAquiferTrans_dTGround => deriv_data%var(iLookDERIV%dAquiferTrans_dTGround )%dat(1) ,& ! intent(out): derivatives in the aquifer transpiration flux w.r.t. ground temperature
+ dAquiferTrans_dCanWat => deriv_data%var(iLookDERIV%dAquiferTrans_dCanWat )%dat(1) & ! intent(out): derivatives in the aquifer transpiration flux w.r.t. canopy total water
+
) ! association to data in structures
! *****
@@ -477,126 +500,71 @@ subroutine computFlux(&
! output: error control
err,cmessage) ! intent(out): error control
- ! ! calculate the energy fluxes over vegetation
- ! call vegNrgFlux(&
- ! ! input: model control
- ! firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- ! firstFluxCall, & ! intent(in): flag to indicate if we are processing the first flux call
- ! computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- ! requireLWBal, & ! intent(in): flag to indicate if we need longwave to be balanced
- ! ! input: model state variables
- ! upperBoundTemp, & ! intent(in): temperature of the upper boundary (K) --> NOTE: use air temperature
- ! scalarCanairTempTrial, & ! intent(in): trial value of the canopy air space temperature (K)
- ! scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
- ! mLayerTempTrial(1), & ! intent(in): trial value of ground temperature (K)
- ! scalarCanopyIceTrial, & ! intent(in): trial value of mass of ice on the vegetation canopy (kg m-2)
- ! scalarCanopyLiqTrial, & ! intent(in): trial value of mass of liquid water on the vegetation canopy (kg m-2)
- ! ! input: model derivatives
- ! dCanLiq_dTcanopy, & ! intent(in): derivative in canopy liquid storage w.r.t. canopy temperature (kg m-2 K-1)
- ! ! input/output: data structures
- ! type_data, & ! intent(in): type of vegetation and soil
- ! forc_data, & ! intent(in): model forcing data
- ! mpar_data, & ! intent(in): model parameters
- ! indx_data, & ! intent(in): index data
- ! prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- ! flux_data, & ! intent(inout): model fluxes for a local HRU
- ! bvar_data, & ! intent(in): model variables for the local basin
- ! model_decisions, & ! intent(in): model decisions
- ! ! output: liquid water fluxes associated with evaporation/transpiration
- ! scalarCanopyTranspiration, & ! intent(out): canopy transpiration (kg m-2 s-1)
- ! scalarCanopyEvaporation, & ! intent(out): canopy evaporation/condensation (kg m-2 s-1)
- ! scalarGroundEvaporation, & ! intent(out): ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
- ! ! output: fluxes
- ! scalarCanairNetNrgFlux, & ! intent(out): net energy flux for the canopy air space (W m-2)
- ! scalarCanopyNetNrgFlux, & ! intent(out): net energy flux for the vegetation canopy (W m-2)
- ! scalarGroundNetNrgFlux, & ! intent(out): net energy flux for the ground surface (W m-2)
- ! ! output: flux derivatives
- ! dCanairNetFlux_dCanairTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
- ! dCanairNetFlux_dCanopyTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
- ! dCanairNetFlux_dGroundTemp, & ! intent(out): derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
- ! dCanopyNetFlux_dCanairTemp, & ! intent(out): derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
- ! dCanopyNetFlux_dCanopyTemp, & ! intent(out): derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
- ! dCanopyNetFlux_dGroundTemp, & ! intent(out): derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
- ! dGroundNetFlux_dCanairTemp, & ! intent(out): derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
- ! dGroundNetFlux_dCanopyTemp, & ! intent(out): derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
- ! dGroundNetFlux_dGroundTemp, & ! intent(out): derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
- ! ! output: liquid water flux derivarives (canopy evap)
- ! dCanopyEvaporation_dCanWat, & ! intent(out): derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
- ! dCanopyEvaporation_dTCanair, & ! intent(out): derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
- ! dCanopyEvaporation_dTCanopy, & ! intent(out): derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
- ! dCanopyEvaporation_dTGround, & ! intent(out): derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- ! ! output: liquid water flux derivarives (ground evap)
- ! dGroundEvaporation_dCanWat, & ! intent(out): derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
- ! dGroundEvaporation_dTCanair, & ! intent(out): derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
- ! dGroundEvaporation_dTCanopy, & ! intent(out): derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
- ! dGroundEvaporation_dTGround, & ! intent(out): derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- ! ! output: cross derivative terms
- ! dCanopyNetFlux_dCanWat, & ! intent(out): derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
- ! dGroundNetFlux_dCanWat, & ! intent(out): derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
- ! ! output: error control
- ! err,cmessage) ! intent(out): error control
- ! if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- ! check fluxes
- if(globalPrintFlag)then
- print*, '**'
- write(*,'(a,1x,10(f30.20))') 'canopyDepth = ', canopyDepth
- write(*,'(a,1x,10(f30.20))') 'mLayerDepth(1:2) = ', mLayerDepth(1:2)
- write(*,'(a,1x,10(f30.20))') 'scalarCanairTempTrial = ', scalarCanairTempTrial ! trial value of the canopy air space temperature (K)
- write(*,'(a,1x,10(f30.20))') 'scalarCanopyTempTrial = ', scalarCanopyTempTrial ! trial value of canopy temperature (K)
- write(*,'(a,1x,10(f30.20))') 'mLayerTempTrial(1:2) = ', mLayerTempTrial(1:2) ! trial value of ground temperature (K)
- write(*,'(a,1x,10(f30.20))') 'scalarCanairNetNrgFlux = ', scalarCanairNetNrgFlux
- write(*,'(a,1x,10(f30.20))') 'scalarCanopyNetNrgFlux = ', scalarCanopyNetNrgFlux
- write(*,'(a,1x,10(f30.20))') 'scalarGroundNetNrgFlux = ', scalarGroundNetNrgFlux
- write(*,'(a,1x,10(f30.20))') 'dGroundNetFlux_dGroundTemp = ', dGroundNetFlux_dGroundTemp
- endif ! if checking fluxes
-
- endif ! if calculating the energy fluxes over vegetation
-
- ! *****
- ! * CALCULATE ENERGY FLUXES THROUGH THE SNOW-SOIL DOMAIN...
- ! **********************************************************
-
- ! check the need to compute energy fluxes throughout the snow+soil domain
- if(nSnowSoilNrg>0)then
+ ! check fluxes
+ if(globalPrintFlag)then
+ print*, '**'
+ write(*,'(a,1x,10(f30.20))') 'canopyDepth = ', canopyDepth
+ write(*,'(a,1x,10(f30.20))') 'mLayerDepth(1:2) = ', mLayerDepth(1:2)
+ write(*,'(a,1x,10(f30.20))') 'scalarCanairTempTrial = ', scalarCanairTempTrial ! trial value of the canopy air space temperature (K)
+ write(*,'(a,1x,10(f30.20))') 'scalarCanopyTempTrial = ', scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ write(*,'(a,1x,10(f30.20))') 'mLayerTempTrial(1:2) = ', mLayerTempTrial(1:2) ! trial value of ground temperature (K)
+ write(*,'(a,1x,10(f30.20))') 'scalarCanairNetNrgFlux = ', scalarCanairNetNrgFlux
+ write(*,'(a,1x,10(f30.20))') 'scalarCanopyNetNrgFlux = ', scalarCanopyNetNrgFlux
+ write(*,'(a,1x,10(f30.20))') 'scalarGroundNetNrgFlux = ', scalarGroundNetNrgFlux
+ write(*,'(a,1x,10(f30.20))') 'dGroundNetFlux_dGroundTemp = ', dGroundNetFlux_dGroundTemp
+ endif ! if checking fluxes
+
+ endif ! if calculating the energy fluxes over vegetation
- ! calculate energy fluxes at layer interfaces through the snow and soil domain
- call ssdNrgFlux(&
- ! input: model control
- (scalarSolution .and. .not.firstFluxCall), & ! intent(in): flag to indicate the scalar solution
- ! input: fluxes and derivatives at the upper boundary
- scalarGroundNetNrgFlux, & ! intent(in): total flux at the ground surface (W m-2)
- dGroundNetFlux_dGroundTemp, & ! intent(in): derivative in total ground surface flux w.r.t. ground temperature (W m-2 K-1)
- ! input: liquid water fluxes throughout the snow and soil domains
- iLayerLiqFluxSnow, & ! intent(in): liquid flux at the interface of each snow layer (m s-1)
- iLayerLiqFluxSoil, & ! intent(in): liquid flux at the interface of each soil layer (m s-1)
- ! input: trial value of model state variabes
- mLayerTempTrial, & ! intent(in): trial temperature at the current iteration (K)
- mLayerMatricHeadTrial, & ! intent(in): trial value for the total water matric potential in each soil layer (m)
- mLayerVolFracLiqTrial, & ! intent(in): trial volumetric fraction of liquid water at the current iteration(-)
- mLayerVolFracIceTrial, & ! intent(in): trial volumetric fraction of ice water at the current iteration(-)
- ! input-output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- ! output: fluxes and derivatives at all layer interfaces
- iLayerNrgFlux, & ! intent(out): energy flux at the layer interfaces (W m-2)
- dNrgFlux_dTempAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (W m-2 K-1)
- dNrgFlux_dTempBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (W m-2 K-1)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! calculate net energy fluxes for each snow and soil layer (J m-3 s-1)
- do iLayer=1,nLayers
- mLayerNrgFlux(iLayer) = -(iLayerNrgFlux(iLayer) - iLayerNrgFlux(iLayer-1))/mLayerDepth(iLayer)
- if(globalPrintFlag)then
- if(iLayer < 10) write(*,'(a,1x,i4,1x,10(f25.15,1x))') 'iLayer, iLayerNrgFlux(iLayer-1:iLayer), mLayerNrgFlux(iLayer) = ', iLayer, iLayerNrgFlux(iLayer-1:iLayer), mLayerNrgFlux(iLayer)
- endif
- end do
+ ! *****
+ ! * CALCULATE ENERGY FLUXES THROUGH THE SNOW-SOIL DOMAIN...
+ ! **********************************************************
+
+ ! check the need to compute energy fluxes throughout the snow+soil domain
+ if(nSnowSoilNrg>0)then
+
+ ! calculate energy fluxes at layer interfaces through the snow and soil domain
+ call ssdNrgFlux(&
+ ! input: model control
+ (scalarSolution .and. .not.firstFluxCall), & ! intent(in): flag to indicate the scalar solution
+ .true., & ! intent(in): flag indicating if derivatives are desired
+ ! input: fluxes and derivatives at the upper boundary
+ scalarGroundNetNrgFlux, & ! intent(in): total flux at the ground surface (W m-2)
+ dGroundNetFlux_dGroundTemp, & ! intent(in): derivative in total ground surface flux w.r.t. ground temperature (W m-2 K-1)
+ ! input: liquid water fluxes throughout the snow and soil domains
+ iLayerLiqFluxSnow, & ! intent(in): liquid flux at the interface of each snow layer (m s-1)
+ iLayerLiqFluxSoil, & ! intent(in): liquid flux at the interface of each soil layer (m s-1)
+ ! input: trial value of model state variabes
+ mLayerTempTrial, & ! intent(in): trial temperature at the current iteration (K)
+ mLayerMatricHeadTrial, & ! intent(in): trial value for the total water matric potential in each soil layer (m)
+ mLayerVolFracLiqTrial, & ! intent(in): trial volumetric fraction of liquid water at the current iteration(-)
+ mLayerVolFracIceTrial, & ! intent(in): trial volumetric fraction of ice water at the current iteration(-)
+ ! input: pre-computed derivatives
+ mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ mLayerFracLiqSnow, & ! intent(in): fraction of liquid water (-)
+ ! input-output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! output: fluxes and derivatives at all layer interfaces
+ iLayerNrgFlux, & ! intent(out): energy flux at the layer interfaces (W m-2)
+ dNrgFlux_dTempAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (W m-2 K-1)
+ dNrgFlux_dTempBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (W m-2 K-1)
+ dNrgFlux_dWatAbove, & ! intent(out): derivatives in the flux w.r.t. water state in the layer above
+ dNrgFlux_dWatBelow, & ! intent(out): derivatives in the flux w.r.t. water state in the layer below
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! calculate net energy fluxes for each snow and soil layer (J m-3 s-1)
+ do iLayer=1,nLayers
+ mLayerNrgFlux(iLayer) = -(iLayerNrgFlux(iLayer) - iLayerNrgFlux(iLayer-1))/mLayerDepth(iLayer)
+ if(globalPrintFlag)then
+ if(iLayer < 10) write(*,'(a,1x,i4,1x,10(f25.15,1x))') 'iLayer, iLayerNrgFlux(iLayer-1:iLayer), mLayerNrgFlux(iLayer) = ', iLayer, iLayerNrgFlux(iLayer-1:iLayer), mLayerNrgFlux(iLayer)
+ endif
+ end do
endif ! if computing energy fluxes throughout the snow+soil domain
@@ -688,14 +656,34 @@ subroutine computFlux(&
! compute drainage from the soil zone (needed for mass balance checks)
scalarSnowDrainage = iLayerLiqFluxSnow(nSnow)
+ ! save bottom layer of snow derivatives
+ above_soilLiqFluxDeriv = iLayerLiqFluxSnowDeriv(nSnow) ! derivative in vertical liquid water flux at bottom snow layer interface
+ above_soildLiq_dTk = mLayerdTheta_dTk(nSnow) ! derivative in volumetric liquid water content in bottom snow layer w.r.t. temperature
+ above_soilFracLiq = mLayerFracLiqSnow(nSnow) ! fraction of liquid water in bottom snow layer (-)
+
else
! define forcing for the soil domain for the case of no snow layers
! NOTE: in case where nSnowOnlyHyd==0 AND snow layers exist, then scalarRainPlusMelt is taken from the previous flux evaluation
- if(nSnow==0)then
- scalarRainPlusMelt = (scalarThroughfallRain + scalarCanopyLiqDrainage)/iden_water & ! liquid flux from the canopy (m s-1)
- + drainageMeltPond/iden_water ! melt of the snow without a layer (m s-1)
- endif ! if no snow layers
+ if(nSnow==0)then !no snow layers
+ scalarRainPlusMelt = (scalarThroughfallRain + scalarCanopyLiqDrainage)/iden_water & ! liquid flux from the canopy (m s-1)
+ + drainageMeltPond/iden_water ! melt of the snow without a layer (m s-1)
+
+ if(ixVegHyd/=integerMissing)then
+ ! save canopy derivatives
+ above_soilLiqFluxDeriv = scalarCanopyLiqDeriv/iden_water ! derivative in (throughfall + drainage) w.r.t. canopy liquid water
+ above_soildLiq_dTk = dCanLiq_dTcanopy ! derivative of canopy liquid storage w.r.t. temperature
+ above_soilFracLiq = scalarFracLiqVeg ! fraction of liquid water in canopy (-)
+ else
+ above_soilLiqFluxDeriv = 0._rkind
+ above_soildLiq_dTk = 0._rkind
+ above_soilFracLiq = 0._rkind
+ endif
+ else ! snow layers, take from previous flux calculation
+ above_soilLiqFluxDeriv = iLayerLiqFluxSnowDeriv(nSnow) ! derivative in vertical liquid water flux at bottom snow layer interface
+ above_soildLiq_dTk = mLayerdTheta_dTk(nSnow) ! derivative in volumetric liquid water content in bottom snow layer w.r.t. temperature
+ above_soilFracLiq = mLayerFracLiqSnow(nSnow) ! fraction of liquid water in bottom snow layer (-)
+ endif ! snow layers or not
endif
@@ -721,6 +709,13 @@ subroutine computFlux(&
! input: pre-computed deriavatives
mLayerdTheta_dTk(nSnow+1:nLayers), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
dPsiLiq_dTemp(1:nSoil), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dCanopyTrans_dCanWat, & ! intent(in): derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ dCanopyTrans_dTCanair, & ! intent(in): derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ dCanopyTrans_dTCanopy, & ! intent(in): derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ dCanopyTrans_dTGround, & ! intent(in): derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ above_soilLiqFluxDeriv, & ! intent(in): derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ above_soildLiq_dTk, & ! intent(in): derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ above_soilFracLiq, & ! intent(in): fraction of liquid water layer above soil (canopy or snow) (-)
! input: fluxes
scalarCanopyTranspiration, & ! intent(in): canopy transpiration (kg m-2 s-1)
scalarGroundEvaporation, & ! intent(in): ground evaporation (kg m-2 s-1)
@@ -748,12 +743,72 @@ subroutine computFlux(&
! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
dq_dHydStateAbove, & ! intent(inout): derivatives in the flux w.r.t. matric head in the layer above (s-1)
dq_dHydStateBelow, & ! intent(inout): derivatives in the flux w.r.t. matric head in the layer below (s-1)
+ dq_dHydStateLayerSurfVec, & ! intent(inout): derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
dq_dNrgStateAbove, & ! intent(inout): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
dq_dNrgStateBelow, & ! intent(inout): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ dq_dNrgStateLayerSurfVec, & ! intent(inout): derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ ! output: derivatives in transpiration w.r.t. canopy state variables
+ mLayerdTrans_dTCanair, & ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ mLayerdTrans_dTCanopy, & ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ mLayerdTrans_dTGround, & ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ mLayerdTrans_dCanWat, & ! intent(inout): derivatives in the soil layer transpiration flux w.r.t. canopy total water
! output: error control
err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! calculate the liquid flux through soil
+ ! call soilLiqFlx(&
+ ! ! input: model control
+ ! nSoil, & ! intent(in): number of soil layers
+ ! firstSplitOper, & ! intent(in): flag indicating first flux call in a splitting operation
+ ! (scalarSolution .and. .not.firstFluxCall), & ! intent(in): flag to indicate the scalar solution
+ ! .true., & ! intent(in): flag indicating if derivatives are desired
+ ! ! input: trial state variables
+ ! mLayerTempTrial(nSnow+1:nLayers), & ! intent(in): trial temperature at the current iteration (K)
+ ! mLayerMatricHeadLiqTrial(1:nSoil), & ! intent(in): liquid water matric potential (m)
+ ! mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): volumetric fraction of liquid water (-)
+ ! mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): volumetric fraction of ice (-)
+ ! ! input: pre-computed deriavatives
+ ! mLayerdTheta_dTk(nSnow+1:nLayers), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ ! dPsiLiq_dTemp(1:nSoil), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! ! input: fluxes
+ ! scalarCanopyTranspiration, & ! intent(in): canopy transpiration (kg m-2 s-1)
+ ! scalarGroundEvaporation, & ! intent(in): ground evaporation (kg m-2 s-1)
+ ! scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! ! input-output: data structures
+ ! mpar_data, & ! intent(in): model parameters
+ ! indx_data, & ! intent(in): model indices
+ ! prog_data, & ! intent(inout): model prognostic variables for a local HRU
+ ! diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ ! flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! ! output: diagnostic variables for surface runoff
+ ! scalarMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ ! scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ ! scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ ! scalarSurfaceRunoff, & ! intent(inout): surface runoff (m s-1)
+ ! ! output: diagnostic variables for model layers
+ ! mLayerdTheta_dPsi, & ! intent(inout): derivative in the soil water characteristic w.r.t. psi (m-1)
+ ! mLayerdPsi_dTheta, & ! intent(inout): derivative in the soil water characteristic w.r.t. theta (m)
+ ! dHydCond_dMatric, & ! intent(inout): derivative in hydraulic conductivity w.r.t matric head (s-1)
+ ! ! output: fluxes
+ ! scalarInfiltration, & ! intent(inout): surface infiltration rate (m s-1) -- controls on infiltration only computed for iter==1
+ ! iLayerLiqFluxSoil, & ! intent(inout): liquid fluxes at layer interfaces (m s-1)
+ ! mLayerTranspire, & ! intent(inout): transpiration loss from each soil layer (m s-1)
+ ! mLayerHydCond, & ! intent(inout): hydraulic conductivity in each layer (m s-1)
+ ! ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ ! dq_dHydStateAbove, & ! intent(inout): derivatives in the flux w.r.t. matric head in the layer above (s-1)
+ ! dq_dHydStateBelow, & ! intent(inout): derivatives in the flux w.r.t. matric head in the layer below (s-1)
+ ! ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ ! dq_dNrgStateAbove, & ! intent(inout): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ ! dq_dNrgStateBelow, & ! intent(inout): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! ! output: error control
+ ! err,cmessage) ! intent(out): error control
+ ! if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
! print*, "After soil Liq call ", flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat
diff --git a/build/source/engine/read_paramActors.f90 b/build/source/engine/read_paramActors.f90
index 661ffe6..356246f 100755
--- a/build/source/engine/read_paramActors.f90
+++ b/build/source/engine/read_paramActors.f90
@@ -51,7 +51,6 @@ contains
subroutine read_param(indxHRU,indxGRU,mparStruct,bparStruct,dparStruct,err)
USE globalData,only:outputStructure
USE globalData,only:mpar_meta,bpar_meta
- USE globalData,only:localParFallback ! local column default parameters
implicit none
! define input
@@ -72,10 +71,6 @@ subroutine read_param(indxHRU,indxGRU,mparStruct,bparStruct,dparStruct,err)
dparStruct%var(:) = outputStructure(1)%dparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(:)
! end do
- ! do iVar=1, size(localParFallback)
- ! mparStruct%var(iVar)%dat(:) = dparStruct%var(iVar)
- ! end do
-
! populate parameter structures
do iVar=1, size(mpar_meta)
mparStruct%var(iVar)%dat(:) = outputStructure(1)%mparStruct(1)%gru(indxGRU)%hru(indxHRU)%var(iVar)%dat(:)
diff --git a/build/source/engine/soilLiqFlx.f90 b/build/source/engine/soilLiqFlx.f90
old mode 100755
new mode 100644
index e5c57fe..06cf0bf
--- a/build/source/engine/soilLiqFlx.f90
+++ b/build/source/engine/soilLiqFlx.f90
@@ -19,1741 +19,1924 @@
! along with this program. If not, see <http://www.gnu.org/licenses/>.
module soilLiqFlx_module
-! -----------------------------------------------------------------------------------------------------------
-
-! data types
-USE nrtype
-USE data_types,only:var_d ! x%var(:) (dp)
-USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
-USE data_types,only:var_dlength ! x%var(:)%dat (dp)
-
-! missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing real number
-
-! physical constants
-USE multiconst,only:&
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- gravity, & ! gravitational acceleteration (m s-2)
- Tfreeze, & ! freezing point of pure water (K)
- iden_air,& ! intrinsic density of air (kg m-3)
- iden_ice,& ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of water (kg m-3)
-
-! named variables
-USE var_lookup,only:iLookPROG ! named variables for structure elements
-USE var_lookup,only:iLookDIAG ! named variables for structure elements
-USE var_lookup,only:iLookFLUX ! named variables for structure elements
-USE var_lookup,only:iLookPARAM ! named variables for structure elements
-USE var_lookup,only:iLookINDEX ! named variables for structure elements
-
-! model decisions
-USE globalData,only:model_decisions ! model decision structure
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-
-! provide access to look-up values for model decisions
-USE mDecisions_module,only: &
- ! look-up values for method used to compute derivative
- numerical, & ! numerical solution
- analytical, & ! analytical solution
- ! look-up values for the form of Richards' equation
- moisture, & ! moisture-based form of Richards' equation
- mixdform, & ! mixed form of Richards' equation
- ! look-up values for the type of hydraulic conductivity profile
- constant, & ! constant hydraulic conductivity with depth
- powerLaw_profile, & ! power-law profile
- ! look-up values for the choice of groundwater parameterization
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit, & ! no explicit groundwater parameterization
- ! look-up values for the choice of boundary conditions for hydrology
- prescribedHead, & ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- funcBottomHead, & ! function of matric head in the lower-most layer
- freeDrainage, & ! free drainage
- liquidFlux, & ! liquid water flux
- zeroFlux ! zero flux
-
-! -----------------------------------------------------------------------------------------------------------
-implicit none
-private
-public::soilLiqFlx
-! constant parameters
-real(dp),parameter :: verySmall=1.e-12_dp ! a very small number (used to avoid divide by zero)
-real(dp),parameter :: dx=1.e-8_dp ! finite difference increment
-contains
-
-
- ! ***************************************************************************************************************
- ! public subroutine soilLiqFlx: compute liquid water fluxes and their derivatives
- ! ***************************************************************************************************************
- subroutine soilLiqFlx(&
- ! input: model control
- nSoil, & ! intent(in): number of soil layers
- doInfiltrate, & ! intent(in): flag to compute infiltration
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- deriv_desired, & ! intent(in): flag indicating if derivatives are desired
- ! input: trial state variables
- mLayerTempTrial, & ! intent(in): temperature (K)
- mLayerMatricHeadTrial, & ! intent(in): matric head (m)
- mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water (-)
- mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice (-)
- ! input: pre-computed derivatives
- mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
- dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
- ! input: fluxes
- scalarCanopyTranspiration, & ! intent(in): canopy transpiration (kg m-2 s-1)
- scalarGroundEvaporation, & ! intent(in): ground evaporation (kg m-2 s-1)
- scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
- ! input-output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- ! output: diagnostic variables for surface runoff
- xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
- scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
- scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
- scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
- ! output: diagnostic variables for model layers
- mLayerdTheta_dPsi, & ! intent(out): derivative in the soil water characteristic w.r.t. psi (m-1)
- mLayerdPsi_dTheta, & ! intent(out): derivative in the soil water characteristic w.r.t. theta (m)
- dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (s-1)
- ! output: fluxes
- scalarSurfaceInfiltration, & ! intent(out): surface infiltration rate (m s-1)
- iLayerLiqFluxSoil, & ! intent(out): liquid fluxes at layer interfaces (m s-1)
- mLayerTranspire, & ! intent(out): transpiration loss from each soil layer (m s-1)
- mLayerHydCond, & ! intent(out): hydraulic conductivity in each soil layer (m s-1)
- ! output: derivatives in fluxes w.r.t. hydrology state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
- dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer above (m s-1)
- dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer below (m s-1)
- ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
- dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
- dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
- ! output: error control
- err,message) ! intent(out): error control
- ! utility modules
- USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
- USE soil_utils_module,only:matricHead ! compute matric head (m)
- USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
- USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
- USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
- USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
- USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- implicit none
- ! input: model control
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- logical(lgt),intent(in) :: doInfiltrate ! flag to compute infiltration
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
- ! input: trial model state variables
- real(dp),intent(in) :: mLayerTempTrial(:) ! temperature in each layer at the current iteration (m)
- real(dp),intent(in) :: mLayerMatricHeadTrial(:) ! matric head in each layer at the current iteration (m)
- real(dp),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid water at the current iteration (-)
- real(dp),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
- ! input: pre-computed derivatves
- real(dp),intent(in) :: mLayerdTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
- real(dp),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
- ! input: model fluxes
- real(dp),intent(in) :: scalarCanopyTranspiration ! canopy transpiration (kg m-2 s-1)
- real(dp),intent(in) :: scalarGroundEvaporation ! ground evaporation (kg m-2 s-1)
- real(dp),intent(in) :: scalarRainPlusMelt ! rain plus melt (m s-1)
- ! input-output: data structures
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(in) :: indx_data ! state vector geometry
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- ! output: diagnostic variables for surface runoff
- real(dp),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
- real(dp),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
- real(dp),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
- real(dp),intent(inout) :: scalarSurfaceRunoff ! surface runoff (m s-1)
- ! output: diagnostic variables for each layer
- real(dp),intent(inout) :: mLayerdTheta_dPsi(:) ! derivative in the soil water characteristic w.r.t. psi (m-1)
- real(dp),intent(inout) :: mLayerdPsi_dTheta(:) ! derivative in the soil water characteristic w.r.t. theta (m)
- real(dp),intent(inout) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (s-1)
- ! output: liquid fluxes
- real(dp),intent(inout) :: scalarSurfaceInfiltration ! surface infiltration rate (m s-1)
- real(dp),intent(inout) :: iLayerLiqFluxSoil(0:) ! liquid flux at soil layer interfaces (m s-1)
- real(dp),intent(inout) :: mLayerTranspire(:) ! transpiration loss from each soil layer (m s-1)
- real(dp),intent(inout) :: mLayerHydCond(:) ! hydraulic conductivity in each soil layer (m s-1)
- ! output: derivatives in fluxes w.r.t. state variables in the layer above and layer below (m s-1)
- real(dp),intent(inout) :: dq_dHydStateAbove(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer above
- real(dp),intent(inout) :: dq_dHydStateBelow(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer below
- ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
- real(dp),intent(inout) :: dq_dNrgStateAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
- real(dp),intent(inout) :: dq_dNrgStateBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! -----------------------------------------------------------------------------------------------------------------------------------------------------
- ! local variables: general
- character(LEN=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: ibeg,iend ! start and end indices of the soil layers in concatanated snow-soil vector
- logical(lgt) :: desireAnal ! flag to identify if analytical derivatives are desired
- integer(i4b) :: iLayer,iSoil ! index of soil layer
- integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
- integer(i4b) :: ixTop ! top layer in subroutine call
- integer(i4b) :: ixBot ! bottom layer in subroutine call
- ! additional variables to compute numerical derivatives
- integer(i4b) :: nFlux ! number of flux calculations required (>1 = numerical derivatives with one-sided finite differences)
- integer(i4b) :: itry ! index of different flux calculations
- integer(i4b),parameter :: unperturbed=0 ! named variable to identify the case of unperturbed state variables
- integer(i4b),parameter :: perturbState=1 ! named variable to identify the case where we perturb the state in the current layer
- integer(i4b),parameter :: perturbStateAbove=2 ! named variable to identify the case where we perturb the state layer above
- integer(i4b),parameter :: perturbStateBelow=3 ! named variable to identify the case where we perturb the state layer below
- integer(i4b) :: ixPerturb ! index of element in 2-element vector to perturb
- integer(i4b) :: ixOriginal ! index of perturbed element in the original vector
- real(dp) :: scalarVolFracLiqTrial ! trial value of volumetric liquid water content (-)
- real(dp) :: scalarMatricHeadTrial ! trial value of matric head (m)
- real(dp) :: scalarHydCondTrial ! trial value of hydraulic conductivity (m s-1)
- real(dp) :: scalarHydCondMicro ! trial value of hydraulic conductivity of micropores (m s-1)
- real(dp) :: scalarHydCondMacro ! trial value of hydraulic conductivity of macropores (m s-1)
- real(dp) :: scalarFlux ! vertical flux (m s-1)
- real(dp) :: scalarFlux_dStateAbove ! vertical flux with perturbation to the state above (m s-1)
- real(dp) :: scalarFlux_dStateBelow ! vertical flux with perturbation to the state below (m s-1)
- ! transpiration sink term
- real(dp),dimension(nSoil) :: mLayerTranspireFrac ! fraction of transpiration allocated to each soil layer (-)
- ! diagnostic variables
- real(dp),dimension(nSoil) :: iceImpedeFac ! ice impedence factor at layer mid-points (-)
- real(dp),dimension(nSoil) :: mLayerDiffuse ! diffusivity at layer mid-point (m2 s-1)
- real(dp),dimension(nSoil) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
- real(dp),dimension(nSoil) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
- real(dp),dimension(nSoil) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- real(dp),dimension(0:nSoil) :: iLayerHydCond ! hydraulic conductivity at layer interface (m s-1)
- real(dp),dimension(0:nSoil) :: iLayerDiffuse ! diffusivity at layer interface (m2 s-1)
- ! compute surface flux
- integer(i4b) :: nRoots ! number of soil layers with roots
- integer(i4b) :: ixIce ! index of the lowest soil layer that contains ice
- real(dp),dimension(0:nSoil) :: iLayerHeight ! height of the layer interfaces (m)
- ! compute fluxes and derivatives at layer interfaces
- real(dp),dimension(2) :: vectorVolFracLiqTrial ! trial value of volumetric liquid water content (-)
- real(dp),dimension(2) :: vectorMatricHeadTrial ! trial value of matric head (m)
- real(dp),dimension(2) :: vectorHydCondTrial ! trial value of hydraulic conductivity (m s-1)
- real(dp),dimension(2) :: vectorDiffuseTrial ! trial value of hydraulic diffusivity (m2 s-1)
- real(dp) :: scalardPsi_dTheta ! derivative in soil water characteristix, used for perturbations when computing numerical derivatives
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='soilLiqFlx/'
-
- ! get indices for the data structures
- ibeg = indx_data%var(iLookINDEX%nSnow)%dat(1) + 1
- iend = indx_data%var(iLookINDEX%nSnow)%dat(1) + indx_data%var(iLookINDEX%nSoil)%dat(1)
-
- ! get a copy of iLayerHeight
- ! NOTE: performance hit, though cannot define the shape (0:) with the associate construct
- iLayerHeight(0:nSoil) = prog_data%var(iLookPROG%iLayerHeight)%dat(ibeg-1:iend) ! height of the layer interfaces (m)
-
- ! make association between local variables and the information in the data structures
- associate(&
- ! input: model control
- ixDerivMethod => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): index of the method used to calculate flux derivatives
- ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision, & ! intent(in): index of the form of Richards' equation
- ixBcUpperSoilHydrology => model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision, & ! intent(in): index of the upper boundary conditions for soil hydrology
- ixBcLowerSoilHydrology => model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision, & ! intent(in): index of the lower boundary conditions for soil hydrology
- ! input: model indices
- ixMatricHead => indx_data%var(iLookINDEX%ixMatricHead)%dat, & ! intent(in): indices of soil layers where matric head is the state variable
- ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat, & ! intent(in): index in the state subset for hydrology state variables in the soil domain
- ! input: model coordinate variables -- NOTE: use of ibeg and iend
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(ibeg:iend), & ! intent(in): depth of the layer (m)
- mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat(ibeg:iend), & ! intent(in): height of the layer mid-point (m)
- ! input: upper boundary conditions
- upperBoundHead => mpar_data%var(iLookPARAM%upperBoundHead)%dat(1), & ! intent(in): upper boundary condition for matric head (m)
- upperBoundTheta => mpar_data%var(iLookPARAM%upperBoundTheta)%dat(1), & ! intent(in): upper boundary condition for volumetric liquid water content (-)
- ! input: lower boundary conditions
- lowerBoundHead => mpar_data%var(iLookPARAM%lowerBoundHead)%dat(1), & ! intent(in): lower boundary condition for matric head (m)
- lowerBoundTheta => mpar_data%var(iLookPARAM%lowerBoundTheta)%dat(1), & ! intent(in): lower boundary condition for volumetric liquid water content (-)
- ! input: vertically variable soil parameters
- vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat, & ! intent(in): van Genutchen "m" parameter (-)
- vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat, & ! intent(in): van Genutchen "n" parameter (-)
- vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat, & ! intent(in): van Genutchen "alpha" parameter (m-1)
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat, & ! intent(in): soil porosity (-)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat, & ! intent(in): soil residual volumetric water content (-)
- ! input: vertically constant soil parameters
- wettingFrontSuction => mpar_data%var(iLookPARAM%wettingFrontSuction)%dat(1), & ! intent(in): Green-Ampt wetting front suction (m)
- rootingDepth => mpar_data%var(iLookPARAM%rootingDepth)%dat(1), & ! intent(in): rooting depth (m)
- kAnisotropic => mpar_data%var(iLookPARAM%kAnisotropic)%dat(1), & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
- zScale_TOPMODEL => mpar_data%var(iLookPARAM%zScale_TOPMODEL)%dat(1), & ! intent(in): TOPMODEL scaling factor (m)
- qSurfScale => mpar_data%var(iLookPARAM%qSurfScale)%dat(1), & ! intent(in): scaling factor in the surface runoff parameterization (-)
- f_impede => mpar_data%var(iLookPARAM%f_impede)%dat(1), & ! intent(in): ice impedence factor (-)
- soilIceScale => mpar_data%var(iLookPARAM%soilIceScale)%dat(1), & ! intent(in): scaling factor for depth of soil ice, used to get frozen fraction (m)
- soilIceCV => mpar_data%var(iLookPARAM%soilIceCV)%dat(1), & ! intent(in): CV of depth of soil ice, used to get frozen fraction (-)
- theta_mp => mpar_data%var(iLookPARAM%theta_mp)%dat(1), & ! intent(in): volumetric liquid water content when macropore flow begins (-)
- mpExp => mpar_data%var(iLookPARAM%mpExp)%dat(1), & ! intent(in): empirical exponent in macropore flow equation (-)
- ! input: saturated hydraulic conductivity
- mLayerSatHydCondMP => flux_data%var(iLookFLUX%mLayerSatHydCondMP)%dat, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
- mLayerSatHydCond => flux_data%var(iLookFLUX%mLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
- iLayerSatHydCond => flux_data%var(iLookFLUX%iLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the interface of each layer (m s-1)
- ! input: factors limiting transpiration (from vegFlux routine)
- mLayerRootDensity => diag_data%var(iLookDIAG%mLayerRootDensity)%dat, & ! intent(in): root density in each layer (-)
- scalarTranspireLim => diag_data%var(iLookDIAG%scalarTranspireLim)%dat(1), & ! intent(in): weighted average of the transpiration limiting factor (-)
- mLayerTranspireLim => diag_data%var(iLookDIAG%mLayerTranspireLim)%dat & ! intent(in): transpiration limiting factor in each layer (-)
- ) ! associating local variables with the information in the data structures
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! preliminaries
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
-
- ! define the pethod to compute derivatives
- !print*, 'numerical derivatives = ', (ixDerivMethod==numerical)
-
- ! numerical derivatives are not implemented yet
- if(ixDerivMethod==numerical)then
- message=trim(message)//'numerical derivates do not account for the cross derivatives between hydrology and thermodynamics'
- err=20; return
- end if
-
- ! check the need to compute analytical derivatives
- if(deriv_desired .and. ixDerivMethod==analytical)then
- desireAnal = .true.
- else
- desireAnal = .false.
- end if
-
- ! check the need to compute numerical derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- nFlux=3 ! compute the derivatives using one-sided finite differences
- else
- nFlux=0 ! compute analytical derivatives
- end if
-
- ! get the indices for the soil layers
- if(scalarSolution)then
- ixLayerDesired = pack(ixMatricHead, ixSoilOnlyHyd/=integerMissing)
- ixTop = ixLayerDesired(1)
- ixBot = ixLayerDesired(1)
- else
- ixTop = 1
- ixBot = nSoil
- endif
-
- ! identify the number of layers that contain roots
- nRoots = count(iLayerHeight(0:nSoil-1) < rootingDepth-verySmall)
- if(nRoots==0)then
- message=trim(message)//'no layers with roots'
- err=20; return
- endif
-
- ! identify lowest soil layer with ice
- ! NOTE: cannot use count because there may be an unfrozen wedge
- ixIce = 0 ! initialize the index of the ice layer (0 means no ice in the soil profile)
- do iLayer=1,nSoil ! (loop through soil layers)
- if(mLayerVolFracIceTrial(iLayer) > verySmall) ixIce = iLayer
- end do
- !if(ixIce==nSoil)then; err=20; message=trim(message)//'ice extends to the bottom of the soil profile'; return; end if
-
- ! *************************************************************************************************************************************************
- ! *************************************************************************************************************************************************
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! compute the transpiration sink term
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
-
- ! check the need to compute transpiration (NOTE: intent=inout)
- if( .not. (scalarSolution .and. ixTop>1) )then
-
- ! compute the fraction of transpiration loss from each soil layer
- if(scalarTranspireLim > tiny(scalarTranspireLim))then ! (transpiration may be non-zero even if the soil moisture limiting factor is zero)
- mLayerTranspireFrac(:) = mLayerRootDensity(:)*mLayerTranspireLim(:)/scalarTranspireLim
- else ! (possible for there to be non-zero conductance and therefore transpiration in this case)
- mLayerTranspireFrac(:) = mLayerRootDensity(:) / sum(mLayerRootDensity)
- end if
-
- ! check fractions sum to one
- if(abs(sum(mLayerTranspireFrac) - 1._dp) > verySmall)then
- message=trim(message)//'fraction transpiration in soil layers does not sum to one'
- err=20; return
- endif
-
- ! compute transpiration loss from each soil layer (kg m-2 s-1 --> m s-1)
- mLayerTranspire = mLayerTranspireFrac(:)*scalarCanopyTranspiration/iden_water
-
- ! special case of prescribed head -- no transpiration
- if(ixBcUpperSoilHydrology==prescribedHead) mLayerTranspire(:) = 0._dp
-
- endif ! if need to compute transpiration
-
- ! *************************************************************************************************************************************************
- ! *************************************************************************************************************************************************
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! compute diagnostic variables at the nodes throughout the soil profile
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- do iSoil=ixTop,min(ixBot+1,nSoil) ! (loop through soil layers)
-
- call diagv_node(&
- ! input: model control
- desireAnal, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
- ! input: state variables
- mLayerTempTrial(iSoil), & ! intent(in): temperature (K)
- mLayerMatricHeadTrial(iSoil), & ! intent(in): matric head in each layer (m)
- mLayerVolFracLiqTrial(iSoil), & ! intent(in): volumetric liquid water content in each soil layer (-)
- mLayerVolFracIceTrial(iSoil), & ! intent(in): volumetric ice content in each soil layer (-)
- ! input: pre-computed deriavatives
- mLayerdTheta_dTk(iSoil), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
- dPsiLiq_dTemp(iSoil), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
- ! input: soil parameters
- vGn_alpha(iSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n(iSoil), & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m(iSoil), & ! intent(in): van Genutchen "m" parameter (-)
- mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
- theta_sat(iSoil), & ! intent(in): soil porosity (-)
- theta_res(iSoil), & ! intent(in): soil residual volumetric water content (-)
- theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
- f_impede, & ! intent(in): ice impedence factor (-)
- ! input: saturated hydraulic conductivity
- mLayerSatHydCond(iSoil), & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
- mLayerSatHydCondMP(iSoil), & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
- ! output: derivative in the soil water characteristic
- mLayerdPsi_dTheta(iSoil), & ! intent(out): derivative in the soil water characteristic
- mLayerdTheta_dPsi(iSoil), & ! intent(out): derivative in the soil water characteristic
- ! output: transmittance
- mLayerHydCond(iSoil), & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
- mLayerDiffuse(iSoil), & ! intent(out): diffusivity at layer mid-points (m2 s-1)
- iceImpedeFac(iSoil), & ! intent(out): ice impedence factor in each layer (-)
- ! output: transmittance derivatives
- dHydCond_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
- dDiffuse_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
- dHydCond_dMatric(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
- dHydCond_dTemp(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- end do ! (looping through soil layers)
-
- ! *************************************************************************************************************************************************
- ! *************************************************************************************************************************************************
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
-
- ! set derivative w.r.t. state above to zero (does not exist)
- dq_dHydStateAbove(0) = 0._dp
- dq_dNrgStateAbove(0) = 0._dp
-
- ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
- do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
-
- ! =====
- ! get input state variables...
- ! ============================
- ! identify the type of perturbation
- select case(itry)
-
- ! skip undesired perturbations
- case(perturbStateAbove); cycle ! cannot perturb state above (does not exist) -- so keep cycling
- case(perturbState); cycle ! perturbing the layer below the flux at the top interface
-
- ! un-perturbed case
- case(unperturbed)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
- scalarMatricHeadTrial = mLayerMatricHeadTrial(1)
-
- ! perturb soil state (one-sided finite differences)
- case(perturbStateBelow)
- ! (perturbation depends on the form of Richards' equation)
- select case(ixRichards)
- case(moisture)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1) + dx
- scalarMatricHeadTrial = mLayerMatricHeadTrial(1)
- case(mixdform)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
- scalarMatricHeadTrial = mLayerMatricHeadTrial(1) + dx
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' equation
- ! check for an unknown perturbation
- case default; err=10; message=trim(message)//"unknown perturbation"; return
-
- end select ! (type of perturbation)
-
- ! =====
- ! compute surface flux and its derivative...
- ! ==========================================
-
- call surfaceFlx(&
- ! input: model control
- doInfiltrate, & ! intent(in): flag indicating if desire to compute infiltration
- desireAnal, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
- ixBcUpperSoilHydrology, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
- nRoots, & ! intent(in): number of layers that contain roots
- ixIce, & ! intent(in): index of lowest ice layer
- ! input: state variables
- scalarMatricHeadTrial, & ! intent(in): matric head in the upper-most soil layer (m)
- scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the upper-most soil layer (-)
- mLayerVolFracLiqTrial, & ! intent(in): volumetric liquid water content in each soil layer (-)
- mLayerVolFracIceTrial, & ! intent(in): volumetric ice content in each soil layer (-)
- ! input: depth of upper-most soil layer (m)
- mLayerDepth, & ! intent(in): depth of each soil layer (m)
- iLayerHeight, & ! intent(in): height at the interface of each layer (m)
- ! input: boundary conditions
- upperBoundHead, & ! intent(in): upper boundary condition (m)
- upperBoundTheta, & ! intent(in): upper boundary condition (-)
- ! input: flux at the upper boundary
- scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
- ! input: transmittance
- iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
- dHydCond_dTemp(1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- iceImpedeFac(1), & ! intent(in): ice impedence factor in the upper-most soil layer (-)
- ! input: soil parameters
- vGn_alpha(1), & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n(1), & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m(1), & ! intent(in): van Genutchen "m" parameter (-)
- theta_sat(1), & ! intent(in): soil porosity (-)
- theta_res(1), & ! intent(in): soil residual volumetric water content (-)
- qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
- zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
- rootingDepth, & ! intent(in): rooting depth (m)
- wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
- soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
- soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
- ! input-output: hydraulic conductivity and diffusivity at the surface
- iLayerHydCond(0), & ! intent(inout): hydraulic conductivity at the surface (m s-1)
- iLayerDiffuse(0), & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
- ! input-output: fluxes at layer interfaces and surface runoff
- xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
- scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
- scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
- scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
- scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
- ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
- dq_dHydStateBelow(0), & ! intent(inout): derivative in surface infiltration w.r.t. hydrology state variable in the upper-most soil layer (m s-1 or s-1)
- dq_dNrgStateBelow(0), & ! intent(out): derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! print*, "scalarGroundEvaporation =", scalarGroundEvaporation
- ! include base soil evaporation as the upper boundary flux
- iLayerLiqFluxSoil(0) = scalarGroundEvaporation/iden_water + scalarSurfaceInfiltration
-
- ! get copies of surface flux to compute numerical derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- select case(itry)
- case(unperturbed); scalarFlux = iLayerLiqFluxSoil(0)
- case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(0)
- case default; err=10; message=trim(message)//"unknown perturbation"; return
- end select
- end if
-
- ! write(*,'(a,1x,10(f30.15))') 'scalarRainPlusMelt, scalarSurfaceInfiltration = ', scalarRainPlusMelt, scalarSurfaceInfiltration
-
- end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
-
- ! compute numerical derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- dq_dHydStateBelow(0) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in surface flux w.r.t. change in the soil moisture in the top soil layer (m s-1)
- end if
-! print*, 'scalarSurfaceInfiltration, iLayerLiqFluxSoil(0) = ', scalarSurfaceInfiltration, iLayerLiqFluxSoil(0)
- !print*, '(ixDerivMethod==numerical), dq_dHydStateBelow(0) = ', (ixDerivMethod==numerical), dq_dHydStateBelow(0)
- !pause
-
- ! *************************************************************************************************************************************************
- ! *************************************************************************************************************************************************
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! * compute fluxes and derivatives at layer interfaces...
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
-
- ! NOTE: computing flux at the bottom of the layer
-
- ! loop through soil layers
- do iLayer=ixTop,min(ixBot,nSoil-1)
-
- ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
- do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
-
- ! =====
- ! determine layer to perturb
- ! ============================
- select case(itry)
- ! skip undesired perturbations
- case(perturbState); cycle ! perturbing the layers above and below the flux at the interface
- ! identify the index for the perturbation
- case(unperturbed); ixPerturb = 0
- case(perturbStateAbove); ixPerturb = 1
- case(perturbStateBelow); ixPerturb = 2
- case default; err=10; message=trim(message)//"unknown perturbation"; return
- end select ! (identifying layer to of perturbation)
- ! determine the index in the original vector
- ixOriginal = iLayer + (ixPerturb-1)
-
- ! =====
- ! get input state variables...
- ! ============================
- ! start with the un-perturbed case
- vectorVolFracLiqTrial(1:2) = mLayerVolFracLiqTrial(iLayer:iLayer+1)
- vectorMatricHeadTrial(1:2) = mLayerMatricHeadTrial(iLayer:iLayer+1)
- ! make appropriate perturbations
- if(ixPerturb > 0)then
- select case(ixRichards)
- case(moisture); vectorVolFracLiqTrial(ixPerturb) = vectorVolFracLiqTrial(ixPerturb) + dx
- case(mixdform); vectorMatricHeadTrial(ixPerturb) = vectorMatricHeadTrial(ixPerturb) + dx
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' equation)
- end if
-
- ! =====
- ! get hydraulic conductivty...
- ! ============================
- ! start with the un-perturbed case
- vectorHydCondTrial(1:2) = mLayerHydCond(iLayer:iLayer+1)
- vectorDiffuseTrial(1:2) = mLayerDiffuse(iLayer:iLayer+1)
- ! make appropriate perturbations
- if(ixPerturb > 0)then
- select case(ixRichards)
- case(moisture)
- scalardPsi_dTheta = dPsi_dTheta(vectorVolFracLiqTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
- vectorHydCondTrial(ixPerturb) = hydCond_liq(vectorVolFracLiqTrial(ixPerturb),mLayerSatHydCond(ixOriginal),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
- vectorDiffuseTrial(ixPerturb) = scalardPsi_dTheta * vectorHydCondTrial(ixPerturb)
- case(mixdform)
- scalarVolFracLiqTrial = volFracLiq(vectorMatricHeadTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
- scalarHydCondMicro = hydCond_psi(vectorMatricHeadTrial(ixPerturb),mLayerSatHydCond(ixOriginal),vGn_alpha(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
- scalarHydCondMacro = hydCondMP_liq(scalarVolFracLiqTrial,theta_sat(ixPerturb),theta_mp,mpExp,mLayerSatHydCondMP(ixOriginal),mLayerSatHydCond(ixOriginal))
- vectorHydCondTrial(ixPerturb) = scalarHydCondMicro + scalarHydCondMacro
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' equation)
- end if
-
- ! =====
- ! compute vertical flux at layer interface and its derivative w.r.t. the state above and the state below...
- ! =========================================================================================================
-
- ! NOTE: computing flux at the bottom of the layer
-
- call iLayerFlux(&
- ! input: model control
- desireAnal, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
- ! input: state variables (adjacent layers)
- vectorMatricHeadTrial, & ! intent(in): matric head at the soil nodes (m)
- vectorVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
- ! input: model coordinate variables (adjacent layers)
- mLayerHeight(iLayer:iLayer+1), & ! intent(in): height of the soil nodes (m)
- ! input: temperature derivatives
- dPsiLiq_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
- dHydCond_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! input: transmittance (adjacent layers)
- vectorHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
- vectorDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
- ! input: transmittance derivatives (adjacent layers)
- dHydCond_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
- dDiffuse_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
- dHydCond_dMatric(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in matric head (s-1)
- ! output: tranmsmittance at the layer interface (scalars)
- iLayerHydCond(iLayer), & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
- iLayerDiffuse(iLayer), & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
- ! output: vertical flux at the layer interface (scalars)
- iLayerLiqFluxSoil(iLayer), & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
- ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
- dq_dHydStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
- dq_dHydStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
- ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
- dq_dNrgStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
- dq_dNrgStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! compute total vertical flux, to compute derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- select case(itry)
- case(unperturbed); scalarFlux = iLayerLiqFluxSoil(iLayer)
- case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(iLayer)
- case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(iLayer)
- case default; err=10; message=trim(message)//"unknown perturbation"; return
- end select
- end if
-
- end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
-
- ! compute numerical derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- dq_dHydStateAbove(iLayer) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
- dq_dHydStateBelow(iLayer) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
- end if
-
- ! check
- !if(iLayer==6) write(*,'(a,i4,1x,10(e25.15,1x))') 'iLayer, vectorMatricHeadTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer) = ',&
- ! iLayer, vectorMatricHeadTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer)
- !if(iLayer==1) write(*,'(a,i4,1x,L1,1x,2(e15.5,1x))') 'iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer) = ', &
- ! iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer)
- !pause
-
- end do ! (looping through soil layers)
-
- ! add infiltration to the upper-most unfrozen layer
- ! NOTE: this is done here rather than in surface runoff
- !iLayerLiqFluxSoil(ixIce) = iLayerLiqFluxSoil(ixIce) + scalarSurfaceInfiltration
-
- ! *************************************************************************************************************************************************
- ! *************************************************************************************************************************************************
-
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
- ! * compute drainage flux from the bottom of the soil profile, and its derivative
- ! -------------------------------------------------------------------------------------------------------------------------------------------------
-
- ! define the need to compute drainage
- if( .not. (scalarSolution .and. ixTop<nSoil) )then
-
- ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
- do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
-
- ! =====
- ! get input state variables...
- ! ============================
- ! identify the type of perturbation
- select case(itry)
-
- ! skip undesired perturbations
- case(perturbStateBelow); cycle ! only perturb soil state at this time (perhaps perturb aquifer state later)
- case(perturbState); cycle ! here pertubing the state above the flux at the interface
-
- ! un-perturbed case
- case(unperturbed)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
- scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil)
-
- ! perturb soil state (one-sided finite differences)
- case(perturbStateAbove)
- select case(ixRichards) ! (perturbation depends on the form of Richards' equation)
- case(moisture)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil) + dx
- scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil)
- case(mixdform)
- scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
- scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil) + dx
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' equation)
-
- end select ! (type of perturbation)
-
- ! =====
- ! get hydraulic conductivty...
- ! ============================
- select case(itry)
-
- ! compute perturbed value of hydraulic conductivity
- case(perturbStateAbove)
- select case(ixRichards)
- case(moisture); scalarHydCondTrial = hydCond_liq(scalarVolFracLiqTrial,mLayerSatHydCond(nSoil),theta_res(nSoil),theta_sat(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
- case(mixdform); scalarHydCondTrial = hydCond_psi(scalarMatricHeadTrial,mLayerSatHydCond(nSoil),vGn_alpha(nSoil),vGn_n(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
- end select
-
- ! (use un-perturbed value)
- case default
- scalarHydCondTrial = mLayerHydCond(nSoil) ! hydraulic conductivity at the mid-point of the lowest unsaturated soil layer (m s-1)
-
- end select ! (re-computing hydraulic conductivity)
-
- ! =====
- ! compute drainage flux and its derivative...
- ! ===========================================
-
- call qDrainFlux(&
- ! input: model control
- desireAnal, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
- ixBcLowerSoilHydrology, & ! intent(in): index defining the type of boundary conditions
- ! input: state variables
- scalarMatricHeadTrial, & ! intent(in): matric head in the lowest unsaturated node (m)
- scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
- ! input: model coordinate variables
- mLayerDepth(nSoil), & ! intent(in): depth of the lowest unsaturated soil layer (m)
- mLayerHeight(nSoil), & ! intent(in): height of the lowest unsaturated soil node (m)
- ! input: boundary conditions
- lowerBoundHead, & ! intent(in): lower boundary condition (m)
- lowerBoundTheta, & ! intent(in): lower boundary condition (-)
- ! input: derivative in the soil water characteristic
- mLayerdPsi_dTheta(nSoil), & ! intent(in): derivative in the soil water characteristic
- ! input: transmittance
- iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
- iLayerSatHydCond(nSoil), & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
- scalarHydCondTrial, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
- iceImpedeFac(nSoil), & ! intent(in): ice impedence factor in the lower-most soil layer (-)
- ! input: transmittance derivatives
- dHydCond_dVolLiq(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
- dHydCond_dMatric(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
- dHydCond_dTemp(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! input: soil parameters
- vGn_alpha(nSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n(nSoil), & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m(nSoil), & ! intent(in): van Genutchen "m" parameter (-)
- theta_sat(nSoil), & ! intent(in): soil porosity (-)
- theta_res(nSoil), & ! intent(in): soil residual volumetric water content (-)
- kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
- zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
- ! output: hydraulic conductivity and diffusivity at the surface
- iLayerHydCond(nSoil), & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
- iLayerDiffuse(nSoil), & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
- ! output: drainage flux
- iLayerLiqFluxSoil(nSoil), & ! intent(out): drainage flux (m s-1)
- ! output: derivatives in drainage flux
- dq_dHydStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in hydrology state in lowest unsaturated node (m s-1 or s-1)
- dq_dNrgStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in energy state in lowest unsaturated node (m s-1 or s-1)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! get copies of drainage flux to compute derivatives
- if(deriv_desired .and. ixDerivMethod==numerical)then
- select case(itry)
- case(unperturbed); scalarFlux = iLayerLiqFluxSoil(nSoil)
- case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(nSoil)
- case(perturbStateBelow); err=20; message=trim(message)//'lower state should never be perturbed when computing drainage do not expect to get here'; return
- case default; err=10; message=trim(message)//"unknown perturbation"; return
- end select
- end if
-
- end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
-
- ! compute numerical derivatives
- ! NOTE: drainage derivatives w.r.t. state below are *actually* w.r.t. water table depth, so need to be corrected for aquifer storage
- ! (note also negative sign to account for inverse relationship between water table depth and aquifer storage)
- if(deriv_desired .and. ixDerivMethod==numerical)then
- dq_dHydStateAbove(nSoil) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in state in lowest unsaturated node (m s-1 or s-1)
- end if
-
- ! no dependence on the aquifer for drainage
- dq_dHydStateBelow(nSoil) = 0._dp ! keep this here in case we want to couple some day....
- dq_dNrgStateBelow(nSoil) = 0._dp ! keep this here in case we want to couple some day....
-
- ! print drainage
- !print*, 'iLayerLiqFluxSoil(nSoil) = ', iLayerLiqFluxSoil(nSoil)
-
- endif ! if computing drainage
- ! end of drainage section
-
- ! *****************************************************************************************************************************************************************
- ! *****************************************************************************************************************************************************************
-
- ! end association between local variables and the information in the data structures
- end associate
-
- end subroutine soilLiqFlx
-
- ! ***************************************************************************************************************
- ! private subroutine diagv_node: compute transmittance and derivatives for model nodes
- ! ***************************************************************************************************************
- subroutine diagv_node(&
- ! input: model control
- deriv_desired, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
- ! input: state variables
- scalarTempTrial, & ! intent(in): temperature (K)
- scalarMatricHeadTrial, & ! intent(in): matric head in a given layer (m)
- scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content in a given soil layer (-)
- scalarVolFracIceTrial, & ! intent(in): volumetric ice content in a given soil layer (-)
- ! input: pre-computed deriavatives
- dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
- dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
- ! input: soil parameters
- vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
- mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
- theta_sat, & ! intent(in): soil porosity (-)
- theta_res, & ! intent(in): soil residual volumetric water content (-)
- theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
- f_impede, & ! intent(in): ice impedence factor (-)
- ! input: saturated hydraulic conductivity
- scalarSatHydCond, & ! intent(in): saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
- scalarSatHydCondMP, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
- ! output: derivative in the soil water characteristic
- scalardPsi_dTheta, & ! derivative in the soil water characteristic
- scalardTheta_dPsi, & ! derivative in the soil water characteristic
- ! output: transmittance
- scalarHydCond, & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
- scalarDiffuse, & ! intent(out): diffusivity at layer mid-points (m2 s-1)
- iceImpedeFac, & ! intent(out): ice impedence factor in each layer (-)
- ! output: transmittance derivatives
- dHydCond_dVolLiq, & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
- dDiffuse_dVolLiq, & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
- dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
- dHydCond_dTemp, & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! output: error control
- err,message) ! intent(out): error control
- USE soil_utils_module,only:iceImpede ! compute the ice impedence factor
- USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head
- USE soil_utils_module,only:matricHead ! compute matric head (m)
- USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
- USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
- USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
- USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
- USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
- USE soil_utils_module,only:dPsi_dTheta2 ! compute derivative in dPsi_dTheta (m)
- USE soil_utils_module,only:dHydCond_dLiq ! compute derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
- USE soil_utils_module,only:dHydCond_dPsi ! compute derivative in hydraulic conductivity w.r.t. matric head (s-1)
- USE soil_utils_module,only:dIceImpede_dTemp ! compute the derivative in the ice impedance factor w.r.t. temperature (K-1)
- ! compute hydraulic transmittance and derivatives for all layers
- implicit none
- ! input: model control
- logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
- integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
- ! input: state and diagnostic variables
- real(dp),intent(in) :: scalarTempTrial ! temperature in each layer (K)
- real(dp),intent(in) :: scalarMatricHeadTrial ! matric head in each layer (m)
- real(dp),intent(in) :: scalarVolFracLiqTrial ! volumetric fraction of liquid water in a given layer (-)
- real(dp),intent(in) :: scalarVolFracIceTrial ! volumetric fraction of ice in a given layer (-)
- ! input: pre-computed deriavatives
- real(dp),intent(in) :: dTheta_dTk ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
- real(dp),intent(in) :: dPsiLiq_dTemp ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
- ! input: soil parameters
- real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
- real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
- real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
- real(dp),intent(in) :: mpExp ! empirical exponent in macropore flow equation (-)
- real(dp),intent(in) :: theta_sat ! soil porosity (-)
- real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
- real(dp),intent(in) :: theta_mp ! volumetric liquid water content when macropore flow begins (-)
- real(dp),intent(in) :: f_impede ! ice impedence factor (-)
- ! input: saturated hydraulic conductivity
- real(dp),intent(in) :: scalarSatHydCond ! saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
- real(dp),intent(in) :: scalarSatHydCondMP ! saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
- ! output: derivative in the soil water characteristic
- real(dp),intent(out) :: scalardPsi_dTheta ! derivative in the soil water characteristic
- real(dp),intent(out) :: scalardTheta_dPsi ! derivative in the soil water characteristic
- ! output: transmittance
- real(dp),intent(out) :: scalarHydCond ! hydraulic conductivity at layer mid-points (m s-1)
- real(dp),intent(out) :: scalarDiffuse ! diffusivity at layer mid-points (m2 s-1)
- real(dp),intent(out) :: iceImpedeFac ! ice impedence factor in each layer (-)
- ! output: transmittance derivatives
- real(dp),intent(out) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
- real(dp),intent(out) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
- real(dp),intent(out) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t matric head (s-1)
- real(dp),intent(out) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- real(dp) :: localVolFracLiq ! local volumetric fraction of liquid water
- real(dp) :: scalarHydCondMP ! hydraulic conductivity of macropores at layer mid-points (m s-1)
- real(dp) :: dIceImpede_dT ! derivative in ice impedance factor w.r.t. temperature (K-1)
- real(dp) :: dHydCondMacro_dVolLiq ! derivative in hydraulic conductivity of macropores w.r.t volumetric liquid water content (m s-1)
- real(dp) :: dHydCondMacro_dMatric ! derivative in hydraulic conductivity of macropores w.r.t matric head (s-1)
- real(dp) :: dHydCondMicro_dMatric ! derivative in hydraulic conductivity of micropores w.r.t matric head (s-1)
- real(dp) :: dHydCondMicro_dTemp ! derivative in hydraulic conductivity of micropores w.r.t temperature (m s-1 K-1)
- real(dp) :: dPsi_dTheta2a ! derivative in dPsi_dTheta (analytical)
- real(dp) :: dIceImpede_dLiq ! derivative in ice impedence factor w.r.t. volumetric liquid water content (-)
- real(dp) :: hydCond_noIce ! hydraulic conductivity in the absence of ice (m s-1)
- real(dp) :: dK_dLiq__noIce ! derivative in hydraulic conductivity w.r.t volumetric liquid water content, in the absence of ice (m s-1)
- real(dp) :: dK_dPsi__noIce ! derivative in hydraulic conductivity w.r.t matric head, in the absence of ice (s-1)
- real(dp) :: relSatMP ! relative saturation of macropores (-)
- ! local variables to test the derivative
- logical(lgt),parameter :: testDeriv=.false. ! local flag to test the derivative
- real(dp) :: xConst ! LH_fus/(gravity*Tfreeze), used in freezing point depression equation (m K-1)
- real(dp) :: vTheta ! volumetric fraction of total water (-)
- real(dp) :: volLiq ! volumetric fraction of liquid water (-)
- real(dp) :: volIce ! volumetric fraction of ice (-)
- real(dp) :: volFracLiq1,volFracLiq2 ! different trial values of volumetric liquid water content (-)
- real(dp) :: effSat ! effective saturation (-)
- real(dp) :: psiLiq ! liquid water matric potential (m)
- real(dp) :: hydCon ! hydraulic conductivity (m s-1)
- real(dp) :: hydIce ! hydraulic conductivity after accounting for ice impedance (-)
- real(dp),parameter :: dx = 1.e-8_dp ! finite difference increment (m)
- ! initialize error control
- err=0; message="diagv_node/"
-
- ! *****
- ! compute the derivative in the soil water characteristic
- select case(ixRichards)
- case(moisture)
- scalardPsi_dTheta = dPsi_dTheta(scalarvolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- scalardTheta_dPsi = realMissing ! (deliberately cause problems if this is ever used)
- case(mixdform)
- scalardTheta_dPsi = dTheta_dPsi(scalarMatricHeadTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- scalardPsi_dTheta = dPsi_dTheta(scalarvolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- if(testDeriv)then
- volFracLiq1 = volFracLiq(scalarMatricHeadTrial, vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- volFracLiq2 = volFracLiq(scalarMatricHeadTrial+dx,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- end if ! (testing the derivative)
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
-
- ! *****
- ! compute hydraulic conductivity and its derivative in each soil layer
-
- ! compute the ice impedence factor and its derivative w.r.t. volumetric liquid water content (-)
- call iceImpede(scalarVolFracIceTrial,f_impede, & ! input
- iceImpedeFac,dIceImpede_dLiq) ! output
-
- select case(ixRichards)
- ! ***** moisture-based form of Richards' equation
- case(moisture)
- ! haven't included macropores yet
- err=20; message=trim(message)//'still need to include macropores for the moisture-based form of Richards eqn'; return
- ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
- hydCond_noIce = hydCond_liq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m)
- scalarHydCond = hydCond_noIce*iceImpedeFac
- scalarDiffuse = scalardPsi_dTheta * scalarHydCond
- ! compute derivative in hydraulic conductivity (m s-1) and hydraulic diffusivity (m2 s-1)
- if(deriv_desired)then
- if(scalarVolFracIceTrial > epsilon(iceImpedeFac))then
- dK_dLiq__noIce = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.) ! [.true. = analytical]
- dHydCond_dVolLiq = hydCond_noIce*dIceImpede_dLiq + dK_dLiq__noIce*iceImpedeFac
- else
- dHydCond_dVolLiq = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.)
- end if
- dPsi_dTheta2a = dPsi_dTheta2(scalarVolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m,.true.) ! [.true. = analytical] compute derivative in dPsi_dTheta (m)
- dDiffuse_dVolLiq = dHydCond_dVolLiq*scalardPsi_dTheta + scalarHydCond*dPsi_dTheta2a
- dHydCond_dMatric = realMissing ! not used, so cause problems
- end if
-
- ! ***** mixed form of Richards' equation -- just compute hydraulic condictivity
- case(mixdform)
- ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
- hydCond_noIce = hydCond_psi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
- scalarDiffuse = realMissing ! not used, so cause problems
- ! compute the hydraulic conductivity of macropores (m s-1)
- localVolFracLiq = volFracLiq(scalarMatricHeadTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- scalarHydCondMP = hydCondMP_liq(localVolFracLiq,theta_sat,theta_mp,mpExp,scalarSatHydCondMP,scalarSatHydCond)
- scalarHydCond = hydCond_noIce*iceImpedeFac + scalarHydCondMP
-
- ! compute derivative in hydraulic conductivity (m s-1)
- if(deriv_desired)then
- ! (compute derivative for macropores)
- if(localVolFracLiq > theta_mp)then
- relSatMP = (localVolFracLiq - theta_mp)/(theta_sat - theta_mp)
- dHydCondMacro_dVolLiq = ((scalarSatHydCondMP - scalarSatHydCond)/(theta_sat - theta_mp))*mpExp*(relSatMP**(mpExp - 1._dp))
- dHydCondMacro_dMatric = scalardTheta_dPsi*dHydCondMacro_dVolLiq
- else
- dHydCondMacro_dVolLiq = 0._dp
- dHydCondMacro_dMatric = 0._dp
- end if
- ! (compute derivatives for micropores)
- if(scalarVolFracIceTrial > verySmall)then
- dK_dPsi__noIce = dHydCond_dPsi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.) ! analytical
- dHydCondMicro_dTemp = dPsiLiq_dTemp*dK_dPsi__noIce ! m s-1 K-1
- dHydCondMicro_dMatric = hydCond_noIce*dIceImpede_dLiq*scalardTheta_dPsi + dK_dPsi__noIce*iceImpedeFac
- else
- dHydCondMicro_dTemp = 0._dp
- dHydCondMicro_dMatric = dHydCond_dPsi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.)
- end if
- ! (combine derivatives)
- dHydCond_dMatric = dHydCondMicro_dMatric + dHydCondMacro_dMatric
-
- ! (compute analytical derivative for change in ice impedance factor w.r.t. temperature)
- call dIceImpede_dTemp(scalarVolFracIceTrial, & ! intent(in): trial value of volumetric ice content (-)
- dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
- f_impede, & ! intent(in): ice impedance parameter (-)
- dIceImpede_dT ) ! intent(out): derivative in ice impedance factor w.r.t. temperature (K-1)
- ! (compute derivative in hydraulic conductivity w.r.t. temperature)
- dHydCond_dTemp = hydCond_noIce*dIceImpede_dT + dHydCondMicro_dTemp*iceImpedeFac
- ! (test derivative)
- if(testDeriv)then
- xConst = LH_fus/(gravity*Tfreeze) ! m K-1 (NOTE: J = kg m2 s-2)
- vTheta = scalarVolFracIceTrial + scalarVolFracLiqTrial
- volLiq = volFracLiq(xConst*(scalarTempTrial+dx - Tfreeze),vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- volIce = vTheta - volLiq
- effSat = (volLiq - theta_res)/(theta_sat - volIce - theta_res)
- psiLiq = matricHead(effSat,vGn_alpha,0._dp,1._dp,vGn_n,vGn_m) ! use effective saturation, so theta_res=0 and theta_sat=1
- hydCon = hydCond_psi(psiLiq,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
- call iceImpede(volIce,f_impede,iceImpedeFac,dIceImpede_dLiq)
- hydIce = hydCon*iceImpedeFac
- print*, 'test derivative: ', (psiLiq - scalarMatricHeadTrial)/dx, dPsiLiq_dTemp
- print*, 'test derivative: ', (hydCon - hydCond_noIce)/dx, dHydCondMicro_dTemp
- print*, 'test derivative: ', (hydIce - scalarHydCond)/dx, dHydCond_dTemp
- print*, 'press any key to continue'; read(*,*) ! (alternative to the deprecated 'pause' statement)
- end if ! testing the derivative
- ! (set values that are not used to missing)
- dHydCond_dVolLiq = realMissing ! not used, so cause problems
- dDiffuse_dVolLiq = realMissing ! not used, so cause problems
- end if
-
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
-
- end select
-
- ! if derivatives are not desired, then set values to missing
- if(.not.deriv_desired)then
- dHydCond_dVolLiq = realMissing ! not used, so cause problems
- dDiffuse_dVolLiq = realMissing ! not used, so cause problems
- dHydCond_dMatric = realMissing ! not used, so cause problems
- end if
-
- end subroutine diagv_node
-
-
- ! ***************************************************************************************************************
- ! private subroutine surfaceFlx: compute the surface flux and its derivative
- ! ***************************************************************************************************************
- subroutine surfaceFlx(&
- ! input: model control
- doInfiltration, & ! intent(in): flag indicating if desire to compute infiltration
- deriv_desired, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
- bc_upper, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
- nRoots, & ! intent(in): number of layers that contain roots
- ixIce, & ! intent(in): index of lowest ice layer
- ! input: state variables
- scalarMatricHead, & ! intent(in): matric head in the upper-most soil layer (m)
- scalarVolFracLiq, & ! intent(in): volumetric liquid water content in the upper-most soil layer (-)
- mLayerVolFracLiq, & ! intent(in): volumetric liquid water content in each soil layer (-)
- mLayerVolFracIce, & ! intent(in): volumetric ice content in each soil layer (-)
- ! input: depth of upper-most soil layer (m)
- mLayerDepth, & ! intent(in): depth of each soil layer (m)
- iLayerHeight, & ! intent(in): height at the interface of each layer (m)
- ! input: boundary conditions
- upperBoundHead, & ! intent(in): upper boundary condition (m)
- upperBoundTheta, & ! intent(in): upper boundary condition (-)
- ! input: flux at the upper boundary
- scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
- ! input: transmittance
- surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
- dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- iceImpedeFac, & ! intent(in): ice impedence factor in the upper-most soil layer (-)
- ! input: soil parameters
- vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
- theta_sat, & ! intent(in): soil porosity (-)
- theta_res, & ! intent(in): soil residual volumetric water content (-)
- qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
- zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
- rootingDepth, & ! intent(in): rooting depth (m)
- wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
- soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
- soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
- ! input-output: hydraulic conductivity and diffusivity at the surface
- surfaceHydCond, & ! intent(inout): hydraulic conductivity at the surface (m s-1)
- surfaceDiffuse, & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
- ! input-output: fluxes at layer interfaces and surface runoff
- xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
- scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
- scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
- scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
- scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
- ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
- dq_dHydState, & ! intent(inout): derivative in surface infiltration w.r.t. state variable in the upper-most soil layer (m s-1 or s-1)
- dq_dNrgState, & ! intent(out): derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
- ! output: error control
- err,message) ! intent(out): error control
- USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
- USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
- USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
- USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
- USE soil_utils_module,only:gammp ! compute the cumulative probabilty based on the Gamma distribution
- ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
- implicit none
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- logical(lgt),intent(in) :: doInfiltration ! flag indicating if desire to compute infiltration
- logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
- integer(i4b),intent(in) :: bc_upper ! index defining the type of boundary conditions
- integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
- integer(i4b),intent(in) :: nRoots ! number of layers that contain roots
- integer(i4b),intent(in) :: ixIce ! index of lowest ice layer
- ! input: state and diagnostic variables
- real(dp),intent(in) :: scalarMatricHead ! matric head in the upper-most soil layer (m)
- real(dp),intent(in) :: scalarVolFracLiq ! volumetric liquid water content in the upper-most soil layer (-)
- real(dp),intent(in) :: mLayerVolFracLiq(:) ! volumetric liquid water content in each soil layer (-)
- real(dp),intent(in) :: mLayerVolFracIce(:) ! volumetric ice content in each soil layer (-)
- ! input: depth of upper-most soil layer (m)
- real(dp),intent(in) :: mLayerDepth(:) ! depth of upper-most soil layer (m)
- real(dp),intent(in) :: iLayerHeight(0:) ! height at the interface of each layer (m)
- ! input: diriclet boundary conditions
- real(dp),intent(in) :: upperBoundHead ! upper boundary condition for matric head (m)
- real(dp),intent(in) :: upperBoundTheta ! upper boundary condition for volumetric liquid water content (-)
- ! input: flux at the upper boundary
- real(dp),intent(in) :: scalarRainPlusMelt ! rain plus melt, used as input to the soil zone before computing surface runoff (m s-1)
- ! input: transmittance
- real(dp),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
- real(dp),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- real(dp),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
- ! input: soil parameters
- real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
- real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
- real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
- real(dp),intent(in) :: theta_sat ! soil porosity (-)
- real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
- real(dp),intent(in) :: qSurfScale ! scaling factor in the surface runoff parameterization (-)
- real(dp),intent(in) :: zScale_TOPMODEL ! scaling factor used to describe decrease in hydraulic conductivity with depth (m)
- real(dp),intent(in) :: rootingDepth ! rooting depth (m)
- real(dp),intent(in) :: wettingFrontSuction ! Green-Ampt wetting front suction (m)
- real(dp),intent(in) :: soilIceScale ! soil ice scaling factor in Gamma distribution used to define frozen area (m)
- real(dp),intent(in) :: soilIceCV ! soil ice CV in Gamma distribution used to define frozen area (-)
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! input-output: hydraulic conductivity and diffusivity at the surface
- ! NOTE: intent(inout) because infiltration may only be computed for the first iteration
- real(dp),intent(inout) :: surfaceHydCond ! hydraulic conductivity (m s-1)
- real(dp),intent(inout) :: surfaceDiffuse ! hydraulic diffusivity at the surface (m
- ! output: surface runoff and infiltration flux (m s-1)
- real(dp),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
- real(dp),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
- real(dp),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
- real(dp),intent(out) :: scalarSurfaceRunoff ! surface runoff (m s-1)
- real(dp),intent(out) :: scalarSurfaceInfiltration ! surface infiltration (m s-1)
- ! output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
- real(dp),intent(out) :: dq_dHydState ! derivative in surface infiltration w.r.t. state variable in the upper-most soil layer (m s-1 or s-1)
- real(dp),intent(out) :: dq_dNrgState ! derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! (general)
- integer(i4b) :: iLayer ! index of soil layer
- ! (head boundary condition)
- real(dp) :: cFlux ! capillary flux (m s-1)
- real(dp) :: dNum ! numerical derivative
- ! (simplified Green-Ampt infiltration)
- real(dp) :: rootZoneLiq ! depth of liquid water in the root zone (m)
- real(dp) :: rootZoneIce ! depth of ice in the root zone (m)
- real(dp) :: availCapacity ! available storage capacity in the root zone (m)
- real(dp) :: depthWettingFront ! depth to the wetting front (m)
- real(dp) :: hydCondWettingFront ! hydraulic conductivity at the wetting front (m s-1)
- ! (saturated area associated with variable storage capacity)
- real(dp) :: fracCap ! fraction of pore space filled with liquid water and ice (-)
- real(dp) :: fInfRaw ! infiltrating area before imposing solution constraints (-)
- real(dp),parameter :: maxFracCap=0.995_dp ! maximum fraction capacity -- used to avoid numerical problems associated with an enormous derivative
- real(dp),parameter :: scaleFactor=0.000001_dp ! scale factor for the smoothing function (-)
- real(dp),parameter :: qSurfScaleMax=1000._dp ! maximum surface runoff scaling factor (-)
- ! (fraction of impermeable area associated with frozen ground)
- real(dp) :: alpha ! shape parameter in the Gamma distribution
- real(dp) :: xLimg ! upper limit of the integral
- ! initialize error control
- err=0; message="surfaceFlx/"
-
- ! compute derivative in the energy state
- ! NOTE: revisit the need to do this
- dq_dNrgState = 0._dp
-
- ! *****
- ! compute the surface flux and its derivative
- select case(bc_upper)
-
- ! *****
- ! head condition
- case(prescribedHead)
-
- ! surface runoff iz zero for the head condition
- scalarSurfaceRunoff = 0._dp
-
- ! compute transmission and the capillary flux
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture)
- ! compute the hydraulic conductivity and diffusivity at the boundary
- surfaceHydCond = hydCond_liq(upperBoundTheta,surfaceSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
- surfaceDiffuse = dPsi_dTheta(upperBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * surfaceHydCond
- ! compute the capillary flux
- cflux = -surfaceDiffuse*(scalarVolFracLiq - upperBoundTheta) / (mLayerDepth(1)*0.5_dp)
- case(mixdform)
- ! compute the hydraulic conductivity and diffusivity at the boundary
- surfaceHydCond = hydCond_psi(upperBoundHead,surfaceSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
- surfaceDiffuse = realMissing
- ! compute the capillary flux
- cflux = -surfaceHydCond*(scalarMatricHead - upperBoundHead) / (mLayerDepth(1)*0.5_dp)
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' eqn)
- ! compute the total flux
- scalarSurfaceInfiltration = cflux + surfaceHydCond
- ! compute the derivative
- if(deriv_desired)then
- ! compute the hydrology derivative
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture); dq_dHydState = -surfaceDiffuse/(mLayerDepth(1)/2._dp)
- case(mixdform); dq_dHydState = -surfaceHydCond/(mLayerDepth(1)/2._dp)
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
- ! compute the energy derivative
- dq_dNrgState = -(dHydCond_dTemp/2._dp)*(scalarMatricHead - upperBoundHead)/(mLayerDepth(1)*0.5_dp) + dHydCond_dTemp/2._dp
- ! compute the numerical derivative
- !cflux = -surfaceHydCond*((scalarMatricHead+dx) - upperBoundHead) / (mLayerDepth(1)*0.5_dp)
- !surfaceInfiltration1 = cflux + surfaceHydCond
- !dNum = (surfaceInfiltration1 - scalarSurfaceInfiltration)/dx
- else
- dq_dHydState = 0._dp
- dNum = 0._dp
- end if
- !write(*,'(a,1x,10(e30.20,1x))') 'scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum = ', &
- ! scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum
-
- ! *****
- ! flux condition
- case(liquidFlux)
-
- ! force infiltration to be constant over the iterations
- if(doInfiltration)then
-
- ! define the storage in the root zone (m)
- rootZoneLiq = 0._dp
- rootZoneIce = 0._dp
- ! (process layers where the roots extend to the bottom of the layer)
- if(nRoots > 1)then
- do iLayer=1,nRoots-1
- rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(iLayer)*mLayerDepth(iLayer)
- rootZoneIce = rootZoneIce + mLayerVolFracIce(iLayer)*mLayerDepth(iLayer)
+ ! -----------------------------------------------------------------------------------------------------------
+
+ ! data types
+ USE nrtype
+ USE data_types,only:var_d ! x%var(:) (rkind)
+ USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
+ USE data_types,only:var_dlength ! x%var(:)%dat (rkind)
+
+ ! missing values
+ USE globalData,only:integerMissing ! missing integer
+ USE globalData,only:realMissing ! missing real number
+
+ ! physical constants
+ USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ gravity, & ! gravitational acceleteration (m s-2)
+ Tfreeze, & ! freezing point of pure water (K)
+ iden_air,& ! intrinsic density of air (kg m-3)
+ iden_ice,& ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of water (kg m-3)
+
+ ! named variables
+ USE var_lookup,only:iLookPROG ! named variables for structure elements
+ USE var_lookup,only:iLookDIAG ! named variables for structure elements
+ USE var_lookup,only:iLookFLUX ! named variables for structure elements
+ USE var_lookup,only:iLookPARAM ! named variables for structure elements
+ USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+ ! model decisions
+ USE globalData,only:model_decisions ! model decision structure
+ USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+ ! provide access to look-up values for model decisions
+ USE mDecisions_module,only: &
+ ! look-up values for method used to compute derivative
+ numerical, & ! numerical solution
+ analytical, & ! analytical solution
+ ! look-up values for the form of Richards' equation
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform, & ! mixed form of Richards' equation
+ ! look-up values for the type of hydraulic conductivity profile
+ constant, & ! constant hydraulic conductivity with depth
+ powerLaw_profile, & ! power-law profile
+ ! look-up values for the choice of groundwater parameterization
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit, & ! no explicit groundwater parameterization
+ ! look-up values for the choice of boundary conditions for hydrology
+ prescribedHead, & ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
+ funcBottomHead, & ! function of matric head in the lower-most layer
+ freeDrainage, & ! free drainage
+ liquidFlux, & ! liquid water flux
+ zeroFlux ! zero flux
+
+ ! -----------------------------------------------------------------------------------------------------------
+ implicit none
+ private
+ public::soilLiqFlx
+ ! constant parameters
+ real(rkind),parameter :: verySmall=1.e-12_rkind ! a very small number (used to avoid divide by zero)
+ real(rkind),parameter :: dx=1.e-8_rkind ! finite difference increment
+ contains
+
+
+ ! ***************************************************************************************************************
+ ! public subroutine soilLiqFlx: compute liquid water fluxes and their derivatives
+ ! ***************************************************************************************************************
+ subroutine soilLiqFlx(&
+ ! input: model control
+ nSoil, & ! intent(in): number of soil layers
+ doInfiltrate, & ! intent(in): flag to compute infiltration
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ! input: trial state variables
+ mLayerTempTrial, & ! intent(in): temperature (K)
+ mLayerMatricHeadLiqTrial, & ! intent(in): liquid matric head (m)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice (-)
+ ! input: pre-computed derivatives
+ mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dCanopyTrans_dCanWat, & ! intent(in): derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ dCanopyTrans_dTCanair, & ! intent(in): derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ dCanopyTrans_dTCanopy, & ! intent(in): derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ dCanopyTrans_dTGround, & ! intent(in): derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ above_soilLiqFluxDeriv, & ! intent(in): derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ above_soildLiq_dTk, & ! intent(in): derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ above_soilFracLiq, & ! intent(in): fraction of liquid water layer above soil (canopy or snow) (-)
+ ! input: fluxes
+ scalarCanopyTranspiration, & ! intent(in): canopy transpiration (kg m-2 s-1)
+ scalarGroundEvaporation, & ! intent(in): ground evaporation (kg m-2 s-1)
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input-output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! output: diagnostic variables for surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ ! output: diagnostic variables for model layers
+ mLayerdTheta_dPsi, & ! intent(out): derivative in the soil water characteristic w.r.t. psi (m-1)
+ mLayerdPsi_dTheta, & ! intent(out): derivative in the soil water characteristic w.r.t. theta (m)
+ dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (s-1)
+ ! output: fluxes
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration rate (m s-1)
+ iLayerLiqFluxSoil, & ! intent(out): liquid fluxes at layer interfaces (m s-1)
+ mLayerTranspire, & ! intent(out): transpiration loss from each soil layer (m s-1)
+ mLayerHydCond, & ! intent(out): hydraulic conductivity in each soil layer (m s-1)
+ ! output: derivatives in fluxes w.r.t. hydrology state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer above (m s-1)
+ dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer below (m s-1)
+ dq_dHydStateLayerSurfVec, & ! intent(out): derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ dq_dNrgStateLayerSurfVec, & ! intent(out): derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ ! output: derivatives in transpiration w.r.t. canopy state variables
+ mLayerdTrans_dTCanair, & ! intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ mLayerdTrans_dTCanopy, & ! intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ mLayerdTrans_dTGround, & ! intent(out): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ mLayerdTrans_dCanWat, & ! intent(out): derivatives in the soil layer transpiration flux w.r.t. canopy total water
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! utility modules
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+ USE soil_utils_module,only:matricHead ! compute matric head (m)
+ USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
+ USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ logical(lgt),intent(in) :: doInfiltrate ! flag to compute infiltration
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ ! input: trial model state variables
+ real(rkind),intent(in) :: mLayerTempTrial(:) ! temperature in each layer at the current iteration (m)
+ real(rkind),intent(in) :: mLayerMatricHeadLiqTrial(:) ! liquid matric head in each layer at the current iteration (m)
+ real(rkind),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid water at the current iteration (-)
+ real(rkind),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
+ ! input: pre-computed derivatves
+ real(rkind),intent(in) :: mLayerdTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ real(rkind),intent(in) :: dCanopyTrans_dCanWat ! derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ real(rkind),intent(in) :: dCanopyTrans_dTCanair ! derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ real(rkind),intent(in) :: dCanopyTrans_dTCanopy ! derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ real(rkind),intent(in) :: dCanopyTrans_dTGround ! derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ real(rkind),intent(in) :: above_soilLiqFluxDeriv ! derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ real(rkind),intent(in) :: above_soildLiq_dTk ! derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ real(rkind),intent(in) :: above_soilFracLiq ! fraction of liquid water layer above soil (canopy or snow) (-)
+ ! input: model fluxes
+ real(rkind),intent(in) :: scalarCanopyTranspiration ! canopy transpiration (kg m-2 s-1)
+ real(rkind),intent(in) :: scalarGroundEvaporation ! ground evaporation (kg m-2 s-1)
+ real(rkind),intent(in) :: scalarRainPlusMelt ! rain plus melt (m s-1)
+ ! input-output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! state vector geometry
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ ! output: diagnostic variables for surface runoff
+ real(rkind),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
+ real(rkind),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
+ real(rkind),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
+ real(rkind),intent(inout) :: scalarSurfaceRunoff ! surface runoff (m s-1)
+ ! output: diagnostic variables for each layer
+ real(rkind),intent(inout) :: mLayerdTheta_dPsi(:) ! derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(rkind),intent(inout) :: mLayerdPsi_dTheta(:) ! derivative in the soil water characteristic w.r.t. theta (m)
+ real(rkind),intent(inout) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (s-1)
+ ! output: liquid fluxes
+ real(rkind),intent(inout) :: scalarSurfaceInfiltration ! surface infiltration rate (m s-1)
+ real(rkind),intent(inout) :: iLayerLiqFluxSoil(0:) ! liquid flux at soil layer interfaces (m s-1)
+ real(rkind),intent(inout) :: mLayerTranspire(:) ! transpiration loss from each soil layer (m s-1)
+ real(rkind),intent(inout) :: mLayerHydCond(:) ! hydraulic conductivity in each soil layer (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables in the layer above and layer below (m s-1)
+ real(rkind),intent(inout) :: dq_dHydStateAbove(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer above
+ real(rkind),intent(inout) :: dq_dHydStateBelow(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer below
+ real(rkind),intent(inout) :: dq_dHydStateLayerSurfVec(0:) ! derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ real(rkind),intent(inout) :: dq_dNrgStateAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ real(rkind),intent(inout) :: dq_dNrgStateBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ real(rkind),intent(inout) :: dq_dNrgStateLayerSurfVec(0:) ! derivative in surface infiltration w.r.t. temperature in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ ! output: derivatives in transpiration w.r.t. canopy state variables
+ real(rkind),intent(inout) :: mLayerdTrans_dTCanair(:) ! derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ real(rkind),intent(inout) :: mLayerdTrans_dTCanopy(:) ! derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ real(rkind),intent(inout) :: mLayerdTrans_dTGround(:) ! derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ real(rkind),intent(inout) :: mLayerdTrans_dCanWat(:) ! derivatives in the soil layer transpiration flux w.r.t. canopy total water
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables: general
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: ibeg,iend ! start and end indices of the soil layers in concatanated snow-soil vector
+ logical(lgt) :: desireAnal ! flag to identify if analytical derivatives are desired
+ integer(i4b) :: iLayer,iSoil ! index of soil layer
+ integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
+ integer(i4b) :: ixTop ! top layer in subroutine call
+ integer(i4b) :: ixBot ! bottom layer in subroutine call
+ ! additional variables to compute numerical derivatives
+ integer(i4b) :: nFlux ! number of flux calculations required (>1 = numerical derivatives with one-sided finite differences)
+ integer(i4b) :: itry ! index of different flux calculations
+ integer(i4b),parameter :: unperturbed=0 ! named variable to identify the case of unperturbed state variables
+ integer(i4b),parameter :: perturbState=1 ! named variable to identify the case where we perturb the state in the current layer
+ integer(i4b),parameter :: perturbStateAbove=2 ! named variable to identify the case where we perturb the state layer above
+ integer(i4b),parameter :: perturbStateBelow=3 ! named variable to identify the case where we perturb the state layer below
+ integer(i4b) :: ixPerturb ! index of element in 2-element vector to perturb
+ integer(i4b) :: ixOriginal ! index of perturbed element in the original vector
+ real(rkind) :: scalarVolFracLiqTrial ! trial value of volumetric liquid water content (-)
+ real(rkind) :: scalarMatricHeadLiqTrial ! trial value of liquid matric head (m)
+ real(rkind) :: scalarHydCondTrial ! trial value of hydraulic conductivity (m s-1)
+ real(rkind) :: scalarHydCondMicro ! trial value of hydraulic conductivity of micropores (m s-1)
+ real(rkind) :: scalarHydCondMacro ! trial value of hydraulic conductivity of macropores (m s-1)
+ real(rkind) :: scalarFlux ! vertical flux (m s-1)
+ real(rkind) :: scalarFlux_dStateAbove ! vertical flux with perturbation to the state above (m s-1)
+ real(rkind) :: scalarFlux_dStateBelow ! vertical flux with perturbation to the state below (m s-1)
+ ! transpiration sink term
+ real(rkind),dimension(nSoil) :: mLayerTranspireFrac ! fraction of transpiration allocated to each soil layer (-)
+ ! diagnostic variables
+ real(rkind),dimension(nSoil) :: iceImpedeFac ! ice impedence factor at layer mid-points (-)
+ real(rkind),dimension(nSoil) :: mLayerDiffuse ! diffusivity at layer mid-point (m2 s-1)
+ real(rkind),dimension(nSoil) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(rkind),dimension(nSoil) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(rkind),dimension(nSoil) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ real(rkind),dimension(0:nSoil) :: iLayerHydCond ! hydraulic conductivity at layer interface (m s-1)
+ real(rkind),dimension(0:nSoil) :: iLayerDiffuse ! diffusivity at layer interface (m2 s-1)
+ ! compute surface flux
+ integer(i4b) :: nRoots ! number of soil layers with roots
+ integer(i4b) :: ixIce ! index of the lowest soil layer that contains ice
+ real(rkind),dimension(0:nSoil) :: iLayerHeight ! height of the layer interfaces (m)
+ ! compute fluxes and derivatives at layer interfaces
+ real(rkind),dimension(2) :: vectorVolFracLiqTrial ! trial value of volumetric liquid water content (-)
+ real(rkind),dimension(2) :: vectorMatricHeadLiqTrial ! trial value of liquid matric head (m)
+ real(rkind),dimension(2) :: vectorHydCondTrial ! trial value of hydraulic conductivity (m s-1)
+ real(rkind),dimension(2) :: vectorDiffuseTrial ! trial value of hydraulic diffusivity (m2 s-1)
+ real(rkind) :: scalardPsi_dTheta ! derivative in soil water characteristix, used for perturbations when computing numerical derivatives
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='soilLiqFlx/'
+
+ ! get indices for the data structures
+ ibeg = indx_data%var(iLookINDEX%nSnow)%dat(1) + 1
+ iend = indx_data%var(iLookINDEX%nSnow)%dat(1) + indx_data%var(iLookINDEX%nSoil)%dat(1)
+
+ ! get a copy of iLayerHeight
+ ! NOTE: performance hit, though cannot define the shape (0:) with the associate construct
+ iLayerHeight(0:nSoil) = prog_data%var(iLookPROG%iLayerHeight)%dat(ibeg-1:iend) ! height of the layer interfaces (m)
+
+ ! make association between local variables and the information in the data structures
+ associate(&
+ ! input: model control
+ ixDerivMethod => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): index of the method used to calculate flux derivatives
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision, & ! intent(in): index of the form of Richards' equation
+ ixBcUpperSoilHydrology => model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision, & ! intent(in): index of the upper boundary conditions for soil hydrology
+ ixBcLowerSoilHydrology => model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision, & ! intent(in): index of the lower boundary conditions for soil hydrology
+ ! input: model indices
+ ixMatricHead => indx_data%var(iLookINDEX%ixMatricHead)%dat, & ! intent(in): indices of soil layers where matric head is the state variable
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat, & ! intent(in): index in the state subset for hydrology state variables in the soil domain
+ ! input: model coordinate variables -- NOTE: use of ibeg and iend
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(ibeg:iend), & ! intent(in): depth of the layer (m)
+ mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat(ibeg:iend), & ! intent(in): height of the layer mid-point (m)
+ ! input: upper boundary conditions
+ upperBoundHead => mpar_data%var(iLookPARAM%upperBoundHead)%dat(1), & ! intent(in): upper boundary condition for matric head (m)
+ upperBoundTheta => mpar_data%var(iLookPARAM%upperBoundTheta)%dat(1), & ! intent(in): upper boundary condition for volumetric liquid water content (-)
+ ! input: lower boundary conditions
+ lowerBoundHead => mpar_data%var(iLookPARAM%lowerBoundHead)%dat(1), & ! intent(in): lower boundary condition for matric head (m)
+ lowerBoundTheta => mpar_data%var(iLookPARAM%lowerBoundTheta)%dat(1), & ! intent(in): lower boundary condition for volumetric liquid water content (-)
+ ! input: vertically variable soil parameters
+ vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat, & ! intent(in): van Genutchen "m" parameter (-)
+ vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat, & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat, & ! intent(in): soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat, & ! intent(in): soil residual volumetric water content (-)
+ ! input: vertically constant soil parameters
+ wettingFrontSuction => mpar_data%var(iLookPARAM%wettingFrontSuction)%dat(1), & ! intent(in): Green-Ampt wetting front suction (m)
+ rootingDepth => mpar_data%var(iLookPARAM%rootingDepth)%dat(1), & ! intent(in): rooting depth (m)
+ kAnisotropic => mpar_data%var(iLookPARAM%kAnisotropic)%dat(1), & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL => mpar_data%var(iLookPARAM%zScale_TOPMODEL)%dat(1), & ! intent(in): TOPMODEL scaling factor (m)
+ qSurfScale => mpar_data%var(iLookPARAM%qSurfScale)%dat(1), & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ f_impede => mpar_data%var(iLookPARAM%f_impede)%dat(1), & ! intent(in): ice impedence factor (-)
+ soilIceScale => mpar_data%var(iLookPARAM%soilIceScale)%dat(1), & ! intent(in): scaling factor for depth of soil ice, used to get frozen fraction (m)
+ soilIceCV => mpar_data%var(iLookPARAM%soilIceCV)%dat(1), & ! intent(in): CV of depth of soil ice, used to get frozen fraction (-)
+ theta_mp => mpar_data%var(iLookPARAM%theta_mp)%dat(1), & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ mpExp => mpar_data%var(iLookPARAM%mpExp)%dat(1), & ! intent(in): empirical exponent in macropore flow equation (-)
+ ! input: saturated hydraulic conductivity
+ mLayerSatHydCondMP => flux_data%var(iLookFLUX%mLayerSatHydCondMP)%dat, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
+ mLayerSatHydCond => flux_data%var(iLookFLUX%mLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
+ iLayerSatHydCond => flux_data%var(iLookFLUX%iLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the interface of each layer (m s-1)
+ ! input: factors limiting transpiration (from vegFlux routine)
+ mLayerRootDensity => diag_data%var(iLookDIAG%mLayerRootDensity)%dat, & ! intent(in): root density in each layer (-)
+ scalarTranspireLim => diag_data%var(iLookDIAG%scalarTranspireLim)%dat(1), & ! intent(in): weighted average of the transpiration limiting factor (-)
+ mLayerTranspireLim => diag_data%var(iLookDIAG%mLayerTranspireLim)%dat & ! intent(in): transpiration limiting factor in each layer (-)
+ ) ! associating local variables with the information in the data structures
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! preliminaries
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! define the pethod to compute derivatives
+ !print*, 'numerical derivatives = ', (ixDerivMethod==numerical)
+
+ ! numerical derivatives are not implemented yet
+ if(ixDerivMethod==numerical)then
+ message=trim(message)//'numerical derivates do not account for the cross derivatives between hydrology and thermodynamics'
+ err=20; return
+ end if
+
+ ! check the need to compute analytical derivatives
+ if(deriv_desired .and. ixDerivMethod==analytical)then
+ desireAnal = .true.
+ else
+ desireAnal = .false.
+ end if
+
+ ! check the need to compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ nFlux=3 ! compute the derivatives using one-sided finite differences
+ else
+ nFlux=0 ! compute analytical derivatives
+ end if
+
+ ! get the indices for the soil layers
+ if(scalarSolution)then
+ ixLayerDesired = pack(ixMatricHead, ixSoilOnlyHyd/=integerMissing)
+ ixTop = ixLayerDesired(1)
+ ixBot = ixLayerDesired(1)
+ else
+ ixTop = 1
+ ixBot = nSoil
+ endif
+
+ ! identify the number of layers that contain roots
+ nRoots = count(iLayerHeight(0:nSoil-1) < rootingDepth-verySmall)
+ if(nRoots==0)then
+ message=trim(message)//'no layers with roots'
+ err=20; return
+ endif
+
+ ! identify lowest soil layer with ice
+ ! NOTE: cannot use count because there may be an unfrozen wedge
+ ixIce = 0 ! initialize the index of the ice layer (0 means no ice in the soil profile)
+ do iLayer=1,nSoil ! (loop through soil layers)
+ if(mLayerVolFracIceTrial(iLayer) > verySmall) ixIce = iLayer
end do
- end if
- ! (process layers where the roots end in the current layer)
- rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
- rootZoneIce = rootZoneIce + mLayerVolFracIce(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
-
- ! define available capacity to hold water (m)
- availCapacity = theta_sat*rootingDepth - rootZoneIce
- if(rootZoneLiq > availCapacity+verySmall)then
- message=trim(message)//'liquid water in the root zone exceeds capacity'
- err=20; return
- end if
-
- ! define the depth to the wetting front (m)
- depthWettingFront = (rootZoneLiq/availCapacity)*rootingDepth
-
- ! define the hydraulic conductivity at depth=depthWettingFront (m s-1)
- hydCondWettingFront = surfaceSatHydCond * ( (1._dp - depthWettingFront/sum(mLayerDepth))**(zScale_TOPMODEL - 1._dp) )
-
- ! define the maximum infiltration rate (m s-1)
- xMaxInfilRate = hydCondWettingFront*( (wettingFrontSuction + depthWettingFront)/depthWettingFront ) ! maximum infiltration rate (m s-1)
- !write(*,'(a,1x,f9.3,1x,10(e20.10,1x))') 'depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate = ', depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate
-
- ! define the infiltrating area for the non-frozen part of the cell/basin
- if(qSurfScale < qSurfScaleMax)then
- fracCap = rootZoneLiq/(maxFracCap*availCapacity) ! fraction of available root zone filled with water
- fInfRaw = 1._dp - exp(-qSurfScale*(1._dp - fracCap)) ! infiltrating area -- allowed to violate solution constraints
- scalarInfilArea = min(0.5_dp*(fInfRaw + sqrt(fInfRaw**2._dp + scaleFactor)), 1._dp) ! infiltrating area -- constrained
- else
- scalarInfilArea = 1._dp
- endif
-
- ! check to ensure we are not infiltrating into a fully saturated column
- if(ixIce<nRoots)then
- if(sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) > 0.9999_dp*theta_sat*sum(mLayerDepth(ixIce+1:nRoots))) scalarInfilArea=0._dp
- !print*, 'ixIce, nRoots, scalarInfilArea = ', ixIce, nRoots, scalarInfilArea
- !print*, 'sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) = ', sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots))
- !print*, 'theta_sat*sum(mLayerDepth(ixIce+1:nRoots)) = ', theta_sat*sum(mLayerDepth(ixIce+1:nRoots))
- endif
-
- ! define the impermeable area due to frozen ground
- if(rootZoneIce > tiny(rootZoneIce))then ! (avoid divide by zero)
- alpha = 1._dp/(soilIceCV**2._dp) ! shape parameter in the Gamma distribution
- xLimg = alpha*soilIceScale/rootZoneIce ! upper limit of the integral
- !scalarFrozenArea = 1._dp - gammp(alpha,xLimg) ! fraction of frozen area
- scalarFrozenArea = 0._dp
- else
- scalarFrozenArea = 0._dp
- end if
- !print*, 'scalarFrozenArea, rootZoneIce = ', scalarFrozenArea, rootZoneIce
-
- end if ! (if desire to compute infiltration)
-
- ! compute infiltration (m s-1)
- scalarSurfaceInfiltration = (1._dp - scalarFrozenArea)*scalarInfilArea*min(scalarRainPlusMelt,xMaxInfilRate)
-
- ! compute surface runoff (m s-1)
- scalarSurfaceRunoff = scalarRainPlusMelt - scalarSurfaceInfiltration
- !print*, 'scalarRainPlusMelt, xMaxInfilRate = ', scalarRainPlusMelt, xMaxInfilRate
- !print*, 'scalarSurfaceInfiltration, scalarSurfaceRunoff = ', scalarSurfaceInfiltration, scalarSurfaceRunoff
- !print*, '(1._dp - scalarFrozenArea), (1._dp - scalarFrozenArea)*scalarInfilArea = ', (1._dp - scalarFrozenArea), (1._dp - scalarFrozenArea)*scalarInfilArea
-
- ! set surface hydraulic conductivity and diffusivity to missing (not used for flux condition)
- surfaceHydCond = realMissing
- surfaceDiffuse = realMissing
-
- ! set numerical derivative to zero
- ! NOTE 1: Depends on multiple soil layers and does not jive with the current tridiagonal matrix
- ! NOTE 2: Need to define the derivative at every call, because intent(out)
- dq_dHydState = 0._dp
- dq_dNrgState = 0._dp
-
- ! ***** error check
- case default; err=20; message=trim(message)//'unknown upper boundary condition for soil hydrology'; return
-
- end select ! (type of upper boundary condition)
-
- end subroutine surfaceFlx
-
-
- ! ***************************************************************************************************************
- ! private subroutine iLayerFlux: compute the fluxes and derivatives at layer interfaces
- ! ***************************************************************************************************************
- subroutine iLayerFlux(&
+ !if(ixIce==nSoil)then; err=20; message=trim(message)//'ice extends to the bottom of the soil profile'; return; end if
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute the transpiration sink term
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! check the need to compute transpiration (NOTE: intent=inout)
+ if( .not. (scalarSolution .and. ixTop>1) )then
+
+ ! compute the fraction of transpiration loss from each soil layer
+ if(scalarTranspireLim > tiny(scalarTranspireLim))then ! (transpiration may be non-zero even if the soil moisture limiting factor is zero)
+ mLayerTranspireFrac(:) = mLayerRootDensity(:)*mLayerTranspireLim(:)/scalarTranspireLim
+ else ! (possible for there to be non-zero conductance and therefore transpiration in this case)
+ mLayerTranspireFrac(:) = mLayerRootDensity(:) / sum(mLayerRootDensity)
+ end if
+
+ ! check fractions sum to one
+ if(abs(sum(mLayerTranspireFrac) - 1._rkind) > verySmall)then
+ message=trim(message)//'fraction transpiration in soil layers does not sum to one'
+ err=20; return
+ endif
+
+ ! compute transpiration loss from each soil layer (kg m-2 s-1 --> m s-1)
+ mLayerTranspire(:) = mLayerTranspireFrac(:)*scalarCanopyTranspiration/iden_water
+ ! derivatives in transpiration w.r.t. canopy state variables
+ mLayerdTrans_dCanWat(:) = mLayerTranspireFrac(:)*dCanopyTrans_dCanWat /iden_water
+ mLayerdTrans_dTCanair(:) = mLayerTranspireFrac(:)*dCanopyTrans_dTCanair/iden_water
+ mLayerdTrans_dTCanopy(:) = mLayerTranspireFrac(:)*dCanopyTrans_dTCanopy/iden_water
+ mLayerdTrans_dTGround(:) = mLayerTranspireFrac(:)*dCanopyTrans_dTGround/iden_water
+
+ ! special case of prescribed head -- no transpiration
+ if(ixBcUpperSoilHydrology==prescribedHead) then
+ mLayerTranspire(:) = 0._rkind
+ ! derivatives in transpiration w.r.t. canopy state variables
+ mLayerdTrans_dCanWat(:) = 0._rkind
+ mLayerdTrans_dTCanair(:)= 0._rkind
+ mLayerdTrans_dTCanopy(:)= 0._rkind
+ mLayerdTrans_dTGround(:)= 0._rkind
+ endif
+
+ endif ! if need to compute transpiration
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute diagnostic variables at the nodes throughout the soil profile
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ do iSoil=ixTop,min(ixBot+1,nSoil) ! (loop through soil layers)
+
+ call diagv_node(&
+ ! input: model control
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ mLayerTempTrial(iSoil), & ! intent(in): temperature (K)
+ mLayerMatricHeadLiqTrial(iSoil), & ! intent(in): liquid matric head in each layer (m)
+ mLayerVolFracLiqTrial(iSoil), & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial(iSoil), & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: pre-computed deriavatives
+ mLayerdTheta_dTk(iSoil), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp(iSoil), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ vGn_alpha(iSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(iSoil), & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m(iSoil), & ! intent(in): van Genutchen "m" parameter (-)
+ mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
+ theta_sat(iSoil), & ! intent(in): soil porosity (-)
+ theta_res(iSoil), & ! intent(in): soil residual volumetric water content (-)
+ theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ f_impede, & ! intent(in): ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ mLayerSatHydCond(iSoil), & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
+ mLayerSatHydCondMP(iSoil), & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ mLayerdPsi_dTheta(iSoil), & ! intent(out): derivative in the soil water characteristic
+ mLayerdTheta_dPsi(iSoil), & ! intent(out): derivative in the soil water characteristic
+ ! output: transmittance
+ mLayerHydCond(iSoil), & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
+ mLayerDiffuse(iSoil), & ! intent(out): diffusivity at layer mid-points (m2 s-1)
+ iceImpedeFac(iSoil), & ! intent(out): ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ dHydCond_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ dHydCond_dTemp(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ end do ! (looping through soil layers)
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! set derivative w.r.t. state above to zero (does not exist)
+ dq_dHydStateAbove(0) = 0._rkind
+ dq_dNrgStateAbove(0) = 0._rkind
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! identify the type of perturbation
+ ! Currently we are ignoring the perturbations in the non-surface layers and with temperature
+ select case(itry)
+
+ ! skip undesired perturbations
+ case(perturbStateAbove); cycle ! cannot perturb state above (does not exist) -- so keep cycling
+ case(perturbState); cycle ! perturbing the layer below the flux at the top interface
+
+ ! un-perturbed case
+ case(unperturbed)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(1)
+
+ ! perturb soil state (one-sided finite differences)
+ case(perturbStateBelow)
+ ! (perturbation depends on the form of Richards' equation)
+ select case(ixRichards)
+ case(moisture)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1) + dx
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(1)
+ case(mixdform)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(1) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation
+ ! check for an unknown perturbation
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+
+ end select ! (type of perturbation)
+
+ ! =====
+ ! compute surface flux and its derivative...
+ ! ==========================================
+
+ call surfaceFlx(&
+ ! input: model control
+ doInfiltrate, & ! intent(in): flag indicating if desire to compute infiltration
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ixBcUpperSoilHydrology, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
+ nRoots, & ! intent(in): number of layers that contain roots
+ ixIce, & ! intent(in): index of lowest ice layer
+ nSoil, & ! intent(in): number of soil layers
+ ! input: state variables
+ mLayerTempTrial, & ! intent(in): temperature (K)
+ scalarMatricHeadLiqTrial, & ! intent(in): liquid matric head in the upper-most soil layer (m)
+ mLayerMatricHeadLiqTrial, & ! intent(in): liquid matric head in each soil layer (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the upper-most soil layer (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: pre-computed deriavatives
+ mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ mLayerdTheta_dPsi, & ! intent(in): derivative in the soil water characteristic w.r.t. psi (m-1)
+ mLayerdPsi_dTheta, & ! intent(in): derivative in the soil water characteristic w.r.t. theta (m)
+ above_soilLiqFluxDeriv, & ! intent(in): derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ above_soildLiq_dTk, & ! intent(in): derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ above_soilFracLiq, & ! intent(in): fraction of liquid water layer above soil (canopy or snow) (-)
+ ! input: depth of upper-most soil layer (m)
+ mLayerDepth, & ! intent(in): depth of each soil layer (m)
+ iLayerHeight, & ! intent(in): height at the interface of each layer (m)
+ ! input: boundary conditions
+ upperBoundHead, & ! intent(in): upper boundary condition (m)
+ upperBoundTheta, & ! intent(in): upper boundary condition (-)
+ ! input: flux at the upper boundary
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input: transmittance
+ iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ dHydCond_dTemp(1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ iceImpedeFac(1), & ! intent(in): ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ vGn_alpha(1), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(1), & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m(1), & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat(1), & ! intent(in): soil porosity (-)
+ theta_res(1), & ! intent(in): soil residual volumetric water content (-)
+ qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ rootingDepth, & ! intent(in): rooting depth (m)
+ wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
+ soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ iLayerHydCond(0), & ! intent(inout): hydraulic conductivity at the surface (m s-1)
+ iLayerDiffuse(0), & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
+ ! input-output: fluxes at layer interfaces and surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
+ ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
+ dq_dHydStateLayerSurfVec, & ! intent(inout): derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ dq_dNrgStateLayerSurfVec, & ! intent(inout): derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! include base soil evaporation as the upper boundary flux
+ iLayerLiqFluxSoil(0) = scalarGroundEvaporation/iden_water + scalarSurfaceInfiltration
+
+ ! get copies of surface flux to compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(0)
+ case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(0)
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ !write(*,'(a,1x,10(f30.15))') 'scalarRainPlusMelt, scalarSurfaceInfiltration = ', scalarRainPlusMelt, scalarSurfaceInfiltration
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ dq_dHydStateBelow(0) = 0._rkind ! contribution will be in dq_dHydStateLayerSurfVec(1)
+ dq_dNrgStateBelow(0) = 0._rkind ! contribution will be in dq_dNrgStateLayerSurfVec(1)
+
+ ! compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateLayerSurfVec(1) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in surface flux w.r.t. change in the soil moisture in the top soil layer (m s-1)
+ dq_dHydStateLayerSurfVec(1) = 0._rkind ! Did not yet compute this perturbation
+ end if
+ !print*, 'scalarSurfaceInfiltration, iLayerLiqFluxSoil(0) = ', scalarSurfaceInfiltration, iLayerLiqFluxSoil(0)
+ !print*, '(ixDerivMethod==numerical), dq_dHydStateBelow(0) = ', (ixDerivMethod==numerical), dq_dHydStateBelow(0)
+ !pause
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! * compute fluxes and derivatives at layer interfaces...
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! NOTE: computing flux at the bottom of the layer
+
+ ! loop through soil layers
+ do iLayer=ixTop,min(ixBot,nSoil-1)
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! determine layer to perturb
+ ! ============================
+ select case(itry)
+ ! skip undesired perturbations
+ case(perturbState); cycle ! perturbing the layers above and below the flux at the interface
+ ! identify the index for the perturbation
+ case(unperturbed); ixPerturb = 0
+ case(perturbStateAbove); ixPerturb = 1
+ case(perturbStateBelow); ixPerturb = 2
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select ! (identifying layer to of perturbation)
+ ! determine the index in the original vector
+ ixOriginal = iLayer + (ixPerturb-1)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! start with the un-perturbed case
+ vectorVolFracLiqTrial(1:2) = mLayerVolFracLiqTrial(iLayer:iLayer+1)
+ vectorMatricHeadLiqTrial(1:2) = mLayerMatricHeadLiqTrial(iLayer:iLayer+1)
+ ! make appropriate perturbations
+ if(ixPerturb > 0)then
+ select case(ixRichards)
+ case(moisture); vectorVolFracLiqTrial(ixPerturb) = vectorVolFracLiqTrial(ixPerturb) + dx
+ case(mixdform); vectorMatricHeadLiqTrial(ixPerturb) = vectorMatricHeadLiqTrial(ixPerturb) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+ end if
+
+ ! =====
+ ! get hydraulic conductivty...
+ ! ============================
+ ! start with the un-perturbed case
+ vectorHydCondTrial(1:2) = mLayerHydCond(iLayer:iLayer+1)
+ vectorDiffuseTrial(1:2) = mLayerDiffuse(iLayer:iLayer+1)
+ ! make appropriate perturbations
+ if(ixPerturb > 0)then ! only recompute these if perturbed
+ select case(ixRichards)
+ case(moisture)
+ scalardPsi_dTheta = dPsi_dTheta(vectorVolFracLiqTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
+ vectorHydCondTrial(ixPerturb) = hydCond_liq(vectorVolFracLiqTrial(ixPerturb),mLayerSatHydCond(ixOriginal),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
+ vectorDiffuseTrial(ixPerturb) = scalardPsi_dTheta * vectorHydCondTrial(ixPerturb)
+ case(mixdform)
+ scalarVolFracLiqTrial = volFracLiq(vectorMatricHeadLiqTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
+ scalarHydCondMicro = hydCond_psi(vectorMatricHeadLiqTrial(ixPerturb),mLayerSatHydCond(ixOriginal),vGn_alpha(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
+ scalarHydCondMacro = hydCondMP_liq(scalarVolFracLiqTrial,theta_sat(ixPerturb),theta_mp,mpExp,mLayerSatHydCondMP(ixOriginal),mLayerSatHydCond(ixOriginal))
+ vectorHydCondTrial(ixPerturb) = scalarHydCondMicro + scalarHydCondMacro
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+ endif ! (recompute if perturbed)
+
+ ! =====
+ ! compute vertical flux at layer interface and its derivative w.r.t. the state above and the state below...
+ ! =========================================================================================================
+
+ ! NOTE: computing flux at the bottom of the layer
+
+ call iLayerFlux(&
! input: model control
- deriv_desired, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
! input: state variables (adjacent layers)
- nodeMatricHeadTrial, & ! intent(in): matric head at the soil nodes (m)
- nodeVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
+ vectorMatricHeadLiqTrial, & ! intent(in): liquid matric head at the soil nodes (m)
+ vectorVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
! input: model coordinate variables (adjacent layers)
- nodeHeight, & ! intent(in): height of the soil nodes (m)
+ mLayerHeight(iLayer:iLayer+1), & ! intent(in): height of the soil nodes (m)
! input: temperature derivatives
- dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
- dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ dPsiLiq_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dHydCond_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
! input: transmittance (adjacent layers)
- nodeHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
- nodeDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
+ vectorHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
+ vectorDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
! input: transmittance derivatives (adjacent layers)
- dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
- dDiffuse_dVolLiq, & ! intent(in): derivative in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
- dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in matric head (s-1)
+ dHydCond_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in matric head (s-1)
! output: tranmsmittance at the layer interface (scalars)
- iLayerHydCond, & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
- iLayerDiffuse, & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
+ iLayerHydCond(iLayer), & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
+ iLayerDiffuse(iLayer), & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
! output: vertical flux at the layer interface (scalars)
- iLayerLiqFluxSoil, & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
+ iLayerLiqFluxSoil(iLayer), & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
- dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
- dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ dq_dHydStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ dq_dHydStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
- dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
- dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ dq_dNrgStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
! output: error control
- err,message) ! intent(out): error control
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
- integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
- ! input: state variables
- real(dp),intent(in) :: nodeMatricHeadTrial(:) ! matric head at the soil nodes (m)
- real(dp),intent(in) :: nodeVolFracLiqTrial(:) ! volumetric fraction of liquid water at the soil nodes (-)
- ! input: model coordinate variables
- real(dp),intent(in) :: nodeHeight(:) ! height at the mid-point of the lower layer (m)
- ! input: temperature derivatives
- real(dp),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
- real(dp),intent(in) :: dHydCond_dTemp(:) ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! input: transmittance
- real(dp),intent(in) :: nodeHydCondTrial(:) ! hydraulic conductivity at layer mid-points (m s-1)
- real(dp),intent(in) :: nodeDiffuseTrial(:) ! diffusivity at layer mid-points (m2 s-1)
- ! input: transmittance derivatives
- real(dp),intent(in) :: dHydCond_dVolLiq(:) ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
- real(dp),intent(in) :: dDiffuse_dVolLiq(:) ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
- real(dp),intent(in) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (m s-1)
- ! output: tranmsmittance at the layer interface (scalars)
- real(dp),intent(out) :: iLayerHydCond ! hydraulic conductivity at the interface between layers (m s-1)
- real(dp),intent(out) :: iLayerDiffuse ! hydraulic diffusivity at the interface between layers (m2 s-1)
- ! output: vertical flux at the layer interface (scalars)
- real(dp),intent(out) :: iLayerLiqFluxSoil ! vertical flux of liquid water at the layer interface (m s-1)
- ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
- real(dp),intent(out) :: dq_dHydStateAbove ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
- real(dp),intent(out) :: dq_dHydStateBelow ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
- ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
- real(dp),intent(out) :: dq_dNrgStateAbove ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
- real(dp),intent(out) :: dq_dNrgStateBelow ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
- ! local variables (named variables to provide index of 2-element vectors)
- integer(i4b),parameter :: ixUpper=1 ! index of upper node in the 2-element vectors
- integer(i4b),parameter :: ixLower=2 ! index of lower node in the 2-element vectors
- logical(lgt),parameter :: useGeometric=.false. ! switch between the arithmetic and geometric mean
- ! local variables (Darcy flux)
- real(dp) :: dPsi ! spatial difference in matric head (m)
- real(dp) :: dLiq ! spatial difference in volumetric liquid water (-)
- real(dp) :: dz ! spatial difference in layer mid-points (m)
- real(dp) :: cflux ! capillary flux (m s-1)
- ! local variables (derivative in Darcy's flux)
- real(dp) :: dHydCondIface_dVolLiqAbove ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer above
- real(dp) :: dHydCondIface_dVolLiqBelow ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer below
- real(dp) :: dDiffuseIface_dVolLiqAbove ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer above
- real(dp) :: dDiffuseIface_dVolLiqBelow ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer below
- real(dp) :: dHydCondIface_dMatricAbove ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer above
- real(dp) :: dHydCondIface_dMatricBelow ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer below
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="iLayerFlux/"
-
- ! *****
- ! compute the vertical flux of liquid water
- ! compute the hydraulic conductivity at the interface
- if(useGeometric)then
- iLayerHydCond = (nodeHydCondTrial(ixLower) * nodeHydCondTrial(ixUpper))**0.5_dp
- else
- iLayerHydCond = (nodeHydCondTrial(ixLower) + nodeHydCondTrial(ixUpper))*0.5_dp
- end if
- !write(*,'(a,1x,5(e20.10,1x))') 'in iLayerFlux: iLayerHydCond, iLayerHydCondMP = ', iLayerHydCond, iLayerHydCondMP
- ! compute the height difference between nodes
- dz = nodeHeight(ixLower) - nodeHeight(ixUpper)
- ! compute the capillary flux
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture)
- iLayerDiffuse = (nodeDiffuseTrial(ixLower) * nodeDiffuseTrial(ixUpper))**0.5_dp
- dLiq = nodeVolFracLiqTrial(ixLower) - nodeVolFracLiqTrial(ixUpper)
- cflux = -iLayerDiffuse * dLiq/dz
- case(mixdform)
- iLayerDiffuse = realMissing
- dPsi = nodeMatricHeadTrial(ixLower) - nodeMatricHeadTrial(ixUpper)
- cflux = -iLayerHydCond * dPsi/dz
- case default; err=10; message=trim(message)//"unable to identify option for Richards' equation"; return
- end select
- ! compute the total flux (add gravity flux, positive downwards)
- iLayerLiqFluxSoil = cflux + iLayerHydCond
- !write(*,'(a,1x,10(e20.10,1x))') 'iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond = ', &
- ! iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond
-
- ! ** compute the derivatives
- if(deriv_desired)then
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture)
- ! still need to implement arithmetric mean for the moisture-based form
- if(.not.useGeometric)then
- message=trim(message)//'only currently implemented for geometric mean -- change local flag'
- err=20; return
- end if
- ! derivatives in hydraulic conductivity at the layer interface (m s-1)
- dHydCondIface_dVolLiqAbove = dHydCond_dVolLiq(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_dp/max(iLayerHydCond,verySmall)
- dHydCondIface_dVolLiqBelow = dHydCond_dVolLiq(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_dp/max(iLayerHydCond,verySmall)
- ! derivatives in hydraulic diffusivity at the layer interface (m2 s-1)
- dDiffuseIface_dVolLiqAbove = dDiffuse_dVolLiq(ixUpper)*nodeDiffuseTrial(ixLower) * 0.5_dp/max(iLayerDiffuse,verySmall)
- dDiffuseIface_dVolLiqBelow = dDiffuse_dVolLiq(ixLower)*nodeDiffuseTrial(ixUpper) * 0.5_dp/max(iLayerDiffuse,verySmall)
- ! derivatives in the flux w.r.t. volumetric liquid water content
- dq_dHydStateAbove = -dDiffuseIface_dVolLiqAbove*dLiq/dz + iLayerDiffuse/dz + dHydCondIface_dVolLiqAbove
- dq_dHydStateBelow = -dDiffuseIface_dVolLiqBelow*dLiq/dz - iLayerDiffuse/dz + dHydCondIface_dVolLiqBelow
- case(mixdform)
- ! derivatives in hydraulic conductivity
- if(useGeometric)then
- dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_dp/max(iLayerHydCond,verySmall)
- dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_dp/max(iLayerHydCond,verySmall)
- else
- dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)/2._dp
- dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)/2._dp
- end if
- ! derivatives in the flux w.r.t. matric head
- dq_dHydStateAbove = -dHydCondIface_dMatricAbove*dPsi/dz + iLayerHydCond/dz + dHydCondIface_dMatricAbove
- dq_dHydStateBelow = -dHydCondIface_dMatricBelow*dPsi/dz - iLayerHydCond/dz + dHydCondIface_dMatricBelow
- ! derivative in the flux w.r.t. temperature
- dq_dNrgStateAbove = -(dHydCond_dTemp(ixUpper)/2._dp)*dPsi/dz + iLayerHydCond*dPsiLiq_dTemp(ixUpper)/dz + dHydCond_dTemp(ixUpper)/2._dp
- dq_dNrgStateBelow = -(dHydCond_dTemp(ixLower)/2._dp)*dPsi/dz - iLayerHydCond*dPsiLiq_dTemp(ixLower)/dz + dHydCond_dTemp(ixLower)/2._dp
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
- else
- dq_dHydStateAbove = realMissing
- dq_dHydStateBelow = realMissing
- end if
-
- end subroutine iLayerFlux
-
-
- ! ***************************************************************************************************************
- ! private subroutine qDrainFlux: compute the drainage flux from the bottom of the soil profile and its derivative
- ! ***************************************************************************************************************
- subroutine qDrainFlux(&
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! compute total vertical flux, to compute derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(iLayer)
+ case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(iLayer)
+ case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(iLayer)
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ ! compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateAbove(iLayer) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
+ dq_dHydStateBelow(iLayer) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
+ end if
+
+ ! check
+ !if(iLayer==6) write(*,'(a,i4,1x,10(e25.15,1x))') 'iLayer, vectorMatricHeadLiqTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer) = ',&
+ ! iLayer, vectorMatricHeadLiqTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer)
+ !if(iLayer==1) write(*,'(a,i4,1x,L1,1x,2(e15.5,1x))') 'iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer) = ', &
+ ! iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer)
+ !pause
+
+ end do ! (looping through soil layers)
+
+ ! add infiltration to the upper-most unfrozen layer
+ ! NOTE: this is done here rather than in surface runoff
+ !iLayerLiqFluxSoil(ixIce) = iLayerLiqFluxSoil(ixIce) + scalarSurfaceInfiltration
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! * compute drainage flux from the bottom of the soil profile, and its derivative
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! define the need to compute drainage
+ if( .not. (scalarSolution .and. ixTop<nSoil) )then
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! identify the type of perturbation
+ select case(itry)
+
+ ! skip undesired perturbations
+ case(perturbStateBelow); cycle ! only perturb soil state at this time (perhaps perturb aquifer state later)
+ case(perturbState); cycle ! here pertubing the state above the flux at the interface
+
+ ! un-perturbed case
+ case(unperturbed)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(nSoil)
+
+ ! perturb soil state (one-sided finite differences)
+ case(perturbStateAbove)
+ select case(ixRichards) ! (perturbation depends on the form of Richards' equation)
+ case(moisture)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil) + dx
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(nSoil)
+ case(mixdform)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
+ scalarMatricHeadLiqTrial = mLayerMatricHeadLiqTrial(nSoil) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+
+ end select ! (type of perturbation)
+
+ ! =====
+ ! get hydraulic conductivty...
+ ! ============================
+ select case(itry)
+
+ ! compute perturbed value of hydraulic conductivity
+ case(perturbStateAbove)
+ select case(ixRichards)
+ case(moisture); scalarHydCondTrial = hydCond_liq(scalarVolFracLiqTrial,mLayerSatHydCond(nSoil),theta_res(nSoil),theta_sat(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
+ case(mixdform); scalarHydCondTrial = hydCond_psi(scalarMatricHeadLiqTrial,mLayerSatHydCond(nSoil),vGn_alpha(nSoil),vGn_n(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
+ end select
+
+ ! (use un-perturbed value)
+ case default
+ scalarHydCondTrial = mLayerHydCond(nSoil) ! hydraulic conductivity at the mid-point of the lowest unsaturated soil layer (m s-1)
+
+ end select ! (re-computing hydraulic conductivity)
+
+ ! =====
+ ! compute drainage flux and its derivative...
+ ! ===========================================
+
+ call qDrainFlux(&
! input: model control
- deriv_desired, & ! intent(in): flag indicating if derivatives are desired
- ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
- bc_lower, & ! intent(in): index defining the type of boundary conditions
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ixBcLowerSoilHydrology, & ! intent(in): index defining the type of boundary conditions
! input: state variables
- nodeMatricHead, & ! intent(in): matric head in the lowest unsaturated node (m)
- nodeVolFracLiq, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
+ scalarMatricHeadLiqTrial, & ! intent(in): liquid matric head in the lowest unsaturated node (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
! input: model coordinate variables
- nodeDepth, & ! intent(in): depth of the lowest unsaturated soil layer (m)
- nodeHeight, & ! intent(in): height of the lowest unsaturated soil node (m)
+ mLayerDepth(nSoil), & ! intent(in): depth of the lowest unsaturated soil layer (m)
+ mLayerHeight(nSoil), & ! intent(in): height of the lowest unsaturated soil node (m)
! input: boundary conditions
- lowerBoundHead, & ! intent(in): lower boundary condition (m)
- lowerBoundTheta, & ! intent(in): lower boundary condition (-)
- ! input: derivative in soil water characteristix
- node__dPsi_dTheta, & ! intent(in): derivative of the soil moisture characteristic w.r.t. theta (m)
+ lowerBoundHead, & ! intent(in): lower boundary condition (m)
+ lowerBoundTheta, & ! intent(in): lower boundary condition (-)
+ ! input: derivative in the soil water characteristic
+ mLayerdPsi_dTheta(nSoil), & ! intent(in): derivative in the soil water characteristic
! input: transmittance
- surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
- bottomSatHydCond, & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
- nodeHydCond, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
- iceImpedeFac, & ! intent(in): ice impedence factor in the lower-most soil layer (-)
+ iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ iLayerSatHydCond(nSoil), & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ scalarHydCondTrial, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
+ iceImpedeFac(nSoil), & ! intent(in): ice impedence factor in the lower-most soil layer (-)
! input: transmittance derivatives
- dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
- dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
- dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ dHydCond_dVolLiq(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ dHydCond_dMatric(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ dHydCond_dTemp(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
! input: soil parameters
- vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
- vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
- VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
- theta_sat, & ! intent(in): soil porosity (-)
- theta_res, & ! intent(in): soil residual volumetric water content (-)
- kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
- zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
+ vGn_alpha(nSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(nSoil), & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m(nSoil), & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat(nSoil), & ! intent(in): soil porosity (-)
+ theta_res(nSoil), & ! intent(in): soil residual volumetric water content (-)
+ kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
! output: hydraulic conductivity and diffusivity at the surface
- bottomHydCond, & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
- bottomDiffuse, & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
- ! output: drainage flux from the bottom of the soil profile
- scalarDrainage, & ! intent(out): drainage flux from the bottom of the soil profile (m s-1)
+ iLayerHydCond(nSoil), & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
+ iLayerDiffuse(nSoil), & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux
+ iLayerLiqFluxSoil(nSoil), & ! intent(out): drainage flux (m s-1)
! output: derivatives in drainage flux
- dq_dHydStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in hydrology state variable in lowest unsaturated node (m s-1 or s-1)
- dq_dNrgStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
+ dq_dHydStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in hydrology state in lowest unsaturated node (m s-1 or s-1)
+ dq_dNrgStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in energy state in lowest unsaturated node (m s-1 or s-1)
! output: error control
- err,message) ! intent(out): error control
- USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
- USE soil_utils_module,only:matricHead ! compute matric head as a function of volumetric fraction of liquid water (m)
- USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
- USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
- USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
- ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
- implicit none
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
- integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
- integer(i4b),intent(in) :: bc_lower ! index defining the type of boundary conditions
- ! input: state and diagnostic variables
- real(dp),intent(in) :: nodeMatricHead ! matric head in the lowest unsaturated node (m)
- real(dp),intent(in) :: nodeVolFracLiq ! volumetric liquid water content in the lowest unsaturated node (-)
- ! input: model coordinate variables
- real(dp),intent(in) :: nodeDepth ! depth of the lowest unsaturated soil layer (m)
- real(dp),intent(in) :: nodeHeight ! height of the lowest unsaturated soil node (m)
- ! input: diriclet boundary conditions
- real(dp),intent(in) :: lowerBoundHead ! lower boundary condition for matric head (m)
- real(dp),intent(in) :: lowerBoundTheta ! lower boundary condition for volumetric liquid water content (-)
- ! input: derivative in soil water characteristix
- real(dp),intent(in) :: node__dPsi_dTheta ! derivative of the soil moisture characteristic w.r.t. theta (m)
- ! input: transmittance
- real(dp),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
- real(dp),intent(in) :: bottomSatHydCond ! saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
- real(dp),intent(in) :: nodeHydCond ! hydraulic conductivity at the node itself (m s-1)
- real(dp),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
- ! input: transmittance derivatives
- real(dp),intent(in) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
- real(dp),intent(in) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t. matric head (s-1)
- real(dp),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
- ! input: soil parameters
- real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
- real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
- real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
- real(dp),intent(in) :: theta_sat ! soil porosity (-)
- real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
- real(dp),intent(in) :: kAnisotropic ! anisotropy factor for lateral hydraulic conductivity (-)
- real(dp),intent(in) :: zScale_TOPMODEL ! scale factor for TOPMODEL-ish baseflow parameterization (m)
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! output: hydraulic conductivity at the bottom of the unsaturated zone
- real(dp),intent(out) :: bottomHydCond ! hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
- real(dp),intent(out) :: bottomDiffuse ! hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
- ! output: drainage flux from the bottom of the soil profile
- real(dp),intent(out) :: scalarDrainage ! drainage flux from the bottom of the soil profile (m s-1)
- ! output: derivatives in drainage flux
- real(dp),intent(out) :: dq_dHydStateUnsat ! change in drainage flux w.r.t. change in state variable in lowest unsaturated node (m s-1 or s-1)
- real(dp),intent(out) :: dq_dNrgStateUnsat ! change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! local variables
- real(dp) :: zWater ! effective water table depth (m)
- real(dp) :: nodePsi ! matric head in the lowest unsaturated node (m)
- real(dp) :: cflux ! capillary flux (m s-1)
- ! -----------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="qDrainFlux/"
-
- ! determine lower boundary condition
- select case(bc_lower)
-
- ! ---------------------------------------------------------------------------------------------
- ! * prescribed head
- ! ---------------------------------------------------------------------------------------------
- case(prescribedHead)
-
- ! compute fluxes
- select case(ixRichards) ! (moisture-based form of Richards' equation)
- case(moisture)
- ! compute the hydraulic conductivity and diffusivity at the boundary
- bottomHydCond = hydCond_liq(lowerBoundTheta,bottomSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
- bottomDiffuse = dPsi_dTheta(lowerBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * bottomHydCond
- ! compute the capillary flux
- cflux = -bottomDiffuse*(lowerBoundTheta - nodeVolFracLiq) / (nodeDepth*0.5_dp)
- case(mixdform)
- ! compute the hydraulic conductivity and diffusivity at the boundary
- bottomHydCond = hydCond_psi(lowerBoundHead,bottomSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
- bottomDiffuse = realMissing
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! get copies of drainage flux to compute derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(nSoil)
+ case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(nSoil)
+ case(perturbStateBelow); err=20; message=trim(message)//'lower state should never be perturbed when computing drainage do not expect to get here'; return
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ ! compute numerical derivatives
+ ! NOTE: drainage derivatives w.r.t. state below are *actually* w.r.t. water table depth, so need to be corrected for aquifer storage
+ ! (note also negative sign to account for inverse relationship between water table depth and aquifer storage)
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateAbove(nSoil) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in state in lowest unsaturated node (m s-1 or s-1)
+ end if
+
+ ! no dependence on the aquifer for drainage
+ dq_dHydStateBelow(nSoil) = 0._rkind ! keep this here in case we want to couple some day....
+ dq_dNrgStateBelow(nSoil) = 0._rkind ! keep this here in case we want to couple some day....
+
+ ! print drainage
+ !print*, 'iLayerLiqFluxSoil(nSoil) = ', iLayerLiqFluxSoil(nSoil)
+
+ endif ! if computing drainage
+ ! end of drainage section
+
+ ! *****************************************************************************************************************************************************************
+ ! *****************************************************************************************************************************************************************
+
+ ! end association between local variables and the information in the data structures
+ end associate
+
+ end subroutine soilLiqFlx
+
+ ! ***************************************************************************************************************
+ ! private subroutine diagv_node: compute transmittance and derivatives for model nodes
+ ! ***************************************************************************************************************
+ subroutine diagv_node(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ scalarTempTrial, & ! intent(in): temperature (K)
+ scalarMatricHeadLiqTrial, & ! intent(in): liquid matric head in a given layer (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content in a given soil layer (-)
+ scalarVolFracIceTrial, & ! intent(in): volumetric ice content in a given soil layer (-)
+ ! input: pre-computed deriavatives
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ f_impede, & ! intent(in): ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ scalarSatHydCond, & ! intent(in): saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
+ scalarSatHydCondMP, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ scalardPsi_dTheta, & ! derivative in the soil water characteristic
+ scalardTheta_dPsi, & ! derivative in the soil water characteristic
+ ! output: transmittance
+ scalarHydCond, & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
+ scalarDiffuse, & ! intent(out): diffusivity at layer mid-points (m2 s-1)
+ iceImpedeFac, & ! intent(out): ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ dHydCond_dVolLiq, & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq, & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ dHydCond_dTemp, & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:iceImpede ! compute the ice impedence factor
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head
+ USE soil_utils_module,only:matricHead ! compute matric head (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
+ USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
+ USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:dPsi_dTheta2 ! compute derivative in dPsi_dTheta (m)
+ USE soil_utils_module,only:dHydCond_dLiq ! compute derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dHydCond_dPsi ! compute derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ USE soil_utils_module,only:dIceImpede_dTemp ! compute the derivative in the ice impedance factor w.r.t. temperature (K-1)
+ ! compute hydraulic transmittance and derivatives for all layers
+ implicit none
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state and diagnostic variables
+ real(rkind),intent(in) :: scalarTempTrial ! temperature in each layer (K)
+ real(rkind),intent(in) :: scalarMatricHeadLiqTrial ! liquid matric head in each layer (m)
+ real(rkind),intent(in) :: scalarVolFracLiqTrial ! volumetric fraction of liquid water in a given layer (-)
+ real(rkind),intent(in) :: scalarVolFracIceTrial ! volumetric fraction of ice in a given layer (-)
+ ! input: pre-computed deriavatives
+ real(rkind),intent(in) :: dTheta_dTk ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: dPsiLiq_dTemp ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ real(rkind),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(rkind),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(rkind),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(rkind),intent(in) :: mpExp ! empirical exponent in macropore flow equation (-)
+ real(rkind),intent(in) :: theta_sat ! soil porosity (-)
+ real(rkind),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(rkind),intent(in) :: theta_mp ! volumetric liquid water content when macropore flow begins (-)
+ real(rkind),intent(in) :: f_impede ! ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ real(rkind),intent(in) :: scalarSatHydCond ! saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
+ real(rkind),intent(in) :: scalarSatHydCondMP ! saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ real(rkind),intent(out) :: scalardPsi_dTheta ! derivative in the soil water characteristic
+ real(rkind),intent(out) :: scalardTheta_dPsi ! derivative in the soil water characteristic
+ ! output: transmittance
+ real(rkind),intent(out) :: scalarHydCond ! hydraulic conductivity at layer mid-points (m s-1)
+ real(rkind),intent(out) :: scalarDiffuse ! diffusivity at layer mid-points (m2 s-1)
+ real(rkind),intent(out) :: iceImpedeFac ! ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ real(rkind),intent(out) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(rkind),intent(out) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(rkind),intent(out) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t matric head (s-1)
+ real(rkind),intent(out) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local variables
+ real(rkind) :: localVolFracLiq ! local volumetric fraction of liquid water
+ real(rkind) :: scalarHydCondMP ! hydraulic conductivity of macropores at layer mid-points (m s-1)
+ real(rkind) :: dIceImpede_dT ! derivative in ice impedance factor w.r.t. temperature (K-1)
+ real(rkind) :: dHydCondMacro_dVolLiq ! derivative in hydraulic conductivity of macropores w.r.t volumetric liquid water content (m s-1)
+ real(rkind) :: dHydCondMacro_dMatric ! derivative in hydraulic conductivity of macropores w.r.t matric head (s-1)
+ real(rkind) :: dHydCondMicro_dMatric ! derivative in hydraulic conductivity of micropores w.r.t matric head (s-1)
+ real(rkind) :: dHydCondMicro_dTemp ! derivative in hydraulic conductivity of micropores w.r.t temperature (m s-1 K-1)
+ real(rkind) :: dPsi_dTheta2a ! derivative in dPsi_dTheta (analytical)
+ real(rkind) :: dIceImpede_dLiq ! derivative in ice impedence factor w.r.t. volumetric liquid water content (-)
+ real(rkind) :: hydCond_noIce ! hydraulic conductivity in the absence of ice (m s-1)
+ real(rkind) :: dK_dLiq__noIce ! derivative in hydraulic conductivity w.r.t volumetric liquid water content, in the absence of ice (m s-1)
+ real(rkind) :: dK_dPsi__noIce ! derivative in hydraulic conductivity w.r.t matric head, in the absence of ice (s-1)
+ real(rkind) :: relSatMP ! relative saturation of macropores (-)
+ ! local variables to test the derivative
+ logical(lgt),parameter :: testDeriv=.false. ! local flag to test the derivative
+ real(rkind) :: xConst ! LH_fus/(gravity*Tfreeze), used in freezing point depression equation (m K-1)
+ real(rkind) :: vTheta ! volumetric fraction of total water (-)
+ real(rkind) :: volLiq ! volumetric fraction of liquid water (-)
+ real(rkind) :: volIce ! volumetric fraction of ice (-)
+ real(rkind) :: volFracLiq1,volFracLiq2 ! different trial values of volumetric liquid water content (-)
+ real(rkind) :: effSat ! effective saturation (-)
+ real(rkind) :: psiLiq ! liquid water matric potential (m)
+ real(rkind) :: hydCon ! hydraulic conductivity (m s-1)
+ real(rkind) :: hydIce ! hydraulic conductivity after accounting for ice impedance (-)
+ real(rkind),parameter :: dx = 1.e-8_rkind ! finite difference increment (m)
+ ! initialize error control
+ err=0; message="diagv_node/"
+
+ ! *****
+ ! compute the derivative in the soil water characteristic
+ select case(ixRichards)
+ case(moisture)
+ scalardPsi_dTheta = dPsi_dTheta(scalarVolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalardTheta_dPsi = realMissing ! (deliberately cause problems if this is ever used)
+ case(mixdform)
+ scalardTheta_dPsi = dTheta_dPsi(scalarMatricHeadLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalardPsi_dTheta = dPsi_dTheta(scalarVolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ if(testDeriv)then
+ volFracLiq1 = volFracLiq(scalarMatricHeadLiqTrial, vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ volFracLiq2 = volFracLiq(scalarMatricHeadLiqTrial+dx,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ end if ! (testing the derivative)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+
+ ! *****
+ ! compute hydraulic conductivity and its derivative in each soil layer
+
+ ! compute the ice impedence factor and its derivative w.r.t. volumetric liquid water content (-)
+ call iceImpede(scalarVolFracIceTrial,f_impede, & ! input
+ iceImpedeFac,dIceImpede_dLiq) ! output
+
+ select case(ixRichards)
+ ! ***** moisture-based form of Richards' equation
+ case(moisture)
+ ! haven't included macropores yet
+ err=20; message=trim(message)//'still need to include macropores for the moisture-based form of Richards eqn'; return
+ ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
+ hydCond_noIce = hydCond_liq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m)
+ scalarHydCond = hydCond_noIce*iceImpedeFac
+ scalarDiffuse = scalardPsi_dTheta * scalarHydCond
+ ! compute derivative in hydraulic conductivity (m s-1) and hydraulic diffusivity (m2 s-1)
+ if(deriv_desired)then
+ if(scalarVolFracIceTrial > epsilon(iceImpedeFac))then
+ dK_dLiq__noIce = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.) ! [.true. = analytical]
+ dHydCond_dVolLiq = hydCond_noIce*dIceImpede_dLiq + dK_dLiq__noIce*iceImpedeFac
+ else
+ dHydCond_dVolLiq = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.)
+ end if
+ dPsi_dTheta2a = dPsi_dTheta2(scalarVolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m,.true.) ! [.true. = analytical] compute derivative in dPsi_dTheta (m)
+ dDiffuse_dVolLiq = dHydCond_dVolLiq*scalardPsi_dTheta + scalarHydCond*dPsi_dTheta2a
+ dHydCond_dMatric = realMissing ! not used, so cause problems
+ end if
+
+ ! ***** mixed form of Richards' equation -- just compute hydraulic condictivity
+ case(mixdform)
+ ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
+ hydCond_noIce = hydCond_psi(scalarMatricHeadLiqTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
+ scalarDiffuse = realMissing ! not used, so cause problems
+ ! compute the hydraulic conductivity of macropores (m s-1)
+ localVolFracLiq = volFracLiq(scalarMatricHeadLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalarHydCondMP = hydCondMP_liq(localVolFracLiq,theta_sat,theta_mp,mpExp,scalarSatHydCondMP,scalarSatHydCond)
+ scalarHydCond = hydCond_noIce*iceImpedeFac + scalarHydCondMP
+
+ ! compute derivative in hydraulic conductivity (m s-1)
+ if(deriv_desired)then
+ ! (compute derivative for macropores)
+ if(localVolFracLiq > theta_mp)then
+ relSatMP = (localVolFracLiq - theta_mp)/(theta_sat - theta_mp)
+ dHydCondMacro_dVolLiq = ((scalarSatHydCondMP - scalarSatHydCond)/(theta_sat - theta_mp))*mpExp*(relSatMP**(mpExp - 1._rkind))
+ dHydCondMacro_dMatric = scalardTheta_dPsi*dHydCondMacro_dVolLiq
+ else
+ dHydCondMacro_dVolLiq = 0._rkind
+ dHydCondMacro_dMatric = 0._rkind
+ end if
+ ! (compute derivatives for micropores)
+ if(scalarVolFracIceTrial > verySmall)then
+ dK_dPsi__noIce = dHydCond_dPsi(scalarMatricHeadLiqTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.) ! analytical
+ dHydCondMicro_dTemp = dPsiLiq_dTemp*dK_dPsi__noIce ! m s-1 K-1
+ dHydCondMicro_dMatric = hydCond_noIce*dIceImpede_dLiq*scalardTheta_dPsi + dK_dPsi__noIce*iceImpedeFac
+ else
+ dHydCondMicro_dTemp = 0._rkind
+ dHydCondMicro_dMatric = dHydCond_dPsi(scalarMatricHeadLiqTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.)
+ end if
+ ! (combine derivatives)
+ dHydCond_dMatric = dHydCondMicro_dMatric + dHydCondMacro_dMatric
+
+ ! (compute analytical derivative for change in ice impedance factor w.r.t. temperature)
+ call dIceImpede_dTemp(scalarVolFracIceTrial, & ! intent(in): trial value of volumetric ice content (-)
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ f_impede, & ! intent(in): ice impedance parameter (-)
+ dIceImpede_dT ) ! intent(out): derivative in ice impedance factor w.r.t. temperature (K-1)
+ ! (compute derivative in hydraulic conductivity w.r.t. temperature)
+ dHydCond_dTemp = hydCond_noIce*dIceImpede_dT + dHydCondMicro_dTemp*iceImpedeFac
+ ! (test derivative)
+ if(testDeriv)then
+ xConst = LH_fus/(gravity*Tfreeze) ! m K-1 (NOTE: J = kg m2 s-2)
+ vTheta = scalarVolFracIceTrial + scalarVolFracLiqTrial
+ volLiq = volFracLiq(xConst*(scalarTempTrial+dx - Tfreeze),vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ volIce = vTheta - volLiq
+ effSat = (volLiq - theta_res)/(theta_sat - volIce - theta_res)
+ psiLiq = matricHead(effSat,vGn_alpha,0._rkind,1._rkind,vGn_n,vGn_m) ! use effective saturation, so theta_res=0 and theta_sat=1
+ hydCon = hydCond_psi(psiLiq,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
+ call iceImpede(volIce,f_impede,iceImpedeFac,dIceImpede_dLiq)
+ hydIce = hydCon*iceImpedeFac
+ print*, 'test derivative: ', (psiLiq - scalarMatricHeadLiqTrial)/dx, dPsiLiq_dTemp
+ print*, 'test derivative: ', (hydCon - hydCond_noIce)/dx, dHydCondMicro_dTemp
+ print*, 'test derivative: ', (hydIce - scalarHydCond)/dx, dHydCond_dTemp
+ print*, 'press any key to continue'; read(*,*) ! (alternative to the deprecated 'pause' statement)
+ end if ! testing the derivative
+ ! (set values that are not used to missing)
+ dHydCond_dVolLiq = realMissing ! not used, so cause problems
+ dDiffuse_dVolLiq = realMissing ! not used, so cause problems
+ end if
+
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+
+ end select
+
+ ! if derivatives are not desired, then set values to missing
+ if(.not.deriv_desired)then
+ dHydCond_dVolLiq = realMissing ! not used, so cause problems
+ dDiffuse_dVolLiq = realMissing ! not used, so cause problems
+ dHydCond_dMatric = realMissing ! not used, so cause problems
+ end if
+
+ end subroutine diagv_node
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine surfaceFlx: compute the surface flux and its derivative
+ ! ***************************************************************************************************************
+ subroutine surfaceFlx(&
+ ! input: model control
+ doInfiltration, & ! intent(in): flag indicating if desire to compute infiltration
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ bc_upper, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
+ nRoots, & ! intent(in): number of layers that contain roots
+ ixIce, & ! intent(in): index of lowest ice layer
+ nSoil, & ! intent(in): number of soil layers
+ ! input: state variables
+ mLayerTemp, & ! intent(in): temperature (K)
+ scalarMatricHead, & ! intent(in): matric head in the upper-most soil layer (m)
+ mLayerMatricHead, & ! intent(in): matric head in each soil layer (m)
+ scalarVolFracLiq, & ! intent(in): volumetric liquid water content in the upper-most soil layer (-)
+ mLayerVolFracLiq, & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIce, & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: pre-computed derivatives
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dTheta_dPsi, & ! intent(in): derivative in the soil water characteristic w.r.t. psi (m-1)
+ mLayerdPsi_dTheta, & ! intent(in): derivative in the soil water characteristic w.r.t. theta (m)
+ above_soilLiqFluxDeriv, & ! intent(in): derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ above_soildLiq_dTk, & ! intent(in): derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ above_soilFracLiq, & ! intent(in): fraction of liquid water layer above soil (canopy or snow) (-)
+ ! input: depth of upper-most soil layer (m)
+ mLayerDepth, & ! intent(in): depth of each soil layer (m)
+ iLayerHeight, & ! intent(in): height at the interface of each layer (m)
+ ! input: boundary conditions
+ upperBoundHead, & ! intent(in): upper boundary condition (m)
+ upperBoundTheta, & ! intent(in): upper boundary condition (-)
+ ! input: flux at the upper boundary
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input: transmittance
+ surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ iceImpedeFac, & ! intent(in): ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ rootingDepth, & ! intent(in): rooting depth (m)
+ wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
+ soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ surfaceHydCond, & ! intent(inout): hydraulic conductivity at the surface (m s-1)
+ surfaceDiffuse, & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
+ ! input-output: fluxes at layer interfaces and surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
+ ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
+ dq_dHydStateVec, & ! intent(inout): derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ dq_dNrgStateVec, & ! intent(inout): derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+ USE soil_utils_module,only:gammp ! compute the cumulative probabilty based on the Gamma distribution
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ implicit none
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: doInfiltration ! flag indicating if desire to compute infiltration
+ logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
+ integer(i4b),intent(in) :: bc_upper ! index defining the type of boundary conditions
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ integer(i4b),intent(in) :: nRoots ! number of layers that contain roots
+ integer(i4b),intent(in) :: ixIce ! index of lowest ice layer
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ ! input: state and diagnostic variables
+ real(rkind),intent(in) :: mLayerTemp(:) ! temperature (K)
+ real(rkind),intent(in) :: scalarMatricHead ! matric head in the upper-most soil layer (m)
+ real(rkind),intent(in) :: mLayerMatricHead(:) ! matric head in each soil layer (m)
+ real(rkind),intent(in) :: scalarVolFracLiq ! volumetric liquid water content in the upper-most soil layer (-)
+ real(rkind),intent(in) :: mLayerVolFracLiq(:) ! volumetric liquid water content in each soil layer (-)
+ real(rkind),intent(in) :: mLayerVolFracIce(:) ! volumetric ice content in each soil layer (-)
+ ! input: pre-computed derivatives, note all of these would need to be recomputed if wanted a numerical derivative
+ real(rkind),intent(in) :: dTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: dTheta_dPsi(:) ! derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(rkind),intent(in) :: mLayerdPsi_dTheta(:) ! derivative in the soil water characteristic w.r.t. theta (m)
+ real(rkind),intent(in) :: above_soilLiqFluxDeriv ! derivative in layer above soil (canopy or snow) liquid flux w.r.t. liquid water
+ real(rkind),intent(in) :: above_soildLiq_dTk ! derivative of layer above soil (canopy or snow) liquid flux w.r.t. temperature
+ real(rkind),intent(in) :: above_soilFracLiq ! fraction of liquid water layer above soil (canopy or snow) (-)
+ ! input: depth of upper-most soil layer (m)
+ real(rkind),intent(in) :: mLayerDepth(:) ! depth of upper-most soil layer (m)
+ real(rkind),intent(in) :: iLayerHeight(0:) ! height at the interface of each layer (m)
+ ! input: diriclet boundary conditions
+ real(rkind),intent(in) :: upperBoundHead ! upper boundary condition for matric head (m)
+ real(rkind),intent(in) :: upperBoundTheta ! upper boundary condition for volumetric liquid water content (-)
+ ! input: flux at the upper boundary
+ real(rkind),intent(in) :: scalarRainPlusMelt ! rain plus melt, used as input to the soil zone before computing surface runoff (m s-1)
+ ! input: transmittance
+ real(rkind),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
+ real(rkind),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ real(rkind),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ real(rkind),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(rkind),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(rkind),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(rkind),intent(in) :: theta_sat ! soil porosity (-)
+ real(rkind),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(rkind),intent(in) :: qSurfScale ! scaling factor in the surface runoff parameterization (-)
+ real(rkind),intent(in) :: zScale_TOPMODEL ! scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ real(rkind),intent(in) :: rootingDepth ! rooting depth (m)
+ real(rkind),intent(in) :: wettingFrontSuction ! Green-Ampt wetting front suction (m)
+ real(rkind),intent(in) :: soilIceScale ! soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ real(rkind),intent(in) :: soilIceCV ! soil ice CV in Gamma distribution used to define frozen area (-)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ ! NOTE: intent(inout) because infiltration may only be computed for the first iteration
+ real(rkind),intent(inout) :: surfaceHydCond ! hydraulic conductivity (m s-1)
+ real(rkind),intent(inout) :: surfaceDiffuse ! hydraulic diffusivity at the surface (m
+ ! output: surface runoff and infiltration flux (m s-1)
+ real(rkind),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
+ real(rkind),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
+ real(rkind),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
+ real(rkind),intent(out) :: scalarSurfaceRunoff ! surface runoff (m s-1)
+ real(rkind),intent(out) :: scalarSurfaceInfiltration ! surface infiltration (m s-1)
+ ! output: derivatives in surface infiltration w.r.t. states in above soil snow or canopy and every soil layer
+ real(rkind),intent(out) :: dq_dHydStateVec(0:) ! derivative in surface infiltration w.r.t. hydrology state in above soil snow or canopy and every soil layer (m s-1 or s-1)
+ real(rkind),intent(out) :: dq_dNrgStateVec(0:) ! derivative in surface infiltration w.r.t. energy state in above soil snow or canopy and every soil layer (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! (general)
+ integer(i4b) :: iLayer ! index of soil layer
+ real(rkind) :: Tcrit ! temperature where all water is unfrozen (K)
+ real(rkind) :: fpart1,fpart2 ! different parts of a function
+ real(rkind) :: dpart1(1:nSoil),dpart2(1:nSoil) ! derivatives for different parts of a function
+ real(rkind) :: dfracCap(1:nSoil),dfInfRaw(1:nSoil) ! derivatives for different parts of a function
+ ! (head boundary condition)
+ real(rkind) :: cFlux ! capillary flux (m s-1)
+ real(rkind) :: dNum ! numerical derivative
+ ! (simplified Green-Ampt infiltration)
+ real(rkind) :: rootZoneLiq ! depth of liquid water in the root zone (m)
+ real(rkind) :: rootZoneIce ! depth of ice in the root zone (m)
+ real(rkind) :: availCapacity ! available storage capacity in the root zone (m)
+ real(rkind) :: depthWettingFront ! depth to the wetting front (m)
+ real(rkind) :: hydCondWettingFront ! hydraulic conductivity at the wetting front (m s-1)
+ ! (saturated area associated with variable storage capacity)
+ real(rkind) :: fracCap ! fraction of pore space filled with liquid water and ice (-)
+ real(rkind) :: fInfRaw ! infiltrating area before imposing solution constraints (-)
+ real(rkind),parameter :: maxFracCap=0.995_rkind ! maximum fraction capacity -- used to avoid numerical problems associated with an enormous derivative
+ real(rkind),parameter :: scaleFactor=0.000001_rkind ! scale factor for the smoothing function (-)
+ real(rkind),parameter :: qSurfScaleMax=1000._rkind ! maximum surface runoff scaling factor (-)
+ ! (fraction of impermeable area associated with frozen ground)
+ real(rkind) :: alpha ! shape parameter in the Gamma distribution
+ real(rkind) :: xLimg ! upper limit of the integral
+ ! (derivatives)
+ real(rkind) :: dVolFracLiq_dWat(1:nSoil) ! derivative in vol fraction of liquid w.r.t. water state variable in root layers
+ real(rkind) :: dVolFracIce_dWat(1:nSoil) ! derivative in vol fraction of ice w.r.t. water state variable in root layers
+ real(rkind) :: dVolFracLiq_dTk(1:nSoil) ! derivative in vol fraction of liquid w.r.t. temperature in root layers
+ real(rkind) :: dVolFracIce_dTk(1:nSoil) ! derivative in vol fraction of ice w.r.t. temperature in root layers
+ real(rkind) :: dRootZoneLiq_dWat(1:nSoil) ! derivative in vol fraction of scalar root zone liquid w.r.t. water state variable in root layers
+ real(rkind) :: dRootZoneIce_dWat(1:nSoil) ! derivative in vol fraction of scalar root zone ice w.r.t. water state variable in root layers
+ real(rkind) :: dRootZoneLiq_dTk(1:nSoil) ! derivative in vol fraction of scalar root zone liquid w.r.t. temperature in root layers
+ real(rkind) :: dRootZoneIce_dTk(1:nSoil) ! derivative in vol fraction of scalar root zone ice w.r.t. temperature in root layers
+ real(rkind) :: dDepthWettingFront_dWat(1:nSoil) ! derivative in scalar depth of wetting front w.r.t. water state variable in root layers
+ real(rkind) :: dDepthWettingFront_dTk(1:nSoil) ! derivative in scalar depth of wetting front w.r.t. temperature in root layers
+ real(rkind) :: dXMaxInfilRate_dWat(1:nSoil) ! derivative in scalar max infiltration rate w.r.t. water state variable in root layers
+ real(rkind) :: dXMaxInfilRate_dTk(1:nSoil) ! derivative in scalar max infiltration rate w.r.t. temperature in root layers
+ real(rkind) :: dInfilArea_dWat(0:nSoil) ! derivative in scalar infiltration rate w.r.t. water state variable in canopy or snow and root layers
+ real(rkind) :: dInfilArea_dTk(0:nSoil) ! derivative in scalar infiltration rate w.r.t. temperature in canopy or snow and root layers
+ real(rkind) :: dFrozenArea_dWat(0:nSoil) ! derivative in scalar frozen area w.r.t. water state variable in canopy or snow and root layers
+ real(rkind) :: dFrozenArea_dTk(0:nSoil) ! derivative in scalar frozen area w.r.t. temperature in canopy or snow and root layers
+ real(rkind) :: dInfilRate_dWat(0:nSoil) ! derivative in scalar infiltration rate w.r.t. water state variable in canopy or snow and root layers
+ real(rkind) :: dInfilRate_dTk(0:nSoil) ! derivative in scalar infiltration rate w.r.t. temperature in canopy or snow and root layers
+
+ ! initialize error control
+ err=0; message="surfaceFlx/"
+
+ ! initialize derivatives
+ dq_dHydStateVec(:) = 0._rkind
+ dq_dNrgStateVec(:) = 0._rkind
+
+ ! *****
+ ! compute the surface flux and its derivative
+ select case(bc_upper)
+
+ ! *****
+ ! head condition
+ case(prescribedHead)
+
+ ! surface runoff iz zero for the head condition
+ scalarSurfaceRunoff = 0._rkind
+
+ ! compute transmission and the capillary flux
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ surfaceHydCond = hydCond_liq(upperBoundTheta,surfaceSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
+ surfaceDiffuse = dPsi_dTheta(upperBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * surfaceHydCond
+ ! compute the capillary flux
+ cflux = -surfaceDiffuse*(scalarVolFracLiq - upperBoundTheta) / (mLayerDepth(1)*0.5_rkind)
+ case(mixdform)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ surfaceHydCond = hydCond_psi(upperBoundHead,surfaceSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
+ surfaceDiffuse = realMissing
+ ! compute the capillary flux
+ cflux = -surfaceHydCond*(scalarMatricHead - upperBoundHead) / (mLayerDepth(1)*0.5_rkind)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' eqn)
+ ! compute the total flux
+ scalarSurfaceInfiltration = cflux + surfaceHydCond
+ ! compute the derivative
+ if(deriv_desired)then
+ ! compute the hydrology derivative at the surface
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateVec(1) = -surfaceDiffuse/(mLayerDepth(1)/2._rkind)
+ case(mixdform); dq_dHydStateVec(1) = -surfaceHydCond/(mLayerDepth(1)/2._rkind)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! compute the energy derivative at the surface
+ dq_dNrgStateVec(1) = -(dHydCond_dTemp/2._rkind)*(scalarMatricHead - upperBoundHead)/(mLayerDepth(1)*0.5_rkind) + dHydCond_dTemp/2._rkind
+ ! compute the numerical derivative
+ !cflux = -surfaceHydCond*((scalarMatricHead+dx) - upperBoundHead) / (mLayerDepth(1)*0.5_rkind)
+ !surfaceInfiltration1 = cflux + surfaceHydCond
+ !dNum = (surfaceInfiltration1 - scalarSurfaceInfiltration)/dx
+ else
+ dNum = 0._rkind
+ end if
+ !write(*,'(a,1x,10(e30.20,1x))') 'scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum = ', &
+ ! scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum
+
+ ! *****
+ ! flux condition
+ case(liquidFlux)
+
+ ! force infiltration to be constant over the iterations
+ if(doInfiltration)then
+
+ ! (process root layers only liquid and ice derivatives)
+ dVolFracLiq_dWat(:) = 0._rkind
+ dVolFracIce_dWat(:) = 0._rkind
+ dVolFracLiq_dTk(:) = 0._rkind
+ dVolFracIce_dTk(:) = 0._rkind
+ if(deriv_desired .and. nRoots > 0)then
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ dVolFracLiq_dWat(:) = 1._rkind
+ dVolFracIce_dWat(:) = mLayerdPsi_dTheta(:) - 1._rkind
+ case(mixdform)
+ do iLayer=1,nRoots
+ Tcrit = crit_soilT( mLayerMatricHead(iLayer) )
+ if(mLayerTemp(iLayer) < Tcrit)then
+ dVolFracLiq_dWat(iLayer) = 0._rkind
+ dVolFracIce_dWat(iLayer) = dTheta_dPsi(iLayer)
+ else
+ dVolFracLiq_dWat(iLayer) = dTheta_dPsi(iLayer)
+ dVolFracIce_dWat(iLayer) = 0._rkind
+ endif
+ enddo
+ end select ! (form of Richards' equation)
+ dVolFracLiq_dTk(:) = dTheta_dTk(:) !already zeroed out if not below critical temperature
+ dVolFracIce_dTk(:) = -dVolFracLiq_dTk(:) !often can and will simplify one of these terms out
+ endif
+
+ ! define the storage in the root zone (m) and derivatives
+ rootZoneLiq = 0._rkind
+ rootZoneIce = 0._rkind
+ dRootZoneLiq_dWat(:) = 0._rkind
+ dRootZoneIce_dWat(:) = 0._rkind
+ dRootZoneLiq_dTk(:) = 0._rkind
+ dRootZoneIce_dTk(:) = 0._rkind
+
+ ! (process layers where the roots extend to the bottom of the layer)
+ if(nRoots > 1)then
+ do iLayer=1,nRoots-1
+ rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(iLayer)*mLayerDepth(iLayer)
+ rootZoneIce = rootZoneIce + mLayerVolFracIce(iLayer)*mLayerDepth(iLayer)
+ dRootZoneLiq_dWat(iLayer) = dVolFracLiq_dWat(iLayer)*mLayerDepth(iLayer)
+ dRootZoneIce_dWat(iLayer) = dVolFracIce_dWat(iLayer)*mLayerDepth(iLayer)
+ dRootZoneLiq_dTk(iLayer) = dVolFracLiq_dTk(iLayer) *mLayerDepth(iLayer)
+ dRootZoneIce_dTk(iLayer) = dVolFracIce_dTk(iLayer) *mLayerDepth(iLayer)
+ end do
+ end if
+ ! (process layers where the roots end in the current layer)
+ rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+ rootZoneIce = rootZoneIce + mLayerVolFracIce(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+ dRootZoneLiq_dWat(nRoots) = dVolFracLiq_dWat(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+ dRootZoneIce_dWat(nRoots) = dVolFracIce_dWat(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+ dRootZoneLiq_dTk(nRoots) = dVolFracLiq_dTk(nRoots)* (rootingDepth - iLayerHeight(nRoots-1))
+ dRootZoneIce_dTk(nRoots) = dVolFracIce_dTk(nRoots)* (rootingDepth - iLayerHeight(nRoots-1))
+
+ ! define available capacity to hold water (m)
+ availCapacity = theta_sat*rootingDepth - rootZoneIce
+ if(rootZoneLiq > availCapacity+verySmall)then
+ message=trim(message)//'liquid water in the root zone exceeds capacity'
+ err=20; return
+ end if
+
+ ! define the depth to the wetting front (m) and derivatives
+ depthWettingFront = (rootZoneLiq/availCapacity)*rootingDepth
+ dDepthWettingFront_dWat(:)=( dRootZoneLiq_dWat(:)*rootingDepth + dRootZoneIce_dWat(:)*depthWettingFront )/availCapacity
+ dDepthWettingFront_dTk(:) =( dRootZoneLiq_dTk(:)*rootingDepth + dRootZoneIce_dTk(:)*depthWettingFront )/availCapacity
+
+ ! define the hydraulic conductivity at depth=depthWettingFront (m s-1)
+ hydCondWettingFront = surfaceSatHydCond * ( (1._rkind - depthWettingFront/sum(mLayerDepth))**(zScale_TOPMODEL - 1._rkind) )
+
+ ! define the maximum infiltration rate (m s-1) and derivatives
+ xMaxInfilRate = hydCondWettingFront*( (wettingFrontSuction + depthWettingFront)/depthWettingFront ) ! maximum infiltration rate (m s-1)
+ !write(*,'(a,1x,f9.3,1x,10(e20.10,1x))') 'depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate = ', depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate
+ fPart1 = hydCondWettingFront
+ fPart2 = (wettingFrontSuction + depthWettingFront)/depthWettingFront
+ dPart1(:) = surfaceSatHydCond*(zScale_TOPMODEL - 1._rkind) * ( (1._rkind - depthWettingFront/sum(mLayerDepth))**(zScale_TOPMODEL - 2._rkind) ) * (-dDepthWettingFront_dWat(:))/sum(mLayerDepth)
+ dPart2(:) = -dDepthWettingFront_dWat(:)*wettingFrontSuction / (depthWettingFront**2._rkind)
+ dXMaxInfilRate_dWat(:) = fPart1*dpart2(:) + fPart2*dPart1(:)
+ dPart1(:) = surfaceSatHydCond*(zScale_TOPMODEL - 1._rkind) * ( (1._rkind - depthWettingFront/sum(mLayerDepth))**(zScale_TOPMODEL - 2._rkind) ) * (-dDepthWettingFront_dTk(:))/sum(mLayerDepth)
+ dPart2(:) = -dDepthWettingFront_dTk(:)*wettingFrontSuction / (depthWettingFront**2._rkind)
+ dXMaxInfilRate_dTk(:) = fPart1*dpart2(:) + fPart2*dPart1(:)
+
+ ! define the infiltrating area and derivatives for the non-frozen part of the cell/basin
+ if(qSurfScale < qSurfScaleMax)then
+ fracCap = rootZoneLiq/(maxFracCap*availCapacity) ! fraction of available root zone filled with water
+ fInfRaw = 1._rkind - exp(-qSurfScale*(1._rkind - fracCap)) ! infiltrating area -- allowed to violate solution constraints
+ scalarInfilArea = min(0.5_rkind*(fInfRaw + sqrt(fInfRaw**2._rkind + scaleFactor)), 1._rkind) ! infiltrating area -- constrained
+ if (0.5_rkind*(fInfRaw + sqrt(fInfRaw**2._rkind + scaleFactor))< 1._rkind) then
+ dfracCap(:) = ( dRootZoneLiq_dWat(:)/maxFracCap + dRootZoneIce_dWat(:)*fracCap )/availCapacity
+ dfInfRaw(:) = -qSurfScale*dfracCap(:) * exp(-qSurfScale*(1._rkind - fracCap))
+ dInfilArea_dWat(1:nSoil) = 0.5_rkind*dfInfRaw(:) * (1._rkind + fInfRaw/sqrt(fInfRaw**2._rkind + scaleFactor))
+ dfracCap(:) = ( dRootZoneLiq_dTk(:)/maxFracCap + dRootZoneIce_dTk(:)*fracCap )/availCapacity
+ dfInfRaw(:) = -qSurfScale*dfracCap(:) * exp(-qSurfScale*(1._rkind - fracCap))
+ dInfilArea_dTk(1:nSoil) = 0.5_rkind*dfInfRaw(:) * (1._rkind + fInfRaw/sqrt(fInfRaw**2._rkind + scaleFactor))
+ else ! scalarInfilArea = 1._rkind
+ dInfilArea_dWat(:) = 0._rkind
+ dInfilArea_dTk(:) = 0._rkind
+ endif
+ else
+ scalarInfilArea = 1._rkind
+ dInfilArea_dWat(:) = 0._rkind
+ dInfilArea_dTk(:) = 0._rkind
+ endif
+ dInfilArea_dWat(0) = 0._rkind
+ dInfilArea_dTk(0) = 0._rkind
+
+ ! check to ensure we are not infiltrating into a fully saturated column
+ if(ixIce<nRoots)then
+ if(sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) > 0.9999_rkind*theta_sat*sum(mLayerDepth(ixIce+1:nRoots))) scalarInfilArea=0._rkind
+ !print*, 'ixIce, nRoots, scalarInfilArea = ', ixIce, nRoots, scalarInfilArea
+ !print*, 'sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) = ', sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots))
+ !print*, 'theta_sat*sum(mLayerDepth(ixIce+1:nRoots)) = ', theta_sat*sum(mLayerDepth(ixIce+1:nRoots))
+ endif
+
+ ! define the impermeable area and derivatives due to frozen ground
+ if(rootZoneIce > tiny(rootZoneIce))then ! (avoid divide by zero)
+ alpha = 1._rkind/(soilIceCV**2._rkind) ! shape parameter in the Gamma distribution
+ xLimg = alpha*soilIceScale/rootZoneIce ! upper limit of the integral
+ !scalarFrozenArea = 1._rkind - gammp(alpha,xLimg) ! fraction of frozen area
+ !if we use this, we will have a derivative of scalarFrozenArea w.r.t. water and temperature in each layer (through mLayerVolFracIce)
+ scalarFrozenArea = 0._rkind
+ dFrozenArea_dWat(:) = 0._rkind
+ dFrozenArea_dTk(:) = 0._rkind
+ else
+ scalarFrozenArea = 0._rkind
+ dFrozenArea_dWat(:) = 0._rkind
+ dFrozenArea_dTk(:) = 0._rkind
+ end if
+ dFrozenArea_dWat(0) = 0._rkind
+ dFrozenArea_dTk(0) = 0._rkind
+ !print*, 'scalarFrozenArea, rootZoneIce = ', scalarFrozenArea, rootZoneIce
+
+ end if ! (if desire to compute infiltration)
+
+ ! compute infiltration (m s-1)
+ scalarSurfaceInfiltration = (1._rkind - scalarFrozenArea)*scalarInfilArea*min(scalarRainPlusMelt,xMaxInfilRate)
+
+ ! compute infiltration derivative for layers not at surface
+ if (xMaxInfilRate < scalarRainPlusMelt) then ! = dXMaxInfilRate_d
+ dInfilRate_dWat(1:nSoil) = dXMaxInfilRate_dWat(:)
+ dInfilRate_dTk(1:nSoil) = dXMaxInfilRate_dTk(:)
+ else ! = dRainPlusMelt_d only dependent on canopy
+ dInfilRate_dWat(:) = 0._rkind !only calculate for layers that are not the surface
+ dInfilRate_dTk(:) = 0._rkind !only calculate for layers that are not the surface
+ ! dependent on above layer (canopy or snow) water and temp
+ dInfilRate_dWat(0) = above_soilLiqFluxDeriv*above_soilFracLiq
+ dInfilRate_dTk(0) = above_soilLiqFluxDeriv*above_soildLiq_dTk
+ endif
+
+ ! dq w.r.t. infiltration only, scalarRainPlusMelt accounted for in computeJacDAE_module
+ dq_dHydStateVec(:) = (1._rkind - scalarFrozenArea) * ( dInfilArea_dWat(:)*min(scalarRainPlusMelt,xMaxInfilRate) + scalarInfilArea*dInfilRate_dWat(:) ) +&
+ (-dFrozenArea_dWat(:))*scalarInfilArea*min(scalarRainPlusMelt,xMaxInfilRate)
+ dq_dNrgStateVec(:) = (1._rkind - scalarFrozenArea) * ( dInfilArea_dTk(:) *min(scalarRainPlusMelt,xMaxInfilRate) + scalarInfilArea*dInfilRate_dTk(:) ) +&
+ (-dFrozenArea_dTk(:)) *scalarInfilArea*min(scalarRainPlusMelt,xMaxInfilRate)
+
+ ! compute surface runoff (m s-1)
+ scalarSurfaceRunoff = scalarRainPlusMelt - scalarSurfaceInfiltration
+ !print*, 'scalarRainPlusMelt, xMaxInfilRate = ', scalarRainPlusMelt, xMaxInfilRate
+ !print*, 'scalarSurfaceInfiltration, scalarSurfaceRunoff = ', scalarSurfaceInfiltration, scalarSurfaceRunoff
+ !print*, '(1._rkind - scalarFrozenArea), (1._rkind - scalarFrozenArea)*scalarInfilArea = ', (1._rkind - scalarFrozenArea), (1._rkind - scalarFrozenArea)*scalarInfilArea
+
+ ! set surface hydraulic conductivity and diffusivity to missing (not used for flux condition)
+ surfaceHydCond = realMissing
+ surfaceDiffuse = realMissing
+
+ ! ***** error check
+ case default; err=20; message=trim(message)//'unknown upper boundary condition for soil hydrology'; return
+
+ end select ! (type of upper boundary condition)
+
+ end subroutine surfaceFlx
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine iLayerFlux: compute the fluxes and derivatives at layer interfaces
+ ! ***************************************************************************************************************
+ subroutine iLayerFlux(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ! input: state variables (adjacent layers)
+ nodeMatricHeadLiqTrial, & ! intent(in): liquid matric head at the soil nodes (m)
+ nodeVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
+ ! input: model coordinate variables (adjacent layers)
+ nodeHeight, & ! intent(in): height of the soil nodes (m)
+ ! input: temperature derivatives
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: transmittance (adjacent layers)
+ nodeHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
+ nodeDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
+ ! input: transmittance derivatives (adjacent layers)
+ dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq, & ! intent(in): derivative in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in matric head (s-1)
+ ! output: tranmsmittance at the layer interface (scalars)
+ iLayerHydCond, & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
+ iLayerDiffuse, & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
+ ! output: vertical flux at the layer interface (scalars)
+ iLayerLiqFluxSoil, & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ real(rkind),intent(in) :: nodeMatricHeadLiqTrial(:) ! liquid matric head at the soil nodes (m)
+ real(rkind),intent(in) :: nodeVolFracLiqTrial(:) ! volumetric fraction of liquid water at the soil nodes (-)
+ ! input: model coordinate variables
+ real(rkind),intent(in) :: nodeHeight(:) ! height at the mid-point of the lower layer (m)
+ ! input: temperature derivatives
+ real(rkind),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ real(rkind),intent(in) :: dHydCond_dTemp(:) ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: transmittance
+ real(rkind),intent(in) :: nodeHydCondTrial(:) ! hydraulic conductivity at layer mid-points (m s-1)
+ real(rkind),intent(in) :: nodeDiffuseTrial(:) ! diffusivity at layer mid-points (m2 s-1)
+ ! input: transmittance derivatives
+ real(rkind),intent(in) :: dHydCond_dVolLiq(:) ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(rkind),intent(in) :: dDiffuse_dVolLiq(:) ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(rkind),intent(in) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ ! output: tranmsmittance at the layer interface (scalars)
+ real(rkind),intent(out) :: iLayerHydCond ! hydraulic conductivity at the interface between layers (m s-1)
+ real(rkind),intent(out) :: iLayerDiffuse ! hydraulic diffusivity at the interface between layers (m2 s-1)
+ ! output: vertical flux at the layer interface (scalars)
+ real(rkind),intent(out) :: iLayerLiqFluxSoil ! vertical flux of liquid water at the layer interface (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ real(rkind),intent(out) :: dq_dHydStateAbove ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ real(rkind),intent(out) :: dq_dHydStateBelow ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ real(rkind),intent(out) :: dq_dNrgStateAbove ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ real(rkind),intent(out) :: dq_dNrgStateBelow ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables (named variables to provide index of 2-element vectors)
+ integer(i4b),parameter :: ixUpper=1 ! index of upper node in the 2-element vectors
+ integer(i4b),parameter :: ixLower=2 ! index of lower node in the 2-element vectors
+ logical(lgt),parameter :: useGeometric=.false. ! switch between the arithmetic and geometric mean
+ ! local variables (Darcy flux)
+ real(rkind) :: dPsi ! spatial difference in matric head (m)
+ real(rkind) :: dLiq ! spatial difference in volumetric liquid water (-)
+ real(rkind) :: dz ! spatial difference in layer mid-points (m)
+ real(rkind) :: cflux ! capillary flux (m s-1)
+ ! local variables (derivative in Darcy's flux)
+ real(rkind) :: dHydCondIface_dVolLiqAbove ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer above
+ real(rkind) :: dHydCondIface_dVolLiqBelow ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer below
+ real(rkind) :: dDiffuseIface_dVolLiqAbove ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer above
+ real(rkind) :: dDiffuseIface_dVolLiqBelow ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer below
+ real(rkind) :: dHydCondIface_dMatricAbove ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer above
+ real(rkind) :: dHydCondIface_dMatricBelow ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer below
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="iLayerFlux/"
+
+ ! *****
+ ! compute the vertical flux of liquid water
+ ! compute the hydraulic conductivity at the interface
+ if(useGeometric)then
+ iLayerHydCond = (nodeHydCondTrial(ixLower) * nodeHydCondTrial(ixUpper))**0.5_rkind
+ else
+ iLayerHydCond = (nodeHydCondTrial(ixLower) + nodeHydCondTrial(ixUpper))*0.5_rkind
+ end if
+ !write(*,'(a,1x,5(e20.10,1x))') 'in iLayerFlux: iLayerHydCond, iLayerHydCondMP = ', iLayerHydCond, iLayerHydCondMP
+ ! compute the height difference between nodes
+ dz = nodeHeight(ixLower) - nodeHeight(ixUpper)
! compute the capillary flux
- cflux = -bottomHydCond*(lowerBoundHead - nodeMatricHead) / (nodeDepth*0.5_dp)
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select ! (form of Richards' eqn)
- scalarDrainage = cflux + bottomHydCond
-
- ! compute derivatives
- if(deriv_desired)then
- ! hydrology derivatives
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture); dq_dHydStateUnsat = bottomDiffuse/(nodeDepth/2._dp)
- case(mixdform); dq_dHydStateUnsat = bottomHydCond/(nodeDepth/2._dp)
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
- ! energy derivatives
- dq_dNrgStateUnsat = -(dHydCond_dTemp/2._dp)*(lowerBoundHead - nodeMatricHead)/(nodeDepth*0.5_dp) + dHydCond_dTemp/2._dp
- else ! (do not desire derivatives)
- dq_dHydStateUnsat = realMissing
- dq_dNrgStateUnsat = realMissing
- end if
-
- ! ---------------------------------------------------------------------------------------------
- ! * function of matric head in the bottom layer
- ! ---------------------------------------------------------------------------------------------
- case(funcBottomHead)
-
- ! compute fluxes
- select case(ixRichards)
- case(moisture); nodePsi = matricHead(nodeVolFracLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
- case(mixdform); nodePsi = nodeMatricHead
- end select
- zWater = nodeHeight - nodePsi
- scalarDrainage = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)
-
- ! compute derivatives
- if(deriv_desired)then
- ! hydrology derivatives
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * node__dPsi_dTheta*exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
- case(mixdform); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
- ! energy derivatives
- err=20; message=trim(message)//"not yet implemented energy derivatives"; return
- else ! (do not desire derivatives)
- dq_dHydStateUnsat = realMissing
- dq_dNrgStateUnsat = realMissing
- end if
-
- ! ---------------------------------------------------------------------------------------------
- ! * free drainage
- ! ---------------------------------------------------------------------------------------------
- case(freeDrainage)
-
- ! compute flux
- scalarDrainage = nodeHydCond*kAnisotropic
-
- ! compute derivatives
- if(deriv_desired)then
- ! hydrology derivatives
- select case(ixRichards) ! (form of Richards' equation)
- case(moisture); dq_dHydStateUnsat = dHydCond_dVolLiq*kAnisotropic
- case(mixdform); dq_dHydStateUnsat = dHydCond_dMatric*kAnisotropic
- case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
- end select
- ! energy derivatives
- dq_dNrgStateUnsat = dHydCond_dTemp*kAnisotropic
- else ! (do not desire derivatives)
- dq_dHydStateUnsat = realMissing
- dq_dNrgStateUnsat = realMissing
- end if
-
-
- ! ---------------------------------------------------------------------------------------------
- ! * zero flux
- ! ---------------------------------------------------------------------------------------------
- case(zeroFlux)
- scalarDrainage = 0._dp
- if(deriv_desired)then
- dq_dHydStateUnsat = 0._dp
- dq_dNrgStateUnsat = 0._dp
- else
- dq_dHydStateUnsat = realMissing
- dq_dNrgStateUnsat = realMissing
- end if
-
- ! ---------------------------------------------------------------------------------------------
- ! * error check
- ! ---------------------------------------------------------------------------------------------
- case default; err=20; message=trim(message)//'unknown lower boundary condition for soil hydrology'; return
-
- end select ! (type of boundary condition)
-
- end subroutine qDrainFlux
-
-
- ! *******************************************************************************************************************************************************************************
- ! *******************************************************************************************************************************************************************************
-
-
-end module soilLiqFlx_module
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ iLayerDiffuse = (nodeDiffuseTrial(ixLower) * nodeDiffuseTrial(ixUpper))**0.5_rkind
+ dLiq = nodeVolFracLiqTrial(ixLower) - nodeVolFracLiqTrial(ixUpper)
+ cflux = -iLayerDiffuse * dLiq/dz
+ case(mixdform)
+ iLayerDiffuse = realMissing
+ dPsi = nodeMatricHeadLiqTrial(ixLower) - nodeMatricHeadLiqTrial(ixUpper)
+ cflux = -iLayerHydCond * dPsi/dz
+ case default; err=10; message=trim(message)//"unable to identify option for Richards' equation"; return
+ end select
+ ! compute the total flux (add gravity flux, positive downwards)
+ iLayerLiqFluxSoil = cflux + iLayerHydCond
+ !write(*,'(a,1x,10(e20.10,1x))') 'iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond = ', &
+ ! iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond
+
+ ! ** compute the derivatives
+ if(deriv_desired)then
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ ! still need to implement arithmetric mean for the moisture-based form
+ if(.not.useGeometric)then
+ message=trim(message)//'only currently implemented for geometric mean -- change local flag'
+ err=20; return
+ end if
+ ! derivatives in hydraulic conductivity at the layer interface (m s-1)
+ dHydCondIface_dVolLiqAbove = dHydCond_dVolLiq(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_rkind/max(iLayerHydCond,verySmall)
+ dHydCondIface_dVolLiqBelow = dHydCond_dVolLiq(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_rkind/max(iLayerHydCond,verySmall)
+ ! derivatives in hydraulic diffusivity at the layer interface (m2 s-1)
+ dDiffuseIface_dVolLiqAbove = dDiffuse_dVolLiq(ixUpper)*nodeDiffuseTrial(ixLower) * 0.5_rkind/max(iLayerDiffuse,verySmall)
+ dDiffuseIface_dVolLiqBelow = dDiffuse_dVolLiq(ixLower)*nodeDiffuseTrial(ixUpper) * 0.5_rkind/max(iLayerDiffuse,verySmall)
+ ! derivatives in the flux w.r.t. volumetric liquid water content
+ dq_dHydStateAbove = -dDiffuseIface_dVolLiqAbove*dLiq/dz + iLayerDiffuse/dz + dHydCondIface_dVolLiqAbove
+ dq_dHydStateBelow = -dDiffuseIface_dVolLiqBelow*dLiq/dz - iLayerDiffuse/dz + dHydCondIface_dVolLiqBelow
+ case(mixdform)
+ ! derivatives in hydraulic conductivity
+ if(useGeometric)then
+ dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_rkind/max(iLayerHydCond,verySmall)
+ dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_rkind/max(iLayerHydCond,verySmall)
+ else
+ dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)/2._rkind
+ dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)/2._rkind
+ end if
+ ! derivatives in the flux w.r.t. matric head
+ dq_dHydStateAbove = -dHydCondIface_dMatricAbove*dPsi/dz + iLayerHydCond/dz + dHydCondIface_dMatricAbove
+ dq_dHydStateBelow = -dHydCondIface_dMatricBelow*dPsi/dz - iLayerHydCond/dz + dHydCondIface_dMatricBelow
+ ! derivative in the flux w.r.t. temperature
+ dq_dNrgStateAbove = -(dHydCond_dTemp(ixUpper)/2._rkind)*dPsi/dz + iLayerHydCond*dPsiLiq_dTemp(ixUpper)/dz + dHydCond_dTemp(ixUpper)/2._rkind
+ dq_dNrgStateBelow = -(dHydCond_dTemp(ixLower)/2._rkind)*dPsi/dz - iLayerHydCond*dPsiLiq_dTemp(ixLower)/dz + dHydCond_dTemp(ixLower)/2._rkind
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ else
+ dq_dHydStateAbove = realMissing
+ dq_dHydStateBelow = realMissing
+ end if
+
+ end subroutine iLayerFlux
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine qDrainFlux: compute the drainage flux from the bottom of the soil profile and its derivative
+ ! ***************************************************************************************************************
+ subroutine qDrainFlux(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ bc_lower, & ! intent(in): index defining the type of boundary conditions
+ ! input: state variables
+ nodeMatricHead, & ! intent(in): matric head in the lowest unsaturated node (m)
+ nodeVolFracLiq, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
+ ! input: model coordinate variables
+ nodeDepth, & ! intent(in): depth of the lowest unsaturated soil layer (m)
+ nodeHeight, & ! intent(in): height of the lowest unsaturated soil node (m)
+ ! input: boundary conditions
+ lowerBoundHead, & ! intent(in): lower boundary condition (m)
+ lowerBoundTheta, & ! intent(in): lower boundary condition (-)
+ ! input: derivative in soil water characteristix
+ node_dPsi_dTheta, & ! intent(in): derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! input: transmittance
+ surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ bottomSatHydCond, & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ nodeHydCond, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
+ iceImpedeFac, & ! intent(in): ice impedence factor in the lower-most soil layer (-)
+ ! input: transmittance derivatives
+ dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
+ ! output: hydraulic conductivity and diffusivity at the surface
+ bottomHydCond, & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
+ bottomDiffuse, & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux from the bottom of the soil profile
+ scalarDrainage, & ! intent(out): drainage flux from the bottom of the soil profile (m s-1)
+ ! output: derivatives in drainage flux
+ dq_dHydStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in hydrology state variable in lowest unsaturated node (m s-1 or s-1)
+ dq_dNrgStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
+ USE soil_utils_module,only:matricHead ! compute matric head as a function of volumetric fraction of liquid water (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ implicit none
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ integer(i4b),intent(in) :: bc_lower ! index defining the type of boundary conditions
+ ! input: state and diagnostic variables
+ real(rkind),intent(in) :: nodeMatricHead ! matric head in the lowest unsaturated node (m)
+ real(rkind),intent(in) :: nodeVolFracLiq ! volumetric liquid water content in the lowest unsaturated node (-)
+ ! input: model coordinate variables
+ real(rkind),intent(in) :: nodeDepth ! depth of the lowest unsaturated soil layer (m)
+ real(rkind),intent(in) :: nodeHeight ! height of the lowest unsaturated soil node (m)
+ ! input: diriclet boundary conditions
+ real(rkind),intent(in) :: lowerBoundHead ! lower boundary condition for matric head (m)
+ real(rkind),intent(in) :: lowerBoundTheta ! lower boundary condition for volumetric liquid water content (-)
+ ! input: derivative in soil water characteristix
+ real(rkind),intent(in) :: node_dPsi_dTheta ! derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! input: transmittance
+ real(rkind),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
+ real(rkind),intent(in) :: bottomSatHydCond ! saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ real(rkind),intent(in) :: nodeHydCond ! hydraulic conductivity at the node itself (m s-1)
+ real(rkind),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
+ ! input: transmittance derivatives
+ real(rkind),intent(in) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ real(rkind),intent(in) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ real(rkind),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: soil parameters
+ real(rkind),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(rkind),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(rkind),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(rkind),intent(in) :: theta_sat ! soil porosity (-)
+ real(rkind),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(rkind),intent(in) :: kAnisotropic ! anisotropy factor for lateral hydraulic conductivity (-)
+ real(rkind),intent(in) :: zScale_TOPMODEL ! scale factor for TOPMODEL-ish baseflow parameterization (m)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! output: hydraulic conductivity at the bottom of the unsaturated zone
+ real(rkind),intent(out) :: bottomHydCond ! hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ real(rkind),intent(out) :: bottomDiffuse ! hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux from the bottom of the soil profile
+ real(rkind),intent(out) :: scalarDrainage ! drainage flux from the bottom of the soil profile (m s-1)
+ ! output: derivatives in drainage flux
+ real(rkind),intent(out) :: dq_dHydStateUnsat ! change in drainage flux w.r.t. change in state variable in lowest unsaturated node (m s-1 or s-1)
+ real(rkind),intent(out) :: dq_dNrgStateUnsat ! change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ real(rkind) :: zWater ! effective water table depth (m)
+ real(rkind) :: nodePsi ! matric head in the lowest unsaturated node (m)
+ real(rkind) :: cflux ! capillary flux (m s-1)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="qDrainFlux/"
+
+ ! determine lower boundary condition
+ select case(bc_lower)
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * prescribed head
+ ! ---------------------------------------------------------------------------------------------
+ case(prescribedHead)
+
+ ! compute fluxes
+ select case(ixRichards) ! (moisture-based form of Richards' equation)
+ case(moisture)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ bottomHydCond = hydCond_liq(lowerBoundTheta,bottomSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
+ bottomDiffuse = dPsi_dTheta(lowerBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * bottomHydCond
+ ! compute the capillary flux
+ cflux = -bottomDiffuse*(lowerBoundTheta - nodeVolFracLiq) / (nodeDepth*0.5_rkind)
+ case(mixdform)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ bottomHydCond = hydCond_psi(lowerBoundHead,bottomSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
+ bottomDiffuse = realMissing
+ ! compute the capillary flux
+ cflux = -bottomHydCond*(lowerBoundHead - nodeMatricHead) / (nodeDepth*0.5_rkind)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' eqn)
+ scalarDrainage = cflux + bottomHydCond
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = bottomDiffuse/(nodeDepth/2._rkind)
+ case(mixdform); dq_dHydStateUnsat = bottomHydCond/(nodeDepth/2._rkind)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ dq_dNrgStateUnsat = -(dHydCond_dTemp/2._rkind)*(lowerBoundHead - nodeMatricHead)/(nodeDepth*0.5_rkind) + dHydCond_dTemp/2._rkind
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * function of matric head in the bottom layer
+ ! ---------------------------------------------------------------------------------------------
+ case(funcBottomHead)
+
+ ! compute fluxes
+ select case(ixRichards)
+ case(moisture); nodePsi = matricHead(nodeVolFracLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ case(mixdform); nodePsi = nodeMatricHead
+ end select
+ zWater = nodeHeight - nodePsi
+ scalarDrainage = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * node_dPsi_dTheta*exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
+ case(mixdform); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ err=20; message=trim(message)//"not yet implemented energy derivatives"; return
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * free drainage
+ ! ---------------------------------------------------------------------------------------------
+ case(freeDrainage)
+
+ ! compute flux
+ scalarDrainage = nodeHydCond*kAnisotropic
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = dHydCond_dVolLiq*kAnisotropic
+ case(mixdform); dq_dHydStateUnsat = dHydCond_dMatric*kAnisotropic
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ dq_dNrgStateUnsat = dHydCond_dTemp*kAnisotropic
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * zero flux
+ ! ---------------------------------------------------------------------------------------------
+ case(zeroFlux)
+ scalarDrainage = 0._rkind
+ if(deriv_desired)then
+ dq_dHydStateUnsat = 0._rkind
+ dq_dNrgStateUnsat = 0._rkind
+ else
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * error check
+ ! ---------------------------------------------------------------------------------------------
+ case default; err=20; message=trim(message)//'unknown lower boundary condition for soil hydrology'; return
+
+ end select ! (type of boundary condition)
+
+ end subroutine qDrainFlux
+
+
+ ! *******************************************************************************************************************************************************************************
+ ! *******************************************************************************************************************************************************************************
+
+
+ end module soilLiqFlx_module
+
\ No newline at end of file
diff --git a/build/source/engine/soilLiqFlx_old.f90 b/build/source/engine/soilLiqFlx_old.f90
new file mode 100755
index 0000000..e5c57fe
--- /dev/null
+++ b/build/source/engine/soilLiqFlx_old.f90
@@ -0,0 +1,1759 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
+!
+! This file is part of SUMMA
+!
+! For more information see: http://www.ral.ucar.edu/projects/summa
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+module soilLiqFlx_module
+! -----------------------------------------------------------------------------------------------------------
+
+! data types
+USE nrtype
+USE data_types,only:var_d ! x%var(:) (dp)
+USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
+USE data_types,only:var_dlength ! x%var(:)%dat (dp)
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! physical constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ gravity, & ! gravitational acceleteration (m s-2)
+ Tfreeze, & ! freezing point of pure water (K)
+ iden_air,& ! intrinsic density of air (kg m-3)
+ iden_ice,& ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of water (kg m-3)
+
+! named variables
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+! model decisions
+USE globalData,only:model_decisions ! model decision structure
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+! provide access to look-up values for model decisions
+USE mDecisions_module,only: &
+ ! look-up values for method used to compute derivative
+ numerical, & ! numerical solution
+ analytical, & ! analytical solution
+ ! look-up values for the form of Richards' equation
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform, & ! mixed form of Richards' equation
+ ! look-up values for the type of hydraulic conductivity profile
+ constant, & ! constant hydraulic conductivity with depth
+ powerLaw_profile, & ! power-law profile
+ ! look-up values for the choice of groundwater parameterization
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit, & ! no explicit groundwater parameterization
+ ! look-up values for the choice of boundary conditions for hydrology
+ prescribedHead, & ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
+ funcBottomHead, & ! function of matric head in the lower-most layer
+ freeDrainage, & ! free drainage
+ liquidFlux, & ! liquid water flux
+ zeroFlux ! zero flux
+
+! -----------------------------------------------------------------------------------------------------------
+implicit none
+private
+public::soilLiqFlx
+! constant parameters
+real(dp),parameter :: verySmall=1.e-12_dp ! a very small number (used to avoid divide by zero)
+real(dp),parameter :: dx=1.e-8_dp ! finite difference increment
+contains
+
+
+ ! ***************************************************************************************************************
+ ! public subroutine soilLiqFlx: compute liquid water fluxes and their derivatives
+ ! ***************************************************************************************************************
+ subroutine soilLiqFlx(&
+ ! input: model control
+ nSoil, & ! intent(in): number of soil layers
+ doInfiltrate, & ! intent(in): flag to compute infiltration
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ! input: trial state variables
+ mLayerTempTrial, & ! intent(in): temperature (K)
+ mLayerMatricHeadTrial, & ! intent(in): matric head (m)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice (-)
+ ! input: pre-computed derivatives
+ mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: fluxes
+ scalarCanopyTranspiration, & ! intent(in): canopy transpiration (kg m-2 s-1)
+ scalarGroundEvaporation, & ! intent(in): ground evaporation (kg m-2 s-1)
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input-output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! output: diagnostic variables for surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ ! output: diagnostic variables for model layers
+ mLayerdTheta_dPsi, & ! intent(out): derivative in the soil water characteristic w.r.t. psi (m-1)
+ mLayerdPsi_dTheta, & ! intent(out): derivative in the soil water characteristic w.r.t. theta (m)
+ dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (s-1)
+ ! output: fluxes
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration rate (m s-1)
+ iLayerLiqFluxSoil, & ! intent(out): liquid fluxes at layer interfaces (m s-1)
+ mLayerTranspire, & ! intent(out): transpiration loss from each soil layer (m s-1)
+ mLayerHydCond, & ! intent(out): hydraulic conductivity in each soil layer (m s-1)
+ ! output: derivatives in fluxes w.r.t. hydrology state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer above (m s-1)
+ dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. volumetric liquid water content in the layer below (m s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! utility modules
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+ USE soil_utils_module,only:matricHead ! compute matric head (m)
+ USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
+ USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ logical(lgt),intent(in) :: doInfiltrate ! flag to compute infiltration
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ ! input: trial model state variables
+ real(dp),intent(in) :: mLayerTempTrial(:) ! temperature in each layer at the current iteration (m)
+ real(dp),intent(in) :: mLayerMatricHeadTrial(:) ! matric head in each layer at the current iteration (m)
+ real(dp),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid water at the current iteration (-)
+ real(dp),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
+ ! input: pre-computed derivatves
+ real(dp),intent(in) :: mLayerdTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(dp),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: model fluxes
+ real(dp),intent(in) :: scalarCanopyTranspiration ! canopy transpiration (kg m-2 s-1)
+ real(dp),intent(in) :: scalarGroundEvaporation ! ground evaporation (kg m-2 s-1)
+ real(dp),intent(in) :: scalarRainPlusMelt ! rain plus melt (m s-1)
+ ! input-output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! state vector geometry
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ ! output: diagnostic variables for surface runoff
+ real(dp),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
+ real(dp),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
+ real(dp),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
+ real(dp),intent(inout) :: scalarSurfaceRunoff ! surface runoff (m s-1)
+ ! output: diagnostic variables for each layer
+ real(dp),intent(inout) :: mLayerdTheta_dPsi(:) ! derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(dp),intent(inout) :: mLayerdPsi_dTheta(:) ! derivative in the soil water characteristic w.r.t. theta (m)
+ real(dp),intent(inout) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (s-1)
+ ! output: liquid fluxes
+ real(dp),intent(inout) :: scalarSurfaceInfiltration ! surface infiltration rate (m s-1)
+ real(dp),intent(inout) :: iLayerLiqFluxSoil(0:) ! liquid flux at soil layer interfaces (m s-1)
+ real(dp),intent(inout) :: mLayerTranspire(:) ! transpiration loss from each soil layer (m s-1)
+ real(dp),intent(inout) :: mLayerHydCond(:) ! hydraulic conductivity in each soil layer (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables in the layer above and layer below (m s-1)
+ real(dp),intent(inout) :: dq_dHydStateAbove(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer above
+ real(dp),intent(inout) :: dq_dHydStateBelow(0:) ! derivative in the flux in layer interfaces w.r.t. state variables in the layer below
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ real(dp),intent(inout) :: dq_dNrgStateAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ real(dp),intent(inout) :: dq_dNrgStateBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables: general
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: ibeg,iend ! start and end indices of the soil layers in concatanated snow-soil vector
+ logical(lgt) :: desireAnal ! flag to identify if analytical derivatives are desired
+ integer(i4b) :: iLayer,iSoil ! index of soil layer
+ integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
+ integer(i4b) :: ixTop ! top layer in subroutine call
+ integer(i4b) :: ixBot ! bottom layer in subroutine call
+ ! additional variables to compute numerical derivatives
+ integer(i4b) :: nFlux ! number of flux calculations required (>1 = numerical derivatives with one-sided finite differences)
+ integer(i4b) :: itry ! index of different flux calculations
+ integer(i4b),parameter :: unperturbed=0 ! named variable to identify the case of unperturbed state variables
+ integer(i4b),parameter :: perturbState=1 ! named variable to identify the case where we perturb the state in the current layer
+ integer(i4b),parameter :: perturbStateAbove=2 ! named variable to identify the case where we perturb the state layer above
+ integer(i4b),parameter :: perturbStateBelow=3 ! named variable to identify the case where we perturb the state layer below
+ integer(i4b) :: ixPerturb ! index of element in 2-element vector to perturb
+ integer(i4b) :: ixOriginal ! index of perturbed element in the original vector
+ real(dp) :: scalarVolFracLiqTrial ! trial value of volumetric liquid water content (-)
+ real(dp) :: scalarMatricHeadTrial ! trial value of matric head (m)
+ real(dp) :: scalarHydCondTrial ! trial value of hydraulic conductivity (m s-1)
+ real(dp) :: scalarHydCondMicro ! trial value of hydraulic conductivity of micropores (m s-1)
+ real(dp) :: scalarHydCondMacro ! trial value of hydraulic conductivity of macropores (m s-1)
+ real(dp) :: scalarFlux ! vertical flux (m s-1)
+ real(dp) :: scalarFlux_dStateAbove ! vertical flux with perturbation to the state above (m s-1)
+ real(dp) :: scalarFlux_dStateBelow ! vertical flux with perturbation to the state below (m s-1)
+ ! transpiration sink term
+ real(dp),dimension(nSoil) :: mLayerTranspireFrac ! fraction of transpiration allocated to each soil layer (-)
+ ! diagnostic variables
+ real(dp),dimension(nSoil) :: iceImpedeFac ! ice impedence factor at layer mid-points (-)
+ real(dp),dimension(nSoil) :: mLayerDiffuse ! diffusivity at layer mid-point (m2 s-1)
+ real(dp),dimension(nSoil) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(dp),dimension(nSoil) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(dp),dimension(nSoil) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ real(dp),dimension(0:nSoil) :: iLayerHydCond ! hydraulic conductivity at layer interface (m s-1)
+ real(dp),dimension(0:nSoil) :: iLayerDiffuse ! diffusivity at layer interface (m2 s-1)
+ ! compute surface flux
+ integer(i4b) :: nRoots ! number of soil layers with roots
+ integer(i4b) :: ixIce ! index of the lowest soil layer that contains ice
+ real(dp),dimension(0:nSoil) :: iLayerHeight ! height of the layer interfaces (m)
+ ! compute fluxes and derivatives at layer interfaces
+ real(dp),dimension(2) :: vectorVolFracLiqTrial ! trial value of volumetric liquid water content (-)
+ real(dp),dimension(2) :: vectorMatricHeadTrial ! trial value of matric head (m)
+ real(dp),dimension(2) :: vectorHydCondTrial ! trial value of hydraulic conductivity (m s-1)
+ real(dp),dimension(2) :: vectorDiffuseTrial ! trial value of hydraulic diffusivity (m2 s-1)
+ real(dp) :: scalardPsi_dTheta ! derivative in soil water characteristix, used for perturbations when computing numerical derivatives
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='soilLiqFlx/'
+
+ ! get indices for the data structures
+ ibeg = indx_data%var(iLookINDEX%nSnow)%dat(1) + 1
+ iend = indx_data%var(iLookINDEX%nSnow)%dat(1) + indx_data%var(iLookINDEX%nSoil)%dat(1)
+
+ ! get a copy of iLayerHeight
+ ! NOTE: performance hit, though cannot define the shape (0:) with the associate construct
+ iLayerHeight(0:nSoil) = prog_data%var(iLookPROG%iLayerHeight)%dat(ibeg-1:iend) ! height of the layer interfaces (m)
+
+ ! make association between local variables and the information in the data structures
+ associate(&
+ ! input: model control
+ ixDerivMethod => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): index of the method used to calculate flux derivatives
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision, & ! intent(in): index of the form of Richards' equation
+ ixBcUpperSoilHydrology => model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision, & ! intent(in): index of the upper boundary conditions for soil hydrology
+ ixBcLowerSoilHydrology => model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision, & ! intent(in): index of the lower boundary conditions for soil hydrology
+ ! input: model indices
+ ixMatricHead => indx_data%var(iLookINDEX%ixMatricHead)%dat, & ! intent(in): indices of soil layers where matric head is the state variable
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat, & ! intent(in): index in the state subset for hydrology state variables in the soil domain
+ ! input: model coordinate variables -- NOTE: use of ibeg and iend
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(ibeg:iend), & ! intent(in): depth of the layer (m)
+ mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat(ibeg:iend), & ! intent(in): height of the layer mid-point (m)
+ ! input: upper boundary conditions
+ upperBoundHead => mpar_data%var(iLookPARAM%upperBoundHead)%dat(1), & ! intent(in): upper boundary condition for matric head (m)
+ upperBoundTheta => mpar_data%var(iLookPARAM%upperBoundTheta)%dat(1), & ! intent(in): upper boundary condition for volumetric liquid water content (-)
+ ! input: lower boundary conditions
+ lowerBoundHead => mpar_data%var(iLookPARAM%lowerBoundHead)%dat(1), & ! intent(in): lower boundary condition for matric head (m)
+ lowerBoundTheta => mpar_data%var(iLookPARAM%lowerBoundTheta)%dat(1), & ! intent(in): lower boundary condition for volumetric liquid water content (-)
+ ! input: vertically variable soil parameters
+ vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat, & ! intent(in): van Genutchen "m" parameter (-)
+ vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat, & ! intent(in): van Genutchen "n" parameter (-)
+ vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat, & ! intent(in): soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat, & ! intent(in): soil residual volumetric water content (-)
+ ! input: vertically constant soil parameters
+ wettingFrontSuction => mpar_data%var(iLookPARAM%wettingFrontSuction)%dat(1), & ! intent(in): Green-Ampt wetting front suction (m)
+ rootingDepth => mpar_data%var(iLookPARAM%rootingDepth)%dat(1), & ! intent(in): rooting depth (m)
+ kAnisotropic => mpar_data%var(iLookPARAM%kAnisotropic)%dat(1), & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL => mpar_data%var(iLookPARAM%zScale_TOPMODEL)%dat(1), & ! intent(in): TOPMODEL scaling factor (m)
+ qSurfScale => mpar_data%var(iLookPARAM%qSurfScale)%dat(1), & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ f_impede => mpar_data%var(iLookPARAM%f_impede)%dat(1), & ! intent(in): ice impedence factor (-)
+ soilIceScale => mpar_data%var(iLookPARAM%soilIceScale)%dat(1), & ! intent(in): scaling factor for depth of soil ice, used to get frozen fraction (m)
+ soilIceCV => mpar_data%var(iLookPARAM%soilIceCV)%dat(1), & ! intent(in): CV of depth of soil ice, used to get frozen fraction (-)
+ theta_mp => mpar_data%var(iLookPARAM%theta_mp)%dat(1), & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ mpExp => mpar_data%var(iLookPARAM%mpExp)%dat(1), & ! intent(in): empirical exponent in macropore flow equation (-)
+ ! input: saturated hydraulic conductivity
+ mLayerSatHydCondMP => flux_data%var(iLookFLUX%mLayerSatHydCondMP)%dat, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
+ mLayerSatHydCond => flux_data%var(iLookFLUX%mLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
+ iLayerSatHydCond => flux_data%var(iLookFLUX%iLayerSatHydCond)%dat, & ! intent(in): saturated hydraulic conductivity at the interface of each layer (m s-1)
+ ! input: factors limiting transpiration (from vegFlux routine)
+ mLayerRootDensity => diag_data%var(iLookDIAG%mLayerRootDensity)%dat, & ! intent(in): root density in each layer (-)
+ scalarTranspireLim => diag_data%var(iLookDIAG%scalarTranspireLim)%dat(1), & ! intent(in): weighted average of the transpiration limiting factor (-)
+ mLayerTranspireLim => diag_data%var(iLookDIAG%mLayerTranspireLim)%dat & ! intent(in): transpiration limiting factor in each layer (-)
+ ) ! associating local variables with the information in the data structures
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! preliminaries
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! define the pethod to compute derivatives
+ !print*, 'numerical derivatives = ', (ixDerivMethod==numerical)
+
+ ! numerical derivatives are not implemented yet
+ if(ixDerivMethod==numerical)then
+ message=trim(message)//'numerical derivates do not account for the cross derivatives between hydrology and thermodynamics'
+ err=20; return
+ end if
+
+ ! check the need to compute analytical derivatives
+ if(deriv_desired .and. ixDerivMethod==analytical)then
+ desireAnal = .true.
+ else
+ desireAnal = .false.
+ end if
+
+ ! check the need to compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ nFlux=3 ! compute the derivatives using one-sided finite differences
+ else
+ nFlux=0 ! compute analytical derivatives
+ end if
+
+ ! get the indices for the soil layers
+ if(scalarSolution)then
+ ixLayerDesired = pack(ixMatricHead, ixSoilOnlyHyd/=integerMissing)
+ ixTop = ixLayerDesired(1)
+ ixBot = ixLayerDesired(1)
+ else
+ ixTop = 1
+ ixBot = nSoil
+ endif
+
+ ! identify the number of layers that contain roots
+ nRoots = count(iLayerHeight(0:nSoil-1) < rootingDepth-verySmall)
+ if(nRoots==0)then
+ message=trim(message)//'no layers with roots'
+ err=20; return
+ endif
+
+ ! identify lowest soil layer with ice
+ ! NOTE: cannot use count because there may be an unfrozen wedge
+ ixIce = 0 ! initialize the index of the ice layer (0 means no ice in the soil profile)
+ do iLayer=1,nSoil ! (loop through soil layers)
+ if(mLayerVolFracIceTrial(iLayer) > verySmall) ixIce = iLayer
+ end do
+ !if(ixIce==nSoil)then; err=20; message=trim(message)//'ice extends to the bottom of the soil profile'; return; end if
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute the transpiration sink term
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! check the need to compute transpiration (NOTE: intent=inout)
+ if( .not. (scalarSolution .and. ixTop>1) )then
+
+ ! compute the fraction of transpiration loss from each soil layer
+ if(scalarTranspireLim > tiny(scalarTranspireLim))then ! (transpiration may be non-zero even if the soil moisture limiting factor is zero)
+ mLayerTranspireFrac(:) = mLayerRootDensity(:)*mLayerTranspireLim(:)/scalarTranspireLim
+ else ! (possible for there to be non-zero conductance and therefore transpiration in this case)
+ mLayerTranspireFrac(:) = mLayerRootDensity(:) / sum(mLayerRootDensity)
+ end if
+
+ ! check fractions sum to one
+ if(abs(sum(mLayerTranspireFrac) - 1._dp) > verySmall)then
+ message=trim(message)//'fraction transpiration in soil layers does not sum to one'
+ err=20; return
+ endif
+
+ ! compute transpiration loss from each soil layer (kg m-2 s-1 --> m s-1)
+ mLayerTranspire = mLayerTranspireFrac(:)*scalarCanopyTranspiration/iden_water
+
+ ! special case of prescribed head -- no transpiration
+ if(ixBcUpperSoilHydrology==prescribedHead) mLayerTranspire(:) = 0._dp
+
+ endif ! if need to compute transpiration
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute diagnostic variables at the nodes throughout the soil profile
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ do iSoil=ixTop,min(ixBot+1,nSoil) ! (loop through soil layers)
+
+ call diagv_node(&
+ ! input: model control
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ mLayerTempTrial(iSoil), & ! intent(in): temperature (K)
+ mLayerMatricHeadTrial(iSoil), & ! intent(in): matric head in each layer (m)
+ mLayerVolFracLiqTrial(iSoil), & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial(iSoil), & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: pre-computed deriavatives
+ mLayerdTheta_dTk(iSoil), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp(iSoil), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ vGn_alpha(iSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(iSoil), & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m(iSoil), & ! intent(in): van Genutchen "m" parameter (-)
+ mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
+ theta_sat(iSoil), & ! intent(in): soil porosity (-)
+ theta_res(iSoil), & ! intent(in): soil residual volumetric water content (-)
+ theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ f_impede, & ! intent(in): ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ mLayerSatHydCond(iSoil), & ! intent(in): saturated hydraulic conductivity at the mid-point of each layer (m s-1)
+ mLayerSatHydCondMP(iSoil), & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of each layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ mLayerdPsi_dTheta(iSoil), & ! intent(out): derivative in the soil water characteristic
+ mLayerdTheta_dPsi(iSoil), & ! intent(out): derivative in the soil water characteristic
+ ! output: transmittance
+ mLayerHydCond(iSoil), & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
+ mLayerDiffuse(iSoil), & ! intent(out): diffusivity at layer mid-points (m2 s-1)
+ iceImpedeFac(iSoil), & ! intent(out): ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ dHydCond_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq(iSoil), & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ dHydCond_dTemp(iSoil), & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ end do ! (looping through soil layers)
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! set derivative w.r.t. state above to zero (does not exist)
+ dq_dHydStateAbove(0) = 0._dp
+ dq_dNrgStateAbove(0) = 0._dp
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! identify the type of perturbation
+ select case(itry)
+
+ ! skip undesired perturbations
+ case(perturbStateAbove); cycle ! cannot perturb state above (does not exist) -- so keep cycling
+ case(perturbState); cycle ! perturbing the layer below the flux at the top interface
+
+ ! un-perturbed case
+ case(unperturbed)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(1)
+
+ ! perturb soil state (one-sided finite differences)
+ case(perturbStateBelow)
+ ! (perturbation depends on the form of Richards' equation)
+ select case(ixRichards)
+ case(moisture)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1) + dx
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(1)
+ case(mixdform)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(1)
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(1) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation
+ ! check for an unknown perturbation
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+
+ end select ! (type of perturbation)
+
+ ! =====
+ ! compute surface flux and its derivative...
+ ! ==========================================
+
+ call surfaceFlx(&
+ ! input: model control
+ doInfiltrate, & ! intent(in): flag indicating if desire to compute infiltration
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ixBcUpperSoilHydrology, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
+ nRoots, & ! intent(in): number of layers that contain roots
+ ixIce, & ! intent(in): index of lowest ice layer
+ ! input: state variables
+ scalarMatricHeadTrial, & ! intent(in): matric head in the upper-most soil layer (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the upper-most soil layer (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: depth of upper-most soil layer (m)
+ mLayerDepth, & ! intent(in): depth of each soil layer (m)
+ iLayerHeight, & ! intent(in): height at the interface of each layer (m)
+ ! input: boundary conditions
+ upperBoundHead, & ! intent(in): upper boundary condition (m)
+ upperBoundTheta, & ! intent(in): upper boundary condition (-)
+ ! input: flux at the upper boundary
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input: transmittance
+ iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ dHydCond_dTemp(1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ iceImpedeFac(1), & ! intent(in): ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ vGn_alpha(1), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(1), & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m(1), & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat(1), & ! intent(in): soil porosity (-)
+ theta_res(1), & ! intent(in): soil residual volumetric water content (-)
+ qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ rootingDepth, & ! intent(in): rooting depth (m)
+ wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
+ soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ iLayerHydCond(0), & ! intent(inout): hydraulic conductivity at the surface (m s-1)
+ iLayerDiffuse(0), & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
+ ! input-output: fluxes at layer interfaces and surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
+ ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
+ dq_dHydStateBelow(0), & ! intent(inout): derivative in surface infiltration w.r.t. hydrology state variable in the upper-most soil layer (m s-1 or s-1)
+ dq_dNrgStateBelow(0), & ! intent(out): derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+ ! print*, "scalarGroundEvaporation =", scalarGroundEvaporation
+ ! include base soil evaporation as the upper boundary flux
+ iLayerLiqFluxSoil(0) = scalarGroundEvaporation/iden_water + scalarSurfaceInfiltration
+
+ ! get copies of surface flux to compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(0)
+ case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(0)
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ ! write(*,'(a,1x,10(f30.15))') 'scalarRainPlusMelt, scalarSurfaceInfiltration = ', scalarRainPlusMelt, scalarSurfaceInfiltration
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ ! compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateBelow(0) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in surface flux w.r.t. change in the soil moisture in the top soil layer (m s-1)
+ end if
+! print*, 'scalarSurfaceInfiltration, iLayerLiqFluxSoil(0) = ', scalarSurfaceInfiltration, iLayerLiqFluxSoil(0)
+ !print*, '(ixDerivMethod==numerical), dq_dHydStateBelow(0) = ', (ixDerivMethod==numerical), dq_dHydStateBelow(0)
+ !pause
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! * compute fluxes and derivatives at layer interfaces...
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! NOTE: computing flux at the bottom of the layer
+
+ ! loop through soil layers
+ do iLayer=ixTop,min(ixBot,nSoil-1)
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! determine layer to perturb
+ ! ============================
+ select case(itry)
+ ! skip undesired perturbations
+ case(perturbState); cycle ! perturbing the layers above and below the flux at the interface
+ ! identify the index for the perturbation
+ case(unperturbed); ixPerturb = 0
+ case(perturbStateAbove); ixPerturb = 1
+ case(perturbStateBelow); ixPerturb = 2
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select ! (identifying layer to of perturbation)
+ ! determine the index in the original vector
+ ixOriginal = iLayer + (ixPerturb-1)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! start with the un-perturbed case
+ vectorVolFracLiqTrial(1:2) = mLayerVolFracLiqTrial(iLayer:iLayer+1)
+ vectorMatricHeadTrial(1:2) = mLayerMatricHeadTrial(iLayer:iLayer+1)
+ ! make appropriate perturbations
+ if(ixPerturb > 0)then
+ select case(ixRichards)
+ case(moisture); vectorVolFracLiqTrial(ixPerturb) = vectorVolFracLiqTrial(ixPerturb) + dx
+ case(mixdform); vectorMatricHeadTrial(ixPerturb) = vectorMatricHeadTrial(ixPerturb) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+ end if
+
+ ! =====
+ ! get hydraulic conductivty...
+ ! ============================
+ ! start with the un-perturbed case
+ vectorHydCondTrial(1:2) = mLayerHydCond(iLayer:iLayer+1)
+ vectorDiffuseTrial(1:2) = mLayerDiffuse(iLayer:iLayer+1)
+ ! make appropriate perturbations
+ if(ixPerturb > 0)then
+ select case(ixRichards)
+ case(moisture)
+ scalardPsi_dTheta = dPsi_dTheta(vectorVolFracLiqTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
+ vectorHydCondTrial(ixPerturb) = hydCond_liq(vectorVolFracLiqTrial(ixPerturb),mLayerSatHydCond(ixOriginal),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
+ vectorDiffuseTrial(ixPerturb) = scalardPsi_dTheta * vectorHydCondTrial(ixPerturb)
+ case(mixdform)
+ scalarVolFracLiqTrial = volFracLiq(vectorMatricHeadTrial(ixPerturb),vGn_alpha(ixPerturb),theta_res(ixPerturb),theta_sat(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb))
+ scalarHydCondMicro = hydCond_psi(vectorMatricHeadTrial(ixPerturb),mLayerSatHydCond(ixOriginal),vGn_alpha(ixPerturb),vGn_n(ixPerturb),vGn_m(ixPerturb)) * iceImpedeFac(ixOriginal)
+ scalarHydCondMacro = hydCondMP_liq(scalarVolFracLiqTrial,theta_sat(ixPerturb),theta_mp,mpExp,mLayerSatHydCondMP(ixOriginal),mLayerSatHydCond(ixOriginal))
+ vectorHydCondTrial(ixPerturb) = scalarHydCondMicro + scalarHydCondMacro
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+ end if
+
+ ! =====
+ ! compute vertical flux at layer interface and its derivative w.r.t. the state above and the state below...
+ ! =========================================================================================================
+
+ ! NOTE: computing flux at the bottom of the layer
+
+ call iLayerFlux(&
+ ! input: model control
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ! input: state variables (adjacent layers)
+ vectorMatricHeadTrial, & ! intent(in): matric head at the soil nodes (m)
+ vectorVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
+ ! input: model coordinate variables (adjacent layers)
+ mLayerHeight(iLayer:iLayer+1), & ! intent(in): height of the soil nodes (m)
+ ! input: temperature derivatives
+ dPsiLiq_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dHydCond_dTemp(iLayer:iLayer+1), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: transmittance (adjacent layers)
+ vectorHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
+ vectorDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
+ ! input: transmittance derivatives (adjacent layers)
+ dHydCond_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq(iLayer:iLayer+1), & ! intent(in): change in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric(iLayer:iLayer+1), & ! intent(in): change in hydraulic conductivity w.r.t. change in matric head (s-1)
+ ! output: tranmsmittance at the layer interface (scalars)
+ iLayerHydCond(iLayer), & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
+ iLayerDiffuse(iLayer), & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
+ ! output: vertical flux at the layer interface (scalars)
+ iLayerLiqFluxSoil(iLayer), & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ dq_dHydStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ dq_dHydStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ dq_dNrgStateAbove(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow(iLayer), & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! compute total vertical flux, to compute derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(iLayer)
+ case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(iLayer)
+ case(perturbStateBelow); scalarFlux_dStateBelow = iLayerLiqFluxSoil(iLayer)
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ ! compute numerical derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateAbove(iLayer) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
+ dq_dHydStateBelow(iLayer) = (scalarFlux_dStateBelow - scalarFlux)/dx ! change in drainage flux w.r.t. change in the state in the layer below (m s-1 or s-1)
+ end if
+
+ ! check
+ !if(iLayer==6) write(*,'(a,i4,1x,10(e25.15,1x))') 'iLayer, vectorMatricHeadTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer) = ',&
+ ! iLayer, vectorMatricHeadTrial, iLayerHydCond(iLayer), iLayerLiqFluxSoil(iLayer)
+ !if(iLayer==1) write(*,'(a,i4,1x,L1,1x,2(e15.5,1x))') 'iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer) = ', &
+ ! iLayer, (ixDerivMethod==numerical), dq_dHydStateBelow(iLayer-1), dq_dHydStateAbove(iLayer)
+ !pause
+
+ end do ! (looping through soil layers)
+
+ ! add infiltration to the upper-most unfrozen layer
+ ! NOTE: this is done here rather than in surface runoff
+ !iLayerLiqFluxSoil(ixIce) = iLayerLiqFluxSoil(ixIce) + scalarSurfaceInfiltration
+
+ ! *************************************************************************************************************************************************
+ ! *************************************************************************************************************************************************
+
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ ! * compute drainage flux from the bottom of the soil profile, and its derivative
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+
+ ! define the need to compute drainage
+ if( .not. (scalarSolution .and. ixTop<nSoil) )then
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! identify the type of perturbation
+ select case(itry)
+
+ ! skip undesired perturbations
+ case(perturbStateBelow); cycle ! only perturb soil state at this time (perhaps perturb aquifer state later)
+ case(perturbState); cycle ! here pertubing the state above the flux at the interface
+
+ ! un-perturbed case
+ case(unperturbed)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil)
+
+ ! perturb soil state (one-sided finite differences)
+ case(perturbStateAbove)
+ select case(ixRichards) ! (perturbation depends on the form of Richards' equation)
+ case(moisture)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil) + dx
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil)
+ case(mixdform)
+ scalarVolFracLiqTrial = mLayerVolFracLiqTrial(nSoil)
+ scalarMatricHeadTrial = mLayerMatricHeadTrial(nSoil) + dx
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' equation)
+
+ end select ! (type of perturbation)
+
+ ! =====
+ ! get hydraulic conductivty...
+ ! ============================
+ select case(itry)
+
+ ! compute perturbed value of hydraulic conductivity
+ case(perturbStateAbove)
+ select case(ixRichards)
+ case(moisture); scalarHydCondTrial = hydCond_liq(scalarVolFracLiqTrial,mLayerSatHydCond(nSoil),theta_res(nSoil),theta_sat(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
+ case(mixdform); scalarHydCondTrial = hydCond_psi(scalarMatricHeadTrial,mLayerSatHydCond(nSoil),vGn_alpha(nSoil),vGn_n(nSoil),vGn_m(nSoil)) * iceImpedeFac(nSoil)
+ end select
+
+ ! (use un-perturbed value)
+ case default
+ scalarHydCondTrial = mLayerHydCond(nSoil) ! hydraulic conductivity at the mid-point of the lowest unsaturated soil layer (m s-1)
+
+ end select ! (re-computing hydraulic conductivity)
+
+ ! =====
+ ! compute drainage flux and its derivative...
+ ! ===========================================
+
+ call qDrainFlux(&
+ ! input: model control
+ desireAnal, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ixBcLowerSoilHydrology, & ! intent(in): index defining the type of boundary conditions
+ ! input: state variables
+ scalarMatricHeadTrial, & ! intent(in): matric head in the lowest unsaturated node (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
+ ! input: model coordinate variables
+ mLayerDepth(nSoil), & ! intent(in): depth of the lowest unsaturated soil layer (m)
+ mLayerHeight(nSoil), & ! intent(in): height of the lowest unsaturated soil node (m)
+ ! input: boundary conditions
+ lowerBoundHead, & ! intent(in): lower boundary condition (m)
+ lowerBoundTheta, & ! intent(in): lower boundary condition (-)
+ ! input: derivative in the soil water characteristic
+ mLayerdPsi_dTheta(nSoil), & ! intent(in): derivative in the soil water characteristic
+ ! input: transmittance
+ iLayerSatHydCond(0), & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ iLayerSatHydCond(nSoil), & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ scalarHydCondTrial, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
+ iceImpedeFac(nSoil), & ! intent(in): ice impedence factor in the lower-most soil layer (-)
+ ! input: transmittance derivatives
+ dHydCond_dVolLiq(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ dHydCond_dMatric(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ dHydCond_dTemp(nSoil), & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: soil parameters
+ vGn_alpha(nSoil), & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n(nSoil), & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m(nSoil), & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat(nSoil), & ! intent(in): soil porosity (-)
+ theta_res(nSoil), & ! intent(in): soil residual volumetric water content (-)
+ kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
+ ! output: hydraulic conductivity and diffusivity at the surface
+ iLayerHydCond(nSoil), & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
+ iLayerDiffuse(nSoil), & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux
+ iLayerLiqFluxSoil(nSoil), & ! intent(out): drainage flux (m s-1)
+ ! output: derivatives in drainage flux
+ dq_dHydStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in hydrology state in lowest unsaturated node (m s-1 or s-1)
+ dq_dNrgStateAbove(nSoil), & ! intent(out): change in drainage flux w.r.t. change in energy state in lowest unsaturated node (m s-1 or s-1)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! get copies of drainage flux to compute derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarFlux = iLayerLiqFluxSoil(nSoil)
+ case(perturbStateAbove); scalarFlux_dStateAbove = iLayerLiqFluxSoil(nSoil)
+ case(perturbStateBelow); err=20; message=trim(message)//'lower state should never be perturbed when computing drainage do not expect to get here'; return
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+ ! compute numerical derivatives
+ ! NOTE: drainage derivatives w.r.t. state below are *actually* w.r.t. water table depth, so need to be corrected for aquifer storage
+ ! (note also negative sign to account for inverse relationship between water table depth and aquifer storage)
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ dq_dHydStateAbove(nSoil) = (scalarFlux_dStateAbove - scalarFlux)/dx ! change in drainage flux w.r.t. change in state in lowest unsaturated node (m s-1 or s-1)
+ end if
+
+ ! no dependence on the aquifer for drainage
+ dq_dHydStateBelow(nSoil) = 0._dp ! keep this here in case we want to couple some day....
+ dq_dNrgStateBelow(nSoil) = 0._dp ! keep this here in case we want to couple some day....
+
+ ! print drainage
+ !print*, 'iLayerLiqFluxSoil(nSoil) = ', iLayerLiqFluxSoil(nSoil)
+
+ endif ! if computing drainage
+ ! end of drainage section
+
+ ! *****************************************************************************************************************************************************************
+ ! *****************************************************************************************************************************************************************
+
+ ! end association between local variables and the information in the data structures
+ end associate
+
+ end subroutine soilLiqFlx
+
+ ! ***************************************************************************************************************
+ ! private subroutine diagv_node: compute transmittance and derivatives for model nodes
+ ! ***************************************************************************************************************
+ subroutine diagv_node(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ scalarTempTrial, & ! intent(in): temperature (K)
+ scalarMatricHeadTrial, & ! intent(in): matric head in a given layer (m)
+ scalarVolFracLiqTrial, & ! intent(in): volumetric liquid water content in a given soil layer (-)
+ scalarVolFracIceTrial, & ! intent(in): volumetric ice content in a given soil layer (-)
+ ! input: pre-computed deriavatives
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ mpExp, & ! intent(in): empirical exponent in macropore flow equation (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ theta_mp, & ! intent(in): volumetric liquid water content when macropore flow begins (-)
+ f_impede, & ! intent(in): ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ scalarSatHydCond, & ! intent(in): saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
+ scalarSatHydCondMP, & ! intent(in): saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ scalardPsi_dTheta, & ! derivative in the soil water characteristic
+ scalardTheta_dPsi, & ! derivative in the soil water characteristic
+ ! output: transmittance
+ scalarHydCond, & ! intent(out): hydraulic conductivity at layer mid-points (m s-1)
+ scalarDiffuse, & ! intent(out): diffusivity at layer mid-points (m2 s-1)
+ iceImpedeFac, & ! intent(out): ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ dHydCond_dVolLiq, & ! intent(out): derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq, & ! intent(out): derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric, & ! intent(out): derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ dHydCond_dTemp, & ! intent(out): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:iceImpede ! compute the ice impedence factor
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head
+ USE soil_utils_module,only:matricHead ! compute matric head (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content
+ USE soil_utils_module,only:hydCondMP_liq ! compute hydraulic conductivity of macropores as a function of volumetric liquid water content
+ USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:dPsi_dTheta2 ! compute derivative in dPsi_dTheta (m)
+ USE soil_utils_module,only:dHydCond_dLiq ! compute derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dHydCond_dPsi ! compute derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ USE soil_utils_module,only:dIceImpede_dTemp ! compute the derivative in the ice impedance factor w.r.t. temperature (K-1)
+ ! compute hydraulic transmittance and derivatives for all layers
+ implicit none
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state and diagnostic variables
+ real(dp),intent(in) :: scalarTempTrial ! temperature in each layer (K)
+ real(dp),intent(in) :: scalarMatricHeadTrial ! matric head in each layer (m)
+ real(dp),intent(in) :: scalarVolFracLiqTrial ! volumetric fraction of liquid water in a given layer (-)
+ real(dp),intent(in) :: scalarVolFracIceTrial ! volumetric fraction of ice in a given layer (-)
+ ! input: pre-computed deriavatives
+ real(dp),intent(in) :: dTheta_dTk ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(dp),intent(in) :: dPsiLiq_dTemp ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ ! input: soil parameters
+ real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(dp),intent(in) :: mpExp ! empirical exponent in macropore flow equation (-)
+ real(dp),intent(in) :: theta_sat ! soil porosity (-)
+ real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(dp),intent(in) :: theta_mp ! volumetric liquid water content when macropore flow begins (-)
+ real(dp),intent(in) :: f_impede ! ice impedence factor (-)
+ ! input: saturated hydraulic conductivity
+ real(dp),intent(in) :: scalarSatHydCond ! saturated hydraulic conductivity at the mid-point of a given layer (m s-1)
+ real(dp),intent(in) :: scalarSatHydCondMP ! saturated hydraulic conductivity of macropores at the mid-point of a given layer (m s-1)
+ ! output: derivative in the soil water characteristic
+ real(dp),intent(out) :: scalardPsi_dTheta ! derivative in the soil water characteristic
+ real(dp),intent(out) :: scalardTheta_dPsi ! derivative in the soil water characteristic
+ ! output: transmittance
+ real(dp),intent(out) :: scalarHydCond ! hydraulic conductivity at layer mid-points (m s-1)
+ real(dp),intent(out) :: scalarDiffuse ! diffusivity at layer mid-points (m2 s-1)
+ real(dp),intent(out) :: iceImpedeFac ! ice impedence factor in each layer (-)
+ ! output: transmittance derivatives
+ real(dp),intent(out) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(dp),intent(out) :: dDiffuse_dVolLiq ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(dp),intent(out) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t matric head (s-1)
+ real(dp),intent(out) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local variables
+ real(dp) :: localVolFracLiq ! local volumetric fraction of liquid water
+ real(dp) :: scalarHydCondMP ! hydraulic conductivity of macropores at layer mid-points (m s-1)
+ real(dp) :: dIceImpede_dT ! derivative in ice impedance factor w.r.t. temperature (K-1)
+ real(dp) :: dHydCondMacro_dVolLiq ! derivative in hydraulic conductivity of macropores w.r.t volumetric liquid water content (m s-1)
+ real(dp) :: dHydCondMacro_dMatric ! derivative in hydraulic conductivity of macropores w.r.t matric head (s-1)
+ real(dp) :: dHydCondMicro_dMatric ! derivative in hydraulic conductivity of micropores w.r.t matric head (s-1)
+ real(dp) :: dHydCondMicro_dTemp ! derivative in hydraulic conductivity of micropores w.r.t temperature (m s-1 K-1)
+ real(dp) :: dPsi_dTheta2a ! derivative in dPsi_dTheta (analytical)
+ real(dp) :: dIceImpede_dLiq ! derivative in ice impedence factor w.r.t. volumetric liquid water content (-)
+ real(dp) :: hydCond_noIce ! hydraulic conductivity in the absence of ice (m s-1)
+ real(dp) :: dK_dLiq__noIce ! derivative in hydraulic conductivity w.r.t volumetric liquid water content, in the absence of ice (m s-1)
+ real(dp) :: dK_dPsi__noIce ! derivative in hydraulic conductivity w.r.t matric head, in the absence of ice (s-1)
+ real(dp) :: relSatMP ! relative saturation of macropores (-)
+ ! local variables to test the derivative
+ logical(lgt),parameter :: testDeriv=.false. ! local flag to test the derivative
+ real(dp) :: xConst ! LH_fus/(gravity*Tfreeze), used in freezing point depression equation (m K-1)
+ real(dp) :: vTheta ! volumetric fraction of total water (-)
+ real(dp) :: volLiq ! volumetric fraction of liquid water (-)
+ real(dp) :: volIce ! volumetric fraction of ice (-)
+ real(dp) :: volFracLiq1,volFracLiq2 ! different trial values of volumetric liquid water content (-)
+ real(dp) :: effSat ! effective saturation (-)
+ real(dp) :: psiLiq ! liquid water matric potential (m)
+ real(dp) :: hydCon ! hydraulic conductivity (m s-1)
+ real(dp) :: hydIce ! hydraulic conductivity after accounting for ice impedance (-)
+ real(dp),parameter :: dx = 1.e-8_dp ! finite difference increment (m)
+ ! initialize error control
+ err=0; message="diagv_node/"
+
+ ! *****
+ ! compute the derivative in the soil water characteristic
+ select case(ixRichards)
+ case(moisture)
+ scalardPsi_dTheta = dPsi_dTheta(scalarvolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalardTheta_dPsi = realMissing ! (deliberately cause problems if this is ever used)
+ case(mixdform)
+ scalardTheta_dPsi = dTheta_dPsi(scalarMatricHeadTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalardPsi_dTheta = dPsi_dTheta(scalarvolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ if(testDeriv)then
+ volFracLiq1 = volFracLiq(scalarMatricHeadTrial, vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ volFracLiq2 = volFracLiq(scalarMatricHeadTrial+dx,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ end if ! (testing the derivative)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+
+ ! *****
+ ! compute hydraulic conductivity and its derivative in each soil layer
+
+ ! compute the ice impedence factor and its derivative w.r.t. volumetric liquid water content (-)
+ call iceImpede(scalarVolFracIceTrial,f_impede, & ! input
+ iceImpedeFac,dIceImpede_dLiq) ! output
+
+ select case(ixRichards)
+ ! ***** moisture-based form of Richards' equation
+ case(moisture)
+ ! haven't included macropores yet
+ err=20; message=trim(message)//'still need to include macropores for the moisture-based form of Richards eqn'; return
+ ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
+ hydCond_noIce = hydCond_liq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m)
+ scalarHydCond = hydCond_noIce*iceImpedeFac
+ scalarDiffuse = scalardPsi_dTheta * scalarHydCond
+ ! compute derivative in hydraulic conductivity (m s-1) and hydraulic diffusivity (m2 s-1)
+ if(deriv_desired)then
+ if(scalarVolFracIceTrial > epsilon(iceImpedeFac))then
+ dK_dLiq__noIce = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.) ! [.true. = analytical]
+ dHydCond_dVolLiq = hydCond_noIce*dIceImpede_dLiq + dK_dLiq__noIce*iceImpedeFac
+ else
+ dHydCond_dVolLiq = dHydCond_dLiq(scalarVolFracLiqTrial,scalarSatHydCond,theta_res,theta_sat,vGn_m,.true.)
+ end if
+ dPsi_dTheta2a = dPsi_dTheta2(scalarVolFracLiqTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m,.true.) ! [.true. = analytical] compute derivative in dPsi_dTheta (m)
+ dDiffuse_dVolLiq = dHydCond_dVolLiq*scalardPsi_dTheta + scalarHydCond*dPsi_dTheta2a
+ dHydCond_dMatric = realMissing ! not used, so cause problems
+ end if
+
+ ! ***** mixed form of Richards' equation -- just compute hydraulic condictivity
+ case(mixdform)
+ ! compute the hydraulic conductivity (m s-1) and diffusivity (m2 s-1) for a given layer
+ hydCond_noIce = hydCond_psi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
+ scalarDiffuse = realMissing ! not used, so cause problems
+ ! compute the hydraulic conductivity of macropores (m s-1)
+ localVolFracLiq = volFracLiq(scalarMatricHeadTrial,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ scalarHydCondMP = hydCondMP_liq(localVolFracLiq,theta_sat,theta_mp,mpExp,scalarSatHydCondMP,scalarSatHydCond)
+ scalarHydCond = hydCond_noIce*iceImpedeFac + scalarHydCondMP
+
+ ! compute derivative in hydraulic conductivity (m s-1)
+ if(deriv_desired)then
+ ! (compute derivative for macropores)
+ if(localVolFracLiq > theta_mp)then
+ relSatMP = (localVolFracLiq - theta_mp)/(theta_sat - theta_mp)
+ dHydCondMacro_dVolLiq = ((scalarSatHydCondMP - scalarSatHydCond)/(theta_sat - theta_mp))*mpExp*(relSatMP**(mpExp - 1._dp))
+ dHydCondMacro_dMatric = scalardTheta_dPsi*dHydCondMacro_dVolLiq
+ else
+ dHydCondMacro_dVolLiq = 0._dp
+ dHydCondMacro_dMatric = 0._dp
+ end if
+ ! (compute derivatives for micropores)
+ if(scalarVolFracIceTrial > verySmall)then
+ dK_dPsi__noIce = dHydCond_dPsi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.) ! analytical
+ dHydCondMicro_dTemp = dPsiLiq_dTemp*dK_dPsi__noIce ! m s-1 K-1
+ dHydCondMicro_dMatric = hydCond_noIce*dIceImpede_dLiq*scalardTheta_dPsi + dK_dPsi__noIce*iceImpedeFac
+ else
+ dHydCondMicro_dTemp = 0._dp
+ dHydCondMicro_dMatric = dHydCond_dPsi(scalarMatricHeadTrial,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m,.true.)
+ end if
+ ! (combine derivatives)
+ dHydCond_dMatric = dHydCondMicro_dMatric + dHydCondMacro_dMatric
+
+ ! (compute analytical derivative for change in ice impedance factor w.r.t. temperature)
+ call dIceImpede_dTemp(scalarVolFracIceTrial, & ! intent(in): trial value of volumetric ice content (-)
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ f_impede, & ! intent(in): ice impedance parameter (-)
+ dIceImpede_dT ) ! intent(out): derivative in ice impedance factor w.r.t. temperature (K-1)
+ ! (compute derivative in hydraulic conductivity w.r.t. temperature)
+ dHydCond_dTemp = hydCond_noIce*dIceImpede_dT + dHydCondMicro_dTemp*iceImpedeFac
+ ! (test derivative)
+ if(testDeriv)then
+ xConst = LH_fus/(gravity*Tfreeze) ! m K-1 (NOTE: J = kg m2 s-2)
+ vTheta = scalarVolFracIceTrial + scalarVolFracLiqTrial
+ volLiq = volFracLiq(xConst*(scalarTempTrial+dx - Tfreeze),vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ volIce = vTheta - volLiq
+ effSat = (volLiq - theta_res)/(theta_sat - volIce - theta_res)
+ psiLiq = matricHead(effSat,vGn_alpha,0._dp,1._dp,vGn_n,vGn_m) ! use effective saturation, so theta_res=0 and theta_sat=1
+ hydCon = hydCond_psi(psiLiq,scalarSatHydCond,vGn_alpha,vGn_n,vGn_m)
+ call iceImpede(volIce,f_impede,iceImpedeFac,dIceImpede_dLiq)
+ hydIce = hydCon*iceImpedeFac
+ print*, 'test derivative: ', (psiLiq - scalarMatricHeadTrial)/dx, dPsiLiq_dTemp
+ print*, 'test derivative: ', (hydCon - hydCond_noIce)/dx, dHydCondMicro_dTemp
+ print*, 'test derivative: ', (hydIce - scalarHydCond)/dx, dHydCond_dTemp
+ print*, 'press any key to continue'; read(*,*) ! (alternative to the deprecated 'pause' statement)
+ end if ! testing the derivative
+ ! (set values that are not used to missing)
+ dHydCond_dVolLiq = realMissing ! not used, so cause problems
+ dDiffuse_dVolLiq = realMissing ! not used, so cause problems
+ end if
+
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+
+ end select
+
+ ! if derivatives are not desired, then set values to missing
+ if(.not.deriv_desired)then
+ dHydCond_dVolLiq = realMissing ! not used, so cause problems
+ dDiffuse_dVolLiq = realMissing ! not used, so cause problems
+ dHydCond_dMatric = realMissing ! not used, so cause problems
+ end if
+
+ end subroutine diagv_node
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine surfaceFlx: compute the surface flux and its derivative
+ ! ***************************************************************************************************************
+ subroutine surfaceFlx(&
+ ! input: model control
+ doInfiltration, & ! intent(in): flag indicating if desire to compute infiltration
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ bc_upper, & ! intent(in): index defining the type of boundary conditions (neumann or diriclet)
+ nRoots, & ! intent(in): number of layers that contain roots
+ ixIce, & ! intent(in): index of lowest ice layer
+ ! input: state variables
+ scalarMatricHead, & ! intent(in): matric head in the upper-most soil layer (m)
+ scalarVolFracLiq, & ! intent(in): volumetric liquid water content in the upper-most soil layer (-)
+ mLayerVolFracLiq, & ! intent(in): volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIce, & ! intent(in): volumetric ice content in each soil layer (-)
+ ! input: depth of upper-most soil layer (m)
+ mLayerDepth, & ! intent(in): depth of each soil layer (m)
+ iLayerHeight, & ! intent(in): height at the interface of each layer (m)
+ ! input: boundary conditions
+ upperBoundHead, & ! intent(in): upper boundary condition (m)
+ upperBoundTheta, & ! intent(in): upper boundary condition (-)
+ ! input: flux at the upper boundary
+ scalarRainPlusMelt, & ! intent(in): rain plus melt (m s-1)
+ ! input: transmittance
+ surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ iceImpedeFac, & ! intent(in): ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ qSurfScale, & ! intent(in): scaling factor in the surface runoff parameterization (-)
+ zScale_TOPMODEL, & ! intent(in): scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ rootingDepth, & ! intent(in): rooting depth (m)
+ wettingFrontSuction, & ! intent(in): Green-Ampt wetting front suction (m)
+ soilIceScale, & ! intent(in): soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ soilIceCV, & ! intent(in): soil ice CV in Gamma distribution used to define frozen area (-)
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ surfaceHydCond, & ! intent(inout): hydraulic conductivity at the surface (m s-1)
+ surfaceDiffuse, & ! intent(inout): hydraulic diffusivity at the surface (m2 s-1)
+ ! input-output: fluxes at layer interfaces and surface runoff
+ xMaxInfilRate, & ! intent(inout): maximum infiltration rate (m s-1)
+ scalarInfilArea, & ! intent(inout): fraction of unfrozen area where water can infiltrate (-)
+ scalarFrozenArea, & ! intent(inout): fraction of area that is considered impermeable due to soil ice (-)
+ scalarSurfaceRunoff, & ! intent(out): surface runoff (m s-1)
+ scalarSurfaceInfiltration, & ! intent(out): surface infiltration (m s-1)
+ ! input-output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
+ dq_dHydState, & ! intent(inout): derivative in surface infiltration w.r.t. state variable in the upper-most soil layer (m s-1 or s-1)
+ dq_dNrgState, & ! intent(out): derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ USE soil_utils_module,only:gammp ! compute the cumulative probabilty based on the Gamma distribution
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ implicit none
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: doInfiltration ! flag indicating if desire to compute infiltration
+ logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
+ integer(i4b),intent(in) :: bc_upper ! index defining the type of boundary conditions
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ integer(i4b),intent(in) :: nRoots ! number of layers that contain roots
+ integer(i4b),intent(in) :: ixIce ! index of lowest ice layer
+ ! input: state and diagnostic variables
+ real(dp),intent(in) :: scalarMatricHead ! matric head in the upper-most soil layer (m)
+ real(dp),intent(in) :: scalarVolFracLiq ! volumetric liquid water content in the upper-most soil layer (-)
+ real(dp),intent(in) :: mLayerVolFracLiq(:) ! volumetric liquid water content in each soil layer (-)
+ real(dp),intent(in) :: mLayerVolFracIce(:) ! volumetric ice content in each soil layer (-)
+ ! input: depth of upper-most soil layer (m)
+ real(dp),intent(in) :: mLayerDepth(:) ! depth of upper-most soil layer (m)
+ real(dp),intent(in) :: iLayerHeight(0:) ! height at the interface of each layer (m)
+ ! input: diriclet boundary conditions
+ real(dp),intent(in) :: upperBoundHead ! upper boundary condition for matric head (m)
+ real(dp),intent(in) :: upperBoundTheta ! upper boundary condition for volumetric liquid water content (-)
+ ! input: flux at the upper boundary
+ real(dp),intent(in) :: scalarRainPlusMelt ! rain plus melt, used as input to the soil zone before computing surface runoff (m s-1)
+ ! input: transmittance
+ real(dp),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
+ real(dp),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ real(dp),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
+ ! input: soil parameters
+ real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(dp),intent(in) :: theta_sat ! soil porosity (-)
+ real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(dp),intent(in) :: qSurfScale ! scaling factor in the surface runoff parameterization (-)
+ real(dp),intent(in) :: zScale_TOPMODEL ! scaling factor used to describe decrease in hydraulic conductivity with depth (m)
+ real(dp),intent(in) :: rootingDepth ! rooting depth (m)
+ real(dp),intent(in) :: wettingFrontSuction ! Green-Ampt wetting front suction (m)
+ real(dp),intent(in) :: soilIceScale ! soil ice scaling factor in Gamma distribution used to define frozen area (m)
+ real(dp),intent(in) :: soilIceCV ! soil ice CV in Gamma distribution used to define frozen area (-)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input-output: hydraulic conductivity and diffusivity at the surface
+ ! NOTE: intent(inout) because infiltration may only be computed for the first iteration
+ real(dp),intent(inout) :: surfaceHydCond ! hydraulic conductivity (m s-1)
+ real(dp),intent(inout) :: surfaceDiffuse ! hydraulic diffusivity at the surface (m
+ ! output: surface runoff and infiltration flux (m s-1)
+ real(dp),intent(inout) :: xMaxInfilRate ! maximum infiltration rate (m s-1)
+ real(dp),intent(inout) :: scalarInfilArea ! fraction of unfrozen area where water can infiltrate (-)
+ real(dp),intent(inout) :: scalarFrozenArea ! fraction of area that is considered impermeable due to soil ice (-)
+ real(dp),intent(out) :: scalarSurfaceRunoff ! surface runoff (m s-1)
+ real(dp),intent(out) :: scalarSurfaceInfiltration ! surface infiltration (m s-1)
+ ! output: deriavtives in surface infiltration w.r.t. volumetric liquid water (m s-1) and matric head (s-1) in the upper-most soil layer
+ real(dp),intent(out) :: dq_dHydState ! derivative in surface infiltration w.r.t. state variable in the upper-most soil layer (m s-1 or s-1)
+ real(dp),intent(out) :: dq_dNrgState ! derivative in surface infiltration w.r.t. energy state variable in the upper-most soil layer (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! (general)
+ integer(i4b) :: iLayer ! index of soil layer
+ ! (head boundary condition)
+ real(dp) :: cFlux ! capillary flux (m s-1)
+ real(dp) :: dNum ! numerical derivative
+ ! (simplified Green-Ampt infiltration)
+ real(dp) :: rootZoneLiq ! depth of liquid water in the root zone (m)
+ real(dp) :: rootZoneIce ! depth of ice in the root zone (m)
+ real(dp) :: availCapacity ! available storage capacity in the root zone (m)
+ real(dp) :: depthWettingFront ! depth to the wetting front (m)
+ real(dp) :: hydCondWettingFront ! hydraulic conductivity at the wetting front (m s-1)
+ ! (saturated area associated with variable storage capacity)
+ real(dp) :: fracCap ! fraction of pore space filled with liquid water and ice (-)
+ real(dp) :: fInfRaw ! infiltrating area before imposing solution constraints (-)
+ real(dp),parameter :: maxFracCap=0.995_dp ! maximum fraction capacity -- used to avoid numerical problems associated with an enormous derivative
+ real(dp),parameter :: scaleFactor=0.000001_dp ! scale factor for the smoothing function (-)
+ real(dp),parameter :: qSurfScaleMax=1000._dp ! maximum surface runoff scaling factor (-)
+ ! (fraction of impermeable area associated with frozen ground)
+ real(dp) :: alpha ! shape parameter in the Gamma distribution
+ real(dp) :: xLimg ! upper limit of the integral
+ ! initialize error control
+ err=0; message="surfaceFlx/"
+
+ ! compute derivative in the energy state
+ ! NOTE: revisit the need to do this
+ dq_dNrgState = 0._dp
+
+ ! *****
+ ! compute the surface flux and its derivative
+ select case(bc_upper)
+
+ ! *****
+ ! head condition
+ case(prescribedHead)
+
+ ! surface runoff iz zero for the head condition
+ scalarSurfaceRunoff = 0._dp
+
+ ! compute transmission and the capillary flux
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ surfaceHydCond = hydCond_liq(upperBoundTheta,surfaceSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
+ surfaceDiffuse = dPsi_dTheta(upperBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * surfaceHydCond
+ ! compute the capillary flux
+ cflux = -surfaceDiffuse*(scalarVolFracLiq - upperBoundTheta) / (mLayerDepth(1)*0.5_dp)
+ case(mixdform)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ surfaceHydCond = hydCond_psi(upperBoundHead,surfaceSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
+ surfaceDiffuse = realMissing
+ ! compute the capillary flux
+ cflux = -surfaceHydCond*(scalarMatricHead - upperBoundHead) / (mLayerDepth(1)*0.5_dp)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' eqn)
+ ! compute the total flux
+ scalarSurfaceInfiltration = cflux + surfaceHydCond
+ ! compute the derivative
+ if(deriv_desired)then
+ ! compute the hydrology derivative
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydState = -surfaceDiffuse/(mLayerDepth(1)/2._dp)
+ case(mixdform); dq_dHydState = -surfaceHydCond/(mLayerDepth(1)/2._dp)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! compute the energy derivative
+ dq_dNrgState = -(dHydCond_dTemp/2._dp)*(scalarMatricHead - upperBoundHead)/(mLayerDepth(1)*0.5_dp) + dHydCond_dTemp/2._dp
+ ! compute the numerical derivative
+ !cflux = -surfaceHydCond*((scalarMatricHead+dx) - upperBoundHead) / (mLayerDepth(1)*0.5_dp)
+ !surfaceInfiltration1 = cflux + surfaceHydCond
+ !dNum = (surfaceInfiltration1 - scalarSurfaceInfiltration)/dx
+ else
+ dq_dHydState = 0._dp
+ dNum = 0._dp
+ end if
+ !write(*,'(a,1x,10(e30.20,1x))') 'scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum = ', &
+ ! scalarMatricHead, scalarSurfaceInfiltration, dq_dHydState, dNum
+
+ ! *****
+ ! flux condition
+ case(liquidFlux)
+
+ ! force infiltration to be constant over the iterations
+ if(doInfiltration)then
+
+ ! define the storage in the root zone (m)
+ rootZoneLiq = 0._dp
+ rootZoneIce = 0._dp
+ ! (process layers where the roots extend to the bottom of the layer)
+ if(nRoots > 1)then
+ do iLayer=1,nRoots-1
+ rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(iLayer)*mLayerDepth(iLayer)
+ rootZoneIce = rootZoneIce + mLayerVolFracIce(iLayer)*mLayerDepth(iLayer)
+ end do
+ end if
+ ! (process layers where the roots end in the current layer)
+ rootZoneLiq = rootZoneLiq + mLayerVolFracLiq(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+ rootZoneIce = rootZoneIce + mLayerVolFracIce(nRoots)*(rootingDepth - iLayerHeight(nRoots-1))
+
+ ! define available capacity to hold water (m)
+ availCapacity = theta_sat*rootingDepth - rootZoneIce
+ if(rootZoneLiq > availCapacity+verySmall)then
+ message=trim(message)//'liquid water in the root zone exceeds capacity'
+ err=20; return
+ end if
+
+ ! define the depth to the wetting front (m)
+ depthWettingFront = (rootZoneLiq/availCapacity)*rootingDepth
+
+ ! define the hydraulic conductivity at depth=depthWettingFront (m s-1)
+ hydCondWettingFront = surfaceSatHydCond * ( (1._dp - depthWettingFront/sum(mLayerDepth))**(zScale_TOPMODEL - 1._dp) )
+
+ ! define the maximum infiltration rate (m s-1)
+ xMaxInfilRate = hydCondWettingFront*( (wettingFrontSuction + depthWettingFront)/depthWettingFront ) ! maximum infiltration rate (m s-1)
+ !write(*,'(a,1x,f9.3,1x,10(e20.10,1x))') 'depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate = ', depthWettingFront, surfaceSatHydCond, hydCondWettingFront, xMaxInfilRate
+
+ ! define the infiltrating area for the non-frozen part of the cell/basin
+ if(qSurfScale < qSurfScaleMax)then
+ fracCap = rootZoneLiq/(maxFracCap*availCapacity) ! fraction of available root zone filled with water
+ fInfRaw = 1._dp - exp(-qSurfScale*(1._dp - fracCap)) ! infiltrating area -- allowed to violate solution constraints
+ scalarInfilArea = min(0.5_dp*(fInfRaw + sqrt(fInfRaw**2._dp + scaleFactor)), 1._dp) ! infiltrating area -- constrained
+ else
+ scalarInfilArea = 1._dp
+ endif
+
+ ! check to ensure we are not infiltrating into a fully saturated column
+ if(ixIce<nRoots)then
+ if(sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) > 0.9999_dp*theta_sat*sum(mLayerDepth(ixIce+1:nRoots))) scalarInfilArea=0._dp
+ !print*, 'ixIce, nRoots, scalarInfilArea = ', ixIce, nRoots, scalarInfilArea
+ !print*, 'sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots)) = ', sum(mLayerVolFracLiq(ixIce+1:nRoots)*mLayerDepth(ixIce+1:nRoots))
+ !print*, 'theta_sat*sum(mLayerDepth(ixIce+1:nRoots)) = ', theta_sat*sum(mLayerDepth(ixIce+1:nRoots))
+ endif
+
+ ! define the impermeable area due to frozen ground
+ if(rootZoneIce > tiny(rootZoneIce))then ! (avoid divide by zero)
+ alpha = 1._dp/(soilIceCV**2._dp) ! shape parameter in the Gamma distribution
+ xLimg = alpha*soilIceScale/rootZoneIce ! upper limit of the integral
+ !scalarFrozenArea = 1._dp - gammp(alpha,xLimg) ! fraction of frozen area
+ scalarFrozenArea = 0._dp
+ else
+ scalarFrozenArea = 0._dp
+ end if
+ !print*, 'scalarFrozenArea, rootZoneIce = ', scalarFrozenArea, rootZoneIce
+
+ end if ! (if desire to compute infiltration)
+
+ ! compute infiltration (m s-1)
+ scalarSurfaceInfiltration = (1._dp - scalarFrozenArea)*scalarInfilArea*min(scalarRainPlusMelt,xMaxInfilRate)
+
+ ! compute surface runoff (m s-1)
+ scalarSurfaceRunoff = scalarRainPlusMelt - scalarSurfaceInfiltration
+ !print*, 'scalarRainPlusMelt, xMaxInfilRate = ', scalarRainPlusMelt, xMaxInfilRate
+ !print*, 'scalarSurfaceInfiltration, scalarSurfaceRunoff = ', scalarSurfaceInfiltration, scalarSurfaceRunoff
+ !print*, '(1._dp - scalarFrozenArea), (1._dp - scalarFrozenArea)*scalarInfilArea = ', (1._dp - scalarFrozenArea), (1._dp - scalarFrozenArea)*scalarInfilArea
+
+ ! set surface hydraulic conductivity and diffusivity to missing (not used for flux condition)
+ surfaceHydCond = realMissing
+ surfaceDiffuse = realMissing
+
+ ! set numerical derivative to zero
+ ! NOTE 1: Depends on multiple soil layers and does not jive with the current tridiagonal matrix
+ ! NOTE 2: Need to define the derivative at every call, because intent(out)
+ dq_dHydState = 0._dp
+ dq_dNrgState = 0._dp
+
+ ! ***** error check
+ case default; err=20; message=trim(message)//'unknown upper boundary condition for soil hydrology'; return
+
+ end select ! (type of upper boundary condition)
+
+ end subroutine surfaceFlx
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine iLayerFlux: compute the fluxes and derivatives at layer interfaces
+ ! ***************************************************************************************************************
+ subroutine iLayerFlux(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ! input: state variables (adjacent layers)
+ nodeMatricHeadTrial, & ! intent(in): matric head at the soil nodes (m)
+ nodeVolFracLiqTrial, & ! intent(in): volumetric liquid water content at the soil nodes (-)
+ ! input: model coordinate variables (adjacent layers)
+ nodeHeight, & ! intent(in): height of the soil nodes (m)
+ ! input: temperature derivatives
+ dPsiLiq_dTemp, & ! intent(in): derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: transmittance (adjacent layers)
+ nodeHydCondTrial, & ! intent(in): hydraulic conductivity at the soil nodes (m s-1)
+ nodeDiffuseTrial, & ! intent(in): hydraulic diffusivity at the soil nodes (m2 s-1)
+ ! input: transmittance derivatives (adjacent layers)
+ dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in volumetric liquid water content (m s-1)
+ dDiffuse_dVolLiq, & ! intent(in): derivative in hydraulic diffusivity w.r.t. change in volumetric liquid water content (m2 s-1)
+ dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. change in matric head (s-1)
+ ! output: tranmsmittance at the layer interface (scalars)
+ iLayerHydCond, & ! intent(out): hydraulic conductivity at the interface between layers (m s-1)
+ iLayerDiffuse, & ! intent(out): hydraulic diffusivity at the interface between layers (m2 s-1)
+ ! output: vertical flux at the layer interface (scalars)
+ iLayerLiqFluxSoil, & ! intent(out): vertical flux of liquid water at the layer interface (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ dq_dHydStateAbove, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ dq_dHydStateBelow, & ! intent(out): derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ dq_dNrgStateAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ dq_dNrgStateBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ ! input: state variables
+ real(dp),intent(in) :: nodeMatricHeadTrial(:) ! matric head at the soil nodes (m)
+ real(dp),intent(in) :: nodeVolFracLiqTrial(:) ! volumetric fraction of liquid water at the soil nodes (-)
+ ! input: model coordinate variables
+ real(dp),intent(in) :: nodeHeight(:) ! height at the mid-point of the lower layer (m)
+ ! input: temperature derivatives
+ real(dp),intent(in) :: dPsiLiq_dTemp(:) ! derivative in liquid water matric potential w.r.t. temperature (m K-1)
+ real(dp),intent(in) :: dHydCond_dTemp(:) ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: transmittance
+ real(dp),intent(in) :: nodeHydCondTrial(:) ! hydraulic conductivity at layer mid-points (m s-1)
+ real(dp),intent(in) :: nodeDiffuseTrial(:) ! diffusivity at layer mid-points (m2 s-1)
+ ! input: transmittance derivatives
+ real(dp),intent(in) :: dHydCond_dVolLiq(:) ! derivative in hydraulic conductivity w.r.t volumetric liquid water content (m s-1)
+ real(dp),intent(in) :: dDiffuse_dVolLiq(:) ! derivative in hydraulic diffusivity w.r.t volumetric liquid water content (m2 s-1)
+ real(dp),intent(in) :: dHydCond_dMatric(:) ! derivative in hydraulic conductivity w.r.t matric head (m s-1)
+ ! output: tranmsmittance at the layer interface (scalars)
+ real(dp),intent(out) :: iLayerHydCond ! hydraulic conductivity at the interface between layers (m s-1)
+ real(dp),intent(out) :: iLayerDiffuse ! hydraulic diffusivity at the interface between layers (m2 s-1)
+ ! output: vertical flux at the layer interface (scalars)
+ real(dp),intent(out) :: iLayerLiqFluxSoil ! vertical flux of liquid water at the layer interface (m s-1)
+ ! output: derivatives in fluxes w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below (m s-1 or s-1)
+ real(dp),intent(out) :: dq_dHydStateAbove ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer above (m s-1 or s-1)
+ real(dp),intent(out) :: dq_dHydStateBelow ! derivatives in the flux w.r.t. matric head or volumetric lquid water in the layer below (m s-1 or s-1)
+ ! output: derivatives in fluxes w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (m s-1 K-1)
+ real(dp),intent(out) :: dq_dNrgStateAbove ! derivatives in the flux w.r.t. temperature in the layer above (m s-1 K-1)
+ real(dp),intent(out) :: dq_dNrgStateBelow ! derivatives in the flux w.r.t. temperature in the layer below (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables (named variables to provide index of 2-element vectors)
+ integer(i4b),parameter :: ixUpper=1 ! index of upper node in the 2-element vectors
+ integer(i4b),parameter :: ixLower=2 ! index of lower node in the 2-element vectors
+ logical(lgt),parameter :: useGeometric=.false. ! switch between the arithmetic and geometric mean
+ ! local variables (Darcy flux)
+ real(dp) :: dPsi ! spatial difference in matric head (m)
+ real(dp) :: dLiq ! spatial difference in volumetric liquid water (-)
+ real(dp) :: dz ! spatial difference in layer mid-points (m)
+ real(dp) :: cflux ! capillary flux (m s-1)
+ ! local variables (derivative in Darcy's flux)
+ real(dp) :: dHydCondIface_dVolLiqAbove ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer above
+ real(dp) :: dHydCondIface_dVolLiqBelow ! derivative in hydraulic conductivity at layer interface w.r.t. volumetric liquid water content in layer below
+ real(dp) :: dDiffuseIface_dVolLiqAbove ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer above
+ real(dp) :: dDiffuseIface_dVolLiqBelow ! derivative in hydraulic diffusivity at layer interface w.r.t. volumetric liquid water content in layer below
+ real(dp) :: dHydCondIface_dMatricAbove ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer above
+ real(dp) :: dHydCondIface_dMatricBelow ! derivative in hydraulic conductivity at layer interface w.r.t. matric head in layer below
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="iLayerFlux/"
+
+ ! *****
+ ! compute the vertical flux of liquid water
+ ! compute the hydraulic conductivity at the interface
+ if(useGeometric)then
+ iLayerHydCond = (nodeHydCondTrial(ixLower) * nodeHydCondTrial(ixUpper))**0.5_dp
+ else
+ iLayerHydCond = (nodeHydCondTrial(ixLower) + nodeHydCondTrial(ixUpper))*0.5_dp
+ end if
+ !write(*,'(a,1x,5(e20.10,1x))') 'in iLayerFlux: iLayerHydCond, iLayerHydCondMP = ', iLayerHydCond, iLayerHydCondMP
+ ! compute the height difference between nodes
+ dz = nodeHeight(ixLower) - nodeHeight(ixUpper)
+ ! compute the capillary flux
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ iLayerDiffuse = (nodeDiffuseTrial(ixLower) * nodeDiffuseTrial(ixUpper))**0.5_dp
+ dLiq = nodeVolFracLiqTrial(ixLower) - nodeVolFracLiqTrial(ixUpper)
+ cflux = -iLayerDiffuse * dLiq/dz
+ case(mixdform)
+ iLayerDiffuse = realMissing
+ dPsi = nodeMatricHeadTrial(ixLower) - nodeMatricHeadTrial(ixUpper)
+ cflux = -iLayerHydCond * dPsi/dz
+ case default; err=10; message=trim(message)//"unable to identify option for Richards' equation"; return
+ end select
+ ! compute the total flux (add gravity flux, positive downwards)
+ iLayerLiqFluxSoil = cflux + iLayerHydCond
+ !write(*,'(a,1x,10(e20.10,1x))') 'iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond = ', &
+ ! iLayerLiqFluxSoil, dPsi, dz, cflux, iLayerHydCond
+
+ ! ** compute the derivatives
+ if(deriv_desired)then
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ ! still need to implement arithmetric mean for the moisture-based form
+ if(.not.useGeometric)then
+ message=trim(message)//'only currently implemented for geometric mean -- change local flag'
+ err=20; return
+ end if
+ ! derivatives in hydraulic conductivity at the layer interface (m s-1)
+ dHydCondIface_dVolLiqAbove = dHydCond_dVolLiq(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_dp/max(iLayerHydCond,verySmall)
+ dHydCondIface_dVolLiqBelow = dHydCond_dVolLiq(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_dp/max(iLayerHydCond,verySmall)
+ ! derivatives in hydraulic diffusivity at the layer interface (m2 s-1)
+ dDiffuseIface_dVolLiqAbove = dDiffuse_dVolLiq(ixUpper)*nodeDiffuseTrial(ixLower) * 0.5_dp/max(iLayerDiffuse,verySmall)
+ dDiffuseIface_dVolLiqBelow = dDiffuse_dVolLiq(ixLower)*nodeDiffuseTrial(ixUpper) * 0.5_dp/max(iLayerDiffuse,verySmall)
+ ! derivatives in the flux w.r.t. volumetric liquid water content
+ dq_dHydStateAbove = -dDiffuseIface_dVolLiqAbove*dLiq/dz + iLayerDiffuse/dz + dHydCondIface_dVolLiqAbove
+ dq_dHydStateBelow = -dDiffuseIface_dVolLiqBelow*dLiq/dz - iLayerDiffuse/dz + dHydCondIface_dVolLiqBelow
+ case(mixdform)
+ ! derivatives in hydraulic conductivity
+ if(useGeometric)then
+ dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)*nodeHydCondTrial(ixLower) * 0.5_dp/max(iLayerHydCond,verySmall)
+ dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)*nodeHydCondTrial(ixUpper) * 0.5_dp/max(iLayerHydCond,verySmall)
+ else
+ dHydCondIface_dMatricAbove = dHydCond_dMatric(ixUpper)/2._dp
+ dHydCondIface_dMatricBelow = dHydCond_dMatric(ixLower)/2._dp
+ end if
+ ! derivatives in the flux w.r.t. matric head
+ dq_dHydStateAbove = -dHydCondIface_dMatricAbove*dPsi/dz + iLayerHydCond/dz + dHydCondIface_dMatricAbove
+ dq_dHydStateBelow = -dHydCondIface_dMatricBelow*dPsi/dz - iLayerHydCond/dz + dHydCondIface_dMatricBelow
+ ! derivative in the flux w.r.t. temperature
+ dq_dNrgStateAbove = -(dHydCond_dTemp(ixUpper)/2._dp)*dPsi/dz + iLayerHydCond*dPsiLiq_dTemp(ixUpper)/dz + dHydCond_dTemp(ixUpper)/2._dp
+ dq_dNrgStateBelow = -(dHydCond_dTemp(ixLower)/2._dp)*dPsi/dz - iLayerHydCond*dPsiLiq_dTemp(ixLower)/dz + dHydCond_dTemp(ixLower)/2._dp
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ else
+ dq_dHydStateAbove = realMissing
+ dq_dHydStateBelow = realMissing
+ end if
+
+ end subroutine iLayerFlux
+
+
+ ! ***************************************************************************************************************
+ ! private subroutine qDrainFlux: compute the drainage flux from the bottom of the soil profile and its derivative
+ ! ***************************************************************************************************************
+ subroutine qDrainFlux(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ bc_lower, & ! intent(in): index defining the type of boundary conditions
+ ! input: state variables
+ nodeMatricHead, & ! intent(in): matric head in the lowest unsaturated node (m)
+ nodeVolFracLiq, & ! intent(in): volumetric liquid water content the lowest unsaturated node (-)
+ ! input: model coordinate variables
+ nodeDepth, & ! intent(in): depth of the lowest unsaturated soil layer (m)
+ nodeHeight, & ! intent(in): height of the lowest unsaturated soil node (m)
+ ! input: boundary conditions
+ lowerBoundHead, & ! intent(in): lower boundary condition (m)
+ lowerBoundTheta, & ! intent(in): lower boundary condition (-)
+ ! input: derivative in soil water characteristix
+ node__dPsi_dTheta, & ! intent(in): derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! input: transmittance
+ surfaceSatHydCond, & ! intent(in): saturated hydraulic conductivity at the surface (m s-1)
+ bottomSatHydCond, & ! intent(in): saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ nodeHydCond, & ! intent(in): hydraulic conductivity at the node itself (m s-1)
+ iceImpedeFac, & ! intent(in): ice impedence factor in the lower-most soil layer (-)
+ ! input: transmittance derivatives
+ dHydCond_dVolLiq, & ! intent(in): derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ dHydCond_dMatric, & ! intent(in): derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ dHydCond_dTemp, & ! intent(in): derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: soil parameters
+ vGn_alpha, & ! intent(in): van Genutchen "alpha" parameter (m-1)
+ vGn_n, & ! intent(in): van Genutchen "n" parameter (-)
+ VGn_m, & ! intent(in): van Genutchen "m" parameter (-)
+ theta_sat, & ! intent(in): soil porosity (-)
+ theta_res, & ! intent(in): soil residual volumetric water content (-)
+ kAnisotropic, & ! intent(in): anisotropy factor for lateral hydraulic conductivity (-)
+ zScale_TOPMODEL, & ! intent(in): TOPMODEL scaling factor (m)
+ ! output: hydraulic conductivity and diffusivity at the surface
+ bottomHydCond, & ! intent(out): hydraulic conductivity at the bottom of the unsatuarted zone (m s-1)
+ bottomDiffuse, & ! intent(out): hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux from the bottom of the soil profile
+ scalarDrainage, & ! intent(out): drainage flux from the bottom of the soil profile (m s-1)
+ ! output: derivatives in drainage flux
+ dq_dHydStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in hydrology state variable in lowest unsaturated node (m s-1 or s-1)
+ dq_dNrgStateUnsat, & ! intent(out): change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water as a function of matric head (-)
+ USE soil_utils_module,only:matricHead ! compute matric head as a function of volumetric fraction of liquid water (m)
+ USE soil_utils_module,only:hydCond_psi ! compute hydraulic conductivity as a function of matric head (m s-1)
+ USE soil_utils_module,only:hydCond_liq ! compute hydraulic conductivity as a function of volumetric liquid water content (m s-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! compute infiltraton at the surface and its derivative w.r.t. mass in the upper soil layer
+ implicit none
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! index defining the option for Richards' equation (moisture or mixdform)
+ integer(i4b),intent(in) :: bc_lower ! index defining the type of boundary conditions
+ ! input: state and diagnostic variables
+ real(dp),intent(in) :: nodeMatricHead ! matric head in the lowest unsaturated node (m)
+ real(dp),intent(in) :: nodeVolFracLiq ! volumetric liquid water content in the lowest unsaturated node (-)
+ ! input: model coordinate variables
+ real(dp),intent(in) :: nodeDepth ! depth of the lowest unsaturated soil layer (m)
+ real(dp),intent(in) :: nodeHeight ! height of the lowest unsaturated soil node (m)
+ ! input: diriclet boundary conditions
+ real(dp),intent(in) :: lowerBoundHead ! lower boundary condition for matric head (m)
+ real(dp),intent(in) :: lowerBoundTheta ! lower boundary condition for volumetric liquid water content (-)
+ ! input: derivative in soil water characteristix
+ real(dp),intent(in) :: node__dPsi_dTheta ! derivative of the soil moisture characteristic w.r.t. theta (m)
+ ! input: transmittance
+ real(dp),intent(in) :: surfaceSatHydCond ! saturated hydraulic conductivity at the surface (m s-1)
+ real(dp),intent(in) :: bottomSatHydCond ! saturated hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ real(dp),intent(in) :: nodeHydCond ! hydraulic conductivity at the node itself (m s-1)
+ real(dp),intent(in) :: iceImpedeFac ! ice impedence factor in the upper-most soil layer (-)
+ ! input: transmittance derivatives
+ real(dp),intent(in) :: dHydCond_dVolLiq ! derivative in hydraulic conductivity w.r.t. volumetric liquid water content (m s-1)
+ real(dp),intent(in) :: dHydCond_dMatric ! derivative in hydraulic conductivity w.r.t. matric head (s-1)
+ real(dp),intent(in) :: dHydCond_dTemp ! derivative in hydraulic conductivity w.r.t temperature (m s-1 K-1)
+ ! input: soil parameters
+ real(dp),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter (m-1)
+ real(dp),intent(in) :: vGn_n ! van Genutchen "n" parameter (-)
+ real(dp),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ real(dp),intent(in) :: theta_sat ! soil porosity (-)
+ real(dp),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(dp),intent(in) :: kAnisotropic ! anisotropy factor for lateral hydraulic conductivity (-)
+ real(dp),intent(in) :: zScale_TOPMODEL ! scale factor for TOPMODEL-ish baseflow parameterization (m)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! output: hydraulic conductivity at the bottom of the unsaturated zone
+ real(dp),intent(out) :: bottomHydCond ! hydraulic conductivity at the bottom of the unsaturated zone (m s-1)
+ real(dp),intent(out) :: bottomDiffuse ! hydraulic diffusivity at the bottom of the unsatuarted zone (m2 s-1)
+ ! output: drainage flux from the bottom of the soil profile
+ real(dp),intent(out) :: scalarDrainage ! drainage flux from the bottom of the soil profile (m s-1)
+ ! output: derivatives in drainage flux
+ real(dp),intent(out) :: dq_dHydStateUnsat ! change in drainage flux w.r.t. change in state variable in lowest unsaturated node (m s-1 or s-1)
+ real(dp),intent(out) :: dq_dNrgStateUnsat ! change in drainage flux w.r.t. change in energy state variable in lowest unsaturated node (m s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ real(dp) :: zWater ! effective water table depth (m)
+ real(dp) :: nodePsi ! matric head in the lowest unsaturated node (m)
+ real(dp) :: cflux ! capillary flux (m s-1)
+ ! -----------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="qDrainFlux/"
+
+ ! determine lower boundary condition
+ select case(bc_lower)
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * prescribed head
+ ! ---------------------------------------------------------------------------------------------
+ case(prescribedHead)
+
+ ! compute fluxes
+ select case(ixRichards) ! (moisture-based form of Richards' equation)
+ case(moisture)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ bottomHydCond = hydCond_liq(lowerBoundTheta,bottomSatHydCond,theta_res,theta_sat,vGn_m) * iceImpedeFac
+ bottomDiffuse = dPsi_dTheta(lowerBoundTheta,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * bottomHydCond
+ ! compute the capillary flux
+ cflux = -bottomDiffuse*(lowerBoundTheta - nodeVolFracLiq) / (nodeDepth*0.5_dp)
+ case(mixdform)
+ ! compute the hydraulic conductivity and diffusivity at the boundary
+ bottomHydCond = hydCond_psi(lowerBoundHead,bottomSatHydCond,vGn_alpha,vGn_n,vGn_m) * iceImpedeFac
+ bottomDiffuse = realMissing
+ ! compute the capillary flux
+ cflux = -bottomHydCond*(lowerBoundHead - nodeMatricHead) / (nodeDepth*0.5_dp)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select ! (form of Richards' eqn)
+ scalarDrainage = cflux + bottomHydCond
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = bottomDiffuse/(nodeDepth/2._dp)
+ case(mixdform); dq_dHydStateUnsat = bottomHydCond/(nodeDepth/2._dp)
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ dq_dNrgStateUnsat = -(dHydCond_dTemp/2._dp)*(lowerBoundHead - nodeMatricHead)/(nodeDepth*0.5_dp) + dHydCond_dTemp/2._dp
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * function of matric head in the bottom layer
+ ! ---------------------------------------------------------------------------------------------
+ case(funcBottomHead)
+
+ ! compute fluxes
+ select case(ixRichards)
+ case(moisture); nodePsi = matricHead(nodeVolFracLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ case(mixdform); nodePsi = nodeMatricHead
+ end select
+ zWater = nodeHeight - nodePsi
+ scalarDrainage = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * node__dPsi_dTheta*exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
+ case(mixdform); dq_dHydStateUnsat = kAnisotropic*surfaceSatHydCond * exp(-zWater/zScale_TOPMODEL)/zScale_TOPMODEL
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ err=20; message=trim(message)//"not yet implemented energy derivatives"; return
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * free drainage
+ ! ---------------------------------------------------------------------------------------------
+ case(freeDrainage)
+
+ ! compute flux
+ scalarDrainage = nodeHydCond*kAnisotropic
+
+ ! compute derivatives
+ if(deriv_desired)then
+ ! hydrology derivatives
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture); dq_dHydStateUnsat = dHydCond_dVolLiq*kAnisotropic
+ case(mixdform); dq_dHydStateUnsat = dHydCond_dMatric*kAnisotropic
+ case default; err=10; message=trim(message)//"unknown form of Richards' equation"; return
+ end select
+ ! energy derivatives
+ dq_dNrgStateUnsat = dHydCond_dTemp*kAnisotropic
+ else ! (do not desire derivatives)
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * zero flux
+ ! ---------------------------------------------------------------------------------------------
+ case(zeroFlux)
+ scalarDrainage = 0._dp
+ if(deriv_desired)then
+ dq_dHydStateUnsat = 0._dp
+ dq_dNrgStateUnsat = 0._dp
+ else
+ dq_dHydStateUnsat = realMissing
+ dq_dNrgStateUnsat = realMissing
+ end if
+
+ ! ---------------------------------------------------------------------------------------------
+ ! * error check
+ ! ---------------------------------------------------------------------------------------------
+ case default; err=20; message=trim(message)//'unknown lower boundary condition for soil hydrology'; return
+
+ end select ! (type of boundary condition)
+
+ end subroutine qDrainFlux
+
+
+ ! *******************************************************************************************************************************************************************************
+ ! *******************************************************************************************************************************************************************************
+
+
+end module soilLiqFlx_module
diff --git a/build/source/engine/ssdNrgFlux.f90 b/build/source/engine/ssdNrgFlux.f90
old mode 100755
new mode 100644
index 25fc68e..b9c7918
--- a/build/source/engine/ssdNrgFlux.f90
+++ b/build/source/engine/ssdNrgFlux.f90
@@ -20,288 +20,965 @@
module ssdNrgFlux_module
-! data types
-USE nrtype
-
-! data types
-USE data_types,only:var_d ! x%var(:) (dp)
-USE data_types,only:var_dlength ! x%var(:)%dat (dp)
-USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
-
-! physical constants
-USE multiconst,only:&
- sb, & ! Stefan Boltzman constant (W m-2 K-4)
- Em_Sno, & ! emissivity of snow (-)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- Cp_water, & ! specifric heat of water (J kg-1 K-1)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- gravity, & ! gravitational acceleteration (m s-2)
- Tfreeze, & ! freezing point of pure water (K)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of water (kg m-3)
-
-! missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing real number
-
-! named variables for snow and soil
-USE globalData,only:iname_snow ! named variables for snow
-USE globalData,only:iname_soil ! named variables for soil
-
-! named variables
-USE var_lookup,only:iLookPROG ! named variables for structure elements
-USE var_lookup,only:iLookDIAG ! named variables for structure elements
-USE var_lookup,only:iLookFLUX ! named variables for structure elements
-USE var_lookup,only:iLookPARAM ! named variables for structure elements
-USE var_lookup,only:iLookINDEX ! named variables for structure elements
-
-! model decisions
-USE globalData,only:model_decisions ! model decision structure
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-
-! provide access to look-up values for model decisions
-USE mDecisions_module,only: &
- ! look-up values for the numerical method
- iterative, & ! iterative
- nonIterative, & ! non-iterative
- iterSurfEnergyBal, & ! iterate only on the surface energy balance
- ! look-up values for method used to compute derivative
- numerical, & ! numerical solution
- analytical, & ! analytical solution
- ! look-up values for choice of boundary conditions for thermodynamics
- prescribedTemp, & ! prescribed temperature
- energyFlux, & ! energy flux
- zeroFlux, & ! zero flux
- ! look-up values for choice of boundary conditions for soil hydrology
- prescribedHead ! prescribed head
-
-! -------------------------------------------------------------------------------------------------
-implicit none
-private
-public::ssdNrgFlux
-! global parameters
-real(dp),parameter :: dx=1.e-10_dp ! finite difference increment (K)
-real(dp),parameter :: valueMissing=-9999._dp ! missing value parameter
-contains
-
- ! ************************************************************************************************
- ! public subroutine ssdNrgFlux: compute energy fluxes and derivatives at layer interfaces
- ! ************************************************************************************************
- subroutine ssdNrgFlux(&
- ! input: model control
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: fluxes and derivatives at the upper boundary
- groundNetFlux, & ! intent(in): total flux at the ground surface (W m-2)
- dGroundNetFlux_dGroundTemp, & ! intent(in): derivative in total ground surface flux w.r.t. ground temperature (W m-2 K-1)
- ! input: liquid water fluxes
- iLayerLiqFluxSnow, & ! intent(in): liquid flux at the interface of each snow layer (m s-1)
- iLayerLiqFluxSoil, & ! intent(in): liquid flux at the interface of each soil layer (m s-1)
- ! input: trial value of model state variabes
- mLayerTempTrial, & ! intent(in): trial temperature at the current iteration (K)
- mLayerMatricHeadTrial, & ! intent(in): trial matric head at the current iteration(m)
- mLayerVolFracLiqTrial, & ! intent(in): trial volumetric fraction of liquid water at the current iteration(-)
- mLayerVolFracIceTrial, & ! intent(in): trial volumetric fraction of ice water at the current iteration(-)
- ! input-output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- ! output: fluxes and derivatives at all layer interfaces
- iLayerNrgFlux, & ! intent(out): energy flux at the layer interfaces (W m-2)
- dFlux_dTempAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (W m-2 K-1)
- dFlux_dTempBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (W m-2 K-1)
- ! output: error control
- err,message) ! intent(out): error control
- implicit none
- ! input: model control
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input: fluxes and derivatives at the upper boundary
- real(dp),intent(in) :: groundNetFlux ! net energy flux for the ground surface (W m-2)
- real(dp),intent(in) :: dGroundNetFlux_dGroundTemp ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
- ! input: liquid water fluxes
- real(dp),intent(in) :: iLayerLiqFluxSnow(0:) ! intent(in): liquid flux at the interface of each snow layer (m s-1)
- real(dp),intent(in) :: iLayerLiqFluxSoil(0:) ! intent(in): liquid flux at the interface of each soil layer (m s-1)
- ! input: trial value of model state variables
- real(dp),intent(in) :: mLayerTempTrial(:) ! trial temperature of each snow/soil layer at the current iteration (K)
- real(dp),intent(in) :: mLayerMatricHeadTrial(:) ! matric head in each layer at the current iteration (m)
- real(dp),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid at the current iteration (-)
- real(dp),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
- ! input-output: data structures
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(in) :: indx_data ! state vector geometry
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- ! output: fluxes and derivatives at all layer interfaces
- real(dp),intent(out) :: iLayerNrgFlux(0:) ! energy flux at the layer interfaces (W m-2)
- real(dp),intent(out) :: dFlux_dTempAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
- real(dp),intent(out) :: dFlux_dTempBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- integer(i4b) :: iLayer ! index of model layers
- integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
- integer(i4b) :: ixTop ! top layer in subroutine call
- integer(i4b) :: ixBot ! bottom layer in subroutine call
- real(dp) :: qFlux ! liquid flux at layer interfaces (m s-1)
- real(dp) :: dz ! height difference (m)
- real(dp) :: flux0,flux1,flux2 ! fluxes used to calculate derivatives (W m-2)
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------
- ! make association of local variables with information in the data structures
- associate(&
- ix_fDerivMeth => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): method used to calculate flux derivatives
- ix_bcLowrTdyn => model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision, & ! intent(in): method used to calculate the lower boundary condition for thermodynamics
- ! input: model coordinates
- nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
- nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1), & ! intent(in): total number of layers
- layerType => indx_data%var(iLookINDEX%layerType)%dat, & ! intent(in): layer type (iname_soil or iname_snow)
- ixLayerState => indx_data%var(iLookINDEX%ixLayerState)%dat, & ! intent(in): list of indices for all model layers
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat, & ! intent(in): index in the state subset for energy state variables in the snow+soil domain
- ! input: thermal properties
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat, & ! intent(in): depth of each layer (m)
- mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat, & ! intent(in): height at the mid-point of each layer (m)
- iLayerThermalC => diag_data%var(iLookDIAG%iLayerThermalC)%dat, & ! intent(in): thermal conductivity at the interface of each layer (W m-1 K-1)
- lowerBoundTemp => mpar_data%var(iLookPARAM%lowerBoundTemp)%dat(1), & ! intent(in): temperature of the lower boundary (K)
- ! output: diagnostic fluxes
- iLayerConductiveFlux => flux_data%var(iLookFLUX%iLayerConductiveFlux)%dat, & ! intent(out): conductive energy flux at layer interfaces at end of time step (W m-2)
- iLayerAdvectiveFlux => flux_data%var(iLookFLUX%iLayerAdvectiveFlux)%dat & ! intent(out): advective energy flux at layer interfaces at end of time step (W m-2)
- ) ! association of local variables with information in the data structures
- ! ------------------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='ssdNrgFlux/'
-
- ! set conductive and advective fluxes to missing in the upper boundary
- ! NOTE: advective flux at the upper boundary is included in the ground heat flux
- iLayerConductiveFlux(0) = valueMissing
- iLayerAdvectiveFlux(0) = valueMissing
-
- ! get the indices for the snow+soil layers
- if(scalarSolution)then
- ixLayerDesired = pack(ixLayerState, ixSnowSoilNrg/=integerMissing)
- ixTop = ixLayerDesired(1)
- ixBot = ixLayerDesired(1)
- else
- ixTop = 1
- ixBot = nLayers
- endif
-
- ! -------------------------------------------------------------------------------------------------------------------------
- ! ***** compute the conductive fluxes at layer interfaces *****
- ! -------------------------------------------------------------------------------------------------------------------------
- do iLayer=ixTop,ixBot ! (loop through model layers)
-
- ! compute fluxes at the lower boundary -- positive downwards
- if(iLayer==nLayers)then
- ! flux depends on the type of lower boundary condition
- select case(ix_bcLowrTdyn) ! (identify the lower boundary condition for thermodynamics
- case(prescribedTemp); iLayerConductiveFlux(nLayers) = -iLayerThermalC(iLayer)*(lowerBoundTemp - mLayerTempTrial(iLayer))/(mLayerDepth(iLayer)*0.5_dp)
- case(zeroFlux); iLayerConductiveFlux(nLayers) = 0._dp
- case default; err=20; message=trim(message)//'unable to identify lower boundary condition for thermodynamics'; return
- end select ! (identifying the lower boundary condition for thermodynamics)
-
- ! compute fluxes within the domain -- positive downwards
- else
- iLayerConductiveFlux(iLayer) = -iLayerThermalC(iLayer)*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer)) / &
- (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
-
- !write(*,'(a,i4,1x,2(f9.3,1x))') 'iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer) = ', iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer)
- end if ! (the type of layer)
- end do
-
- ! -------------------------------------------------------------------------------------------------------------------------
- ! ***** compute the advective fluxes at layer interfaces *****
- ! -------------------------------------------------------------------------------------------------------------------------
- do iLayer=ixTop,ixBot
- ! get the liquid flux at layer interfaces
- select case(layerType(iLayer))
- case(iname_snow); qFlux = iLayerLiqFluxSnow(iLayer)
- case(iname_soil); qFlux = iLayerLiqFluxSoil(iLayer-nSnow)
- case default; err=20; message=trim(message)//'unable to identify layer type'; return
- end select
- ! compute fluxes at the lower boundary -- positive downwards
- if(iLayer==nLayers)then
- iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(lowerBoundTemp - mLayerTempTrial(iLayer))
- ! compute fluxes within the domain -- positive downwards
- else
- iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer))
- end if
- end do ! looping through layers
-
- ! -------------------------------------------------------------------------------------------------------------------------
- ! ***** compute the total fluxes at layer interfaces *****
- ! -------------------------------------------------------------------------------------------------------------------------
- ! NOTE: ignore advective fluxes for now
- iLayerNrgFlux(0) = groundNetFlux
- iLayerNrgFlux(ixTop:ixBot) = iLayerConductiveFlux(ixTop:ixBot)
- !print*, 'iLayerNrgFlux(0:4) = ', iLayerNrgFlux(0:4)
-
- ! -------------------------------------------------------------------------------------------------------------------------
- ! ***** compute the derivative in fluxes at layer interfaces w.r.t temperature in the layer above and the layer below *****
- ! -------------------------------------------------------------------------------------------------------------------------
-
- ! initialize un-used elements
- dFlux_dTempBelow(nLayers) = -huge(lowerBoundTemp) ! don't expect this to be used, so deliberately set to a ridiculous value to cause problems
-
- ! ***** the upper boundary
- dFlux_dTempBelow(0) = dGroundNetFlux_dGroundTemp
-
- ! loop through INTERFACES...
- do iLayer=ixTop,ixBot
-
- ! ***** the lower boundary
- if(iLayer==nLayers)then ! (lower boundary)
-
- ! identify the lower boundary condition
- select case(ix_bcLowrTdyn)
-
- ! * prescribed temperature at the lower boundary
- case(prescribedTemp)
-
- dz = mLayerDepth(iLayer)*0.5_dp
- if(ix_fDerivMeth==analytical)then ! ** analytical derivatives
- dFlux_dTempAbove(iLayer) = iLayerThermalC(iLayer)/dz
- else ! ** numerical derivatives
- flux0 = -iLayerThermalC(iLayer)*(lowerBoundTemp - (mLayerTempTrial(iLayer) ))/dz
- flux1 = -iLayerThermalC(iLayer)*(lowerBoundTemp - (mLayerTempTrial(iLayer)+dx))/dz
- dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
+ ! data types
+ USE nrtype
+
+ ! data types
+ USE data_types,only:var_d ! x%var(:) (rkind)
+ USE data_types,only:var_dlength ! x%var(:)%dat (rkind)
+ USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
+
+ ! physical constants
+ USE multiconst,only:&
+ sb, & ! Stefan Boltzman constant (W m-2 K-4)
+ Em_Sno, & ! emissivity of snow (-)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ gravity, & ! gravitational acceleteration (m s-2)
+ Tfreeze, & ! freezing point of pure water (K)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water, & ! intrinsic density of water (kg m-3)
+ ! specific heat
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ Cp_water, & ! specific heat of liquid water (J kg-1 K-1)
+ ! thermal conductivity
+ lambda_air, & ! thermal conductivity of air (J s-1 m-1)
+ lambda_ice, & ! thermal conductivity of ice (J s-1 m-1)
+ lambda_water ! thermal conductivity of water (J s-1 m-1)
+
+
+ ! missing values
+ USE globalData,only:integerMissing ! missing integer
+ USE globalData,only:realMissing ! missing real number
+
+ ! named variables for snow and soil
+ USE globalData,only:iname_snow ! named variables for snow
+ USE globalData,only:iname_soil ! named variables for soil
+
+ ! named variables
+ USE var_lookup,only:iLookPROG ! named variables for structure elements
+ USE var_lookup,only:iLookDIAG ! named variables for structure elements
+ USE var_lookup,only:iLookFLUX ! named variables for structure elements
+ USE var_lookup,only:iLookPARAM ! named variables for structure elements
+ USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+ ! model decisions
+ USE globalData,only:model_decisions ! model decision structure
+ USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+ ! provide access to look-up values for model decisions
+ USE mDecisions_module,only: &
+ ! look-up values for method used to compute derivative
+ numerical, & ! numerical solution
+ analytical, & ! analytical solution
+ ! look-up values for choice of boundary conditions for thermodynamics
+ prescribedTemp, & ! prescribed temperature
+ energyFlux, & ! energy flux
+ zeroFlux, & ! zero flux
+ ! look-up values for choice of boundary conditions for soil hydrology
+ prescribedHead, & ! prescribed head
+ ! look-up values for choice of thermal conductivity representation for snow
+ Yen1965, & ! Yen (1965)
+ Mellor1977, & ! Mellor (1977)
+ Jordan1991, & ! Jordan (1991)
+ Smirnova2000, & ! Smirnova et al. (2000)
+ ! look-up values for choice of thermal conductivity representation for soil
+ funcSoilWet, & ! function of soil wetness
+ mixConstit, & ! mixture of constituents
+ hanssonVZJ, & ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
+ ! look-up values for the form of Richards' equation
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+ ! -------------------------------------------------------------------------------------------------
+ implicit none
+ private
+ public::ssdNrgFlux
+ ! global parameters
+ real(rkind),parameter :: dx=1.e-10_rkind ! finite difference increment (K)
+ contains
+
+
+ ! **********************************************************************************************************
+ ! public subroutine ssdNrgFlux: compute energy fluxes and derivatives at layer interfaces
+ ! **********************************************************************************************************
+ subroutine ssdNrgFlux(&
+ ! input: model control
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ! input: fluxes and derivatives at the upper boundary
+ groundNetFlux, & ! intent(in): total flux at the ground surface (W m-2)
+ dGroundNetFlux_dGroundTemp, & ! intent(in): derivative in total ground surface flux w.r.t. ground temperature (W m-2 K-1)
+ ! input: liquid water fluxes
+ iLayerLiqFluxSnow, & ! intent(in): liquid flux at the interface of each snow layer (m s-1)
+ iLayerLiqFluxSoil, & ! intent(in): liquid flux at the interface of each soil layer (m s-1)
+ ! input: trial value of model state variables
+ mLayerTempTrial, & ! intent(in): trial temperature at the current iteration (K)
+ mLayerMatricHeadTrial, & ! intent(in): trial matric head at the current iteration(m)
+ mLayerVolFracLiqTrial, & ! intent(in): trial volumetric fraction of liquid water at the current iteration(-)
+ mLayerVolFracIceTrial, & ! intent(in): trial volumetric fraction of ice water at the current iteration(-)
+ ! input: pre-computed derivatives
+ mLayerdTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ mLayerFracLiqSnow, & ! intent(in): fraction of liquid water (-)
+ ! input-output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! output: fluxes and derivatives at all layer interfaces
+ iLayerNrgFlux, & ! intent(out): energy flux at the layer interfaces (W m-2)
+ dFlux_dTempAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (W m-2 K-1)
+ dFlux_dTempBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (W m-2 K-1)
+ dFlux_dWatAbove, & ! intent(out): derivatives in the flux w.r.t. water state in the layer above (W m-2 K-1)
+ dFlux_dWatBelow, & ! intent(out): derivatives in the flux w.r.t. water state in the layer below (W m-2 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! utility modules
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+ USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+ USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+ USE snow_utils_module,only:fracliquid ! compute fraction of liquid water at a given temperature
+ USE soil_utils_module,only:dTheta_dPsi ! compute derivative of the soil moisture characteristic w.r.t. psi (m-1)
+ USE soil_utils_module,only:dPsi_dTheta ! compute derivative of the soil moisture characteristic w.r.t. theta (m)
+
+ ! constants
+ USE multiconst, only: gravity, & ! gravitational acceleration (m s-1)
+ Tfreeze, & ! freezing point of water (K)
+ iden_water,iden_ice,& ! intrinsic density of water and ice (kg m-3)
+ LH_fus ! latent heat of fusion (J kg-1)
+ ! -------------------------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ logical(lgt),intent(in) :: deriv_desired ! flag indicating if derivatives are desired
+ ! input: fluxes and derivatives at the upper boundary
+ real(rkind),intent(in) :: groundNetFlux ! net energy flux for the ground surface (W m-2)
+ real(rkind),intent(inout) :: dGroundNetFlux_dGroundTemp ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
+ ! input: liquid water fluxes
+ real(rkind),intent(in) :: iLayerLiqFluxSnow(0:) ! liquid flux at the interface of each snow layer (m s-1)
+ real(rkind),intent(in) :: iLayerLiqFluxSoil(0:) ! liquid flux at the interface of each soil layer (m s-1)
+ ! input: trial model state variables
+ real(rkind),intent(in) :: mLayerTempTrial(:) ! temperature in each layer at the current iteration (m)
+ real(rkind),intent(in) :: mLayerMatricHeadTrial(:) ! matric head in each layer at the current iteration (m)
+ real(rkind),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid at the current iteration (-)
+ real(rkind),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
+ ! input: pre-computed derivatives
+ real(rkind),intent(in) :: mLayerdTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: mLayerFracLiqSnow(:) ! fraction of liquid water (-)
+ ! input-output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! state vector geometry
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ ! output: fluxes and derivatives at all layer interfaces
+ real(rkind),intent(out) :: iLayerNrgFlux(0:) ! energy flux at the layer interfaces (W m-2)
+ real(rkind),intent(out) :: dFlux_dTempAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
+ real(rkind),intent(out) :: dFlux_dTempBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
+ real(rkind),intent(out) :: dFlux_dWatAbove(0:) ! derivatives in the flux w.r.t. water state in the layer above (J m-2 s-1 K-1)
+ real(rkind),intent(out) :: dFlux_dWatBelow(0:) ! derivatives in the flux w.r.t. water state in the layer below (J m-2 s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: i,j,iLayer ! index of model layers
+ integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
+ integer(i4b) :: ixTop ! top layer in subroutine call
+ integer(i4b) :: ixBot ! bottom layer in subroutine call
+ real(rkind) :: qFlux ! liquid flux at layer interfaces (m s-1)
+ real(rkind) :: dz ! height difference (m)
+ ! additional variables to compute numerical derivatives
+ integer(i4b) :: nFlux ! number of flux calculations required (>1 = numerical derivatives with one-sided finite differences)
+ integer(i4b) :: itry ! index of different flux calculations
+ integer(i4b),parameter :: unperturbed=0 ! named variable to identify the case of unperturbed state variables
+ integer(i4b),parameter :: perturbState=1 ! named variable to identify the case where we perturb the state in the current layer
+ integer(i4b),parameter :: perturbStateTempAbove=2 ! named variable to identify the case where we perturb the state layer above
+ integer(i4b),parameter :: perturbStateTempBelow=3 ! named variable to identify the case where we perturb the state layer below
+ integer(i4b),parameter :: perturbStateWatAbove=4 ! named variable to identify the case where we perturb the state layer above
+ integer(i4b),parameter :: perturbStateWatBelow=5 ! named variable to identify the case where we perturb the state layer below
+ integer(i4b) :: ixPerturb ! index of element in 2-element vector to perturb
+ integer(i4b) :: ixOriginal ! index of perturbed element in the original vector
+ real(rkind) :: scalarThermCFlux ! thermal conductivity (W m-1 K-1)
+ real(rkind) :: scalarThermCFlux_dTempAbove ! thermal conductivity with perturbation to the temperature state above (W m-1 K-1)
+ real(rkind) :: scalarThermCFlux_dTempBelow ! thermal conductivity with perturbation to the temperature state below (W m-1 K-1)
+ real(rkind) :: scalarThermCFlux_dWatAbove ! thermal conductivity with perturbation to the water state above
+ real(rkind) :: scalarThermCFlux_dWatBelow ! thermal conductivity with perturbation to the water state below
+ real(rkind) :: flux0,flux1,flux2 ! fluxes used to calculate derivatives (W m-2)
+ ! compute fluxes and derivatives at layer interfaces
+ integer(i4b),dimension(2) :: mLayer_ind ! indices of above and below layers
+ integer(i4b),dimension(2) :: iLayer_ind ! indices of above and below interfaces
+ real(rkind) :: matricFHead ! matric head for frozen soil
+ real(rkind) :: Tcrit ! temperature where all water is unfrozen (K)
+ real(rkind) :: fLiq ! fraction of liquid water (-)
+ real(rkind),dimension(2) :: vectorMatricHeadTrial ! trial value of matric head (m)
+ real(rkind),dimension(2) :: vectorVolFracLiqTrial ! trial value of volumetric liquid content (-)
+ real(rkind),dimension(2) :: vectorVolFracIceTrial ! trial value of volumetric ice content (-)
+ real(rkind),dimension(2) :: vectorTempTrial ! trial value of temperature (K)
+ real(rkind),dimension(2) :: vectordTheta_dPsi ! derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(rkind),dimension(2) :: vectordPsi_dTheta ! derivative in the soil water characteristic w.r.t. theta (m)
+ real(rkind),dimension(2) :: vectorFracLiqSnow ! fraction of liquid water (-)
+ real(rkind),dimension(2) :: vectortheta_sat ! layer above and below soil porosity (-)
+ real(rkind),dimension(2) :: vectoriden_soil ! layer above and below density of soil (kg m-3)
+ real(rkind),dimension(2) :: vectorthCond_soil ! layer above and below thermal conductivity of soil (W m-1 K-1)
+ real(rkind),dimension(2) :: vectorfrac_sand ! layer above and below fraction of sand (-)
+ real(rkind),dimension(2) :: vectorfrac_clay ! layer above and below fraction of clay (-)
+ ! recompute the perturbed version of iLayerThermalC, this could be the only version and remove the omputThermConduct_module
+ real(rkind) :: dThermalC_dHydStateAbove ! derivative in the thermal conductivity w.r.t. water state in the layer above
+ real(rkind) :: dThermalC_dHydStateBelow ! derivative in the thermal conductivity w.r.t. water state in the layer above
+ real(rkind) :: dThermalC_dNrgStateAbove ! derivative in the thermal conductivity w.r.t. energy state in the layer above
+ real(rkind) :: dThermalC_dNrgStateBelow ! derivative in the thermal conductivity w.r.t. energy state in the layer above
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! make association of local variables with information in the data structures
+ associate(&
+ ixDerivMethod => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): method used to calculate flux derivatives
+ ix_bcUpprTdyn => model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision, & ! intent(in): method used to calculate the upper boundary condition for thermodynamics
+ ix_bcLowrTdyn => model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision, & ! intent(in): method used to calculate the lower boundary condition for thermodynamics
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision, & ! intent(in): index of the form of Richards' equation
+ ixThCondSnow => model_decisions(iLookDECISIONS%thCondSnow)%iDecision, & ! intent(in): choice of method for thermal conductivity of snow
+ ixThCondSoil => model_decisions(iLookDECISIONS%thCondSoil)%iDecision, & ! intent(in): choice of method for thermal conductivity of soil
+ ! input: model coordinates
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1), & ! intent(in): total number of layers
+ layerType => indx_data%var(iLookINDEX%layerType)%dat, & ! intent(in): layer type (iname_soil or iname_snow)
+ ixLayerState => indx_data%var(iLookINDEX%ixLayerState)%dat, & ! intent(in): list of indices for all model layers
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat, & ! intent(in): index in the state subset for energy state variables in the snow+soil domain
+ ! input: thermal properties
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat, & ! intent(in): depth of each layer (m)
+ mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat, & ! intent(in): height at the mid-point of each layer (m)
+ upperBoundTemp => mpar_data%var(iLookPARAM%upperBoundTemp)%dat(1), & ! intent(in): temperature of the upper boundary (K)
+ lowerBoundTemp => mpar_data%var(iLookPARAM%lowerBoundTemp)%dat(1), & ! intent(in): temperature of the lower boundary (K)
+ iLayerHeight => prog_data%var(iLookPROG%iLayerHeight)%dat, & ! intent(in): height at the interface of each layer (m)
+ fixedThermalCond_snow => mpar_data%var(iLookPARAM%fixedThermalCond_snow)%dat(1), & ! intent(in): temporally constant thermal conductivity of snow (W m-1 K-1)
+ iLayerThermalC => diag_data%var(iLookDIAG%iLayerThermalC)%dat, & ! intent(inout): thermal conductivity at the interface of each layer (W m-1 K-1)
+ ! input: depth varying soil parameters
+ iden_soil => mpar_data%var(iLookPARAM%soil_dens_intr)%dat, & ! intent(in): intrinsic density of soil (kg m-3)
+ thCond_soil => mpar_data%var(iLookPARAM%thCond_soil)%dat, & ! intent(in): thermal conductivity of soil (W m-1 K-1)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat, & ! intent(in): soil porosity (-)
+ frac_sand => mpar_data%var(iLookPARAM%frac_sand)%dat, & ! intent(in): fraction of sand (-)
+ frac_clay => mpar_data%var(iLookPARAM%frac_clay)%dat, & ! intent(in): fraction of clay (-)
+ vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat, & ! intent(in): [dp(:)] van Genutchen "m" parameter (-)
+ vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat, & ! intent(in): [dp(:)] van Genutchen "n" parameter (-)
+ vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat, & ! intent(in): [dp(:)] van Genutchen "alpha" parameter (m-1)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat, & ! intent(in): [dp(:)] soil residual volumetric water content (-)
+ ! input: snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1), & ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! output: diagnostic fluxes
+ iLayerConductiveFlux => flux_data%var(iLookFLUX%iLayerConductiveFlux)%dat, & ! intent(out): conductive energy flux at layer interfaces at end of time step (W m-2)
+ iLayerAdvectiveFlux => flux_data%var(iLookFLUX%iLayerAdvectiveFlux)%dat & ! intent(out): advective energy flux at layer interfaces at end of time step (W m-2)
+ ) ! association of local variables with information in the data structures
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='ssdNrgFlux/'
+
+ ! set conductive and advective fluxes to missing in the upper boundary
+ ! NOTE: advective flux at the upper boundary is included in the ground heat flux
+ iLayerConductiveFlux(0) = realMissing
+ iLayerAdvectiveFlux(0) = realMissing
+
+ ! check the need to compute numerical derivatives
+ if(ixDerivMethod==numerical)then
+ nFlux=5 ! compute the derivatives and cross derivates using one-sided finite differences
+ else
+ nFlux=0 ! compute analytical derivatives
end if
-
- ! * zero flux at the lower boundary
- case(zeroFlux)
- dFlux_dTempAbove(iLayer) = 0._dp
-
- case default; err=20; message=trim(message)//'unable to identify lower boundary condition for thermodynamics'; return
-
- end select ! (identifying the lower boundary condition for thermodynamics)
-
- ! ***** internal layers
- else
- dz = (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
- if(ix_fDerivMeth==analytical)then ! ** analytical derivatives
- dFlux_dTempAbove(iLayer) = iLayerThermalC(iLayer)/dz
- dFlux_dTempBelow(iLayer) = -iLayerThermalC(iLayer)/dz
- else ! ** numerical derivatives
- flux0 = -iLayerThermalC(iLayer)*( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
- flux1 = -iLayerThermalC(iLayer)*( mLayerTempTrial(iLayer+1) - (mLayerTempTrial(iLayer)+dx)) / dz
- flux2 = -iLayerThermalC(iLayer)*((mLayerTempTrial(iLayer+1)+dx) - mLayerTempTrial(iLayer) ) / dz
- dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
- dFlux_dTempBelow(iLayer) = (flux2 - flux0)/dx
- end if
-
- end if ! type of layer (upper, internal, or lower)
-
- end do ! (looping through layers)
-
- ! end association of local variables with information in the data structures
- end associate
-
- end subroutine ssdNrgFlux
-
-end module ssdNrgFlux_module
-
+
+ ! get the indices for the snow+soil layers
+ if(scalarSolution)then
+ ixLayerDesired = pack(ixLayerState, ixSnowSoilNrg/=integerMissing)
+ ixTop = ixLayerDesired(1)
+ ixBot = ixLayerDesired(1)
+ else
+ ixTop = 0 !include layer 0 in layer interface derivatives
+ ixBot = nLayers
+ endif
+
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the derivative in fluxes at layer interfaces w.r.t state in the layer above and the layer below *****
+ ! -------------------------------------------------------------------------------------------------------------------
+
+ ! initialize un-used elements
+ ! ***** the upper boundary
+ dFlux_dTempAbove(0) = 0._rkind ! this will be in canopy
+ dFlux_dWatAbove(0) = 0._rkind ! this will be in canopy
+
+ ! ***** the lower boundary
+ dFlux_dTempBelow(nLayers) = -huge(lowerBoundTemp) ! don't expect this to be used, so deliberately set to a ridiculous value to cause problems
+ dFlux_dWatBelow(nLayers) = -huge(lowerBoundTemp) ! don't expect this to be used, so deliberately set to a ridiculous value to cause problems
+
+ ! loop through INTERFACES...
+ do iLayer=ixTop,ixBot
+
+ ! either one or multiple flux calls, depending on if using analytical or numerical derivatives
+ do itry=nFlux,0,-1 ! (work backwards to ensure all computed fluxes come from the un-perturbed case)
+
+ ! =====
+ ! determine layer to perturb
+ ! ==========================
+ select case(itry)
+ ! skip undesired perturbations
+ case(perturbState); cycle ! perturbing the layers above and below the flux at the interface
+ ! identify the index for the perturbation
+ case(unperturbed); ixPerturb = 0
+ case(perturbStateTempAbove)
+ if(iLayer==0) cycle ! cannot perturb state above (does not exist) -- so keep cycling
+ ixPerturb = 1
+ case(perturbStateTempBelow)
+ if(iLayer==nLayers) cycle ! cannot perturb state below (does not exist) -- so keep cycling
+ ixPerturb = 2
+ case(perturbStateWatAbove)
+ if(iLayer==0) cycle ! cannot perturb state above (does not exist) -- so keep cycling
+ ixPerturb = 3
+ case(perturbStateWatBelow)
+ if(iLayer==nLayers) cycle ! cannot perturb state below (does not exist) -- so keep cycling
+ ixPerturb = 4
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select ! (identifying layer to of perturbation)
+ ! determine the index in the original vector
+ ixOriginal = iLayer + (ixPerturb-1)
+
+ ! =====
+ ! set indices and parameters needed for layer perturbation
+ ! ========================================================
+ mLayer_ind(1) = iLayer
+ mLayer_ind(2) = iLayer+1
+ if (iLayer==0 ) mLayer_ind(1) = 1
+ if (iLayer==nLayers ) mLayer_ind(2) = nLayers
+ ! indices of interface are different at top layer since interface 0 exists
+ iLayer_ind = mLayer_ind
+ if (iLayer==0 ) iLayer_ind(1) = 0
+
+ ! =====
+ ! get input state variables...
+ ! ============================
+ ! start with the un-perturbed case
+ vectorVolFracLiqTrial(1:2) = mLayerVolFracLiqTrial(mLayer_ind)
+ vectorMatricHeadTrial(1:2) = mLayerMatricHeadTrial(mLayer_ind-nSnow)
+ vectorTempTrial(1:2) = mLayerTempTrial(mLayer_ind)
+ vectorVolFracIceTrial(1:2) = mLayerVolFracIceTrial(mLayer_ind)
+ ! make appropriate perturbations,
+ if(ixPerturb > 2)then
+ vectorMatricHeadTrial(ixPerturb-2) = vectorMatricHeadTrial(ixPerturb-2) + dx
+ vectorVolFracLiqTrial(ixPerturb-2) = vectorVolFracLiqTrial(ixPerturb-2) + dx
+ else if(ixPerturb > 0)then
+ vectorTempTrial(ixPerturb) = vectorTempTrial(ixPerturb) + dx
+ endif
+
+ ! *****
+ ! * compute the volumetric fraction of liquid, ice, and air in each layer in response to perturbation ...
+ ! *******************************************************************************************************
+
+ do i = 1,2 !(layer above and below)
+ select case(layerType(mLayer_ind(i))) !(snow or soil)
+
+ case(iname_soil)
+ j = mLayer_ind(i)-nSnow !soil layer
+ if(ixPerturb > 0)then ! only recompute these if perturbed
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture) !
+ vectorMatricHeadTrial(i) = matricHead(vectorVolFracLiqTrial(i),vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ Tcrit = crit_soilT(vectorMatricHeadTrial(i))
+ !if change temp and below critical, it changes the state variable, seems like a problem FIX
+ if(vectorTempTrial(i) < Tcrit) then !if do not perturb temperature, this should not change
+ matricFHead = (LH_fus/gravity)*(vectorTempTrial(i) - Tfreeze)/Tfreeze
+ vectorVolFracLiqTrial(i) = volFracLiq(matricFHead,vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ endif
+ case(mixdform)
+ Tcrit = crit_soilT(vectorMatricHeadTrial(i))
+ if(vectorTempTrial(i) < Tcrit) then !if do not perturb temperature, this should not change, but matricHeadTrial will have changed
+ matricFHead = (LH_fus/gravity)*(vectorTempTrial(i) - Tfreeze)/Tfreeze
+ vectorVolFracLiqTrial(i) = volFracLiq(matricFHead,vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ else
+ vectorVolFracLiqTrial(i) = volFracLiq(vectorMatricHeadTrial(i),vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ endif
+ end select ! (form of Richards' equation)
+ vectorVolFracIceTrial(i) = volFracLiq(vectorMatricHeadTrial(i),vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j)) - vectorVolFracLiqTrial(i)
+ endif ! (recompute if perturbed)
+ ! derivatives, these need to be computed because they are computed only in soilLiqFlx which is called after this
+ vectordPsi_dTheta(i) = dPsi_dTheta(vectorVolFracLiqTrial(i),vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ vectordTheta_dPsi(i) = dTheta_dPsi(vectorMatricHeadTrial(i),vGn_alpha(j),theta_res(j),theta_sat(j),vGn_n(j),vGn_m(j))
+ vectorFracLiqSnow(i) = realMissing
+ ! soil parameters
+ vectortheta_sat(i) = theta_sat(j)
+ vectoriden_soil(i) = iden_soil(j)
+ vectorthCond_soil(i) = thCond_soil(j)
+ vectorfrac_sand(i) = frac_sand(j)
+ vectorfrac_clay(i) = frac_clay(j)
+
+ case(iname_snow)
+ fLiq = fracliquid(vectorTempTrial(i),snowfrz_scale) ! fraction of liquid water
+ if(ixPerturb > 0) vectorVolFracIceTrial(i) = ( vectorVolFracLiqTrial(i) / fLiq - vectorVolFracLiqTrial(i) )*(iden_water/iden_ice) ! use perturbed nodeVolTotWatTrial
+ ! derivatives
+ vectordPsi_dTheta(i) = realMissing
+ vectordTheta_dPsi(i) = realMissing
+ vectorFracLiqSnow(i) = mLayerFracLiqSnow(mLayer_ind(i))
+ ! soil parameters do not exist
+ vectortheta_sat(i) = realMissing
+ vectoriden_soil(i) = realMissing
+ vectorthCond_soil(i) = realMissing
+ vectorfrac_sand(i) = realMissing
+ vectorfrac_clay(i) = realMissing
+
+ case default; err=20; message=trim(message)//'unable to identify type of layer (snow or soil) to compute volumetric fraction of air'; return
+
+ end select !(snow or soil)
+ enddo !(layer above and below)
+
+ ! =====
+ ! get thermal conductivity at layer interface and its derivative w.r.t. the state above and the state below...
+ ! ============================================================================================================
+ call iLayerThermalConduct(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): index defining the form of Richards' equation (moisture or mixdform)
+ ixThCondSnow, & ! intent(in): choice of method for thermal conductivity of snow
+ ixThCondSoil, & ! intent(in): choice of method for thermal conductivity of soil
+ ! input: coordinate variables
+ nLayers, & ! intent(in): number of layers
+ iLayer, & ! intent(in): layer index for output
+ layerType(mLayer_ind), & ! intent(in): layer type (iname_soil or iname_snow)
+ ! input: state variables (adjacent layers)
+ vectorMatricHeadTrial, & ! intent(in): matric head at the nodes (m)
+ vectorVolFracLiqTrial, & ! intent(in): volumetric liquid water at the nodes (m)
+ vectorVolFracIceTrial, & ! intent(in): volumetric ice at the nodes (m)
+ vectorTempTrial, & ! intent(in): temperature at the nodes (m)
+ ! input: pre-computed derivatives
+ mLayerdTheta_dTk(mLayer_ind), & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ vectorFracLiqSnow, & ! intent(in): fraction of liquid water (-)
+ vectordTheta_dPsi, & ! intent(in): derivative in the soil water characteristic w.r.t. psi (m-1)
+ vectordPsi_dTheta, & ! intent(in): derivative in the soil water characteristic w.r.t. theta (m)
+ ! input: model coordinate variables (adjacent layers)
+ mLayerHeight(mLayer_ind), & ! intent(in): height at the mid-point of the node (m)
+ iLayerHeight(iLayer_ind), & ! intent(in): height at the interface of the nodes (m)
+ ! input: soil parameters
+ vectortheta_sat, & ! intent(in): soil porosity (-)
+ vectoriden_soil, & ! intent(in): intrinsic density of soil (kg m-3)
+ vectorthCond_soil, & ! intent(in): thermal conductivity of soil (W m-1 K-1)
+ vectorfrac_sand, & ! intent(in): fraction of sand (-)
+ vectorfrac_clay, & ! intent(in): fraction of clay (-)
+ ! input: snow parameters
+ fixedThermalCond_snow, & ! intent(in): temporally constant thermal conductivity of snow (W m-1 K-1)
+ ! output: conductivity at the layer interface (scalars)
+ iLayerThermalC(iLayer), & ! intent(inout): thermal conductivity at the interface of each layer (W m-1 K-1)
+ ! output: derivatives in thermal conductivity w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below
+ dThermalC_dHydStateAbove, & ! intent(out): derivative in the thermal conductivity w.r.t. water state in the layer above
+ dThermalC_dHydStateBelow, & ! intent(out): derivative in the thermal conductivity w.r.t. water state in the layer above
+ ! output: derivatives in thermal conductivity w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (W m-1 K-2)
+ dThermalC_dNrgStateAbove, & ! intent(out): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ dThermalC_dNrgStateBelow, & ! intent(out): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ ! compute total vertical flux, to compute derivatives
+ if(deriv_desired .and. ixDerivMethod==numerical)then
+ select case(itry)
+ case(unperturbed); scalarThermCFlux = iLayerThermalC(iLayer)
+ case(perturbStateTempAbove); scalarThermCFlux_dTempAbove = iLayerThermalC(iLayer)
+ case(perturbStateTempBelow); scalarThermCFlux_dTempBelow = iLayerThermalC(iLayer)
+ case(perturbStateWatAbove); scalarThermCFlux_dWatAbove = iLayerThermalC(iLayer)
+ case(perturbStateWatBelow); scalarThermCFlux_dWatBelow = iLayerThermalC(iLayer)
+ case default; err=10; message=trim(message)//"unknown perturbation"; return
+ end select
+ end if
+
+ end do ! (looping through different flux calculations -- one or multiple calls depending if desire for numerical or analytical derivatives)
+
+
+ ! ***** the upper boundary
+ if(iLayer==0)then ! (upper boundary)
+
+ ! identify the upper boundary condition
+ select case(ix_bcUpprTdyn)
+
+ ! * prescribed temperature at the upper boundary
+ case(prescribedTemp)
+ dz = (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+ if(ixDerivMethod==analytical)then ! ** analytical derivatives
+ dFlux_dWatBelow(iLayer) = -dThermalC_dHydStateBelow * ( mLayerTempTrial(iLayer+1) - upperBoundTemp )/dz
+ dFlux_dTempBelow(iLayer) = -dThermalC_dNrgStateBelow * ( mLayerTempTrial(iLayer+1) - upperBoundTemp )/dz - iLayerThermalC(iLayer)/dz
+ else ! ** numerical derivatives
+ flux0 = -scalarThermCFlux *( mLayerTempTrial(iLayer+1) - upperBoundTemp ) / dz
+ flux2 = -scalarThermCFlux_dWatBelow*( mLayerTempTrial(iLayer+1) - upperBoundTemp ) / dz
+ dFlux_dWatBelow(iLayer) = (flux2 - flux0)/dx
+ flux0 = -scalarThermCFlux *( mLayerTempTrial(iLayer+1) - upperBoundTemp ) / dz
+ flux2 = -scalarThermCFlux_dTempBelow*((mLayerTempTrial(iLayer+1)+dx) - upperBoundTemp ) / dz
+ dFlux_dTempBelow(iLayer) = (flux2 - flux0)/dx
+ end if
+
+ ! * zero flux at the upper boundary
+ case(zeroFlux)
+ dFlux_dWatBelow(iLayer) = 0._rkind
+ dFlux_dTempBelow(iLayer) = 0._rkind
+
+ ! * compute flux inside vegetation energy flux routine, use here
+ case(energyFlux)
+ dFlux_dWatBelow(iLayer) = 0._rkind !dGroundNetFlux_dGroundWat, does not exist in vegNrgFlux
+ dFlux_dTempBelow(iLayer) = dGroundNetFlux_dGroundTemp
+
+ case default; err=20; message=trim(message)//'unable to identify upper boundary condition for thermodynamics'; return
+
+ end select ! (identifying the upper boundary condition for thermodynamics)
+ !dGroundNetFlux_dGroundWat = dFlux_dWatBelow(iLayer) ! this is true, but since not used in vegNrgFlux do not define
+ dGroundNetFlux_dGroundTemp = dFlux_dTempBelow(iLayer) ! need this in vegNrgFlux
+
+ ! ***** the lower boundary
+ else if(iLayer==nLayers)then ! (lower boundary)
+
+ ! identify the lower boundary condition
+ select case(ix_bcLowrTdyn)
+
+ ! * prescribed temperature at the lower boundary
+ case(prescribedTemp)
+ dz = mLayerDepth(iLayer)*0.5_rkind
+ if(ixDerivMethod==analytical)then ! ** analytical derivatives
+ dFlux_dWatAbove(iLayer) = -dThermalC_dHydStateAbove * ( lowerBoundTemp - mLayerTempTrial(iLayer) )/dz
+ dFlux_dTempAbove(iLayer) = -dThermalC_dNrgStateAbove * ( lowerBoundTemp - mLayerTempTrial(iLayer) )/dz + iLayerThermalC(iLayer)/dz
+ else ! ** numerical derivatives
+ flux0 = -scalarThermCFlux * ( lowerBoundTemp - mLayerTempTrial(iLayer) )/dz
+ flux1 = -scalarThermCFlux_dWatAbove * ( lowerBoundTemp - mLayerTempTrial(iLayer) )/dz
+ dFlux_dWatAbove(iLayer) = (flux1 - flux0)/dx
+ flux0 = -scalarThermCFlux * ( lowerBoundTemp - mLayerTempTrial(iLayer) )/dz
+ flux1 = -scalarThermCFlux_dTempAbove * ( lowerBoundTemp - (mLayerTempTrial(iLayer)+dx) )/dz
+ dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
+ end if
+
+ ! * zero flux at the lower boundary
+ case(zeroFlux)
+ dFlux_dWatAbove(iLayer) = 0._rkind
+ dFlux_dTempAbove(iLayer) = 0._rkind
+
+ case default; err=20; message=trim(message)//'unable to identify lower boundary condition for thermodynamics'; return
+
+ end select ! (identifying the lower boundary condition for thermodynamics)
+
+ ! ***** internal layers
+
+ else
+ dz = (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+ if(ixDerivMethod==analytical)then ! ** analytical derivatives
+ dFlux_dWatAbove(iLayer) = -dThermalC_dHydStateAbove * ( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) )/dz
+ dFlux_dWatBelow(iLayer) = -dThermalC_dHydStateBelow * ( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) )/dz
+ dFlux_dTempAbove(iLayer) = -dThermalC_dNrgStateAbove * ( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) )/dz + iLayerThermalC(iLayer)/dz
+ dFlux_dTempBelow(iLayer) = -dThermalC_dNrgStateBelow * ( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) )/dz - iLayerThermalC(iLayer)/dz
+ else ! ** numerical derivatives
+ flux0 = -scalarThermCFlux *( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
+ flux1 = -scalarThermCFlux_dWatAbove*( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
+ flux2 = -scalarThermCFlux_dWatBelow*( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
+ dFlux_dWatAbove(iLayer) = (flux1 - flux0)/dx
+ dFlux_dWatBelow(iLayer) = (flux2 - flux0)/dx
+ flux0 = -scalarThermCFlux *( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
+ flux1 = -scalarThermCFlux_dTempAbove*( mLayerTempTrial(iLayer+1) - (mLayerTempTrial(iLayer)+dx)) / dz
+ flux2 = -scalarThermCFlux_dTempBelow*((mLayerTempTrial(iLayer+1)+dx) - mLayerTempTrial(iLayer) ) / dz
+ dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
+ dFlux_dTempBelow(iLayer) = (flux2 - flux0)/dx
+ end if
+
+ end if ! type of layer (upper, internal, or lower)
+
+ end do ! (looping through layers)
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the conductive fluxes at layer interfaces *****
+ ! Compute flux after the derivatives, because need iLayerThermal as calculated above
+ ! -------------------------------------------------------------------------------------------------------------------------
+ do iLayer=ixTop,ixBot ! (loop through model layers)
+
+ if(iLayer==0)then ! (upper boundary fluxes -- positive downwards)
+ ! flux depends on the type of upper boundary condition
+ select case(ix_bcUpprTdyn) ! (identify the upper boundary condition for thermodynamics
+ case(prescribedTemp); iLayerConductiveFlux(iLayer) = -iLayerThermalC(iLayer)*( mLayerTempTrial(iLayer+1) - upperBoundTemp )/ &
+ (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+ case(zeroFlux); iLayerConductiveFlux(iLayer) = 0._rkind
+ case(energyFlux); iLayerConductiveFlux(iLayer) = groundNetFlux !from vegNrgFlux module
+ end select ! (identifying the lower boundary condition for thermodynamics)
+
+ else if(iLayer==nLayers)then ! (lower boundary fluxes -- positive downwards)
+ ! flux depends on the type of lower boundary condition
+ select case(ix_bcLowrTdyn) ! (identify the lower boundary condition for thermodynamics
+ case(prescribedTemp); iLayerConductiveFlux(iLayer) = -iLayerThermalC(iLayer)*(lowerBoundTemp - mLayerTempTrial(iLayer))/(mLayerDepth(iLayer)*0.5_rkind)
+ case(zeroFlux); iLayerConductiveFlux(iLayer) = 0._rkind
+ end select ! (identifying the lower boundary condition for thermodynamics)
+
+ else ! (domain boundary fluxes -- positive downwards)
+ iLayerConductiveFlux(iLayer) = -iLayerThermalC(iLayer)*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer)) / &
+ (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+
+ !write(*,'(a,i4,1x,2(f9.3,1x))') 'iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer) = ', iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer)
+ end if ! (the type of layer)
+ end do ! looping through layers
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the advective fluxes at layer interfaces *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+ do iLayer=ixTop,ixBot !(loop through model layers)
+
+ if (iLayer==0) then
+ iLayerAdvectiveFlux(iLayer) = realMissing !advective flux at the upper boundary is included in the ground heat flux
+ else ! get the liquid flux at layer interfaces
+ select case(layerType(iLayer))
+ case(iname_snow); qFlux = iLayerLiqFluxSnow(iLayer)
+ case(iname_soil); qFlux = iLayerLiqFluxSoil(iLayer-nSnow)
+ case default; err=20; message=trim(message)//'unable to identify layer type'; return
+ end select
+ ! compute fluxes at the lower boundary -- positive downwards
+ if(iLayer==nLayers)then
+ iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(lowerBoundTemp - mLayerTempTrial(iLayer))
+ ! compute fluxes within the domain -- positive downwards
+ else
+ iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer))
+ end if
+ end if ! (all layers except surface)
+ end do ! looping through layers
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the total fluxes at layer interfaces *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! NOTE: ignore advective fluxes for now
+ iLayerNrgFlux(ixTop:ixBot) = iLayerConductiveFlux(ixTop:ixBot)
+ !print*, 'iLayerNrgFlux(0:4) = ', iLayerNrgFlux(0:4)
+
+ ! end association of local variables with information in the data structures
+ end associate
+
+ end subroutine ssdNrgFlux
+
+
+ ! *************************************************************************************************************************************
+ ! private subroutine iLayerThermalConduct: compute diagnostic energy variables (thermal conductivity and heat capacity) and derivatives
+ ! *************************************************************************************************************************************
+ subroutine iLayerThermalConduct(&
+ ! input: model control
+ deriv_desired, & ! intent(in): flag indicating if derivatives are desired
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ixThCondSnow, & ! intent(in): choice of method for thermal conductivity of snow
+ ixThCondSoil, & ! intent(in): choice of method for thermal conductivity of soil
+ ! input: coordinate variables
+ nLayers, & ! intent(in): number of layers
+ ixLayerDesired, & ! intent(in): layer index for output
+ layerType, & ! intent(in): layer type (iname_soil or iname_snow)
+ ! input: state variables (adjacent layers)
+ nodeMatricHead, & ! intent(in): matric head at the nodes (m)
+ nodeVolFracLiq, & ! intent(in): volumetric liquid water content at the nodes (m)
+ nodeVolFracIce, & ! intent(in): volumetric ice at the nodes (m)
+ nodeTemp, & ! intent(in): temperature at the nodes (m)
+ ! input: pre-computed derivatives
+ dTheta_dTk, & ! intent(in): derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ fracLiqSnow, & ! intent(in) : fraction of liquid water (-)
+ dTheta_dPsi, & ! intent(in): derivative in the soil water characteristic w.r.t. psi (m-1)
+ dPsi_dTheta, & ! intent(in): derivative in the soil water characteristic w.r.t. theta (m)
+ ! input: model coordinate variables (adjacent layers)
+ nodeHeight, & ! intent(in): height at the mid-point of the node (m)
+ node_iHeight, & ! intent(in): height at the interface of the nodes (m)
+ ! input: soil parameters at nodes
+ theta_sat, & ! intent(in): soil porosity (-)
+ iden_soil, & !intrinsic density of soil (kg m-3)
+ thCond_soil, & ! thermal conductivity of soil (W m-1 K-1)
+ frac_sand, & ! intent(in): fraction of sand (-)
+ frac_clay, & ! fraction of clay (-)
+ ! input: snow parameters
+ fixedThermalCond_snow, & ! intent(in): temporally constant thermal conductivity of snow (W m-1 K-1)
+ ! output: conductivity at the layer interface (scalars)
+ iLayerThermalC, & ! intent(inout) thermal conductivity at the interface of each layer (W m-1 K-1)
+ ! output: derivatives in thermal conductivity w.r.t. state variables -- matric head or volumetric lquid water -- in the layer above and layer below
+ dThermalC_dHydStateAbove, & ! intent(out): derivative in the thermal conductivity w.r.t. water state in the layer above
+ dThermalC_dHydStateBelow, & ! intent(out): derivative in the thermal conductivity w.r.t. water state in the layer above
+ ! output: derivatives in thermal conductivity w.r.t. energy state variables -- now just temperature -- in the layer above and layer below (W m-1 K-2)
+ dThermalC_dNrgStateAbove, & ! intent(out): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ dThermalC_dNrgStateBelow, & ! intent(out): derivative in the thermal conductivity w.r.t. energy state in the layer above
+ ! output: error control
+ err,message) ! intent(out): error control
+
+ USE snow_utils_module,only:tcond_snow ! compute thermal conductivity of snow
+ USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+ ! constants
+ USE multiconst, only: gravity, & ! gravitational acceleration (m s-1)
+ Tfreeze, & ! freezing point of water (K)
+ iden_water,iden_ice,& ! intrinsic density of water and ice (kg m-3)
+ LH_fus ! latent heat of fusion (J kg-1)
+
+ implicit none
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: deriv_desired ! flag to indicate if derivatives are desired
+ integer(i4b),intent(in) :: ixRichards ! choice of option for Richards' equation
+ integer(i4b),intent(in) :: ixThCondSnow ! choice of method for thermal conductivity of snow
+ integer(i4b),intent(in) :: ixThCondSoil ! choice of method for thermal conductivity of soil
+ ! input: coordinate variables
+ integer(i4b),intent(in) :: nLayers ! number of layers
+ integer(i4b),intent(in) :: ixLayerDesired ! layer index for output
+ integer(i4b),intent(in) :: layerType(:) ! layer type (iname_soil or iname_snow)
+ ! input: state variables
+ real(rkind),intent(in) :: nodeMatricHead(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(in) :: nodeVolFracLiq(:) ! trial vector of volumetric liquid water content, recomputed with perturbed water state(-)
+ real(rkind),intent(in) :: nodeVolFracIce(:) ! trial vector of ice content, recomputed with perturbed water state(-)
+ real(rkind),intent(in) :: nodeTemp(:) ! trial vector of temperature (K)
+ ! input: pre-computed derivatives
+ real(rkind),intent(in) :: dTheta_dTk(:) ! derivative in volumetric liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: fracLiqSnow(:) ! fraction of liquid water (-)
+ real(rkind),intent(in) :: dTheta_dPsi(:) ! derivative in the soil water characteristic w.r.t. psi (m-1)
+ real(rkind),intent(in) :: dPsi_dTheta(:) ! derivative in the soil water characteristic w.r.t. theta (m)
+ ! input: model coordinate variables
+ real(rkind),intent(in) :: nodeHeight(:) ! height at the mid-point of the lower node (m)
+ real(rkind),intent(in) :: node_iHeight(:) ! height at the interface of each node (m)
+ ! input: soil parameters
+ real(rkind),intent(in) :: theta_sat(:) ! soil porosity (-)
+ real(rkind),intent(in) :: iden_soil(:) ! intrinsic density of soil (kg m-3)
+ real(rkind),intent(in) :: thCond_soil(:) ! thermal conductivity of soil (W m-1 K-1)
+ real(rkind),intent(in) :: frac_sand(:) ! intent(in): fraction of sand (-)
+ real(rkind),intent(in) :: frac_clay(:) ! fraction of clay (-)
+ ! input: snow parameters
+ real(rkind),intent(in) :: fixedThermalCond_snow ! intent(in): temporally constant thermal conductivity of snow (W m-1 K-1)
+ ! output: thermal conductivity at layer interfaces
+ real(rkind),intent(inout) :: iLayerThermalC ! thermal conductivity at the interface of each layer (W m-1 K-1)
+ ! output: thermal conductivity derivatives at all layer interfaces
+ real(rkind),intent(out) :: dThermalC_dHydStateAbove ! derivatives in the thermal conductivity w.r.t. matric head or volumetric liquid water in the layer above
+ real(rkind),intent(out) :: dThermalC_dHydStateBelow ! derivatives in the thermal conductivity w.r.t. matric head or volumetric liquid water in the layer below
+ real(rkind),intent(out) :: dThermalC_dNrgStateAbove ! derivatives in the thermal conductivity w.r.t. temperature in the layer above (W m-1 K-2)
+ real(rkind),intent(out) :: dThermalC_dNrgStateBelow ! derivatives in the thermal conductivity w.r.t. temperature in the layer below (W m-1 K-2)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables (named variables to provide index of 2-element vectors)
+ integer(i4b),parameter :: ixUpper=1 ! index of upper node in the 2-element vectors
+ integer(i4b),parameter :: ixLower=2 ! index of lower node in the 2-element vectors
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: iLayer ! index of model layer
+ real(rkind) :: TCn ! thermal conductivity below the layer interface (W m-1 K-1)
+ real(rkind) :: TCp ! thermal conductivity above the layer interface (W m-1 K-1)
+ real(rkind) :: zdn ! height difference between interface and lower value (m)
+ real(rkind) :: zdp ! height difference between interface and upper value (m)
+ real(rkind) :: bulkden_soil ! bulk density of soil (kg m-3)
+ real(rkind) :: lambda_drysoil ! thermal conductivity of dry soil (W m-1)
+ real(rkind) :: lambda_wetsoil ! thermal conductivity of wet soil (W m-1)
+ real(rkind) :: lambda_wet ! thermal conductivity of the wet material
+ real(rkind) :: relativeSat ! relative saturation (-)
+ real(rkind) :: kerstenNum ! the Kersten number (-), defining weight applied to conductivity of the wet medium
+ real(rkind) :: den ! denominator in the thermal conductivity calculations
+ real(rkind) :: dThermalC_dWat(2) ! derivative in thermal conductivity w.r.t. matric head or volumetric liquid water
+ real(rkind) :: dThermalC_dNrg(2) ! derivative in thermal conductivity w.r.t. temperature
+ real(rkind) :: Tcrit ! temperature where all water is unfrozen (K)
+ real(rkind) :: dlambda_wet_dWat ! derivative in thermal conductivity of wet material w.r.t.soil water state variable
+ real(rkind) :: dlambda_wet_dTk ! derivative in thermal conductivity of wet material w.r.t. temperature
+ real(rkind) :: dkerstenNum_dWat ! derivative in Kersten number w.r.t. soil water state variable
+ real(rkind) :: mLayerThermalC(2) ! thermal conductivity of each layer (W m-1 K-1)
+ real(rkind) :: dVolFracLiq_dWat ! derivative in vol fraction of liquid w.r.t. water state variable
+ real(rkind) :: dVolFracIce_dWat ! derivative in vol fraction of ice w.r.t. water state variable
+ real(rkind) :: dVolFracLiq_dTk ! derivative in vol fraction of liquid w.r.t. temperature
+ real(rkind) :: dVolFracIce_dTk ! derivative in vol fraction of ice w.r.t. temperature
+ ! local variables to reproduce the thermal conductivity of Hansson et al. VZJ 2005
+ real(rkind),parameter :: c1=0.55_rkind ! optimized parameter from Hansson et al. VZJ 2005 (W m-1 K-1)
+ real(rkind),parameter :: c2=0.8_rkind ! optimized parameter from Hansson et al. VZJ 2005 (W m-1 K-1)
+ real(rkind),parameter :: c3=3.07_rkind ! optimized parameter from Hansson et al. VZJ 2005 (-)
+ real(rkind),parameter :: c4=0.13_rkind ! optimized parameter from Hansson et al. VZJ 2005 (W m-1 K-1)
+ real(rkind),parameter :: c5=4._rkind ! optimized parameter from Hansson et al. VZJ 2005 (-)
+ real(rkind),parameter :: f1=13.05_rkind ! optimized parameter from Hansson et al. VZJ 2005 (-)
+ real(rkind),parameter :: f2=1.06_rkind ! optimized parameter from Hansson et al. VZJ 2005 (-)
+ real(rkind) :: fArg,xArg ! temporary variables (see Hansson et al. VZJ 2005 for details)
+ real(rkind) :: dxArg_dWat,dxArg_dTk ! derivates of the temporary variables with respect to soil water state variable and temperature
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="iLayerThermalConduct/"
+
+ ! loop through layers
+ do iLayer=ixUpper,ixLower
+
+ ! compute the thermal conductivity of dry and wet soils (W m-1)
+ ! NOTE: this is actually constant over the simulation, and included here for clarity
+ if(ixThCondSoil==funcSoilWet .and. layerType(iLayer)==iname_soil)then
+ bulkden_soil = iden_soil(iLayer)*( 1._rkind - theta_sat(iLayer) )
+ lambda_drysoil = (0.135_rkind*bulkden_soil + 64.7_rkind) / (iden_soil(iLayer) - 0.947_rkind*bulkden_soil)
+ lambda_wetsoil = (8.80_rkind*frac_sand(iLayer) + 2.92_rkind*frac_clay(iLayer)) / (frac_sand(iLayer) + frac_clay(iLayer))
+ end if
+
+ ! *****
+ ! * compute the thermal conductivity of snow and soil and derivates at the mid-point of each layer...
+ ! ***************************************************************************************************
+ dThermalC_dWat(iLayer) = 0._rkind
+ dThermalC_dNrg(iLayer) = 0._rkind
+
+ select case(layerType(iLayer))
+
+ ! ***** soil
+ case(iname_soil)
+
+ ! (process derivatives)
+ dVolFracLiq_dWat = 0._rkind
+ dVolFracIce_dWat = 0._rkind
+ dVolFracLiq_dTk = 0._rkind
+ dVolFracIce_dTk = 0._rkind
+ if(deriv_desired)then
+ select case(ixRichards) ! (form of Richards' equation)
+ case(moisture)
+ dVolFracLiq_dWat = 1._rkind
+ dVolFracIce_dWat = dPsi_dTheta(iLayer) - 1._rkind
+ case(mixdform)
+ Tcrit = crit_soilT(nodeMatricHead(iLayer) )
+ if(nodeTemp(iLayer) < Tcrit) then
+ dVolFracLiq_dWat = 0._rkind
+ dVolFracIce_dWat = dTheta_dPsi(iLayer)
+ else
+ dVolFracLiq_dWat = dTheta_dPsi(iLayer)
+ dVolFracIce_dWat = 0._rkind
+ endif
+ end select
+ dVolFracLiq_dTk = dTheta_dTk(iLayer) !already zeroed out if not below critical temperature
+ dVolFracIce_dTk = -dVolFracLiq_dTk !often can and will simplify one of these terms out
+ endif
+
+ ! select option for thermal conductivity of soil
+ select case(ixThCondSoil)
+
+ ! ** function of soil wetness
+ case(funcSoilWet)
+
+ ! compute the thermal conductivity of the wet material (W m-1)
+ lambda_wet = lambda_wetsoil**( 1._rkind - theta_sat(iLayer) ) * lambda_water**theta_sat(iLayer) * lambda_ice**(theta_sat(iLayer) - nodeVolFracLiq(iLayer))
+ dlambda_wet_dWat = -lambda_wet * log(lambda_ice) * dVolFracLiq_dWat
+ dlambda_wet_dTk = -lambda_wet * log(lambda_ice) * dVolFracLiq_dTk
+
+ relativeSat = (nodeVolFracIce(iLayer) + nodeVolFracLiq(iLayer))/theta_sat(iLayer) ! relative saturation
+ ! drelativeSat_dWat = dPsi0_dWat/theta_sat(iLayer), and drelativeSat_dTk = 0 (so dkerstenNum_dTk = 0)
+ ! compute the Kersten number (-)
+ if(relativeSat > 0.1_rkind)then ! log10(0.1) = -1
+ kerstenNum = log10(relativeSat) + 1._rkind
+ dkerstenNum_dWat = (dVolFracIce_dWat + dVolFracLiq_dWat) / ( theta_sat(iLayer) * relativeSat * log(10._rkind) )
+ else
+ kerstenNum = 0._rkind ! dry thermal conductivity
+ dkerstenNum_dWat = 0._rkind
+ endif
+ ! ...and, compute the thermal conductivity
+ mLayerThermalC(iLayer) = kerstenNum*lambda_wet + (1._rkind - kerstenNum)*lambda_drysoil
+
+ ! compute derivatives
+ dThermalC_dWat(iLayer) = dkerstenNum_dWat * ( lambda_wet - lambda_drysoil ) + kerstenNum*dlambda_wet_dWat
+ dThermalC_dNrg(iLayer) = kerstenNum*dlambda_wet_dTk
+
+ ! ** mixture of constituents
+ case(mixConstit)
+ mLayerThermalC(iLayer) = thCond_soil(iLayer) * ( 1._rkind - theta_sat(iLayer) ) + & ! soil component
+ lambda_ice * nodeVolFracIce(iLayer) + & ! ice component
+ lambda_water * nodeVolFracLiq(iLayer) + & ! liquid water component
+ lambda_air * ( theta_sat(iLayer) - (nodeVolFracIce(iLayer) + nodeVolFracLiq(iLayer)) ) ! air component
+ ! compute derivatives
+ dThermalC_dWat(iLayer) = lambda_ice*dVolFracIce_dWat + lambda_water*dVolFracLiq_dWat + lambda_air*(-dVolFracIce_dWat - dVolFracLiq_dWat)
+ dThermalC_dNrg(iLayer) = (lambda_ice - lambda_water) * dVolFracIce_dTk
+
+ ! ** test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
+ case(hanssonVZJ)
+ fArg = 1._rkind + f1*nodeVolFracIce(iLayer)**f2
+ xArg = nodeVolFracLiq(iLayer) + fArg*nodeVolFracIce(iLayer)
+ dxArg_dWat = dVolFracLiq_dWat + dVolFracIce_dWat * (1._rkind + f1*(f2+1)*nodeVolFracIce(iLayer)**f2)
+ dxArg_dTk = dVolFracIce_dTk * f1*(f2+1)*nodeVolFracIce(iLayer)**f2
+ ! ...and, compute the thermal conductivity
+ mLayerThermalC(iLayer) = c1 + c2*xArg + (c1 - c4)*exp(-(c3*xArg)**c5)
+
+ ! compute derivatives
+ dThermalC_dWat(iLayer) = ( c2 - c5*c3*(c3*xArg)**(c5-1)*(c1 - c4)*exp(-(c3*xArg)**c5) ) * dxArg_dWat
+ dThermalC_dNrg(iLayer) = ( c2 - c5*c3*(c3*xArg)**(c5-1)*(c1 - c4)*exp(-(c3*xArg)**c5) ) * dxArg_dTk
+
+ ! ** check
+ case default; err=20; message=trim(message)//'unable to identify option for thermal conductivity of soil'; return
+
+ end select ! option for the thermal conductivity of soil
+
+ ! ***** snow
+ case(iname_snow)
+ dVolFracIce_dWat = ( 1._rkind - fracLiqSnow(iLayer) )*(iden_water/iden_ice)
+ dVolFracIce_dTk = -dTheta_dTk(iLayer)*(iden_water/iden_ice)
+
+ ! temporally constant thermal conductivity
+ if(ixThCondSnow==Smirnova2000)then
+ mLayerThermalC(iLayer) = fixedThermalCond_snow
+ dThermalC_dWat(iLayer) = 0._rkind
+ dThermalC_dNrg(iLayer) = 0._rkind
+ ! thermal conductivity as a function of snow density
+ else
+ call tcond_snow(nodeVolFracIce(iLayer)*iden_ice, & ! input: snow density (kg m-3)
+ mLayerThermalC(iLayer), & ! output: thermal conductivity (W m-1 K-1)
+ err,cmessage) ! output: error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
+
+ select case(ixThCondSnow)
+ case(Yen1965)
+ dThermalC_dWat(iLayer) = 2._rkind * 3.217d-6 * nodeVolFracIce(iLayer) * iden_ice**2._rkind * dVolFracIce_dWat
+ dThermalC_dNrg(iLayer) = 2._rkind * 3.217d-6 * nodeVolFracIce(iLayer) * iden_ice**2._rkind * dVolFracIce_dTk
+ case(Mellor1977)
+ dThermalC_dWat(iLayer) = 2._rkind * 2.576d-6 * nodeVolFracIce(iLayer) * iden_ice**2._rkind * dVolFracIce_dWat
+ dThermalC_dNrg(iLayer) = 2._rkind * 2.576d-6 * nodeVolFracIce(iLayer) * iden_ice**2._rkind * dVolFracIce_dTk
+ case(Jordan1991)
+ dThermalC_dWat(iLayer) = ( 7.75d-5 + 2._rkind * 1.105d-6 * nodeVolFracIce(iLayer) * iden_ice ) * (lambda_ice-lambda_air) * iden_ice * dVolFracIce_dWat
+ dThermalC_dNrg(iLayer) = ( 7.75d-5 + 2._rkind * 1.105d-6 * nodeVolFracIce(iLayer) * iden_ice ) * (lambda_ice-lambda_air) * iden_ice * dVolFracIce_dTk
+ end select ! option for the thermal conductivity of snow
+ end if
+
+ ! * error check
+ case default; err=20; message=trim(message)//'unable to identify type of layer (snow or soil) to compute thermal conductivity'; return
+
+ end select
+ !print*, 'iLayer, mLayerThermalC(iLayer) = ', iLayer, mLayerThermalC(iLayer)
+
+ end do ! looping through layers
+ !pause
+
+ ! *****
+ ! * compute the thermal conductivity of snow at the interface of each layer...
+ ! ****************************************************************************
+ if (ixLayerDesired==0) then
+ ! special case of hansson
+ if(ixThCondSoil==hanssonVZJ)then
+ iLayerThermalC = 28._rkind*(0.5_rkind*(node_iHeight(ixLower) - node_iHeight(ixUpper))) ! these are indices 1,0 since was passed with 0:1
+ dThermalC_dHydStateBelow = 0._rkind
+ dThermalC_dNrgStateBelow = 0._rkind
+ else
+ iLayerThermalC = mLayerThermalC(ixUpper) ! index was passed with 1:1
+ dThermalC_dHydStateBelow = dThermalC_dWat(ixUpper)
+ dThermalC_dNrgStateBelow = dThermalC_dNrg(ixUpper)
+ end if
+ dThermalC_dHydStateAbove = realMissing
+ dThermalC_dNrgStateAbove = realMissing
+ else if (ixLayerDesired==nLayers ) then
+ ! assume the thermal conductivity at the domain boundaries is equal to the thermal conductivity of the layer
+ iLayerThermalC = mLayerThermalC(ixLower) ! index was passed with iLayers:iLayers
+ dThermalC_dHydStateAbove = dThermalC_dWat(ixLower)
+ dThermalC_dNrgStateAbove = dThermalC_dNrg(ixLower)
+ dThermalC_dHydStateBelow = realMissing
+ dThermalC_dNrgStateBelow = realMissing
+ else
+ ! get temporary variables
+ TCn = mLayerThermalC(ixUpper) ! thermal conductivity below the layer interface (W m-1 K-1)
+ TCp = mLayerThermalC(ixLower) ! thermal conductivity above the layer interface (W m-1 K-1)
+ zdn = node_iHeight(ixUpper) - nodeHeight(ixUpper) ! height difference between interface and lower value (m)
+ zdp = nodeHeight(ixLower) - node_iHeight(ixUpper) ! height difference between interface and upper value (m)
+ den = TCn*zdp + TCp*zdn ! denominator
+ ! compute thermal conductivity
+ if(TCn+TCp > epsilon(TCn))then
+ iLayerThermalC = (TCn*TCp*(zdn + zdp)) / den
+ dThermalC_dHydStateBelow = ( TCn*(zdn + zdp) - iLayerThermalC*zdn ) / den * dThermalC_dWat(ixLower)
+ dThermalC_dHydStateAbove = ( TCp*(zdn + zdp) - iLayerThermalC*zdp ) / den * dThermalC_dWat(ixUpper)
+ dThermalC_dNrgStateBelow = ( TCn*(zdn + zdp) - iLayerThermalC*zdn ) / den * dThermalC_dNrg(ixLower)
+ dThermalC_dNrgStateAbove = ( TCp*(zdn + zdp) - iLayerThermalC*zdp ) / den * dThermalC_dNrg(ixUpper)
+ else
+ iLayerThermalC = (TCn*zdn + TCp*zdp) / (zdn + zdp)
+ dThermalC_dHydStateBelow = zdp / (zdn + zdp) * dThermalC_dWat(ixLower)
+ dThermalC_dHydStateAbove = zdn / (zdn + zdp) * dThermalC_dWat(ixUpper)
+ dThermalC_dNrgStateBelow = zdp / (zdn + zdp) * dThermalC_dNrg(ixLower)
+ dThermalC_dNrgStateAbove = zdn / (zdn + zdp) * dThermalC_dNrg(ixUpper)
+ end if
+ !write(*,'(a,1x,i4,1x,10(f9.3,1x))') 'iLayer, TCn, TCp, zdn, zdp, iLayerThermalC(iLayer) = ', iLayer, TCn, TCp, zdn, zdp, iLayerThermalC(iLayer)
+ endif
+
+ end subroutine iLayerThermalConduct
+
+
+
+ end module ssdNrgFlux_module
+
+
\ No newline at end of file
diff --git a/build/source/engine/ssdNrgFlux_old.f90 b/build/source/engine/ssdNrgFlux_old.f90
new file mode 100755
index 0000000..25fc68e
--- /dev/null
+++ b/build/source/engine/ssdNrgFlux_old.f90
@@ -0,0 +1,307 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
+!
+! This file is part of SUMMA
+!
+! For more information see: http://www.ral.ucar.edu/projects/summa
+!
+! This program is free software: you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+module ssdNrgFlux_module
+
+! data types
+USE nrtype
+
+! data types
+USE data_types,only:var_d ! x%var(:) (dp)
+USE data_types,only:var_dlength ! x%var(:)%dat (dp)
+USE data_types,only:var_ilength ! x%var(:)%dat (i4b)
+
+! physical constants
+USE multiconst,only:&
+ sb, & ! Stefan Boltzman constant (W m-2 K-4)
+ Em_Sno, & ! emissivity of snow (-)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ Cp_water, & ! specifric heat of water (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ gravity, & ! gravitational acceleteration (m s-2)
+ Tfreeze, & ! freezing point of pure water (K)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of water (kg m-3)
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! named variables for snow and soil
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+! model decisions
+USE globalData,only:model_decisions ! model decision structure
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+! provide access to look-up values for model decisions
+USE mDecisions_module,only: &
+ ! look-up values for the numerical method
+ iterative, & ! iterative
+ nonIterative, & ! non-iterative
+ iterSurfEnergyBal, & ! iterate only on the surface energy balance
+ ! look-up values for method used to compute derivative
+ numerical, & ! numerical solution
+ analytical, & ! analytical solution
+ ! look-up values for choice of boundary conditions for thermodynamics
+ prescribedTemp, & ! prescribed temperature
+ energyFlux, & ! energy flux
+ zeroFlux, & ! zero flux
+ ! look-up values for choice of boundary conditions for soil hydrology
+ prescribedHead ! prescribed head
+
+! -------------------------------------------------------------------------------------------------
+implicit none
+private
+public::ssdNrgFlux
+! global parameters
+real(dp),parameter :: dx=1.e-10_dp ! finite difference increment (K)
+real(dp),parameter :: valueMissing=-9999._dp ! missing value parameter
+contains
+
+ ! ************************************************************************************************
+ ! public subroutine ssdNrgFlux: compute energy fluxes and derivatives at layer interfaces
+ ! ************************************************************************************************
+ subroutine ssdNrgFlux(&
+ ! input: model control
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: fluxes and derivatives at the upper boundary
+ groundNetFlux, & ! intent(in): total flux at the ground surface (W m-2)
+ dGroundNetFlux_dGroundTemp, & ! intent(in): derivative in total ground surface flux w.r.t. ground temperature (W m-2 K-1)
+ ! input: liquid water fluxes
+ iLayerLiqFluxSnow, & ! intent(in): liquid flux at the interface of each snow layer (m s-1)
+ iLayerLiqFluxSoil, & ! intent(in): liquid flux at the interface of each soil layer (m s-1)
+ ! input: trial value of model state variabes
+ mLayerTempTrial, & ! intent(in): trial temperature at the current iteration (K)
+ mLayerMatricHeadTrial, & ! intent(in): trial matric head at the current iteration(m)
+ mLayerVolFracLiqTrial, & ! intent(in): trial volumetric fraction of liquid water at the current iteration(-)
+ mLayerVolFracIceTrial, & ! intent(in): trial volumetric fraction of ice water at the current iteration(-)
+ ! input-output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ ! output: fluxes and derivatives at all layer interfaces
+ iLayerNrgFlux, & ! intent(out): energy flux at the layer interfaces (W m-2)
+ dFlux_dTempAbove, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer above (W m-2 K-1)
+ dFlux_dTempBelow, & ! intent(out): derivatives in the flux w.r.t. temperature in the layer below (W m-2 K-1)
+ ! output: error control
+ err,message) ! intent(out): error control
+ implicit none
+ ! input: model control
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: fluxes and derivatives at the upper boundary
+ real(dp),intent(in) :: groundNetFlux ! net energy flux for the ground surface (W m-2)
+ real(dp),intent(in) :: dGroundNetFlux_dGroundTemp ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
+ ! input: liquid water fluxes
+ real(dp),intent(in) :: iLayerLiqFluxSnow(0:) ! intent(in): liquid flux at the interface of each snow layer (m s-1)
+ real(dp),intent(in) :: iLayerLiqFluxSoil(0:) ! intent(in): liquid flux at the interface of each soil layer (m s-1)
+ ! input: trial value of model state variables
+ real(dp),intent(in) :: mLayerTempTrial(:) ! trial temperature of each snow/soil layer at the current iteration (K)
+ real(dp),intent(in) :: mLayerMatricHeadTrial(:) ! matric head in each layer at the current iteration (m)
+ real(dp),intent(in) :: mLayerVolFracLiqTrial(:) ! volumetric fraction of liquid at the current iteration (-)
+ real(dp),intent(in) :: mLayerVolFracIceTrial(:) ! volumetric fraction of ice at the current iteration (-)
+ ! input-output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! state vector geometry
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ ! output: fluxes and derivatives at all layer interfaces
+ real(dp),intent(out) :: iLayerNrgFlux(0:) ! energy flux at the layer interfaces (W m-2)
+ real(dp),intent(out) :: dFlux_dTempAbove(0:) ! derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
+ real(dp),intent(out) :: dFlux_dTempBelow(0:) ! derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of model layers
+ integer(i4b) :: ixLayerDesired(1) ! layer desired (scalar solution)
+ integer(i4b) :: ixTop ! top layer in subroutine call
+ integer(i4b) :: ixBot ! bottom layer in subroutine call
+ real(dp) :: qFlux ! liquid flux at layer interfaces (m s-1)
+ real(dp) :: dz ! height difference (m)
+ real(dp) :: flux0,flux1,flux2 ! fluxes used to calculate derivatives (W m-2)
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! make association of local variables with information in the data structures
+ associate(&
+ ix_fDerivMeth => model_decisions(iLookDECISIONS%fDerivMeth)%iDecision, & ! intent(in): method used to calculate flux derivatives
+ ix_bcLowrTdyn => model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision, & ! intent(in): method used to calculate the lower boundary condition for thermodynamics
+ ! input: model coordinates
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1), & ! intent(in): total number of layers
+ layerType => indx_data%var(iLookINDEX%layerType)%dat, & ! intent(in): layer type (iname_soil or iname_snow)
+ ixLayerState => indx_data%var(iLookINDEX%ixLayerState)%dat, & ! intent(in): list of indices for all model layers
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat, & ! intent(in): index in the state subset for energy state variables in the snow+soil domain
+ ! input: thermal properties
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat, & ! intent(in): depth of each layer (m)
+ mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat, & ! intent(in): height at the mid-point of each layer (m)
+ iLayerThermalC => diag_data%var(iLookDIAG%iLayerThermalC)%dat, & ! intent(in): thermal conductivity at the interface of each layer (W m-1 K-1)
+ lowerBoundTemp => mpar_data%var(iLookPARAM%lowerBoundTemp)%dat(1), & ! intent(in): temperature of the lower boundary (K)
+ ! output: diagnostic fluxes
+ iLayerConductiveFlux => flux_data%var(iLookFLUX%iLayerConductiveFlux)%dat, & ! intent(out): conductive energy flux at layer interfaces at end of time step (W m-2)
+ iLayerAdvectiveFlux => flux_data%var(iLookFLUX%iLayerAdvectiveFlux)%dat & ! intent(out): advective energy flux at layer interfaces at end of time step (W m-2)
+ ) ! association of local variables with information in the data structures
+ ! ------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='ssdNrgFlux/'
+
+ ! set conductive and advective fluxes to missing in the upper boundary
+ ! NOTE: advective flux at the upper boundary is included in the ground heat flux
+ iLayerConductiveFlux(0) = valueMissing
+ iLayerAdvectiveFlux(0) = valueMissing
+
+ ! get the indices for the snow+soil layers
+ if(scalarSolution)then
+ ixLayerDesired = pack(ixLayerState, ixSnowSoilNrg/=integerMissing)
+ ixTop = ixLayerDesired(1)
+ ixBot = ixLayerDesired(1)
+ else
+ ixTop = 1
+ ixBot = nLayers
+ endif
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the conductive fluxes at layer interfaces *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+ do iLayer=ixTop,ixBot ! (loop through model layers)
+
+ ! compute fluxes at the lower boundary -- positive downwards
+ if(iLayer==nLayers)then
+ ! flux depends on the type of lower boundary condition
+ select case(ix_bcLowrTdyn) ! (identify the lower boundary condition for thermodynamics
+ case(prescribedTemp); iLayerConductiveFlux(nLayers) = -iLayerThermalC(iLayer)*(lowerBoundTemp - mLayerTempTrial(iLayer))/(mLayerDepth(iLayer)*0.5_dp)
+ case(zeroFlux); iLayerConductiveFlux(nLayers) = 0._dp
+ case default; err=20; message=trim(message)//'unable to identify lower boundary condition for thermodynamics'; return
+ end select ! (identifying the lower boundary condition for thermodynamics)
+
+ ! compute fluxes within the domain -- positive downwards
+ else
+ iLayerConductiveFlux(iLayer) = -iLayerThermalC(iLayer)*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer)) / &
+ (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+
+ !write(*,'(a,i4,1x,2(f9.3,1x))') 'iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer) = ', iLayer, iLayerConductiveFlux(iLayer), iLayerThermalC(iLayer)
+ end if ! (the type of layer)
+ end do
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the advective fluxes at layer interfaces *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+ do iLayer=ixTop,ixBot
+ ! get the liquid flux at layer interfaces
+ select case(layerType(iLayer))
+ case(iname_snow); qFlux = iLayerLiqFluxSnow(iLayer)
+ case(iname_soil); qFlux = iLayerLiqFluxSoil(iLayer-nSnow)
+ case default; err=20; message=trim(message)//'unable to identify layer type'; return
+ end select
+ ! compute fluxes at the lower boundary -- positive downwards
+ if(iLayer==nLayers)then
+ iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(lowerBoundTemp - mLayerTempTrial(iLayer))
+ ! compute fluxes within the domain -- positive downwards
+ else
+ iLayerAdvectiveFlux(iLayer) = -Cp_water*iden_water*qFlux*(mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer))
+ end if
+ end do ! looping through layers
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the total fluxes at layer interfaces *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! NOTE: ignore advective fluxes for now
+ iLayerNrgFlux(0) = groundNetFlux
+ iLayerNrgFlux(ixTop:ixBot) = iLayerConductiveFlux(ixTop:ixBot)
+ !print*, 'iLayerNrgFlux(0:4) = ', iLayerNrgFlux(0:4)
+
+ ! -------------------------------------------------------------------------------------------------------------------------
+ ! ***** compute the derivative in fluxes at layer interfaces w.r.t temperature in the layer above and the layer below *****
+ ! -------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize un-used elements
+ dFlux_dTempBelow(nLayers) = -huge(lowerBoundTemp) ! don't expect this to be used, so deliberately set to a ridiculous value to cause problems
+
+ ! ***** the upper boundary
+ dFlux_dTempBelow(0) = dGroundNetFlux_dGroundTemp
+
+ ! loop through INTERFACES...
+ do iLayer=ixTop,ixBot
+
+ ! ***** the lower boundary
+ if(iLayer==nLayers)then ! (lower boundary)
+
+ ! identify the lower boundary condition
+ select case(ix_bcLowrTdyn)
+
+ ! * prescribed temperature at the lower boundary
+ case(prescribedTemp)
+
+ dz = mLayerDepth(iLayer)*0.5_dp
+ if(ix_fDerivMeth==analytical)then ! ** analytical derivatives
+ dFlux_dTempAbove(iLayer) = iLayerThermalC(iLayer)/dz
+ else ! ** numerical derivatives
+ flux0 = -iLayerThermalC(iLayer)*(lowerBoundTemp - (mLayerTempTrial(iLayer) ))/dz
+ flux1 = -iLayerThermalC(iLayer)*(lowerBoundTemp - (mLayerTempTrial(iLayer)+dx))/dz
+ dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
+ end if
+
+ ! * zero flux at the lower boundary
+ case(zeroFlux)
+ dFlux_dTempAbove(iLayer) = 0._dp
+
+ case default; err=20; message=trim(message)//'unable to identify lower boundary condition for thermodynamics'; return
+
+ end select ! (identifying the lower boundary condition for thermodynamics)
+
+ ! ***** internal layers
+ else
+ dz = (mLayerHeight(iLayer+1) - mLayerHeight(iLayer))
+ if(ix_fDerivMeth==analytical)then ! ** analytical derivatives
+ dFlux_dTempAbove(iLayer) = iLayerThermalC(iLayer)/dz
+ dFlux_dTempBelow(iLayer) = -iLayerThermalC(iLayer)/dz
+ else ! ** numerical derivatives
+ flux0 = -iLayerThermalC(iLayer)*( mLayerTempTrial(iLayer+1) - mLayerTempTrial(iLayer) ) / dz
+ flux1 = -iLayerThermalC(iLayer)*( mLayerTempTrial(iLayer+1) - (mLayerTempTrial(iLayer)+dx)) / dz
+ flux2 = -iLayerThermalC(iLayer)*((mLayerTempTrial(iLayer+1)+dx) - mLayerTempTrial(iLayer) ) / dz
+ dFlux_dTempAbove(iLayer) = (flux1 - flux0)/dx
+ dFlux_dTempBelow(iLayer) = (flux2 - flux0)/dx
+ end if
+
+ end if ! type of layer (upper, internal, or lower)
+
+ end do ! (looping through layers)
+
+ ! end association of local variables with information in the data structures
+ end associate
+
+ end subroutine ssdNrgFlux
+
+end module ssdNrgFlux_module
+
diff --git a/build/source/engine/sundials/computEnthalpy.f90 b/build/source/engine/sundials/computEnthalpy.f90
index d76bbaa..41aedaa 100644
--- a/build/source/engine/sundials/computEnthalpy.f90
+++ b/build/source/engine/sundials/computEnthalpy.f90
@@ -137,7 +137,7 @@ contains
)
if(computeVegFlux)then
- scalarCanopyEnthalpyPrime = heatCapVeg * scalarCanopyTempPrime - LH_fus*scalarCanopyIcePrime/canopyDepth
+ scalarCanopyEnthalpyPrime = heatCapVeg * scalarCanopyTempPrime - LH_fus*scalarCanopyIcePrime/canopyDepth
end if
! (loop through non-missing energy state variables in the snow+soil domain)
do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing)
diff --git a/build/source/engine/sundials/computHeatCap.f90 b/build/source/engine/sundials/computHeatCap.f90
index 5e880c5..1c8440c 100644
--- a/build/source/engine/sundials/computHeatCap.f90
+++ b/build/source/engine/sundials/computHeatCap.f90
@@ -34,15 +34,15 @@ USE var_lookup,only:iLookPARAM,iLookDIAG,iLookINDEX ! named variables for struc
! physical constants
USE multiconst,only:&
- Tfreeze, & ! freezing point of water (K)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water, & ! intrinsic density of water (kg m-3)
- ! specific heat
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- Cp_ice, & ! specific heat of ice (J kg-1 K-1)
- Cp_soil, & ! specific heat of soil (J kg-1 K-1)
- Cp_water ! specific heat of liquid water (J kg-1 K-1)
+ Tfreeze, & ! freezing point of water (K)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water, & ! intrinsic density of water (kg m-3)
+ ! specific heat
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ Cp_ice, & ! specific heat of ice (J kg-1 K-1)
+ Cp_soil, & ! specific heat of soil (J kg-1 K-1)
+ Cp_water ! specific heat of liquid water (J kg-1 K-1)
! named variables to describe the state variable type
USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
@@ -405,7 +405,7 @@ contains
computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
! input: state variables
scalarCanopyTemp, & ! intent(in)
- mLayerTemp, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerTemp, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
mLayerMatricHead, & ! intent(in)
! input data structures
mpar_data, & ! intent(in): model parameters
@@ -484,9 +484,9 @@ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) & !
g2 = mLayerTemp(iLayer) - Tfreeze
Tcrit = crit_soilT( mLayerMatricHead(iSoil) )
if( mLayerTemp(iLayer) < Tcrit)then
- mLayerCm(iLayer) = (iden_ice * Cp_ice - iden_air * Cp_air) * g2
+ mLayerCm(iLayer) = (iden_ice * Cp_ice - iden_air * Cp_air) * g2
else
- mLayerCm(iLayer) = (iden_water * Cp_water - iden_air * Cp_air) * g2
+ mLayerCm(iLayer) = (iden_water * Cp_water - iden_air * Cp_air) * g2
end if
case(iname_snow)
diff --git a/build/source/engine/sundials/soil_utilsSundials.f90 b/build/source/engine/sundials/soil_utilsSundials.f90
index 9c02f31..0d06b2c 100644
--- a/build/source/engine/sundials/soil_utilsSundials.f90
+++ b/build/source/engine/sundials/soil_utilsSundials.f90
@@ -59,7 +59,6 @@ contains
vGn_alpha,vGn_n,theta_sat,theta_res,vGn_m,& ! intent(in) : soil parameters
dVolTot_dPsi0 ,& ! intent(in) : derivative in the soil water characteristic (m-1)
dTheta_dT ,& ! intent(in) : derivative in volumetric total water w.r.t. temperature (K-1)
- tempPrime ,& ! intent(in)
volFracLiqPrime ,& ! intent(in)
volFracIcePrime ,& ! intent(in)
! output
@@ -78,7 +77,6 @@ contains
real(rkind),intent(in) :: vGn_alpha,vGn_n,theta_sat,theta_res,vGn_m ! soil parameters
real(rkind),intent(in) ,optional :: dVolTot_dPsi0 ! derivative in the soil water characteristic (m-1)
real(rkind),intent(in) ,optional :: dTheta_dT ! derivative in volumetric total water w.r.t. temperature (K-1)
- real(rkind),intent(in) :: TempPrime
real(rkind),intent(in) :: volFracLiqPrime
real(rkind),intent(in) :: volFracIcePrime
! output
@@ -163,10 +161,7 @@ contains
! (compute the derivative in the liquid water matric potential w.r.t. temperature)
dEffSat_dTemp = -dTheta_dT*xNum/(xDen**2._rkind) + dTheta_dT/xDen
dPsiLiq_dTemp = dPsiLiq_dEffSat*dEffSat_dTemp
- ! matricHeadLiqPrime = dPsiLiq_dTemp * tempPrime
-
-
-
+
endif ! if dPsiLiq_dTemp is desired
! ** unfrozen soil
diff --git a/build/source/engine/sundials/updatStateSundials.f90 b/build/source/engine/sundials/updatStateSundials.f90
index 51a3ead..c02a1b0 100644
--- a/build/source/engine/sundials/updatStateSundials.f90
+++ b/build/source/engine/sundials/updatStateSundials.f90
@@ -232,7 +232,6 @@ contains
! *************************************************************************************************************
subroutine updateSoilSundials2(&
! input
- dt_cur ,& ! intent(in): time step
mLayerTemp ,& ! intent(in): temperature vector (K)
mLayerMatricHead ,& ! intent(in): total water matric potential (m)
mLayerTempPrime ,& ! intent(in): temperature time derivative (K/s)
@@ -256,7 +255,6 @@ contains
USE soil_utils_module,only:dTheta_dPsi
implicit none
! input variables
- real(rkind),intent(in) :: dt_cur
real(rkind),intent(in) :: mLayerTemp ! estimate of temperature (K)
real(rkind),intent(in) :: mLayerMatricHead ! matric head (m)
real(rkind),intent(in) :: mLayerTempPrime ! temperature time derivative (K/s)
diff --git a/build/source/engine/sundials/updateVars4JacDAE.f90 b/build/source/engine/sundials/updateVars4JacDAE.f90
index 734483c..6ff6bc7 100644
--- a/build/source/engine/sundials/updateVars4JacDAE.f90
+++ b/build/source/engine/sundials/updateVars4JacDAE.f90
@@ -572,7 +572,6 @@ contains
! compute volumetric fraction of liquid water and ice
call updateSoilSundials2(&
- dt, & ! intent(in) : time step
xTemp, & ! intent(in) : temperature (K)
mLayerMatricHeadTrial(ixControlIndex), & ! intent(in) : total water matric potential (m)
mLayerTempPrime(iLayer), & ! intent(in) : temperature time derivative (K/s)
@@ -756,7 +755,6 @@ contains
vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),theta_sat(ixControlIndex),theta_res(ixControlIndex),vGn_m(ixControlIndex), & ! intent(in) : soil parameters
dVolTot_dPsi0(ixControlIndex) ,& ! intent(in) : derivative in the soil water characteristic (m-1)
mLayerdTheta_dTk(iLayer) ,& ! intent(in) : derivative in volumetric total water w.r.t. temperature (K-1)
- mLayerTempPrime(ixControlIndex) ,&
mLayerVolFracLiqPrime(iLayer) ,&
mLayerVolFracIcePrime(iLayer) ,&
! output
diff --git a/build/source/engine/sundials/updateVarsSundials.f90 b/build/source/engine/sundials/updateVarsSundials.f90
index 35a7d4c..bd79753 100644
--- a/build/source/engine/sundials/updateVarsSundials.f90
+++ b/build/source/engine/sundials/updateVarsSundials.f90
@@ -625,7 +625,6 @@ contains
vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),theta_sat(ixControlIndex),theta_res(ixControlIndex),vGn_m(ixControlIndex), & ! intent(in) : soil parameters
dVolTot_dPsi0(ixControlIndex) ,& ! intent(in) : derivative in the soil water characteristic (m-1)
mLayerdTheta_dTk(iLayer) ,& ! intent(in) : derivative in volumetric total water w.r.t. temperature (K-1)
- mLayerTempPrime(ixControlIndex) ,&
mLayerVolFracLiqPrime(iLayer) ,&
mLayerVolFracIcePrime(iLayer) ,&
! output
diff --git a/build/source/engine/sundials/varExtrSundials.f90 b/build/source/engine/sundials/varExtrSundials.f90
index 0760b51..35ba1f7 100644
--- a/build/source/engine/sundials/varExtrSundials.f90
+++ b/build/source/engine/sundials/varExtrSundials.f90
@@ -349,8 +349,6 @@ contains
subroutine residDiscontinuity(&
! input
stateVec, & ! intent(in): model state vector (mixed units)
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(in): model prognostic variables for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
! output
resid, & ! intent(out)
@@ -360,8 +358,6 @@ contains
implicit none
! input
real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
real(qp),intent(out) :: resid(:)
! output: error control
@@ -436,9 +432,6 @@ contains
! **********************************************************************************************************
subroutine countDiscontinuity(&
! input
- stateVec, & ! intent(in): model state vector (mixed units)
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(in): model prognostic variables for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
! output
countD, & ! intent(out)
@@ -447,9 +440,6 @@ contains
! --------------------------------------------------------------------------------------------------------------------------------
implicit none
! input
- real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
integer(i4b),intent(out) :: countD
! output: error control
--
GitLab