From ee6bcac0559023b1fb1299b30cadb276b10b24bc Mon Sep 17 00:00:00 2001
From: Kyle <kyle.c.klenk@gmail.com>
Date: Wed, 31 Aug 2022 21:15:51 +0000
Subject: [PATCH] sundials is compiling with the files that are a part of this
commit. Errors in the code still.
---
build/makefile_sundials | 23 +-
build/source/dshare/get_ixname.f90 | 8 +-
build/source/dshare/popMetadat.f90 | 53 +-
build/source/dshare/var_lookup.f90 | 60 +-
build/source/engine/computFlux.f90 | 74 +-
build/source/engine/computJacob.f90 | 24 +-
build/source/engine/eval8summa.f90 | 6 +
build/source/engine/opSplittin.f90 | 1616 +++++++++--------
build/source/engine/ssdNrgFlux.f90 | 6 +
build/source/engine/summaSolve.f90 | 4 +
.../source/engine/sundials/computEnthalpy.f90 | 156 ++
.../source/engine/sundials/computHeatCap.f90 | 510 ++++++
build/source/engine/sundials/computJacDAE.f90 | 738 ++++++++
.../source/engine/sundials/computResidDAE.f90 | 346 ++++
.../engine/sundials/computThermConduct.f90 | 287 +++
build/source/engine/sundials/eval8DAE.f90 | 764 ++++++++
.../engine/sundials/eval8JacDAE copy.f90 | 352 ++++
build/source/engine/sundials/eval8JacDAE.f90 | 352 ++++
build/source/engine/sundials/evalDAE4IDA.f90 | 167 ++
build/source/engine/sundials/evalJac4IDA.f90 | 128 ++
.../engine/sundials/soil_utilsSundials.f90 | 234 +++
build/source/engine/sundials/solveByIDA.f90 | 742 ++++++++
.../engine/sundials/systemSolvSundials.f90 | 553 ++++++
build/source/engine/sundials/tol4IDA.f90 | 291 +++
build/source/engine/sundials/type4IDA.f90 | 84 +
.../engine/sundials/updatStateSundials.f90 | 320 ++++
.../engine/sundials/updateVars4JacDAE.f90 | 820 +++++++++
.../engine/sundials/updateVarsSundials.f90 | 655 +++++++
.../engine/sundials/varExtrSundials.f90 | 515 ++++++
.../engine/sundials/varSubstepSundials.f90 | 1094 +++++++++++
build/source/engine/systemSolv.f90 | 5 +
build/source/engine/updateVars.f90 | 5 +-
build/source/engine/varSubstep.f90 | 16 +-
33 files changed, 10207 insertions(+), 801 deletions(-)
create mode 100644 build/source/engine/sundials/computEnthalpy.f90
create mode 100644 build/source/engine/sundials/computHeatCap.f90
create mode 100644 build/source/engine/sundials/computJacDAE.f90
create mode 100644 build/source/engine/sundials/computResidDAE.f90
create mode 100644 build/source/engine/sundials/computThermConduct.f90
create mode 100644 build/source/engine/sundials/eval8DAE.f90
create mode 100644 build/source/engine/sundials/eval8JacDAE copy.f90
create mode 100644 build/source/engine/sundials/eval8JacDAE.f90
create mode 100644 build/source/engine/sundials/evalDAE4IDA.f90
create mode 100644 build/source/engine/sundials/evalJac4IDA.f90
create mode 100644 build/source/engine/sundials/soil_utilsSundials.f90
create mode 100644 build/source/engine/sundials/solveByIDA.f90
create mode 100644 build/source/engine/sundials/systemSolvSundials.f90
create mode 100644 build/source/engine/sundials/tol4IDA.f90
create mode 100644 build/source/engine/sundials/type4IDA.f90
create mode 100644 build/source/engine/sundials/updatStateSundials.f90
create mode 100644 build/source/engine/sundials/updateVars4JacDAE.f90
create mode 100644 build/source/engine/sundials/updateVarsSundials.f90
create mode 100644 build/source/engine/sundials/varExtrSundials.f90
create mode 100644 build/source/engine/sundials/varSubstepSundials.f90
diff --git a/build/makefile_sundials b/build/makefile_sundials
index 1c35e58..78d7a75 100644
--- a/build/makefile_sundials
+++ b/build/makefile_sundials
@@ -66,7 +66,8 @@ GRU_ACTOR_DIR = $(ACTORS_DIR)/gru_actor
SUMMA_NRUTIL= \
nrtype.f90 \
f2008funcs.f90 \
- nr_utility.f90
+ nr_utility.f90 \
+
NRUTIL = $(patsubst %, $(ENGINE_DIR)/%, $(SUMMA_NRUTIL))
# Numerical recipes procedures
@@ -103,7 +104,9 @@ SUMMA_UTILMS= \
mDecisions.f90 \
snow_utils.f90 \
soil_utils.f90 \
+ sundials/soil_utilsSundials.f90 \
updatState.f90 \
+ sundials/updatStateSundials.f90 \
matrixOper.f90
UTILMS = $(patsubst %, $(ENGINE_DIR)/%, $(SUMMA_UTILMS))
@@ -130,8 +133,23 @@ SUMMA_SOLVER= \
eval8summa.f90 \
summaSolve.f90 \
systemSolv.f90 \
+ sundials/type4IDA.f90 \
+ sundials/tol4IDA.f90 \
+ sundials/computEnthalpy.f90 \
+ sundials/computHeatCap.f90 \
+ sundials/computThermConduct.f90 \
+ sundials/computResidDAE.f90 \
+ sundials/eval8DAE.f90 \
+ sundials/evalDAE4IDA.f90 \
+ sundials/computJacDAE.f90 \
+ sundials/eval8DAE.f90 \
+ sundials/eval8JacDAE.f90 \
+ sundials/evalJac4IDA.f90 \
sundials/computSnowDepth.f90 \
+ sundials/solveByIDA.f90 \
+ sundials/systemSolvSundials.f90 \
varSubstep.f90 \
+ sundials/varSubstepSundials.f90 \
opSplittin.f90 \
coupled_em.f90
@@ -203,8 +221,11 @@ NOAHMP = $(patsubst %, $(NOAHMP_DIR)/%, $(SUMMA_NOAHMP))
SUMMA_MODRUN = \
indexState.f90 \
getVectorz.f90 \
+ sundials/varExtrSundials.f90 \
sundials/t2enthalpy.f90 \
updateVars.f90 \
+ sundials/updateVarsSundials.f90 \
+ sundials/updateVars4JacDAE.f90 \
var_derive.f90 \
read_forcingActors.f90 \
access_forcing.f90\
diff --git a/build/source/dshare/get_ixname.f90 b/build/source/dshare/get_ixname.f90
index e3b1249..a1f4680 100755
--- a/build/source/dshare/get_ixname.f90
+++ b/build/source/dshare/get_ixname.f90
@@ -706,20 +706,20 @@ contains
case('dCanopyNetFlux_dCanairTemp' ); get_ixderiv = iLookDERIV%dCanopyNetFlux_dCanairTemp ! derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
case('dCanopyNetFlux_dCanopyTemp' ); get_ixderiv = iLookDERIV%dCanopyNetFlux_dCanopyTemp ! derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
case('dCanopyNetFlux_dGroundTemp' ); get_ixderiv = iLookDERIV%dCanopyNetFlux_dGroundTemp ! derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
- case('dCanopyNetFlux_dCanLiq' ); get_ixderiv = iLookDERIV%dCanopyNetFlux_dCanLiq ! derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
+ case('dCanopyNetFlux_dCanWat' ); get_ixderiv = iLookDERIV%dCanopyNetFlux_dCanWat ! derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
case('dGroundNetFlux_dCanairTemp' ); get_ixderiv = iLookDERIV%dGroundNetFlux_dCanairTemp ! derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
case('dGroundNetFlux_dCanopyTemp' ); get_ixderiv = iLookDERIV%dGroundNetFlux_dCanopyTemp ! derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
case('dGroundNetFlux_dGroundTemp' ); get_ixderiv = iLookDERIV%dGroundNetFlux_dGroundTemp ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
- case('dGroundNetFlux_dCanLiq' ); get_ixderiv = iLookDERIV%dGroundNetFlux_dCanLiq ! derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
+ case('dGroundNetFlux_dCanWat' ); get_ixderiv = iLookDERIV%dGroundNetFlux_dCanWat ! derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! derivatives in evaporative fluxes w.r.t. relevant state variables
case('dCanopyEvaporation_dTCanair' ); get_ixderiv = iLookDERIV%dCanopyEvaporation_dTCanair ! derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
case('dCanopyEvaporation_dTCanopy' ); get_ixderiv = iLookDERIV%dCanopyEvaporation_dTCanopy ! derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
case('dCanopyEvaporation_dTGround' ); get_ixderiv = iLookDERIV%dCanopyEvaporation_dTGround ! derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- case('dCanopyEvaporation_dCanLiq' ); get_ixderiv = iLookDERIV%dCanopyEvaporation_dCanLiq ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
+ case('dCanopyEvaporation_dCanWat' ); get_ixderiv = iLookDERIV%dCanopyEvaporation_dCanWat ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
case('dGroundEvaporation_dTCanair' ); get_ixderiv = iLookDERIV%dGroundEvaporation_dTCanair ! derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
case('dGroundEvaporation_dTCanopy' ); get_ixderiv = iLookDERIV%dGroundEvaporation_dTCanopy ! derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
case('dGroundEvaporation_dTGround' ); get_ixderiv = iLookDERIV%dGroundEvaporation_dTGround ! derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- case('dGroundEvaporation_dCanLiq' ); get_ixderiv = iLookDERIV%dGroundEvaporation_dCanLiq ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
+ case('dGroundEvaporation_dCanWat' ); get_ixderiv = iLookDERIV%dGroundEvaporation_dCanWat ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
! derivatives in canopy water w.r.t canopy temperature
case('dTheta_dTkCanopy' ); get_ixderiv = iLookDERIV%dTheta_dTkCanopy ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
case('dCanLiq_dTcanopy' ); get_ixderiv = iLookDERIV%dCanLiq_dTcanopy ! derivative of canopy liquid storage w.r.t. temperature (kg m-2 K-1)
diff --git a/build/source/dshare/popMetadat.f90 b/build/source/dshare/popMetadat.f90
index 3ec9511..7d023e4 100755
--- a/build/source/dshare/popMetadat.f90
+++ b/build/source/dshare/popMetadat.f90
@@ -352,6 +352,10 @@ subroutine popMetadat(err,message)
diag_meta(iLookDIAG%scalarLambda_wetsoil) = var_info('scalarLambda_wetsoil' , 'thermal conductivity of wet soil' , 'W m-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
diag_meta(iLookDIAG%mLayerThermalC) = var_info('mLayerThermalC' , 'thermal conductivity at the mid-point of each layer' , 'W m-1 K-1' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
diag_meta(iLookDIAG%iLayerThermalC) = var_info('iLayerThermalC' , 'thermal conductivity at the interface of each layer' , 'W m-1 K-1' , get_ixVarType('ifcToto'), iMissVec, iMissVec, .false.)
+ ! enthalpy
+ diag_meta(iLookDIAG%scalarCanairEnthalpy) = var_info('scalarCanairEnthalpy' , 'enthalpy of the canopy air space' , 'J m-3' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ diag_meta(iLookDIAG%scalarCanopyEnthalpy) = var_info('scalarCanopyEnthalpy' , 'enthalpy of the vegetation canopy' , 'J m-3' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ diag_meta(iLookDIAG%mLayerEnthalpy) = var_info('mLayerEnthalpy' , 'enthalpy of the snow+soil layers' , 'J m-3' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
! forcing
diag_meta(iLookDIAG%scalarVPair) = var_info('scalarVPair' , 'vapor pressure of the air above the vegetation canopy' , 'Pa' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
diag_meta(iLookDIAG%scalarVP_CanopyAir) = var_info('scalarVP_CanopyAir' , 'vapor pressure of the canopy air space' , 'Pa' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
@@ -423,6 +427,7 @@ subroutine popMetadat(err,message)
diag_meta(iLookDIAG%scalarVolLatHt_fus) = var_info('scalarVolLatHt_fus' , 'volumetric latent heat of fusion' , 'J m-3' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
! number of function evaluations
diag_meta(iLookDIAG%numFluxCalls) = var_info('numFluxCalls' , 'number of flux calls' , '-' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ diag_meta(iLookDIAG%wallClockTime) = var_info('wallClockTime' , 'wall clock time' , 's' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
! -----
! * local model fluxes...
@@ -538,23 +543,30 @@ subroutine popMetadat(err,message)
deriv_meta(iLookDERIV%dCanopyNetFlux_dCanairTemp) = var_info('dCanopyNetFlux_dCanairTemp' , 'derivative in net canopy flux w.r.t. canopy air temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCanopyNetFlux_dCanopyTemp) = var_info('dCanopyNetFlux_dCanopyTemp' , 'derivative in net canopy flux w.r.t. canopy temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCanopyNetFlux_dGroundTemp) = var_info('dCanopyNetFlux_dGroundTemp' , 'derivative in net canopy flux w.r.t. ground temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- deriv_meta(iLookDERIV%dCanopyNetFlux_dCanLiq) = var_info('dCanopyNetFlux_dCanLiq' , 'derivative in net canopy fluxes w.r.t. canopy liquid water content' , 'J kg-1 s-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dCanopyNetFlux_dCanWat) = var_info('dCanopyNetFlux_dCanWat' , 'derivative in net canopy fluxes w.r.t. canopy liquid water content' , 'J kg-1 s-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundNetFlux_dCanairTemp) = var_info('dGroundNetFlux_dCanairTemp' , 'derivative in net ground flux w.r.t. canopy air temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundNetFlux_dCanopyTemp) = var_info('dGroundNetFlux_dCanopyTemp' , 'derivative in net ground flux w.r.t. canopy temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundNetFlux_dGroundTemp) = var_info('dGroundNetFlux_dGroundTemp' , 'derivative in net ground flux w.r.t. ground temperature' , 'W m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- deriv_meta(iLookDERIV%dGroundNetFlux_dCanLiq) = var_info('dGroundNetFlux_dCanLiq' , 'derivative in net ground fluxes w.r.t. canopy liquid water content' , 'J kg-1 s-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dGroundNetFlux_dCanWat) = var_info('dGroundNetFlux_dCanWat' , 'derivative in net ground fluxes w.r.t. canopy liquid water content' , 'J kg-1 s-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
! derivatives in evaporative fluxes w.r.t. relevant state variables
deriv_meta(iLookDERIV%dCanopyEvaporation_dTCanair) = var_info('dCanopyEvaporation_dTCanair' , 'derivative in canopy evaporation w.r.t. canopy air temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCanopyEvaporation_dTCanopy) = var_info('dCanopyEvaporation_dTCanopy' , 'derivative in canopy evaporation w.r.t. canopy temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCanopyEvaporation_dTGround) = var_info('dCanopyEvaporation_dTGround' , 'derivative in canopy evaporation w.r.t. ground temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- deriv_meta(iLookDERIV%dCanopyEvaporation_dCanLiq) = var_info('dCanopyEvaporation_dCanLiq' , 'derivative in canopy evaporation w.r.t. canopy liquid water content' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dCanopyEvaporation_dCanWat) = var_info('dCanopyEvaporation_dCanWat' , 'derivative in canopy evaporation w.r.t. canopy liquid water content' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundEvaporation_dTCanair) = var_info('dGroundEvaporation_dTCanair' , 'derivative in ground evaporation w.r.t. canopy air temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundEvaporation_dTCanopy) = var_info('dGroundEvaporation_dTCanopy' , 'derivative in ground evaporation w.r.t. canopy temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dGroundEvaporation_dTGround) = var_info('dGroundEvaporation_dTGround' , 'derivative in ground evaporation w.r.t. ground temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- deriv_meta(iLookDERIV%dGroundEvaporation_dCanLiq) = var_info('dGroundEvaporation_dCanLiq' , 'derivative in ground evaporation w.r.t. canopy liquid water content' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- ! derivatives in canopy water w.r.t canopy temperature
+ deriv_meta(iLookDERIV%dGroundEvaporation_dCanWat) = var_info('dGroundEvaporation_dCanWat' , 'derivative in ground evaporation w.r.t. canopy liquid water content' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ ! derivatives in transpiration
+ deriv_meta(iLookDERIV%dCanopyTrans_dTCanair) = var_info('dCanopyTrans_dTCanair' , 'derivative in canopy transpiration w.r.t. canopy air temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dCanopyTrans_dTCanopy) = var_info('dCanopyTrans_dTCanopy' , 'derivative in canopy transpiration w.r.t. canopy temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dCanopyTrans_dTGround) = var_info('dCanopyTrans_dTGround' , 'derivative in canopy transpiration w.r.t. ground temperature' , 'kg m-2 s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dCanopyTrans_dCanWat) = var_info('dCanopyTrans_dCanWat' , 'derivative in canopy transpiration w.r.t. canopy total water content' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ ! derivatives in canopy water w.r.t canopy temperature
deriv_meta(iLookDERIV%dTheta_dTkCanopy) = var_info('dTheta_dTkCanopy' , 'derivative of volumetric liquid water content w.r.t. temperature' , 'K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%d2Theta_dTkCanopy2) = var_info('d2Theta_dTkCanopy2' , 'second derivative of volumetric liquid water content w.r.t. temperature', 'K-2' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCanLiq_dTcanopy) = var_info('dCanLiq_dTcanopy' , 'derivative of canopy liquid storage w.r.t. temperature' , 'kg m-2 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dFracLiqVeg_dTkCanopy) = var_info('dFracLiqVeg_dTkCanopy' , 'derivative in fraction of (throughfall + drainage) w.r.t. temperature', 'K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
! derivatives in canopy liquid fluxes w.r.t. canopy water
deriv_meta(iLookDERIV%scalarCanopyLiqDeriv) = var_info('scalarCanopyLiqDeriv' , 'derivative in (throughfall + drainage) w.r.t. canopy liquid water' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%scalarThroughfallRainDeriv) = var_info('scalarThroughfallRainDeriv' , 'derivative in throughfall w.r.t. canopy liquid water' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
@@ -562,24 +574,49 @@ subroutine popMetadat(err,message)
! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
deriv_meta(iLookDERIV%dNrgFlux_dTempAbove) = var_info('dNrgFlux_dTempAbove' , 'derivatives in the flux w.r.t. temperature in the layer above' , 'J m-2 s-1 K-1' , get_ixVarType('ifcToto'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dNrgFlux_dTempBelow) = var_info('dNrgFlux_dTempBelow' , 'derivatives in the flux w.r.t. temperature in the layer below' , 'J m-2 s-1 K-1' , get_ixVarType('ifcToto'), iMissVec, iMissVec, .false.)
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
+ deriv_meta(iLookDERIV%dNrgFlux_dWatAbove) = var_info('dNrgFlux_dWatAbove' , 'derivatives in the flux w.r.t. water state in the layer above' , 'unknown' , get_ixVarType('ifcToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dNrgFlux_dWatBelow) = var_info('dNrgFlux_dWatBelow' , 'derivatives in the flux w.r.t. water state in the layer below' , 'unknown' , get_ixVarType('ifcToto'), iMissVec, iMissVec, .false.)
! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
deriv_meta(iLookDERIV%iLayerLiqFluxSnowDeriv) = var_info('iLayerLiqFluxSnowDeriv' , 'derivative in vertical liquid water flux at layer interfaces' , 'm s-1' , get_ixVarType('ifcSnow'), iMissVec, iMissVec, .false.)
! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
deriv_meta(iLookDERIV%dVolTot_dPsi0) = var_info('dVolTot_dPsi0' , 'derivative in total water content w.r.t. total water matric potential', 'm-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%d2VolTot_d2Psi0) = var_info('d2VolTot_d2Psi0' , 'second derivative in total water content w.r.t. total water matric potential', 'm-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dCompress_dPsi) = var_info('dCompress_dPsi' , 'derivative in compressibility w.r.t matric head' , 'm-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%mLayerdTheta_dPsi) = var_info('mLayerdTheta_dPsi' , 'derivative in the soil water characteristic w.r.t. psi' , 'm-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%mLayerdPsi_dTheta) = var_info('mLayerdPsi_dTheta' , 'derivative in the soil water characteristic w.r.t. theta' , 'm' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dq_dHydStateAbove) = var_info('dq_dHydStateAbove' , 'change in flux at layer interfaces w.r.t. states in the layer above' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dq_dHydStateBelow) = var_info('dq_dHydStateBelow' , 'change in flux at layer interfaces w.r.t. states in the layer below' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dq_dHydStateLayerSurfVec) = var_info('dq_dHydStateLayerSurfVec' , 'change in the flux in soil surface interface w.r.t. state variables in layers' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
! derivative in baseflow flux w.r.t. aquifer storage
deriv_meta(iLookDERIV%dBaseflow_dAquifer) = var_info('dBaseflow_dAquifer' , 'derivative in baseflow flux w.r.t. aquifer storage' , 's-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
- ! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
+ ! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
deriv_meta(iLookDERIV%dq_dNrgStateAbove) = var_info('dq_dNrgStateAbove' , 'change in flux at layer interfaces w.r.t. states in the layer above' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dq_dNrgStateBelow) = var_info('dq_dNrgStateBelow' , 'change in flux at layer interfaces w.r.t. states in the layer below' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
- deriv_meta(iLookDERIV%mLayerdTheta_dTk) = var_info('mLayerdTheta_dTk' , 'derivative of volumetric liquid water content w.r.t. temperature' , 'K-1' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dq_dNrgStateLayerSurfVec) = var_info('dq_dNrgStateLayerSurfVec' , 'change in the flux in soil surface interface w.r.t. state variables in layers' , 'unknown' , get_ixVarType('ifcSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dPsiLiq_dTemp) = var_info('dPsiLiq_dTemp' , 'derivative in the liquid water matric potential w.r.t. temperature' , 'm K-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
deriv_meta(iLookDERIV%dPsiLiq_dPsi0) = var_info('dPsiLiq_dPsi0' , 'derivative in liquid matric potential w.r.t. total matric potential' , '-' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
-
+ ! derivatives in soil transpiration w.r.t. canopy state variables
+ deriv_meta(iLookDERIV%mLayerdTrans_dTCanair) = var_info('mLayerdTrans_dTCanair' , 'derivatives in the soil layer transpiration flux w.r.t. canopy air temperature', 'm s-1 K-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%mLayerdTrans_dTCanopy) = var_info('mLayerdTrans_dTCanopy' , 'derivatives in the soil layer transpiration flux w.r.t. canopy temperature', 'm s-1 K-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%mLayerdTrans_dTGround) = var_info('mLayerdTrans_dTGround' , 'derivatives in the soil layer transpiration flux w.r.t. ground temperature', 'm s-1 K-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%mLayerdTrans_dCanWat) = var_info('mLayerdTrans_dCanWat' , 'derivatives in the soil layer transpiration flux w.r.t. canopy total water', 'm-1 s-1 kg-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ ! derivatives in aquifer transpiration w.r.t. canopy state variables
+ deriv_meta(iLookDERIV%dAquiferTrans_dTCanair) = var_info('dAquiferTrans_dTCanair' , 'derivative in the aquifer transpiration flux w.r.t. canopy air temperature', 'm s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dAquiferTrans_dTCanopy) = var_info('dAquiferTrans_dTCanopy' , 'derivative in the aquifer transpiration flux w.r.t. canopy temperature', 'm s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dAquiferTrans_dTGround) = var_info('dAquiferTrans_dTGround' , 'derivative in the aquifer transpiration flux w.r.t. ground temperature', 'm s-1 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dAquiferTrans_dCanWat) = var_info('dAquiferTrans_dCanWat' , 'derivative in the aquifer transpiration flux w.r.t. canopy total water', 'm-1 s-1 kg-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
+ deriv_meta(iLookDERIV%dFracLiqSnow_dTk) = var_info('dFracLiqSnow_dTk' , 'derivative in fraction of liquid snow w.r.t. temperature' , 'K-1' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%mLayerdTheta_dTk) = var_info('mLayerdTheta_dTk' , 'derivative of volumetric liquid water content w.r.t. temperature' , 'K-1' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%mLayerd2Theta_dTk2) = var_info('mLayerd2Theta_dTk2' , 'second derivative of volumetric liquid water content w.r.t. temperature', 'K-2' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ ! derivate in bulk heat capacity w.r.t. relevant state variables
+ deriv_meta(iLookDERIV%dVolHtCapBulk_dPsi0) = var_info('dVolHtCapBulk_dPsi0' , 'derivative in bulk heat capacity w.r.t. matric potential' , 'J m-4 K-1' , get_ixVarType('midSoil'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dVolHtCapBulk_dTheta) = var_info('dVolHtCapBulk_dTheta' , 'derivative in bulk heat capacity w.r.t. volumetric water content' , 'J m-3 K-1' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dVolHtCapBulk_dCanWat) = var_info('dVolHtCapBulk_dCanWat' , 'derivative in bulk heat capacity w.r.t. volumetric water content' , 'J m-3 K-1' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dVolHtCapBulk_dTk) = var_info('dVolHtCapBulk_dTk' , 'derivative in bulk heat capacity w.r.t. temperature' , 'J m-3 K-2' , get_ixVarType('midToto'), iMissVec, iMissVec, .false.)
+ deriv_meta(iLookDERIV%dVolHtCapBulk_dTkCanopy) = var_info('dVolHtCapBulk_dTkCanopy' , 'derivative in bulk heat capacity w.r.t. temperature' , 'J m-3 K-2' , get_ixVarType('scalarv'), iMissVec, iMissVec, .false.)
+
! -----
! * basin-wide runoff and aquifer fluxes...
! -----------------------------------------
diff --git a/build/source/dshare/var_lookup.f90 b/build/source/dshare/var_lookup.f90
index 7e9e48e..df8c155 100755
--- a/build/source/dshare/var_lookup.f90
+++ b/build/source/dshare/var_lookup.f90
@@ -369,6 +369,10 @@ MODULE var_lookup
integer(i4b) :: scalarLambda_wetsoil = integerMissing ! thermal conductivity of wet soil (W m-1 K-1)
integer(i4b) :: mLayerThermalC = integerMissing ! thermal conductivity at the mid-point of each layer (W m-1 K-1)
integer(i4b) :: iLayerThermalC = integerMissing ! thermal conductivity at the interface of each layer (W m-1 K-1)
+ ! enthalpy
+ integer(i4b) :: scalarCanairEnthalpy = integerMissing ! enthalpy of the canopy air space (J m-3)
+ integer(i4b) :: scalarCanopyEnthalpy = integerMissing ! enthalpy of the vegetation canopy (J m-3)
+ integer(i4b) :: mLayerEnthalpy = integerMissing ! enthalpy of the snow+soil layers (J m-3)
! forcing
integer(i4b) :: scalarVPair = integerMissing ! vapor pressure of the air above the vegetation canopy (Pa)
integer(i4b) :: scalarVP_CanopyAir = integerMissing ! vapor pressure of the canopy air space (Pa)
@@ -440,6 +444,7 @@ MODULE var_lookup
integer(i4b) :: scalarVolLatHt_fus = integerMissing ! volumetric latent heat of fusion (J m-3)
! number of function evaluations
integer(i4b) :: numFluxCalls = integerMissing ! number of flux calls (-)
+ integer(i4b) :: wallClockTime = integerMissing ! wall clock time (s)
endtype iLook_diag
! ***********************************************************************************************************
@@ -559,23 +564,30 @@ MODULE var_lookup
integer(i4b) :: dCanopyNetFlux_dCanairTemp = integerMissing ! derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
integer(i4b) :: dCanopyNetFlux_dCanopyTemp = integerMissing ! derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
integer(i4b) :: dCanopyNetFlux_dGroundTemp = integerMissing ! derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
- integer(i4b) :: dCanopyNetFlux_dCanLiq = integerMissing ! derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
+ integer(i4b) :: dCanopyNetFlux_dCanWat = integerMissing ! derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
integer(i4b) :: dGroundNetFlux_dCanairTemp = integerMissing ! derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
integer(i4b) :: dGroundNetFlux_dCanopyTemp = integerMissing ! derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
integer(i4b) :: dGroundNetFlux_dGroundTemp = integerMissing ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
- integer(i4b) :: dGroundNetFlux_dCanLiq = integerMissing ! derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
+ integer(i4b) :: dGroundNetFlux_dCanWat = integerMissing ! derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
! derivatives in evaporative fluxes w.r.t. relevant state variables
integer(i4b) :: dCanopyEvaporation_dTCanair = integerMissing ! derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
integer(i4b) :: dCanopyEvaporation_dTCanopy = integerMissing ! derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
integer(i4b) :: dCanopyEvaporation_dTGround = integerMissing ! derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyEvaporation_dCanLiq = integerMissing ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
+ integer(i4b) :: dCanopyEvaporation_dCanWat = integerMissing ! derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
integer(i4b) :: dGroundEvaporation_dTCanair = integerMissing ! derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
integer(i4b) :: dGroundEvaporation_dTCanopy = integerMissing ! derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
integer(i4b) :: dGroundEvaporation_dTGround = integerMissing ! derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dGroundEvaporation_dCanLiq = integerMissing ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
- ! derivatives in canopy water w.r.t canopy temperature
+ integer(i4b) :: dGroundEvaporation_dCanWat = integerMissing ! derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
+! derivatives in transpiration
+ integer(i4b) :: dCanopyTrans_dTCanair = integerMissing ! derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
+ integer(i4b) :: dCanopyTrans_dTCanopy = integerMissing ! derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
+ integer(i4b) :: dCanopyTrans_dTGround = integerMissing ! derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
+ integer(i4b) :: dCanopyTrans_dCanWat = integerMissing ! derivative in canopy transpiration w.r.t. canopy total water content (s-1)
+ ! derivatives in canopy water w.r.t canopy temperature
integer(i4b) :: dTheta_dTkCanopy = integerMissing ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
+ integer(i4b) :: d2Theta_dTkCanopy2 = integerMissing ! second derivative of volumetric liquid water content w.r.t. temperature
integer(i4b) :: dCanLiq_dTcanopy = integerMissing ! derivative of canopy liquid storage w.r.t. temperature (kg m-2 K-1)
+ integer(i4b) :: dFracLiqVeg_dTkCanopy = integerMissing ! derivative in fraction of (throughfall + drainage) w.r.t. temperature
! derivatives in canopy liquid fluxes w.r.t. canopy water
integer(i4b) :: scalarCanopyLiqDeriv = integerMissing ! derivative in (throughfall + canopy drainage) w.r.t. canopy liquid water (s-1)
integer(i4b) :: scalarThroughfallRainDeriv = integerMissing ! derivative in throughfall w.r.t. canopy liquid water (s-1)
@@ -583,12 +595,17 @@ MODULE var_lookup
! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
integer(i4b) :: dNrgFlux_dTempAbove = integerMissing ! derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
integer(i4b) :: dNrgFlux_dTempBelow = integerMissing ! derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
- ! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
+ integer(i4b) :: dNrgFlux_dWatAbove = integerMissing ! derivatives in the flux w.r.t. water state in the layer above
+ integer(i4b) :: dNrgFlux_dWatBelow = integerMissing ! 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
integer(i4b) :: iLayerLiqFluxSnowDeriv = integerMissing ! derivative in vertical liquid water flux at layer interfaces (m s-1)
! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
integer(i4b) :: dVolTot_dPsi0 = integerMissing ! derivative in total water content w.r.t. total water matric potential (m-1)
+ integer(i4b) :: d2VolTot_d2Psi0 = integerMissing ! second derivative in total water content w.r.t. total water matric potential
integer(i4b) :: dq_dHydStateAbove = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer above
integer(i4b) :: dq_dHydStateBelow = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer below
+ integer(i4b) :: dq_dHydStateLayerSurfVec = integerMissing ! change in the flux in soil surface interface w.r.t. state variables in layer above and below
integer(i4b) :: mLayerdTheta_dPsi = integerMissing ! derivative in the soil water characteristic w.r.t. psi (m-1)
integer(i4b) :: mLayerdPsi_dTheta = integerMissing ! derivative in the soil water characteristic w.r.t. theta (m)
integer(i4b) :: dCompress_dPsi = integerMissing ! derivative in compressibility w.r.t matric head (m-1)
@@ -597,10 +614,30 @@ MODULE var_lookup
! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
integer(i4b) :: dq_dNrgStateAbove = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer above
integer(i4b) :: dq_dNrgStateBelow = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer below
- integer(i4b) :: mLayerdTheta_dTk = integerMissing ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
+ integer(i4b) :: dq_dNrgStateLayerSurfVec = integerMissing ! change in the flux in soil surface interface w.r.t. state variables in layer above and below
integer(i4b) :: dPsiLiq_dTemp = integerMissing ! derivative in the liquid water matric potential w.r.t. temperature (m K-1)
integer(i4b) :: dPsiLiq_dPsi0 = integerMissing ! derivative in liquid water matric potential w.r.t. the total water matric potential (-)
- endtype iLook_deriv
+ ! derivatives in soil transpiration w.r.t. canopy state variables
+ integer(i4b) :: mLayerdTrans_dTCanair = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ integer(i4b) :: mLayerdTrans_dTCanopy = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ integer(i4b) :: mLayerdTrans_dTGround = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ integer(i4b) :: mLayerdTrans_dCanWat = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy total water
+ ! derivatives in aquifer transpiration w.r.t. canopy state variables
+ integer(i4b) :: dAquiferTrans_dTCanair = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy air temperature
+ integer(i4b) :: dAquiferTrans_dTCanopy = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy temperature
+ integer(i4b) :: dAquiferTrans_dTGround = integerMissing ! derivative in the aquifer transpiration flux w.r.t. ground temperature
+ integer(i4b) :: dAquiferTrans_dCanWat = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy total water
+ ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
+ integer(i4b) :: dFracLiqSnow_dTk = integerMissing ! derivative in fraction of liquid snow w.r.t. temperature
+ integer(i4b) :: mLayerdTheta_dTk = integerMissing ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
+ integer(i4b) :: mLayerd2Theta_dTk2 = integerMissing ! second derivative of volumetric liquid water content w.r.t. temperature
+ ! derivate in bulk heat capacity w.r.t. relevant state variables
+ integer(i4b) :: dVolHtCapBulk_dPsi0 = integerMissing ! derivative in bulk heat capacity w.r.t. matric potential
+ integer(i4b) :: dVolHtCapBulk_dTheta = integerMissing ! derivative in bulk heat capacity w.r.t. volumetric water content
+ integer(i4b) :: dVolHtCapBulk_dCanWat = integerMissing ! derivative in bulk heat capacity w.r.t. volumetric water content
+ integer(i4b) :: dVolHtCapBulk_dTk = integerMissing ! derivative in bulk heat capacity w.r.t. temperature
+ integer(i4b) :: dVolHtCapBulk_dTkCanopy = integerMissing ! derivative in bulk heat capacity w.r.t. temperature
+ endtype iLook_deriv
! ***********************************************************************************************************
! (10) define model indices
@@ -826,7 +863,7 @@ MODULE var_lookup
51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
61, 62, 63, 64, 65, 66, 67, 68, 69, 70,&
71, 72, 73, 74, 75, 76, 77, 78, 79, 80,&
- 81, 82, 83)
+ 81, 82, 83, 84, 85, 86, 87)
! named variables: model fluxes
type(iLook_flux), public,parameter :: iLookFLUX =iLook_flux ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
@@ -842,7 +879,10 @@ MODULE var_lookup
type(iLook_deriv), public,parameter :: iLookDERIV =iLook_deriv ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39)
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
+ 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
+ 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
+ 61, 62, 63, 64, 65)
! named variables: model indices
type(iLook_index), public,parameter :: iLookINDEX =ilook_index ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
diff --git a/build/source/engine/computFlux.f90 b/build/source/engine/computFlux.f90
index 1c7e5cd..2fe3d0b 100755
--- a/build/source/engine/computFlux.f90
+++ b/build/source/engine/computFlux.f90
@@ -97,6 +97,7 @@ implicit none
private
public::computFlux
public::soilCmpres
+public::soilCmpresSundials
contains
! *********************************************************************************************************
@@ -112,12 +113,14 @@ contains
firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ requireLWBal, & ! intent(in): flag to indicate if we need longwave to be balanced
drainageMeltPond, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
! input: state variables
scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
+ mLayerMatricHeadTrial, & ! intent(in) trial vector of total water matric potential (m)
scalarAquiferStorageTrial,& ! intent(in): trial value of storage of water in the aquifer (m)
! input: diagnostic variables defining the liquid water and ice content
scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
@@ -164,12 +167,14 @@ contains
logical(lgt),intent(in) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ logical(lgt),intent(in) :: requireLWBal ! flag to indicate if we need longwave to be balanced
real(dp),intent(in) :: drainageMeltPond ! drainage from the surface melt pond (kg m-2 s-1)
! input: state variables
real(dp),intent(in) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
real(dp),intent(in) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
real(dp),intent(in) :: mLayerTempTrial(:) ! trial value for temperature of each snow/soil layer (K)
real(dp),intent(in) :: mLayerMatricHeadLiqTrial(:) ! trial value for the liquid water matric potential (m)
+ real(dp),intent(in) :: mLayerMatricHeadTrial(:) ! trial value for the total water matric potential (m)
real(dp),intent(in) :: scalarAquiferStorageTrial ! trial value of aquifer storage (m)
! input: diagnostic variables
real(dp),intent(in) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
@@ -317,21 +322,21 @@ contains
dCanopyNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanairTemp )%dat(1) ,& ! intent(out): [dp] derivative in net canopy flux w.r.t. canopy air temperature
dCanopyNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanopyTemp )%dat(1) ,& ! intent(out): [dp] derivative in net canopy flux w.r.t. canopy temperature
dCanopyNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dGroundTemp )%dat(1) ,& ! intent(out): [dp] derivative in net canopy flux w.r.t. ground temperature
- dCanopyNetFlux_dCanLiq => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanLiq )%dat(1) ,& ! intent(out): [dp] derivative in net canopy fluxes w.r.t. canopy liquid water content
+ dCanopyNetFlux_dCanWat => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanWat )%dat(1) ,& ! intent(out): [dp] derivative in net canopy fluxes w.r.t. canopy liquid water content
dGroundNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanairTemp )%dat(1) ,& ! intent(out): [dp] derivative in net ground flux w.r.t. canopy air temperature
dGroundNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanopyTemp )%dat(1) ,& ! intent(out): [dp] derivative in net ground flux w.r.t. canopy temperature
dGroundNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dGroundTemp )%dat(1) ,& ! intent(out): [dp] derivative in net ground flux w.r.t. ground temperature
- dGroundNetFlux_dCanLiq => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanLiq )%dat(1) ,& ! intent(out): [dp] derivative in net ground fluxes w.r.t. canopy liquid water content
+ dGroundNetFlux_dCanWat => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanWat )%dat(1) ,& ! intent(out): [dp] derivative in net ground fluxes w.r.t. canopy liquid water content
! derivatives in evaporative fluxes w.r.t. relevant state variables
dCanopyEvaporation_dTCanair => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanair )%dat(1) ,& ! intent(out): [dp] derivative in canopy evaporation w.r.t. canopy air temperature
dCanopyEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanopy )%dat(1) ,& ! intent(out): [dp] derivative in canopy evaporation w.r.t. canopy temperature
dCanopyEvaporation_dTGround => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTGround )%dat(1) ,& ! intent(out): [dp] derivative in canopy evaporation w.r.t. ground temperature
- dCanopyEvaporation_dCanLiq => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanLiq )%dat(1) ,& ! intent(out): [dp] derivative in canopy evaporation w.r.t. canopy liquid water content
+ dCanopyEvaporation_dCanWat => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanWat )%dat(1) ,& ! intent(out): [dp] derivative in canopy evaporation w.r.t. canopy liquid water content
dGroundEvaporation_dTCanair => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanair )%dat(1) ,& ! intent(out): [dp] derivative in ground evaporation w.r.t. canopy air temperature
dGroundEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanopy )%dat(1) ,& ! intent(out): [dp] derivative in ground evaporation w.r.t. canopy temperature
dGroundEvaporation_dTGround => deriv_data%var(iLookDERIV%dGroundEvaporation_dTGround )%dat(1) ,& ! intent(out): [dp] derivative in ground evaporation w.r.t. ground temperature
- dGroundEvaporation_dCanLiq => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanLiq )%dat(1) ,& ! intent(out): [dp] derivative in ground evaporation w.r.t. canopy liquid water content
+ dGroundEvaporation_dCanWat => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanWat )%dat(1) ,& ! intent(out): [dp] derivative in ground evaporation w.r.t. canopy liquid water content
! derivatives in canopy water w.r.t canopy temperature
dCanLiq_dTcanopy => deriv_data%var(iLookDERIV%dCanLiq_dTcanopy )%dat(1) ,& ! intent(out): [dp] derivative of canopy liquid storage w.r.t. temperature
@@ -446,18 +451,18 @@ contains
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_dCanLiq, & ! intent(out): derivative in canopy evaporation w.r.t. canopy liquid water content (s-1)
+ 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_dCanLiq, & ! intent(out): derivative in ground evaporation w.r.t. canopy liquid water content (s-1)
+ 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_dCanLiq, & ! intent(out): derivative in net canopy fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
- dGroundNetFlux_dCanLiq, & ! intent(out): derivative in net ground fluxes w.r.t. canopy liquid water content (J kg-1 s-1)
+ 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)
@@ -497,6 +502,9 @@ contains
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
@@ -904,5 +912,55 @@ contains
dCompress_dPsi(:) = 0._dp
end if
end subroutine soilCmpres
+ ! **********************************************************************************************************
+ ! public subroutine soilCmpres: compute soil compressibility (-) and its derivative w.r.t matric head (m-1)
+ ! **********************************************************************************************************
+subroutine soilCmpresSundials(&
+ ! input:
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
+ mLayerMatricHeadPrime, & ! intent(in): matric head at the start of the time step (m)
+ mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ! output:
+ compress, & ! intent(out): compressibility of the soil matrix (-)
+ dCompress_dPsi, & ! intent(out): derivative in compressibility w.r.t. matric head (m-1)
+ err,message) ! intent(out): error code and error message
+ implicit none
+ ! input:
+ integer(i4b),intent(in) :: ixRichards ! choice of option for Richards' equation
+ integer(i4b),intent(in) :: ixBeg,ixEnd ! start and end indices defining desired layers
+ real(rkind),intent(in) :: mLayerMatricHeadPrime(:) ! matric head at the start of the time step (m)
+ real(rkind),intent(in) :: mLayerVolFracLiqTrial(:) ! trial value for volumetric fraction of liquid water (-)
+ real(rkind),intent(in) :: mLayerVolFracIceTrial(:) ! trial value for volumetric fraction of ice (-)
+ real(rkind),intent(in) :: specificStorage ! specific storage coefficient (m-1)
+ real(rkind),intent(in) :: theta_sat(:) ! soil porosity (-)
+ ! output:
+ real(rkind),intent(inout) :: compress(:) ! soil compressibility (-)
+ real(rkind),intent(inout) :: dCompress_dPsi(:) ! derivative in soil compressibility w.r.t. matric head (m-1)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local variables
+ integer(i4b) :: iLayer ! index of soil layer
+ ! --------------------------------------------------------------
+ ! initialize error control
+ err=0; message='soilCmpresSundials/'
+ ! (only compute for the mixed form of Richards' equation)
+ if(ixRichards==mixdform)then
+ do iLayer=1,size(mLayerMatricHeadPrime)
+ if(iLayer>=ixBeg .and. iLayer<=ixEnd)then
+ ! compute the derivative for the compressibility term (m-1)
+ dCompress_dPsi(iLayer) = specificStorage*(mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer))/theta_sat(iLayer)
+ ! compute the compressibility term (-)
+ compress(iLayer) = mLayerMatricHeadPrime(iLayer) * dCompress_dPsi(iLayer)
+ endif
+ end do
+ else
+ compress(:) = 0._rkind
+ dCompress_dPsi(:) = 0._rkind
+ end if
+end subroutine soilCmpresSundials
end module computFlux_module
diff --git a/build/source/engine/computJacob.f90 b/build/source/engine/computJacob.f90
index 147f320..4073f56 100755
--- a/build/source/engine/computJacob.f90
+++ b/build/source/engine/computJacob.f90
@@ -185,19 +185,19 @@ contains
dCanopyNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy air temperature
dCanopyNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy temperature
dCanopyNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. ground temperature
- dCanopyNetFlux_dCanLiq => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanLiq )%dat(1) ,& ! intent(in): [dp] derivative in net canopy fluxes w.r.t. canopy liquid water content
+ dCanopyNetFlux_dCanWat => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net canopy fluxes w.r.t. canopy liquid water content
dGroundNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy air temperature
dGroundNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy temperature
- dGroundNetFlux_dCanLiq => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanLiq )%dat(1) ,& ! intent(in): [dp] derivative in net ground fluxes w.r.t. canopy liquid water content
+ dGroundNetFlux_dCanWat => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net ground fluxes w.r.t. canopy liquid water content
! derivatives in evaporative fluxes w.r.t. relevant state variables
dCanopyEvaporation_dTCanair => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy air temperature
dCanopyEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy temperature
dCanopyEvaporation_dTGround => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. ground temperature
- dCanopyEvaporation_dCanLiq => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanLiq )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy liquid water content
+ dCanopyEvaporation_dCanWat => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy liquid water content
dGroundEvaporation_dTCanair => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy air temperature
dGroundEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy temperature
dGroundEvaporation_dTGround => deriv_data%var(iLookDERIV%dGroundEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. ground temperature
- dGroundEvaporation_dCanLiq => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanLiq )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy liquid water content
+ dGroundEvaporation_dCanWat => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy liquid water content
! derivatives in canopy water w.r.t canopy temperature
dCanLiq_dTcanopy => deriv_data%var(iLookDERIV%dCanLiq_dTcanopy )%dat(1) ,& ! intent(in): [dp] derivative of canopy liquid storage w.r.t. temperature
dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative of volumetric liquid water content w.r.t. temperature
@@ -285,7 +285,7 @@ contains
! * diagonal elements for the vegetation canopy (-)
if(ixCasNrg/=integerMissing) aJac(ixDiag,ixCasNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanairTemp) + dMat(ixCasNrg)
if(ixVegNrg/=integerMissing) aJac(ixDiag,ixVegNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanopyTemp) + dMat(ixVegNrg)
- if(ixVegHyd/=integerMissing) aJac(ixDiag,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanLiq - scalarCanopyLiqDeriv)*dt + 1._dp ! ixVegHyd: CORRECT
+ if(ixVegHyd/=integerMissing) aJac(ixDiag,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._dp ! ixVegHyd: CORRECT
! * cross-derivative terms w.r.t. canopy water
if(ixVegHyd/=integerMissing)then
@@ -297,8 +297,8 @@ contains
if(ixTopHyd/=integerMissing) aJac(ixOffDiag(ixTopHyd,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
! cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
- if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixVegNrg,ixVegHyd),ixVegHyd) = (dt/canopyDepth) *(-dCanopyNetFlux_dCanLiq) - (1._dp - scalarFracLiqVeg)*LH_fus/canopyDepth ! dF/dLiq
- if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixTopNrg,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanLiq)
+ if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixVegNrg,ixVegHyd),ixVegHyd) = (dt/canopyDepth) *(-dCanopyNetFlux_dCanWat) - (1._dp - scalarFracLiqVeg)*LH_fus/canopyDepth ! dF/dLiq
+ if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixTopNrg,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
endif
! cross-derivative terms between surface hydrology and the temperature of the vegetation canopy (K-1)
@@ -472,7 +472,7 @@ contains
! - include derivatives w.r.t. ground evaporation
if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
if(computeVegFlux)then
- aJac(ixOffDiag(watState,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanLiq/iden_water) ! dVol/dLiq (kg m-2)-1
+ aJac(ixOffDiag(watState,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
aJac(ixOffDiag(watState,ixCasNrg),ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
aJac(ixOffDiag(watState,ixVegNrg),ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
endif
@@ -529,7 +529,7 @@ contains
if(computeVegFlux)then ! (derivatives only defined when vegetation protrudes over the surface)
! * liquid water fluxes for vegetation canopy (-)
- if(ixVegHyd/=integerMissing) aJac(ixVegHyd,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanLiq - scalarCanopyLiqDeriv)*dt + 1._dp
+ if(ixVegHyd/=integerMissing) aJac(ixVegHyd,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._dp
! * cross-derivative terms for canopy water
if(ixVegHyd/=integerMissing)then
@@ -541,8 +541,8 @@ contains
if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
! cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
- if(ixVegNrg/=integerMissing) aJac(ixVegNrg,ixVegHyd) = (dt/canopyDepth) *(-dCanopyNetFlux_dCanLiq) - (1._dp - scalarFracLiqVeg)*LH_fus/canopyDepth ! dF/dLiq
- if(ixTopNrg/=integerMissing) aJac(ixTopNrg,ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanLiq)
+ if(ixVegNrg/=integerMissing) aJac(ixVegNrg,ixVegHyd) = (dt/canopyDepth) *(-dCanopyNetFlux_dCanWat) - (1._dp - scalarFracLiqVeg)*LH_fus/canopyDepth ! dF/dLiq
+ if(ixTopNrg/=integerMissing) aJac(ixTopNrg,ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
endif
! cross-derivative terms w.r.t. canopy temperature (K-1)
@@ -727,7 +727,7 @@ contains
! - include derivatives w.r.t. ground evaporation
if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
if(computeVegFlux)then
- aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanLiq/iden_water) ! dVol/dLiq (kg m-2)-1
+ aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
endif
diff --git a/build/source/engine/eval8summa.f90 b/build/source/engine/eval8summa.f90
index bd13c24..8c13c23 100755
--- a/build/source/engine/eval8summa.f90
+++ b/build/source/engine/eval8summa.f90
@@ -67,6 +67,7 @@ USE data_types,only:&
var_d, & ! data vector (dp)
var_ilength, & ! data vector with variable length dimension (i4b)
var_dlength, & ! data vector with variable length dimension (dp)
+ zLookup, &
model_options ! defines the model decisions
! indices that define elements of the data structures
@@ -121,6 +122,7 @@ contains
sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
! input: data structures
model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
mpar_data, & ! intent(in): model parameters
@@ -169,6 +171,7 @@ contains
real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
! input: data structures
type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
type(var_i), intent(in) :: type_data ! type of vegetation and soil
type(var_d), intent(in) :: attr_data ! spatial attributes
type(var_dlength), intent(in) :: mpar_data ! model parameters
@@ -364,6 +367,7 @@ contains
call updateVars(&
! input
.false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ lookup_data, & ! intent(in): lookup tables for a local HRU
mpar_data, & ! intent(in): model parameters for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
prog_data, & ! intent(in): model prognostic variables for a local HRU
@@ -421,12 +425,14 @@ contains
firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ .true., & ! intent(in): balance longwave
scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
! input: state variables
scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
! input: diagnostic variables defining the liquid water and ice content
scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
diff --git a/build/source/engine/opSplittin.f90 b/build/source/engine/opSplittin.f90
index f499e8c..ee77b6d 100755
--- a/build/source/engine/opSplittin.f90
+++ b/build/source/engine/opSplittin.f90
@@ -193,818 +193,926 @@ subroutine opSplittin(&
stepFailure, & ! intent(out): flag to denote step failure
ixCoupling, & ! intent(out): coupling method used in this iteration
err,message) ! intent(out): error code and error message
- ! ---------------------------------------------------------------------------------------
- ! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
- ! simulation of fluxes and residuals given a trial state vector
- USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
- USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
- ! population/extraction of state vectors
- USE indexState_module,only:indexSplit ! get state indices
- USE varSubstep_module,only:varSubstep ! complete substeps for a given split
- ! identify name of variable type (for error message)
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- implicit none
- ! ---------------------------------------------------------------------------------------
- ! * dummy variables
- ! ---------------------------------------------------------------------------------------
- ! input: model control
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer(i4b),intent(in) :: nState ! total number of state variables
- real(dp),intent(inout) :: dt ! time step (seconds)
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! input/output: data structures
- type(var_i),intent(in) :: type_data ! type of vegetation and soil
- type(var_d),intent(in) :: attr_data ! spatial attributes
- type(var_d),intent(in) :: forc_data ! model forcing data
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
- type(var_dlength),intent(inout) :: 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
- type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- ! output: model control
- real(dp),intent(out) :: dtMultiplier ! substep multiplier (-)
- logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that ice is insufficient to support melt
- logical(lgt),intent(out) :: stepFailure ! flag to denote step failure
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- ! ---------------------------------------------------------------------------------------
- ! * general local variables
- ! ---------------------------------------------------------------------------------------
- character(LEN=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: minLayer ! the minimum layer used in assigning flags for flux aggregations
- integer(i4b) :: iOffset ! offset to account for different indices in the soil domain
- integer(i4b) :: iMin(1),iMax(1) ! bounds of a given vector
- integer(i4b) :: iLayer,jLayer ! index of model layer
- integer(i4b) :: iSoil ! index of soil layer
- integer(i4b) :: iVar ! index of variables in data structures
- logical(lgt) :: firstSuccess ! flag to define the first success
- logical(lgt) :: firstFluxCall ! flag to define the first flux call
- logical(lgt) :: reduceCoupledStep ! flag to define the need to reduce the length of the coupled step
- type(var_dlength) :: prog_temp ! temporary model prognostic variables
- type(var_dlength) :: diag_temp ! temporary model diagnostic variables
- type(var_dlength) :: flux_temp ! temporary model fluxes
- type(var_dlength) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- real(dp),dimension(nLayers) :: mLayerVolFracIceInit ! initial vector for volumetric fraction of ice (-)
- ! ------------------------------------------------------------------------------------------------------
- ! * operator splitting
- ! ------------------------------------------------------------------------------------------------------
- ! minimum timestep
- real(dp),parameter :: dtmin_coupled=1800._dp ! minimum time step for the fully coupled solution (seconds)
- real(dp),parameter :: dtmin_split=60._dp ! minimum time step for the fully split solution (seconds)
- real(dp),parameter :: dtmin_scalar=10._dp ! minimum time step for the scalar solution (seconds)
- real(dp) :: dt_min ! minimum time step (seconds)
- real(dp) :: dtInit ! initial time step (seconds)
- ! explicit error tolerance (depends on state type split, so defined here)
- real(dp),parameter :: errorTolLiqFlux=0.01_dp ! error tolerance in the explicit solution (liquid flux)
- real(dp),parameter :: errorTolNrgFlux=10._dp ! error tolerance in the explicit solution (energy flux)
- ! number of substeps taken for a given split
- integer(i4b) :: nSubsteps ! number of substeps taken for a given split
- ! named variables defining the coupling and solution method
- integer(i4b) :: ixCoupling ! index of coupling method (1,2)
- integer(i4b) :: ixSolution ! index of solution method (1,2)
- integer(i4b) :: ixStateThenDomain ! switch between the state and domain (1,2)
- integer(i4b) :: tryDomainSplit ! (0,1) - flag to try the domain split
- ! actual number of splits
- integer(i4b) :: nStateTypeSplit ! number of splits for the state type
- integer(i4b) :: nDomainSplit ! number of splits for the domain
- integer(i4b) :: nStateSplit ! number of splits for the states within a given domain
- ! indices for the state type and the domain split
- integer(i4b) :: iStateTypeSplit ! index of the state type split
- integer(i4b) :: iDomainSplit ! index of the domain split
- integer(i4b) :: iStateSplit ! index of the state split
- ! flux masks
- logical(lgt) :: neededFlux(nFlux) ! .true. if flux is needed at all
- logical(lgt) :: desiredFlux ! .true. if flux is desired for a given split
- type(var_ilength) :: fluxCount ! number of times each flux is updated (should equal nSubsteps)
- type(var_flagVec) :: fluxMask ! mask defining model fluxes
- ! state masks
- integer(i4b),dimension(nState) :: stateCheck ! number of times each state variable is updated (should equal 1)
- logical(lgt),dimension(nState) :: stateMask ! mask defining desired state variables
- integer(i4b) :: nSubset ! number of selected state variables for a given split
- ! flags
- logical(lgt) :: failure ! flag to denote failure of substepping
- logical(lgt) :: doAdjustTemp ! flag to adjust temperature after the mass split
- logical(lgt) :: failedMinimumStep ! flag to denote failure of substepping for a given split
- integer(i4b) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
- integer(i4b) :: nCoupling ! number of possible solutions
-
- ! ---------------------------------------------------------------------------------------
- ! point to variables in the data structures
- ! ---------------------------------------------------------------------------------------
- globalVars: associate(&
- ! model decisions
- ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
- ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
- ! domain boundary conditions
- airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
- ! vector of energy and hydrology indices for the snow and soil domains
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology state variables in the snow+soil domain
- ! indices of model state variables
- ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset (missing for values not in the subset)
- ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
- ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
- ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
- ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
- ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
- ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ! numerix tracking
- numberStateSplit => indx_data%var(iLookINDEX%numberStateSplit )%dat(1) ,& ! intent(inout): [i4b] number of state splitting solutions (-)
- numberDomainSplitNrg => indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for energy (-)
- numberDomainSplitMass => indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for mass (-)
- numberScalarSolutions => indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) ,& ! intent(inout): [i4b] number of scalar solutions (-)
- ! domain configuration
- canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- ! snow parameters
- snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
- ! depth-varying soil parameters
- 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_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
- ! soil parameters
- specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
- ! model diagnostic variables (fraction of liquid water)
- scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
- mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
- mLayerMeltFreeze => diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat ,& ! intent(out): [dp(:)] melt-freeze in each snow and soil layer (kg m-3)
- ! model state variables (vegetation canopy)
- scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(out): [dp] temperature of the canopy air space (K)
- scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(out): [dp] temperature of the vegetation canopy (K)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(out): [dp] mass of ice on the vegetation canopy (kg m-2)
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(out): [dp] mass of liquid water on the vegetation canopy (kg m-2)
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(out): [dp] mass of total water on the vegetation canopy (kg m-2)
- ! model state variables (snow and soil domains)
- mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(out): [dp(:)] temperature of each snow/soil layer (K)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(out): [dp(:)] volumetric fraction of ice (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(out): [dp(:)] volumetric fraction of liquid water (-)
- mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(out): [dp(:)] volumetric fraction of total water (-)
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(out): [dp(:)] matric head (m)
- mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(out): [dp(:)] matric potential of liquid water (m)
- )
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="opSplittin/"
-
- ! we just solve the fully coupled problem by ida
- select case(model_decisions(iLookDECISIONS%diffEqSolv)%iDecision)
- case(sundialIDA); nCoupling = 1
- case(backwEuler); nCoupling = 2
- case default
- err=20
- message=trim(message)//'expect case to be sundialIDA or backwEuler'
- print*, message
- return
- end select
-
-
- print*, "nCoupling", nCoupling
- ! *****
- ! (0) PRELIMINARIES...
- ! ********************
-
- ! -----
- ! * initialize...
- ! ---------------
-
- ! set the global print flag
- globalPrintFlag=.false.
-
- if(globalPrintFlag)&
- print*, trim(message), dt
-
- ! initialize the first success call
- firstSuccess=.false.
-
- ! initialize the flags
- tooMuchMelt=.false. ! too much melt (merge snow layers)
- stepFailure=.false. ! step failure
-
- ! initialize flag for the success of the substepping
- failure=.false.
-
- ! initialize the flux check
- neededFlux(:) = .false.
-
- ! initialize the state check
- stateCheck(:) = 0
-
- ! compute the total water content in the vegetation canopy
- scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce ! kg m-2
-
- ! save volumetric ice content at the start of the step
- ! NOTE: used for volumetric loss due to melt-freeze
- mLayerVolFracIceInit(:) = mLayerVolFracIce(:)
-
- ! compute the total water content in snow and soil
- ! NOTE: no ice expansion allowed for soil
- if(nSnow>0)&
- mLayerVolFracWat( 1:nSnow ) = mLayerVolFracLiq( 1:nSnow ) + mLayerVolFracIce( 1:nSnow )*(iden_ice/iden_water)
- mLayerVolFracWat(nSnow+1:nLayers) = mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers)
-
- ! compute the liquid water matric potential (m)
- ! NOTE: include ice content as part of the solid porosity - major effect of ice is to reduce the pore size; ensure that effSat=1 at saturation
- ! (from Zhao et al., J. Hydrol., 1997: Numerical analysis of simultaneous heat and mass transfer...)
- do iSoil=1,nSoil
- call liquidHead(mLayerMatricHead(iSoil),mLayerVolFracLiq(nSnow+iSoil),mLayerVolFracIce(nSnow+iSoil), & ! input: state variables
- vGn_alpha(iSoil),vGn_n(iSoil),theta_sat(iSoil),theta_res(iSoil),vGn_m(iSoil), & ! input: parameters
- matricHeadLiq=mLayerMatricHeadLiq(iSoil), & ! output: liquid water matric potential (m)
- err=err,message=cmessage) ! output: error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- end do ! looping through soil layers (computing liquid water matric potential)
-
- ! allocate space for the flux mask (used to define when fluxes are updated)
- call allocLocal(flux_meta(:),fluxMask,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the flux count (used to check that fluxes are only updated once)
- call allocLocal(flux_meta(:),fluxCount,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the temporary prognostic variable structure
- call allocLocal(prog_meta(:),prog_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the temporary diagnostic variable structure
- call allocLocal(diag_meta(:),diag_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the temporary flux variable structure
- call allocLocal(flux_meta(:),flux_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the derivative structure
- call allocLocal(deriv_meta(:),deriv_data,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! intialize the flux conter
- do iVar=1,size(flux_meta) ! loop through fluxes
- fluxCount%var(iVar)%dat(:) = 0
- end do
-
- ! initialize the model fluxes
- do iVar=1,size(flux_meta) ! loop through fluxes
- if(flux2state_orig(iVar)%state1==integerMissing .and. flux2state_orig(iVar)%state2==integerMissing) cycle ! flux does not depend on state (e.g., input)
- if(flux2state_orig(iVar)%state1==iname_watCanopy .and. .not.computeVegFlux) cycle ! use input fluxes in cases where there is no canopy
- flux_data%var(iVar)%dat(:) = 0._dp
- end do
-
- ! initialize derivatives
- do iVar=1,size(deriv_meta)
- deriv_data%var(iVar)%dat(:) = 0._dp
- end do
-
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
-
- ! loop through different coupling strategies
- coupling: do ixCoupling=1,nCoupling
-
- ! initialize the time step
- dtInit = min( merge(dt, dtmin_coupled, ixCoupling==fullyCoupled), dt) ! initial time step
- dt_min = min( merge(dtmin_coupled, dtmin_split, ixCoupling==fullyCoupled), dt) ! minimum time step
-
- ! keep track of the number of state splits
- if(ixCoupling/=fullyCoupled) numberStateSplit = numberStateSplit + 1
-
- ! define the number of operator splits for the state type
- select case(ixCoupling)
- case(fullyCoupled); nStateTypeSplit=1
- case(stateTypeSplit); nStateTypeSplit=nStateTypes
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select ! operator splitting option
-
- ! define if we wish to try the domain split
- select case(ixCoupling)
- case(fullyCoupled); tryDomainSplit=0
- case(stateTypeSplit); tryDomainSplit=1
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select ! operator splitting option
-
- ! state splitting loop
- stateTypeSplitLoop: do iStateTypeSplit=1,nStateTypeSplit
-
- !print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
-
- ! -----
- ! * identify state-specific variables for a given state split...
- ! --------------------------------------------------------------
-
- ! flag to adjust the temperature
- doAdjustTemp = (ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)
-
- ! modify the state type names associated with the state vector
- if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
- if(computeVegFlux)then
- where(ixStateType(ixHydCanopy)==iname_watCanopy) ixStateType(ixHydCanopy)=iname_liqCanopy
- endif
- where(ixStateType(ixHydLayer) ==iname_watLayer) ixStateType(ixHydLayer) =iname_liqLayer
- where(ixStateType(ixHydLayer) ==iname_matLayer) ixStateType(ixHydLayer) =iname_lmpLayer
- endif ! if modifying state variables for the mass split
+ ! ---------------------------------------------------------------------------------------
+ ! structure allocations
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ ! simulation of fluxes and residuals given a trial state vector
+ USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+ USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
+ ! population/extraction of state vectors
+ USE indexState_module,only:indexSplit ! get state indices
+ USE varSubstep_module,only:varSubstep ! complete substeps for a given split
+ ! identify name of variable type (for error message)
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+ ! sundials var_substep
+ USE varSubstepSundials_module,only:varSubstepSundials ! complete substeps for a given split
+ implicit none
+ ! ---------------------------------------------------------------------------------------
+ ! * dummy variables
+ ! ---------------------------------------------------------------------------------------
+ ! input: model control
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ real(dp),intent(inout) :: dt ! time step (seconds)
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
+ ! input/output: data structures
+ type(var_i),intent(in) :: type_data ! type of vegetation and soil
+ type(var_d),intent(in) :: attr_data ! spatial attributes
+ type(var_d),intent(in) :: forc_data ! model forcing data
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: 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
+ type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ ! output: model control
+ real(dp),intent(out) :: dtMultiplier ! substep multiplier (-)
+ logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that ice is insufficient to support melt
+ logical(lgt),intent(out) :: stepFailure ! flag to denote step failure
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! ---------------------------------------------------------------------------------------
+ ! * general local variables
+ ! ---------------------------------------------------------------------------------------
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: minLayer ! the minimum layer used in assigning flags for flux aggregations
+ integer(i4b) :: iOffset ! offset to account for different indices in the soil domain
+ integer(i4b) :: iMin(1),iMax(1) ! bounds of a given vector
+ integer(i4b) :: iLayer,jLayer ! index of model layer
+ integer(i4b) :: iSoil ! index of soil layer
+ integer(i4b) :: iVar ! index of variables in data structures
+ logical(lgt) :: firstSuccess ! flag to define the first success
+ logical(lgt) :: firstFluxCall ! flag to define the first flux call
+ logical(lgt) :: reduceCoupledStep ! flag to define the need to reduce the length of the coupled step
+ type(var_dlength) :: prog_temp ! temporary model prognostic variables
+ type(var_dlength) :: diag_temp ! temporary model diagnostic variables
+ type(var_dlength) :: flux_temp ! temporary model fluxes
+ type(var_dlength) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(dp),dimension(nLayers) :: mLayerVolFracIceInit ! initial vector for volumetric fraction of ice (-)
+ ! ------------------------------------------------------------------------------------------------------
+ ! * operator splitting
+ ! ------------------------------------------------------------------------------------------------------
+ ! minimum timestep
+ real(dp),parameter :: dtmin_coupled=1800._dp ! minimum time step for the fully coupled solution (seconds)
+ real(dp),parameter :: dtmin_split=60._dp ! minimum time step for the fully split solution (seconds)
+ real(dp),parameter :: dtmin_scalar=10._dp ! minimum time step for the scalar solution (seconds)
+ real(dp) :: dt_min ! minimum time step (seconds)
+ real(dp) :: dtInit ! initial time step (seconds)
+ ! explicit error tolerance (depends on state type split, so defined here)
+ real(dp),parameter :: errorTolLiqFlux=0.01_dp ! error tolerance in the explicit solution (liquid flux)
+ real(dp),parameter :: errorTolNrgFlux=10._dp ! error tolerance in the explicit solution (energy flux)
+ ! number of substeps taken for a given split
+ integer(i4b) :: nSubsteps ! number of substeps taken for a given split
+ ! named variables defining the coupling and solution method
+ integer(i4b) :: ixCoupling ! index of coupling method (1,2)
+ integer(i4b) :: ixSolution ! index of solution method (1,2)
+ integer(i4b) :: ixStateThenDomain ! switch between the state and domain (1,2)
+ integer(i4b) :: tryDomainSplit ! (0,1) - flag to try the domain split
+ ! actual number of splits
+ integer(i4b) :: nStateTypeSplit ! number of splits for the state type
+ integer(i4b) :: nDomainSplit ! number of splits for the domain
+ integer(i4b) :: nStateSplit ! number of splits for the states within a given domain
+ ! indices for the state type and the domain split
+ integer(i4b) :: iStateTypeSplit ! index of the state type split
+ integer(i4b) :: iDomainSplit ! index of the domain split
+ integer(i4b) :: iStateSplit ! index of the state split
+ ! flux masks
+ logical(lgt) :: neededFlux(nFlux) ! .true. if flux is needed at all
+ logical(lgt) :: desiredFlux ! .true. if flux is desired for a given split
+ type(var_ilength) :: fluxCount ! number of times each flux is updated (should equal nSubsteps)
+ type(var_flagVec) :: fluxMask ! mask defining model fluxes
+ ! state masks
+ integer(i4b),dimension(nState) :: stateCheck ! number of times each state variable is updated (should equal 1)
+ logical(lgt),dimension(nState) :: stateMask ! mask defining desired state variables
+ integer(i4b) :: nSubset ! number of selected state variables for a given split
+ ! flags
+ logical(lgt) :: failure ! flag to denote failure of substepping
+ logical(lgt) :: doAdjustTemp ! flag to adjust temperature after the mass split
+ logical(lgt) :: failedMinimumStep ! flag to denote failure of substepping for a given split
+ integer(i4b) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ integer(i4b) :: nCoupling ! number of possible solutions
+ real(qp) :: dt_out !
- ! first try the state type split, then try the domain split within a given state type
- stateThenDomain: do ixStateThenDomain=1,1+tryDomainSplit ! 1=state type split; 2=domain split within a given state type
-
- !print*, 'start of stateThenDomain loop'
+
+ ! ---------------------------------------------------------------------------------------
+ ! point to variables in the data structures
+ ! ---------------------------------------------------------------------------------------
+ globalVars: associate(&
+ ! model decisions
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
+ ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
+ ! domain boundary conditions
+ airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
+ ! vector of energy and hydrology indices for the snow and soil domains
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology state variables in the snow+soil domain
+ ! indices of model state variables
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset (missing for values not in the subset)
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
+ ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
+ ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ! numerix tracking
+ numberStateSplit => indx_data%var(iLookINDEX%numberStateSplit )%dat(1) ,& ! intent(inout): [i4b] number of state splitting solutions (-)
+ numberDomainSplitNrg => indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for energy (-)
+ numberDomainSplitMass => indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for mass (-)
+ numberScalarSolutions => indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) ,& ! intent(inout): [i4b] number of scalar solutions (-)
+ ! domain configuration
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! depth-varying soil parameters
+ 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_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
+ ! soil parameters
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! model diagnostic variables (fraction of liquid water)
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
+ mLayerMeltFreeze => diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat ,& ! intent(out): [dp(:)] melt-freeze in each snow and soil layer (kg m-3)
+ ! model state variables (vegetation canopy)
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(out): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(out): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(out): [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(out): [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(out): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(out): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(out): [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(out): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(out): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(out): [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(out): [dp(:)] matric potential of liquid water (m)
+ )
+ ! ---------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="opSplittin/"
+
+ ! we just solve the fully coupled problem by ida
+ select case(model_decisions(iLookDECISIONS%diffEqSolv)%iDecision)
+ case(sundialIDA); nCoupling = 1
+ case(backwEuler); nCoupling = 2
+ case default
+ err=20
+ message=trim(message)//'expect case to be sundialIDA or backwEuler'
+ print*, message
+ return
+ end select
- ! keep track of the number of domain splits
- if(iStateTypeSplit==nrgSplit .and. ixStateThenDomain==subDomain) numberDomainSplitNrg = numberDomainSplitNrg + 1
- if(iStateTypeSplit==massSplit .and. ixStateThenDomain==subDomain) numberDomainSplitMass = numberDomainSplitMass + 1
- ! define the number of domain splits for the state type
- select case(ixStateThenDomain)
- case(fullDomain); nDomainSplit=1
- case(subDomain); nDomainSplit=nDomains
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select
+ print*, "nCoupling", nCoupling
+ ! *****
+ ! (0) PRELIMINARIES...
+ ! ********************
- ! check that we haven't split the domain when we are fully coupled
- if(ixCoupling==fullyCoupled .and. nDomainSplit==nDomains)then
- message=trim(message)//'cannot split domains when fully coupled'
- err=20; return
+ ! -----
+ ! * initialize...
+ ! ---------------
+
+ ! set the global print flag
+ globalPrintFlag=.false.
+
+ if(globalPrintFlag)&
+ print*, trim(message), dt
+
+ ! initialize the first success call
+ firstSuccess=.false.
+
+ ! initialize the flags
+ tooMuchMelt=.false. ! too much melt (merge snow layers)
+ stepFailure=.false. ! step failure
+
+ ! initialize flag for the success of the substepping
+ failure=.false.
+
+ ! initialize the flux check
+ neededFlux(:) = .false.
+
+ ! initialize the state check
+ stateCheck(:) = 0
+
+ ! compute the total water content in the vegetation canopy
+ scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce ! kg m-2
+
+ ! save volumetric ice content at the start of the step
+ ! NOTE: used for volumetric loss due to melt-freeze
+ mLayerVolFracIceInit(:) = mLayerVolFracIce(:)
+
+ ! compute the total water content in snow and soil
+ ! NOTE: no ice expansion allowed for soil
+ if(nSnow>0)&
+ mLayerVolFracWat( 1:nSnow ) = mLayerVolFracLiq( 1:nSnow ) + mLayerVolFracIce( 1:nSnow )*(iden_ice/iden_water)
+ mLayerVolFracWat(nSnow+1:nLayers) = mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers)
+
+ ! compute the liquid water matric potential (m)
+ ! NOTE: include ice content as part of the solid porosity - major effect of ice is to reduce the pore size; ensure that effSat=1 at saturation
+ ! (from Zhao et al., J. Hydrol., 1997: Numerical analysis of simultaneous heat and mass transfer...)
+ do iSoil=1,nSoil
+ call liquidHead(mLayerMatricHead(iSoil),mLayerVolFracLiq(nSnow+iSoil),mLayerVolFracIce(nSnow+iSoil), & ! input: state variables
+ vGn_alpha(iSoil),vGn_n(iSoil),theta_sat(iSoil),theta_res(iSoil),vGn_m(iSoil), & ! input: parameters
+ matricHeadLiq=mLayerMatricHeadLiq(iSoil), & ! output: liquid water matric potential (m)
+ err=err,message=cmessage) ! output: error control
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
endif
+ end do ! looping through soil layers (computing liquid water matric potential)
+
+ ! allocate space for the flux mask (used to define when fluxes are updated)
+ call allocLocal(flux_meta(:),fluxMask,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ return
+ endif
- ! domain splitting loop
- domainSplit: do iDomainSplit=1,nDomainSplit
+ ! allocate space for the flux count (used to check that fluxes are only updated once)
+ call allocLocal(flux_meta(:),fluxCount,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
- ! trial with the vector then scalar solution
- solution: do ixSolution=1,nSolutions
+ ! allocate space for the temporary prognostic variable structure
+ call allocLocal(prog_meta(:),prog_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
- ! initialize error control
- err=0; message="opSplittin/"
+ ! allocate space for the temporary diagnostic variable structure
+ call allocLocal(diag_meta(:),diag_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
- ! refine the time step
- if(ixSolution==scalar)then
- dtInit = min(dtmin_split, dt) ! initial time step
- dt_min = min(dtmin_scalar, dt) ! minimum time step
- endif
+ ! allocate space for the temporary flux variable structure
+ call allocLocal(flux_meta(:),flux_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
- ! initialize the first flux call
- firstFluxCall=.true.
+ ! allocate space for the derivative structure
+ call allocLocal(deriv_meta(:),deriv_data,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ end if
+
+ ! intialize the flux conter
+ do iVar=1,size(flux_meta) ! loop through fluxes
+ fluxCount%var(iVar)%dat(:) = 0
+ end do
+
+ ! initialize the model fluxes
+ do iVar=1,size(flux_meta) ! loop through fluxes
+ if(flux2state_orig(iVar)%state1==integerMissing .and. flux2state_orig(iVar)%state2==integerMissing) cycle ! flux does not depend on state (e.g., input)
+ if(flux2state_orig(iVar)%state1==iname_watCanopy .and. .not.computeVegFlux) cycle ! use input fluxes in cases where there is no canopy
+ flux_data%var(iVar)%dat(:) = 0._dp
+ end do
+
+ ! initialize derivatives
+ do iVar=1,size(deriv_meta)
+ deriv_data%var(iVar)%dat(:) = 0._dp
+ end do
- ! get the number of split layers
- select case(ixSolution)
- case(vector); nStateSplit=1
- case(scalar); nStateSplit=count(stateMask)
- case default; err=20; message=trim(message)//'unknown solution method'; return
- end select
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
- !print*, '*****'
- !print*, 'computeVegFlux = ', computeVegFlux
- !print*, '(ixSolution==scalar) = ', (ixSolution==scalar)
- !print*, 'ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit: ', ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit
- !print*, 'ixSoilOnlyHyd = ', indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat
-
- ! loop through layers (NOTE: nStateSplit=1 for the vector solution, hence no looping)
- stateSplit: do iStateSplit=1,nStateSplit
-
- ! -----
- ! * define state subsets for a given split...
- ! -------------------------------------------
-
- ! get the mask for the state subset
- call stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
- indx_data,stateMask,nSubset,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- ! check that state variables exist
- if(nSubset==0) cycle domainSplit
-
- ! avoid redundant case where vector solution is of length 1
- if(ixSolution==vector .and. count(stateMask)==1) cycle solution
-
- ! check
- !print*, 'after stateFilter: stateMask = ', stateMask
- !print*, 'count(stateMask) = ', count(stateMask)
-
- !if(ixSolution==scalar)then
- ! print*, 'iStateSplit, nStateSplit = ', iStateSplit, nStateSplit
- ! print*, 'start of scalar solution'
- ! !print*, 'PAUSE'; read(*,*)
- !endif
-
- ! -----
- ! * assemble vectors for a given split...
- ! ---------------------------------------
-
- ! get indices for a given split
- call indexSplit(stateMask, & ! intent(in) : logical vector (.true. if state is in the subset)
- nSnow,nSoil,nLayers,nSubset, & ! intent(in) : number of snow and soil layers, and total number of layers
- indx_data, & ! intent(inout) : index data structure
- err,cmessage) ! intent(out) : error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! -----
- ! * define the mask of the fluxes used...
- ! ---------------------------------------
-
- ! identify the type of state for the states in the subset
- stateSubset: associate(ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] indices of state types
- ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
- ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
- ixLayerActive => indx_data%var(iLookINDEX%ixLayerActive)%dat ,& ! intent(in): [i4b(:)] list of indices for all active layers (inactive=integerM
- ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ) ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
-
- ! loop through flux variables
- do iVar=1,size(flux_meta)
-
- ! * identify flux mask for the fully coupled solution
- if(ixCoupling==fullyCoupled)then
- desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
- fluxMask%var(iVar)%dat = desiredFlux
-
- ! * identify flux mask for the split solution
- else
-
- ! identify the flux mask for a given state split
- select case(iStateTypeSplit)
- case(nrgSplit); desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
- case(massSplit); desiredFlux = any(ixStateType_subset==flux2state_liq(iVar)%state1) .or. any(ixStateType_subset==flux2state_liq(iVar)%state2)
- case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
- end select
-
- ! no domain splitting
- if(nDomains==1)then
- fluxMask%var(iVar)%dat = desiredFlux
-
- ! domain splitting
- else
-
- ! initialize to .false.
- fluxMask%var(iVar)%dat = .false.
-
- ! only need to proceed if the flux is desired
- if(desiredFlux)then
-
- ! different domain splitting operations
- select case(iDomainSplit)
-
- ! canopy fluxes -- (:1) gets the upper boundary(0) if it exists
- case(vegSplit)
-
- ! vector solution (should only be present for energy)
- if(ixSolution==vector)then
- fluxMask%var(iVar)%dat(:1) = desiredFlux
- if(ixStateThenDomain>1 .and. iStateTypeSplit/=nrgSplit)then
- message=trim(message)//'only expect a vector solution for the vegetation domain for energy'
- err=20; return
- endif
+ ! loop through different coupling strategies
+ coupling: do ixCoupling=1,nCoupling
- ! scalar solution
- else
- fluxMask%var(iVar)%dat(:1) = desiredFlux
- endif
-
- ! fluxes through snow and soil
- case(snowSplit,soilSplit)
-
- ! loop through layers
- do iLayer=1,nLayers
- if(ixlayerActive(iLayer)/=integerMissing)then
-
- ! get the offset (ixLayerActive=1,2,3,...nLayers, and soil vectors nSnow+1, nSnow+2, ..., nLayers)
- iOffset = merge(nSnow, 0, flux_meta(iVar)%vartype==iLookVarType%midSoil .or. flux_meta(iVar)%vartype==iLookVarType%ifcSoil)
- jLayer = iLayer-iOffset
-
- ! identify the minimum layer
- select case(flux_meta(iVar)%vartype)
- case(iLookVarType%ifcToto, iLookVarType%ifcSnow, iLookVarType%ifcSoil); minLayer=merge(jLayer-1, jLayer, jLayer==1)
- case(iLookVarType%midToto, iLookVarType%midSnow, iLookVarType%midSoil); minLayer=jLayer
- case default; minLayer=integerMissing
- end select
-
- ! set desired layers
- select case(flux_meta(iVar)%vartype)
- case(iLookVarType%midToto,iLookVarType%ifcToto); fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- case(iLookVarType%midSnow,iLookVarType%ifcSnow); if(iLayer<=nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- case(iLookVarType%midSoil,iLookVarType%ifcSoil); if(iLayer> nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- end select
-
- ! add hydrology states for scalar variables
- if(iStateTypeSplit==massSplit .and. flux_meta(iVar)%vartype==iLookVarType%scalarv)then
- select case(iDomainSplit)
- case(snowSplit); if(iLayer==nSnow) fluxMask%var(iVar)%dat = desiredFlux
- case(soilSplit); if(iLayer==nSnow+1) fluxMask%var(iVar)%dat = desiredFlux
- end select
- endif ! if hydrology split and scalar
+ ! initialize the time step
+ dtInit = min( merge(dt, dtmin_coupled, ixCoupling==fullyCoupled), dt) ! initial time step
+ dt_min = min( merge(dtmin_coupled, dtmin_split, ixCoupling==fullyCoupled), dt) ! minimum time step
- endif ! if the layer is active
- end do ! looping through layers
+ ! keep track of the number of state splits
+ if(ixCoupling/=fullyCoupled) numberStateSplit = numberStateSplit + 1
- ! check
- case default; err=20; message=trim(message)//'unable to identify split based on domain type'; return
- end select ! domain split
+ ! define the number of operator splits for the state type
+ select case(ixCoupling)
+ case(fullyCoupled); nStateTypeSplit=1
+ case(stateTypeSplit); nStateTypeSplit=nStateTypes
+ case default; err=20; message=trim(message)//'coupling case not found'; return
+ end select ! operator splitting option
- endif ! if flux is desired
+ ! define if we wish to try the domain split
+ select case(ixCoupling)
+ case(fullyCoupled); tryDomainSplit=0
+ case(stateTypeSplit); tryDomainSplit=1
+ case default; err=20; message=trim(message)//'coupling case not found'; return
+ end select ! operator splitting option
- endif ! domain splitting
- endif ! not fully coupled
+ ! state splitting loop
+ stateTypeSplitLoop: do iStateTypeSplit=1,nStateTypeSplit
- ! define if the flux is desired
- if(desiredFlux) neededFlux(iVar)=.true.
- !if(desiredFlux) print*, flux_meta(iVar)%varname, fluxMask%var(iVar)%dat
+ !print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
- ! * check
- if( globalPrintFlag .and. count(fluxMask%var(iVar)%dat)>0 )&
- print*, trim(flux_meta(iVar)%varname)
+ ! -----
+ ! * identify state-specific variables for a given state split...
+ ! --------------------------------------------------------------
- end do ! (loop through fluxes)
+ ! flag to adjust the temperature
+ doAdjustTemp = (ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)
- end associate stateSubset
+ ! modify the state type names associated with the state vector
+ if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
+ if(computeVegFlux)then
+ where(ixStateType(ixHydCanopy)==iname_watCanopy) ixStateType(ixHydCanopy)=iname_liqCanopy
+ endif
+ where(ixStateType(ixHydLayer) ==iname_watLayer) ixStateType(ixHydLayer) =iname_liqLayer
+ where(ixStateType(ixHydLayer) ==iname_matLayer) ixStateType(ixHydLayer) =iname_lmpLayer
+ endif ! if modifying state variables for the mass split
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! ***** trial with a given solution method...
+ ! first try the state type split, then try the domain split within a given state type
+ stateThenDomain: do ixStateThenDomain=1,1+tryDomainSplit ! 1=state type split; 2=domain split within a given state type
- ! check that we do not attempt the scalar solution for the fully coupled case
- if(ixCoupling==fullyCoupled .and. ixSolution==scalar)then
- message=trim(message)//'only apply the scalar solution to the fully split coupling strategy'
- err=20; return
- endif
+ !print*, 'start of stateThenDomain loop'
- ! reset the flag for the first flux call
- if(.not.firstSuccess) firstFluxCall=.true.
+ ! keep track of the number of domain splits
+ if(iStateTypeSplit==nrgSplit .and. ixStateThenDomain==subDomain) numberDomainSplitNrg = numberDomainSplitNrg + 1
+ if(iStateTypeSplit==massSplit .and. ixStateThenDomain==subDomain) numberDomainSplitMass = numberDomainSplitMass + 1
- ! save/recover copies of prognostic variables
- do iVar=1,size(prog_data%var)
- select case(failure)
- case(.false.); prog_temp%var(iVar)%dat(:) = prog_data%var(iVar)%dat(:)
- case(.true.); prog_data%var(iVar)%dat(:) = prog_temp%var(iVar)%dat(:)
+ ! define the number of domain splits for the state type
+ select case(ixStateThenDomain)
+ case(fullDomain); nDomainSplit=1
+ case(subDomain); nDomainSplit=nDomains
+ case default; err=20; message=trim(message)//'coupling case not found'; return
end select
- end do ! looping through variables
- ! save/recover copies of diagnostic variables
- do iVar=1,size(diag_data%var)
- select case(failure)
- case(.false.); diag_temp%var(iVar)%dat(:) = diag_data%var(iVar)%dat(:)
- case(.true.); diag_data%var(iVar)%dat(:) = diag_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
+ ! check that we haven't split the domain when we are fully coupled
+ if(ixCoupling==fullyCoupled .and. nDomainSplit==nDomains)then
+ message=trim(message)//'cannot split domains when fully coupled'
+ print*, message
+ err=20; return
+ endif
- ! save/recover copies of model fluxes
- do iVar=1,size(flux_data%var)
- select case(failure)
- case(.false.); flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
- case(.true.); flux_data%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
+ ! domain splitting loop
+ domainSplit: do iDomainSplit=1,nDomainSplit
+
+ ! trial with the vector then scalar solution
+ solution: do ixSolution=1,nSolutions
+
+ ! initialize error control
+ err=0; message="opSplittin/"
+
+ ! refine the time step
+ if(ixSolution==scalar)then
+ dtInit = min(dtmin_split, dt) ! initial time step
+ dt_min = min(dtmin_scalar, dt) ! minimum time step
+ endif
+
+ ! initialize the first flux call
+ firstFluxCall=.true.
+
+ ! get the number of split layers
+ select case(ixSolution)
+ case(vector); nStateSplit=1
+ case(scalar); nStateSplit=count(stateMask)
+ case default; err=20
+ message=trim(message)//'unknown solution method'
+ print*, message
+ return
+ end select
+
+ !print*, '*****'
+ !print*, 'computeVegFlux = ', computeVegFlux
+ !print*, '(ixSolution==scalar) = ', (ixSolution==scalar)
+ !print*, 'ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit: ', ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit
+ !print*, 'ixSoilOnlyHyd = ', indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat
+
+ ! loop through layers (NOTE: nStateSplit=1 for the vector solution, hence no looping)
+ stateSplit: do iStateSplit=1,nStateSplit
+
+ ! -----
+ ! * define state subsets for a given split...
+ ! -------------------------------------------
+
+ ! get the mask for the state subset
+ call stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
+ indx_data,stateMask,nSubset,err,cmessage)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif ! (check for errors)
+
+ ! check that state variables exist
+ if(nSubset==0) cycle domainSplit
+
+ ! avoid redundant case where vector solution is of length 1
+ if(ixSolution==vector .and. count(stateMask)==1) cycle solution
+
+ ! check
+ !print*, 'after stateFilter: stateMask = ', stateMask
+ !print*, 'count(stateMask) = ', count(stateMask)
+
+ !if(ixSolution==scalar)then
+ ! print*, 'iStateSplit, nStateSplit = ', iStateSplit, nStateSplit
+ ! print*, 'start of scalar solution'
+ ! !print*, 'PAUSE'; read(*,*)
+ !endif
+
+ ! -----
+ ! * assemble vectors for a given split...
+ ! ---------------------------------------
+
+ ! get indices for a given split
+ call indexSplit(stateMask, & ! intent(in) : logical vector (.true. if state is in the subset)
+ nSnow,nSoil,nLayers,nSubset, & ! intent(in) : number of snow and soil layers, and total number of layers
+ indx_data, & ! intent(inout) : index data structure
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
- ! -----
- ! * solve variable subset for one time step...
- ! --------------------------------------------
+ ! -----
+ ! * define the mask of the fluxes used...
+ ! ---------------------------------------
+
+ ! identify the type of state for the states in the subset
+ stateSubset: associate(ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] indices of state types
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ixLayerActive => indx_data%var(iLookINDEX%ixLayerActive)%dat ,& ! intent(in): [i4b(:)] list of indices for all active layers (inactive=integerM
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ) ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
+
+ ! loop through flux variables
+ do iVar=1,size(flux_meta)
+
+ ! * identify flux mask for the fully coupled solution
+ if(ixCoupling==fullyCoupled)then
+ desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
+ fluxMask%var(iVar)%dat = desiredFlux
+
+ ! * identify flux mask for the split solution
+ else
+
+ ! identify the flux mask for a given state split
+ select case(iStateTypeSplit)
+ case(nrgSplit); desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
+ case(massSplit); desiredFlux = any(ixStateType_subset==flux2state_liq(iVar)%state1) .or. any(ixStateType_subset==flux2state_liq(iVar)%state2)
+ case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
+ end select
+
+ ! no domain splitting
+ if(nDomains==1)then
+ fluxMask%var(iVar)%dat = desiredFlux
+
+ ! domain splitting
+ else
+
+ ! initialize to .false.
+ fluxMask%var(iVar)%dat = .false.
+
+ ! only need to proceed if the flux is desired
+ if(desiredFlux)then
+
+ ! different domain splitting operations
+ select case(iDomainSplit)
+
+ ! canopy fluxes -- (:1) gets the upper boundary(0) if it exists
+ case(vegSplit)
+
+ ! vector solution (should only be present for energy)
+ if(ixSolution==vector)then
+ fluxMask%var(iVar)%dat(:1) = desiredFlux
+ if(ixStateThenDomain>1 .and. iStateTypeSplit/=nrgSplit)then
+ message=trim(message)//'only expect a vector solution for the vegetation domain for energy'
+ print*, message
+ err=20; return
+ endif
+
+ ! scalar solution
+ else
+ fluxMask%var(iVar)%dat(:1) = desiredFlux
+ endif
+
+ ! fluxes through snow and soil
+ case(snowSplit,soilSplit)
+
+ ! loop through layers
+ do iLayer=1,nLayers
+ if(ixlayerActive(iLayer)/=integerMissing)then
+
+ ! get the offset (ixLayerActive=1,2,3,...nLayers, and soil vectors nSnow+1, nSnow+2, ..., nLayers)
+ iOffset = merge(nSnow, 0, flux_meta(iVar)%vartype==iLookVarType%midSoil .or. flux_meta(iVar)%vartype==iLookVarType%ifcSoil)
+ jLayer = iLayer-iOffset
+
+ ! identify the minimum layer
+ select case(flux_meta(iVar)%vartype)
+ case(iLookVarType%ifcToto, iLookVarType%ifcSnow, iLookVarType%ifcSoil); minLayer=merge(jLayer-1, jLayer, jLayer==1)
+ case(iLookVarType%midToto, iLookVarType%midSnow, iLookVarType%midSoil); minLayer=jLayer
+ case default; minLayer=integerMissing
+ end select
+
+ ! set desired layers
+ select case(flux_meta(iVar)%vartype)
+ case(iLookVarType%midToto,iLookVarType%ifcToto); fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ case(iLookVarType%midSnow,iLookVarType%ifcSnow); if(iLayer<=nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ case(iLookVarType%midSoil,iLookVarType%ifcSoil); if(iLayer> nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ end select
+
+ ! add hydrology states for scalar variables
+ if(iStateTypeSplit==massSplit .and. flux_meta(iVar)%vartype==iLookVarType%scalarv)then
+ select case(iDomainSplit)
+ case(snowSplit); if(iLayer==nSnow) fluxMask%var(iVar)%dat = desiredFlux
+ case(soilSplit); if(iLayer==nSnow+1) fluxMask%var(iVar)%dat = desiredFlux
+ end select
+ endif ! if hydrology split and scalar
+
+ endif ! if the layer is active
+ end do ! looping through layers
+
+ ! check
+ case default
+ err=20
+ message=trim(message)//'unable to identify split based on domain type'
+ print*, message
+ return
+ end select ! domain split
+
+ endif ! if flux is desired
+
+ endif ! domain splitting
+ endif ! not fully coupled
+
+ ! define if the flux is desired
+ if(desiredFlux) neededFlux(iVar)=.true.
+ !if(desiredFlux) print*, flux_meta(iVar)%varname, fluxMask%var(iVar)%dat
+
+ ! * check
+ if( globalPrintFlag .and. count(fluxMask%var(iVar)%dat)>0 )&
+ print*, trim(flux_meta(iVar)%varname)
+
+ end do ! (loop through fluxes)
+
+ end associate stateSubset
+
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! ***** trial with a given solution method...
+
+ ! check that we do not attempt the scalar solution for the fully coupled case
+ if(ixCoupling==fullyCoupled .and. ixSolution==scalar)then
+ message=trim(message)//'only apply the scalar solution to the fully split coupling strategy'
+ print*, message
+ err=20; return
+ endif
- !print*, trim(message)//'before varSubstep: nSubset = ', nSubset
+ ! reset the flag for the first flux call
+ if(.not.firstSuccess) firstFluxCall=.true.
- ! keep track of the number of scalar solutions
- if(ixSolution==scalar) numberScalarSolutions = numberScalarSolutions + 1
+ ! save/recover copies of prognostic variables
+ do iVar=1,size(prog_data%var)
+ select case(failure)
+ case(.false.); prog_temp%var(iVar)%dat(:) = prog_data%var(iVar)%dat(:)
+ case(.true.); prog_data%var(iVar)%dat(:) = prog_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
- ! solve variable subset for one full time step
- call varSubstep(&
- ! input: model control
- dt, & ! intent(inout) : time step (s)
- dtInit, & ! intent(in) : initial time step (seconds)
- dt_min, & ! intent(in) : minimum time step (seconds)
- nSubset, & ! intent(in) : total number of variables in the state subset
- doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
- firstSubStep, & ! intent(in) : flag to denote first sub-step
- firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
- computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
- (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
- iStateSplit, & ! intent(in) : index of the layer in the splitting operation
- fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
- fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
- ! input/output: data structures
- model_decisions, & ! intent(in) : model decisions
- type_data, & ! intent(in) : type of vegetation and soil
- attr_data, & ! intent(in) : spatial attributes
- forc_data, & ! intent(in) : model forcing data
- mpar_data, & ! intent(in) : model parameters
- indx_data, & ! intent(inout) : index data
- 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
- deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
- bvar_data, & ! intent(in) : model variables for the local basin
- ! output: control
- ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dtMultiplier, & ! intent(out) : substep multiplier (-)
- nSubsteps, & ! intent(out) : number of substeps taken for a given split
- failedMinimumStep, & ! intent(out) : flag for failed substeps
- reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
- tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
- err,cmessage) ! intent(out) : error code and error message
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- if(err>0) return
- endif ! (check for errors)
-
- ! print*, trim(message)//'after varSubstep: scalarSnowDrainage = ', flux_data%var(iLookFLUX%scalarSnowDrainage)%dat
- ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%iLayerLiqFluxSnow)%dat
- ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat
-
- ! check
- !if(ixSolution==scalar)then
- ! print*, 'PAUSE: check scalar'; read(*,*)
- !endif
-
- ! reduce coupled step if failed the minimum step for the scalar solution
- if(failedMinimumStep .and. ixSolution==scalar) reduceCoupledStep=.true.
-
- ! check
- !if(ixCoupling/=fullyCoupled)then
- ! print*, 'dt = ', dt
- ! print*, 'after varSubstep: err = ', err
- ! print*, 'after varSubstep: cmessage = ', trim(cmessage)
- ! print*, 'after varSubstep: computeVegFlux = ', computeVegFlux
- ! print*, 'after varSubstep: stateMask = ', stateMask
- ! print*, 'after varSubstep: coupling = ', (ixCoupling==fullyCoupled)
- ! print*, 'after varSubstep: scalar solve = ', (ixSolution==scalar)
- ! print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
- ! print*, 'iDomainSplit, nDomainSplit = ', iDomainSplit, nDomainSplit
- ! print*, 'nSubset = ', nSubset
- ! print*, 'tooMuchMelt = ', tooMuchMelt
- ! print*, 'reduceCoupledStep = ', reduceCoupledStep
- ! print*, 'failedMinimumStep = ', failedMinimumStep, merge('coupled','opSplit',ixCoupling==fullyCoupled)
- ! if(ixSolution==scalar)then; print*, 'PAUSE'; read(*,*); endif
- !endif
-
- !if(ixSolution==scalar)then
- ! !print*, trim(message)//'stop: checking scalar solution'; stop
- ! print*, trim(message)//'pause: checking scalar solution'; read(*,*)
- !endif
-
- !print*, 'tooMuchMelt, reduceCoupledStep = ', tooMuchMelt, reduceCoupledStep
-
- ! if too much melt (or some other need to reduce the coupled step) then return
- ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
- if(tooMuchMelt .or. reduceCoupledStep)then
- stepFailure=.true.
- err=0 ! recovering
- return
- endif
-
- ! define failure
- failure = (failedMinimumStep .or. err<0)
- if(.not.failure) firstSuccess=.true.
-
- ! if failed, need to reset the flux counter
- if(failure)then
- !print*, 'failure!'
- do iVar=1,size(flux_meta)
- iMin=lbound(flux_data%var(iVar)%dat)
- iMax=ubound(flux_data%var(iVar)%dat)
- do iLayer=iMin(1),iMax(1)
- if(fluxMask%var(iVar)%dat(iLayer)) fluxCount%var(iVar)%dat(iLayer) = fluxCount%var(iVar)%dat(iLayer) - nSubsteps
- end do
- !if(iVar==iLookFLUX%mLayerTranspire) print*, flux_meta(iVar)%varname, fluxCount%var(iVar)%dat
- end do
- endif
-
- ! try the fully split solution if failed to converge with a minimum time step in the coupled solution
- if(ixCoupling==fullyCoupled .and. failure) cycle coupling
-
- ! try the scalar solution if failed to converge with a minimum time step in the split solution
- if(ixCoupling/=fullyCoupled)then
- select case(ixStateThenDomain)
- case(fullDomain); if(failure) cycle stateThenDomain
- case(subDomain); if(failure) cycle solution
- case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
- end select
- endif
+ ! save/recover copies of diagnostic variables
+ do iVar=1,size(diag_data%var)
+ select case(failure)
+ case(.false.); diag_temp%var(iVar)%dat(:) = diag_data%var(iVar)%dat(:)
+ case(.true.); diag_data%var(iVar)%dat(:) = diag_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
+
+ ! save/recover copies of model fluxes
+ do iVar=1,size(flux_data%var)
+ select case(failure)
+ case(.false.); flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
+ case(.true.); flux_data%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
+
+ ! -----
+ ! * solve variable subset for one time step...
+ ! --------------------------------------------
+
+ !print*, trim(message)//'before varSubstep: nSubset = ', nSubset
+
+ ! keep track of the number of scalar solutions
+ if(ixSolution==scalar) numberScalarSolutions = numberScalarSolutions + 1
+
+ select case(model_decisions(iLookDECISIONS%diffEqSolv)%iDecision)
+ case(sundialIDA)
+ call varSubstepSundials(&
+ ! input: model control
+ dt, & ! intent(inout) : time step (s)
+ dtInit, & ! intent(in) : initial time step (seconds)
+ dt_min, & ! intent(in) : minimum time step (seconds)
+ nSubset, & ! intent(in) : total number of variables in the state subset
+ doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
+ firstSubStep, & ! intent(in) : flag to denote first sub-step
+ firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
+ computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
+ (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
+ iStateSplit, & ! intent(in) : index of the layer in the splitting operation
+ fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
+ fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
+ ! input/output: data structures
+ model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
+ type_data, & ! intent(in) : type of vegetation and soil
+ attr_data, & ! intent(in) : spatial attributes
+ forc_data, & ! intent(in) : model forcing data
+ mpar_data, & ! intent(in) : model parameters
+ indx_data, & ! intent(inout) : index data
+ 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
+ deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
+ bvar_data, & ! intent(in) : model variables for the local basin
+ ! output: control
+ ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dtMultiplier, & ! intent(out) : substep multiplier (-)
+ nSubsteps, & ! intent(out) : number of substeps taken for a given split
+ failedMinimumStep, & ! intent(out) : flag for failed substeps
+ reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
+ dt_out, & ! intent(out)
+ err,cmessage) ! intent(out) : error code and error message
+ ! solve variable subset for one full time step
+ case(backwEuler)
+ call varSubstep(&
+ ! input: model control
+ dt, & ! intent(inout) : time step (s)
+ dtInit, & ! intent(in) : initial time step (seconds)
+ dt_min, & ! intent(in) : minimum time step (seconds)
+ nSubset, & ! intent(in) : total number of variables in the state subset
+ doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
+ firstSubStep, & ! intent(in) : flag to denote first sub-step
+ firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
+ computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
+ (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
+ iStateSplit, & ! intent(in) : index of the layer in the splitting operation
+ fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
+ fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
+ ! input/output: data structures
+ model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
+ type_data, & ! intent(in) : type of vegetation and soil
+ attr_data, & ! intent(in) : spatial attributes
+ forc_data, & ! intent(in) : model forcing data
+ mpar_data, & ! intent(in) : model parameters
+ indx_data, & ! intent(inout) : index data
+ 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
+ deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
+ bvar_data, & ! intent(in) : model variables for the local basin
+ ! output: control
+ ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dtMultiplier, & ! intent(out) : substep multiplier (-)
+ nSubsteps, & ! intent(out) : number of substeps taken for a given split
+ failedMinimumStep, & ! intent(out) : flag for failed substeps
+ reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
+ err,cmessage) ! intent(out) : error code and error message
+ case default
+ err=20
+ message=trim(message)//'expect case to backwEuler or sundialIDA'
+ print*, message
+ return
+ end select
+
+ dt = dt_out
+
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ if(err>0) return
+ endif ! (check for errors)
+
+ ! print*, trim(message)//'after varSubstep: scalarSnowDrainage = ', flux_data%var(iLookFLUX%scalarSnowDrainage)%dat
+ ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%iLayerLiqFluxSnow)%dat
+ ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat
+
+ ! check
+ !if(ixSolution==scalar)then
+ ! print*, 'PAUSE: check scalar'; read(*,*)
+ !endif
+
+ ! reduce coupled step if failed the minimum step for the scalar solution
+ if(failedMinimumStep .and. ixSolution==scalar) reduceCoupledStep=.true.
+
+ ! check
+ !if(ixCoupling/=fullyCoupled)then
+ ! print*, 'dt = ', dt
+ ! print*, 'after varSubstep: err = ', err
+ ! print*, 'after varSubstep: cmessage = ', trim(cmessage)
+ ! print*, 'after varSubstep: computeVegFlux = ', computeVegFlux
+ ! print*, 'after varSubstep: stateMask = ', stateMask
+ ! print*, 'after varSubstep: coupling = ', (ixCoupling==fullyCoupled)
+ ! print*, 'after varSubstep: scalar solve = ', (ixSolution==scalar)
+ ! print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
+ ! print*, 'iDomainSplit, nDomainSplit = ', iDomainSplit, nDomainSplit
+ ! print*, 'nSubset = ', nSubset
+ ! print*, 'tooMuchMelt = ', tooMuchMelt
+ ! print*, 'reduceCoupledStep = ', reduceCoupledStep
+ ! print*, 'failedMinimumStep = ', failedMinimumStep, merge('coupled','opSplit',ixCoupling==fullyCoupled)
+ ! if(ixSolution==scalar)then; print*, 'PAUSE'; read(*,*); endif
+ !endif
+
+ !if(ixSolution==scalar)then
+ ! !print*, trim(message)//'stop: checking scalar solution'; stop
+ ! print*, trim(message)//'pause: checking scalar solution'; read(*,*)
+ !endif
+
+ !print*, 'tooMuchMelt, reduceCoupledStep = ', tooMuchMelt, reduceCoupledStep
+
+ ! if too much melt (or some other need to reduce the coupled step) then return
+ ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
+ if(tooMuchMelt .or. reduceCoupledStep)then
+ stepFailure=.true.
+ err=0 ! recovering
+ return
+ endif
+
+ ! define failure
+ failure = (failedMinimumStep .or. err<0)
+ if(.not.failure) firstSuccess=.true.
+
+ ! if failed, need to reset the flux counter
+ if(failure)then
+ !print*, 'failure!'
+ do iVar=1,size(flux_meta)
+ iMin=lbound(flux_data%var(iVar)%dat)
+ iMax=ubound(flux_data%var(iVar)%dat)
+ do iLayer=iMin(1),iMax(1)
+ if(fluxMask%var(iVar)%dat(iLayer)) fluxCount%var(iVar)%dat(iLayer) = fluxCount%var(iVar)%dat(iLayer) - nSubsteps
+ end do
+ !if(iVar==iLookFLUX%mLayerTranspire) print*, flux_meta(iVar)%varname, fluxCount%var(iVar)%dat
+ end do
+ endif
- ! check that state variables updated
- where(stateMask) stateCheck = stateCheck+1
- if(any(stateCheck>1))then
- message=trim(message)//'state variable updated more than once!'
- err=20; return
- endif
+ ! try the fully split solution if failed to converge with a minimum time step in the coupled solution
+ if(ixCoupling==fullyCoupled .and. failure) cycle coupling
- ! success = exit solution
- if(.not.failure)then
- select case(ixStateThenDomain)
- case(fullDomain); if(iStateSplit==nStateSplit) exit stateThenDomain
- case(subDomain); if(iStateSplit==nStateSplit) exit solution
- case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
- end select
- else
+ ! try the scalar solution if failed to converge with a minimum time step in the split solution
+ if(ixCoupling/=fullyCoupled)then
+ select case(ixStateThenDomain)
+ case(fullDomain); if(failure) cycle stateThenDomain
+ case(subDomain); if(failure) cycle solution
+ case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
+ end select
+ endif
- ! check that we did not fail for the scalar solution (last resort)
- if(ixSolution==scalar)then
- message=trim(message)//'failed the minimum step for the scalar solution'
- err=20; return
+ ! check that state variables updated
+ where(stateMask) stateCheck = stateCheck+1
+ if(any(stateCheck>1))then
+ message=trim(message)//'state variable updated more than once!'
+ err=20; return
+ endif
- ! check for an unexpected failure
- else
- message=trim(message)//'unexpected failure'
- err=20; return
- endif
+ ! success = exit solution
+ if(.not.failure)then
+ select case(ixStateThenDomain)
+ case(fullDomain); if(iStateSplit==nStateSplit) exit stateThenDomain
+ case(subDomain); if(iStateSplit==nStateSplit) exit solution
+ case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
+ end select
+ else
- endif ! success check
+ ! check that we did not fail for the scalar solution (last resort)
+ if(ixSolution==scalar)then
+ message=trim(message)//'failed the minimum step for the scalar solution'
+ print*, message
+ err=20; return
- end do stateSplit ! solution with split layers
- !print*, 'after stateSplit'
+ ! check for an unexpected failure
+ else
+ message=trim(message)//'unexpected failure'
+ print*, message
+ err=20; return
+ endif
- end do solution ! trial with the full layer solution then the split layer solution
+ endif ! success check
- !print*, 'after solution loop'
+ end do stateSplit ! solution with split layers
+ !print*, 'after stateSplit'
- ! ***** trial with a given solution method...
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
+ end do solution ! trial with the full layer solution then the split layer solution
- end do domainSplit ! domain type splitting loop
+ !print*, 'after solution loop'
- !print*, 'ixStateThenDomain = ', ixStateThenDomain
- !print*, 'after domain split loop'
+ ! ***** trial with a given solution method...
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
- end do stateThenDomain ! switch between the state and the domain
+ end do domainSplit ! domain type splitting loop
- !print*, 'after stateThenDomain switch'
+ !print*, 'ixStateThenDomain = ', ixStateThenDomain
+ !print*, 'after domain split loop'
- ! -----
- ! * reset state variables for the mass split...
- ! ---------------------------------------------
+ end do stateThenDomain ! switch between the state and the domain
- ! modify the state type names associated with the state vector
- if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
- if(computeVegFlux)then
- where(ixStateType(ixHydCanopy)==iname_liqCanopy) ixStateType(ixHydCanopy)=iname_watCanopy
- endif
- where(ixStateType(ixHydLayer) ==iname_liqLayer) ixStateType(ixHydLayer) =iname_watLayer
- where(ixStateType(ixHydLayer) ==iname_lmpLayer) ixStateType(ixHydLayer) =iname_matLayer
- endif ! if modifying state variables for the mass split
+ !print*, 'after stateThenDomain switch'
- end do stateTypeSplitLoop ! state type splitting loop
+ ! -----
+ ! * reset state variables for the mass split...
+ ! ---------------------------------------------
- ! check
- !if(ixCoupling/=fullyCoupled)then
- ! print*, 'PAUSE: end of splitting loop'; read(*,*)
- !endif
+ ! modify the state type names associated with the state vector
+ if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
+ if(computeVegFlux)then
+ where(ixStateType(ixHydCanopy)==iname_liqCanopy) ixStateType(ixHydCanopy)=iname_watCanopy
+ endif
+ where(ixStateType(ixHydLayer) ==iname_liqLayer) ixStateType(ixHydLayer) =iname_watLayer
+ where(ixStateType(ixHydLayer) ==iname_lmpLayer) ixStateType(ixHydLayer) =iname_matLayer
+ endif ! if modifying state variables for the mass split
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
+ end do stateTypeSplitLoop ! state type splitting loop
+
+ ! check
+ !if(ixCoupling/=fullyCoupled)then
+ ! print*, 'PAUSE: end of splitting loop'; read(*,*)
+ !endif
+
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
- ! success = exit the coupling loop
- ! terminate DO loop early if fullyCoupled returns a solution,
- ! so that the loop does not proceed to ixCoupling = stateTypeSplit
- if(ixCoupling==fullyCoupled .and. .not. failure) exit coupling
+ ! success = exit the coupling loop
+ ! terminate DO loop early if fullyCoupled returns a solution,
+ ! so that the loop does not proceed to ixCoupling = stateTypeSplit
+ if(ixCoupling==fullyCoupled .and. .not. failure) exit coupling
- ! if we reach stateTypeSplit, terminating the DO loop here is cleaner
- ! than letting the loop complete, because in the latter case the coupling
- ! loop will end with ixCoupling = nCoupling+1 = 3 (a FORTRAN loop
- ! increments the index variable at the end of each iteration and stops
- ! the loop if the index > specified stop value). Variable ixCoupling is
- ! used for error reporting in coupled_em.f90 in the balance checks and
- ! we thus need to make sure ixCoupling is not incremented to be larger
- ! than nCoupling.
- if(ixCoupling==stateTypeSplit .and. .not. failure) exit coupling
+ ! if we reach stateTypeSplit, terminating the DO loop here is cleaner
+ ! than letting the loop complete, because in the latter case the coupling
+ ! loop will end with ixCoupling = nCoupling+1 = 3 (a FORTRAN loop
+ ! increments the index variable at the end of each iteration and stops
+ ! the loop if the index > specified stop value). Variable ixCoupling is
+ ! used for error reporting in coupled_em.f90 in the balance checks and
+ ! we thus need to make sure ixCoupling is not incremented to be larger
+ ! than nCoupling.
+ if(ixCoupling==stateTypeSplit .and. .not. failure) exit coupling
- end do coupling ! coupling method
-
- ! check that all state variables were updated
- if(any(stateCheck==0))then
- message=trim(message)//'some state variables were not updated!'
- err=20; return
- endif
+ end do coupling ! coupling method
- ! check that the desired fluxes were computed
- do iVar=1,size(flux_meta)
- if(neededFlux(iVar) .and. any(fluxCount%var(iVar)%dat==0))then
- print*, 'fluxCount%var(iVar)%dat = ', fluxCount%var(iVar)%dat
- message=trim(message)//'flux '//trim(flux_meta(iVar)%varname)//' was not computed'
- err=20; return
+ ! check that all state variables were updated
+ if(any(stateCheck==0))then
+ message=trim(message)//'some state variables were not updated!'
+ print*,message
+ err=20; return
endif
- end do
- ! use step halving if unable to complete the fully coupled solution in one substep
- if(ixCoupling/=fullyCoupled .or. nSubsteps>1) dtMultiplier=0.5_dp
+ ! check that the desired fluxes were computed
+ do iVar=1,size(flux_meta)
+ if(neededFlux(iVar) .and. any(fluxCount%var(iVar)%dat==0))then
+ print*, 'fluxCount%var(iVar)%dat = ', fluxCount%var(iVar)%dat
+ message=trim(message)//'flux '//trim(flux_meta(iVar)%varname)//' was not computed'
+ err=20; return
+ endif
+ end do
+
+ ! use step halving if unable to complete the fully coupled solution in one substep
+ if(ixCoupling/=fullyCoupled .or. nSubsteps>1) dtMultiplier=0.5_dp
- ! compute the melt in each snow and soil layer
- if(nSnow>0) mLayerMeltFreeze( 1:nSnow ) = -(mLayerVolFracIce( 1:nSnow ) - mLayerVolFracIceInit( 1:nSnow ))*iden_ice
- mLayerMeltFreeze(nSnow+1:nLayers) = -(mLayerVolFracIce(nSnow+1:nLayers) - mLayerVolFracIceInit(nSnow+1:nLayers))*iden_water
+ ! compute the melt in each snow and soil layer
+ if(nSnow>0) mLayerMeltFreeze( 1:nSnow ) = -(mLayerVolFracIce( 1:nSnow ) - mLayerVolFracIceInit( 1:nSnow ))*iden_ice
+ mLayerMeltFreeze(nSnow+1:nLayers) = -(mLayerVolFracIce(nSnow+1:nLayers) - mLayerVolFracIceInit(nSnow+1:nLayers))*iden_water
- ! end associate statements
- end associate globalVars
+ ! end associate statements
+ end associate globalVars
end subroutine opSplittin
diff --git a/build/source/engine/ssdNrgFlux.f90 b/build/source/engine/ssdNrgFlux.f90
index cd4f371..25fc68e 100755
--- a/build/source/engine/ssdNrgFlux.f90
+++ b/build/source/engine/ssdNrgFlux.f90
@@ -101,6 +101,9 @@ contains
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
@@ -124,6 +127,9 @@ contains
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
diff --git a/build/source/engine/summaSolve.f90 b/build/source/engine/summaSolve.f90
index ee4dfc8..fba4522 100755
--- a/build/source/engine/summaSolve.f90
+++ b/build/source/engine/summaSolve.f90
@@ -67,6 +67,7 @@ USE data_types,only:&
var_d, & ! data vector (dp)
var_ilength, & ! data vector with variable length dimension (i4b)
var_dlength, & ! data vector with variable length dimension (dp)
+ zLookup, &
model_options ! defines the model decisions
! look-up values for the choice of groundwater parameterization
@@ -108,6 +109,7 @@ contains
fOld, & ! intent(in): old function evaluation
! input: data structures
model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
mpar_data, & ! intent(in): model parameters
@@ -159,6 +161,7 @@ contains
real(dp),intent(in) :: fOld ! old function evaluation
! input: data structures
type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
type(var_i), intent(in) :: type_data ! type of vegetation and soil
type(var_d), intent(in) :: attr_data ! spatial attributes
type(var_dlength), intent(in) :: mpar_data ! model parameters
@@ -940,6 +943,7 @@ contains
sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
! input: data structures
model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
mpar_data, & ! intent(in): model parameters
diff --git a/build/source/engine/sundials/computEnthalpy.f90 b/build/source/engine/sundials/computEnthalpy.f90
new file mode 100644
index 0000000..ba216ad
--- /dev/null
+++ b/build/source/engine/sundials/computEnthalpy.f90
@@ -0,0 +1,156 @@
+
+module computEnthalpy_module
+
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! 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:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! freezing temperature (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water, & ! intrinsic density of liquid water (kg m-3)
+ iden_air, &
+ ! 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)
+! privacy
+implicit none
+private
+public::computEnthalpy
+public::computEnthalpyPrime
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine computEnthalpy
+ ! **********************************************************************************************************
+ subroutine computEnthalpy(&
+ ! input
+ indx_data, &
+ nLayers, &
+ mLayerTemp, &
+ mLayerVolFracIce, &
+ mLayerHeatCap, &
+ ! output
+ mLayerEnthalpy &
+ )
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ integer(i4b),intent(in) :: nLayers ! number of snow layers
+ real(rkind),intent(in) :: mLayerTemp(:) ! temperature of each snow/soil layer (K)
+ real(rkind),intent(in) :: mLayerVolFracIce(:) ! volumetric fraction of ice (-)
+ real(rkind),intent(in) :: mLayerHeatCap(:)
+ real(rkind),intent(out) :: mLayerEnthalpy(:)
+
+ ! local variables
+ integer(i4b) :: iLayer
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ associate(&
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] named variables defining the type of layer
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat & ! intent(in): [i4b(:)] indices for energy states
+ )
+ ! (loop through non-missing energy state variables in the snow+soil domain)
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing)
+ select case( layerType(iLayer) )
+ case(iname_snow)
+ mLayerEnthalpy(iLayer) = mLayerHeatCap(iLayer)*mLayerTemp(iLayer) - LH_fus*iden_ice * mLayerVolFracIce(iLayer)
+ case(iname_soil)
+ mLayerEnthalpy(iLayer) = mLayerHeatCap(iLayer)*mLayerTemp(iLayer) - LH_fus*iden_water * mLayerVolFracIce(iLayer)
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+
+ end associate
+
+ end subroutine computEnthalpy
+
+ ! **********************************************************************************************************
+ ! public subroutine computEnthalpyPrime
+ ! **********************************************************************************************************
+ subroutine computEnthalpyPrime(&
+ ! input
+ computeVegFlux, &
+ indx_data, &
+ nLayers, &
+ canopyDepth, & ! intent(in): canopy depth (m)
+ scalarCanopyTempPrime, & ! intent(in): Prime value for the temperature of the vegetation canopy (K)
+ scalarCanopyIcePrime, & ! intent(in): Prime value for the ice on the vegetation canopy (kg m-2)
+ mLayerTempPrime, &
+ mLayerVolFracIcePrime, &
+ heatCapVeg, &
+ mLayerHeatCap, &
+ ! output
+ scalarCanopyEnthalpyPrime, &
+ mLayerEnthalpyPrime &
+ )
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ logical(lgt),intent(in) :: computeVegFlux ! logical flag to denote if computing the vegetation flux
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ integer(i4b),intent(in) :: nLayers ! number of snow layers
+ real(rkind),intent(in) :: canopyDepth ! canopy depth (m)
+ real(rkind),intent(in) :: scalarCanopyTempPrime ! Prime value for the temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyIcePrime ! Prime value for the ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: heatCapVeg
+ real(rkind),intent(in) :: mLayerTempPrime(:) ! temperature of each snow/soil layer (K)
+ real(rkind),intent(in) :: mLayerVolFracIcePrime(:) ! volumetric fraction of ice (-)
+ real(rkind),intent(in) :: mLayerHeatCap(:)
+ real(rkind),intent(out) :: scalarCanopyEnthalpyPrime
+ real(rkind),intent(out) :: mLayerEnthalpyPrime(:)
+
+ ! local variables
+ integer(i4b) :: iLayer
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ associate(&
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] named variables defining the type of layer
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat & ! intent(in): [i4b(:)] indices for energy states
+ )
+
+ if(computeVegFlux)then
+ 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)
+ select case( layerType(iLayer) )
+ case(iname_snow)
+ mLayerEnthalpyPrime(iLayer) = mLayerHeatCap(iLayer)*mLayerTempPrime(iLayer) - LH_fus*iden_ice * mLayerVolFracIcePrime(iLayer)
+ case(iname_soil)
+ mLayerEnthalpyPrime(iLayer) = mLayerHeatCap(iLayer)*mLayerTempPrime(iLayer) - LH_fus*iden_water * mLayerVolFracIcePrime(iLayer)
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+
+ end associate
+
+ end subroutine computEnthalpyPrime
+
+end module computEnthalpy_module
diff --git a/build/source/engine/sundials/computHeatCap.f90 b/build/source/engine/sundials/computHeatCap.f90
new file mode 100644
index 0000000..615e1d3
--- /dev/null
+++ b/build/source/engine/sundials/computHeatCap.f90
@@ -0,0 +1,510 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 computHeatCap_module
+
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! named variables defining elements in the data structures
+USE var_lookup,only:iLookPARAM,iLookDIAG,iLookINDEX ! named variables for structure elements
+
+! 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)
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:iname_watAquifer ! named variable defining the water storage in the aquifer
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+
+! named variables that define the layer type
+USE globalData,only:iname_snow ! snow
+USE globalData,only:iname_soil ! soil
+
+
+! privacy
+implicit none
+private
+public::computHeatCap
+public::computStatMult
+public::computHeatCapAnalytic
+public::computCm
+
+contains
+
+
+ ! **********************************************************************************************************
+ ! public subroutine computHeatCap: compute diagnostic energy variables (heat capacity)
+ ! **********************************************************************************************************
+ subroutine computHeatCap(&
+ ! input: control variables
+ nLayers, & ! intent(in): number of layers (soil+snow)
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ ! input: state variables
+ scalarCanopyIce, & ! intent(in)
+ scalarCanopyLiquid, & ! intent(in)
+ scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ scalarCanopyEnthalpyTrial, & ! intent(in): trial enthalpy of the vegetation canopy (J m-3)
+ scalarCanopyEnthalpyPrev, & ! intent(in): previous enthalpy of the vegetation canopy (J m-3)
+ mLayerVolFracIce, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiq, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerTempTrial, & ! intent(in): trial temperature
+ mLayerTempPrev, & ! intent(in): previous temperature
+ mLayerEnthalpyTrial, & ! intent(in): trial enthalpy for snow and soil
+ mLayerEnthalpyPrev, & ! intent(in): previous enthalpy for snow and soil
+ ! output
+ heatCapVeg, &
+ mLayerHeatCap, & ! intent(out): heat capacity for snow and soil
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! input: control variables
+ logical(lgt),intent(in) :: computeVegFlux ! logical flag to denote if computing the vegetation flux
+ real(rkind),intent(in) :: canopyDepth ! depth of the vegetation canopy (m)
+ ! input/output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! model layer indices
+ ! input:
+ integer(i4b),intent(in) :: nLayers
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ real(rkind),intent(in) :: scalarCanopyIce ! trial value of canopy ice content (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiquid
+ real(rkind),intent(in) :: scalarCanopyTempTrial ! trial value of canopy temperature
+ real(rkind),intent(in) :: scalarCanopyEnthalpyTrial ! trial enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(in) :: scalarCanopyEnthalpyPrev ! intent(in): previous enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(in) :: scalarCanopyTempPrev ! Previous value of canopy temperature
+ real(rkind),intent(in) :: mLayerVolFracLiq(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerVolFracIce(:) ! trial vector of volumetric ice water content (-)
+ real(rkind),intent(in) :: mLayerTempTrial(:)
+ real(rkind),intent(in) :: mLayerTempPrev(:)
+ real(rkind),intent(in) :: mLayerEnthalpyTrial(:)
+ real(rkind),intent(in) :: mLayerEnthalpyPrev(:)
+ ! output:
+ real(qp),intent(out) :: heatCapVeg
+ real(qp),intent(out) :: mLayerHeatCap(:)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of model layer
+ real(rkind) :: delT
+ real(rkind) :: delEnt
+ integer(i4b) :: iSoil ! index of soil layer
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! associate variables in data structure
+ associate(&
+ ! input: coordinate variables
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
+ layerType => indx_data%var(iLookINDEX%layerType)%dat, & ! intent(in): layer type (iname_soil or iname_snow)
+ ! input: heat capacity and thermal conductivity
+ specificHeatVeg => mpar_data%var(iLookPARAM%specificHeatVeg)%dat(1), & ! intent(in): specific heat of vegetation (J kg-1 K-1)
+ maxMassVegetation => mpar_data%var(iLookPARAM%maxMassVegetation)%dat(1), & ! intent(in): maximum mass of vegetation (kg m-2)
+ ! input: depth varying soil parameters
+ iden_soil => mpar_data%var(iLookPARAM%soil_dens_intr)%dat, & ! intent(in): intrinsic density of soil (kg m-3)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat & ! intent(in): soil porosity (-)
+ ) ! end associate statemen
+ ! initialize error control
+ err=0; message="computHeatCap/"
+
+ ! initialize the soil layer
+ iSoil=integerMissing
+
+ ! compute the bulk volumetric heat capacity of vegetation (J m-3 K-1)
+ if(computeVegFlux)then
+ delT = scalarCanopyTempTrial - scalarCanopyTempPrev
+ if(abs(delT) <= 1e-14_rkind)then
+ heatCapVeg = specificHeatVeg*maxMassVegetation/canopyDepth + & ! vegetation component
+ Cp_water*scalarCanopyLiquid/canopyDepth + & ! liquid water component
+ Cp_ice*scalarCanopyIce/canopyDepth ! ice component
+ else
+ delEnt = scalarCanopyEnthalpyTrial - scalarCanopyEnthalpyPrev
+ heatCapVeg = delEnt / delT
+ end if
+ end if
+
+ ! loop through layers
+ do iLayer=1,nLayers
+ delT = mLayerTempTrial(iLayer) - mLayerTempPrev(iLayer)
+ if(abs(delT) <= 1e-14_rkind)then
+ ! get the soil layer
+ if(iLayer>nSnow) iSoil = iLayer-nSnow
+ select case(layerType(iLayer))
+ ! * soil
+ case(iname_soil)
+ mLayerHeatCap(iLayer) = iden_soil(iSoil) * Cp_soil * ( 1._rkind - theta_sat(iSoil) ) + & ! soil component
+ iden_ice * Cp_Ice * mLayerVolFracIce(iLayer) + & ! ice component
+ iden_water * Cp_water * mLayerVolFracLiq(iLayer) + & ! liquid water component
+ iden_air * Cp_air * ( theta_sat(iSoil) - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer)) )! air component
+ case(iname_snow)
+ mLayerHeatCap(iLayer) = iden_ice * Cp_ice * mLayerVolFracIce(iLayer) + & ! ice component
+ iden_water * Cp_water * mLayerVolFracLiq(iLayer) + & ! liquid water component
+ iden_air * Cp_air * ( 1._rkind - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer)) ) ! air component
+ case default; err=20; message=trim(message)//'unable to identify type of layer (snow or soil) to compute olumetric heat capacity'; return
+ end select
+ else
+ delEnt = mLayerEnthalpyTrial(iLayer) - mLayerEnthalpyPrev(iLayer)
+ mLayerHeatCap(iLayer) = delEnt / delT
+ endif
+ end do ! looping through layers
+
+ end associate
+
+ end subroutine computHeatCap
+
+ ! **********************************************************************************************************
+ ! public subroutine computStatMult: get scale factors
+ ! **********************************************************************************************************
+ subroutine computStatMult(&
+ heatCapVeg, &
+ mLayerHeatCap, &
+ ! input: data structures
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ USE nr_utility_module,only:arth ! get a sequence of numbers arth(start, incr, count)
+ USE f2008funcs_module,only:findIndex ! finds the index of the first value within a vector
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: data structures
+ real(qp),intent(out) :: heatCapVeg
+ real(qp),intent(out) :: mLayerHeatCap(:)
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ ! output: state vectors
+ real(qp),intent(out) :: sMul(:) ! NOTE: qp ! multiplier for state vector (used in the residual calculations)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state subsets
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: ixStateSubset ! index within the state subset
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! model diagnostic variables
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
+ volHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1),& ! intent(in) : [dp] bulk volumetric heat capacity of vegetation (J m-3 K-1)
+ ! indices defining specific model states
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy hydrology state variable (mass)
+ ! vector of energy and hydrology indices for the snow and soil domains
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in) : [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in) : [i4b] number of hydrology state variables in the snow+soil domain
+ ! type of model state variabless
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in) : [i4b(:)] [state subset] type of desired model state variables
+ ! number of layers
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in) : [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in) : [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in) : [i4b] total number of layers
+ ) ! end association with variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='computStatMult/'
+
+ ! -----
+ ! * define components of derivative matrices that are constant over a time step (substep)...
+ ! ------------------------------------------------------------------------------------------
+
+ ! define the multiplier for the state vector for residual calculations (vegetation canopy)
+ ! NOTE: Use the "where" statement to generalize to multiple canopy layers (currently one canopy layer)
+
+ where(ixStateType_subset==iname_nrgCanair) sMul = Cp_air*iden_air ! volumetric heat capacity of air (J m-3 K-1)
+ where(ixStateType_subset==iname_nrgCanopy) sMul = heatCapVeg ! volumetric heat capacity of the vegetation (J m-3 K-1)
+ where(ixStateType_subset==iname_watCanopy) sMul = 1._rkind ! nothing else on the left hand side
+ where(ixStateType_subset==iname_liqCanopy) sMul = 1._rkind ! nothing else on the left hand side
+
+
+ ! define the energy multiplier for the state vector for residual calculations (snow-soil domain)
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilNrg(iLayer) ! index within the state vector
+ sMul(ixStateSubset) = mLayerHeatCap(iLayer) ! transfer volumetric heat capacity to the state multiplier
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! define the hydrology multiplier and diagonal elements for the state vector for residual calculations (snow-soil domain)
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilHyd(iLayer) ! index within the state vector
+ sMul(ixStateSubset) = 1._rkind ! state multiplier = 1 (nothing else on the left-hand-side)
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! define the scaling factor and diagonal elements for the aquifer
+ where(ixStateType_subset==iname_watAquifer) sMul = 1._rkind
+
+ ! ------------------------------------------------------------------------------------------
+ ! ------------------------------------------------------------------------------------------
+
+ end associate
+ ! end association to variables in the data structure where vector length does not change
+ end subroutine computStatMult
+
+ ! **********************************************************************************************************
+ ! public subroutine computHeatCapAnalytic: compute diagnostic energy variables (heat capacity)
+ ! **********************************************************************************************************
+ subroutine computHeatCapAnalytic(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input: state variables
+ scalarCanopyIce, & ! intent(in)
+ scalarCanopyLiquid, & ! intent(in)
+ mLayerVolFracIce, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiq, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ ! output
+ heatCapVeg, &
+ mLayerHeatCap, &
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: computeVegFlux ! logical flag to denote if computing the vegetation flux
+ real(rkind),intent(in) :: canopyDepth ! depth of the vegetation canopy (m)
+ real(rkind),intent(in) :: scalarCanopyIce ! trial value of canopy ice content (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiquid
+ real(rkind),intent(in) :: mLayerVolFracLiq(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerVolFracIce(:) ! trial vector of volumetric ice water content (-)
+ ! input/output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! model layer indices
+ ! output: error control
+ real(qp),intent(out) :: heatCapVeg
+ real(qp),intent(out) :: mLayerHeatCap(:)
+ 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) :: iLayer ! index of model layer
+ integer(i4b) :: iSoil ! index of soil layer
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! associate variables in data structure
+ associate(&
+ ! input: coordinate variables
+ 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)
+ ! input: heat capacity and thermal conductivity
+ specificHeatVeg => mpar_data%var(iLookPARAM%specificHeatVeg)%dat(1), & ! intent(in): specific heat of vegetation (J kg-1 K-1)
+ maxMassVegetation => mpar_data%var(iLookPARAM%maxMassVegetation)%dat(1), & ! intent(in): maximum mass of vegetation (kg m-2)
+ ! input: depth varying soil parameters
+ iden_soil => mpar_data%var(iLookPARAM%soil_dens_intr)%dat, & ! intent(in): intrinsic density of soil (kg m-3)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat & ! intent(in): soil porosity (-)
+ ) ! end associate statement
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="computHeatCapAnalytic/"
+
+ ! initialize the soil layer
+ iSoil=integerMissing
+
+ ! compute the bulk volumetric heat capacity of vegetation (J m-3 K-1)
+ if(computeVegFlux)then
+ heatCapVeg = specificHeatVeg*maxMassVegetation/canopyDepth + & ! vegetation component
+ Cp_water*scalarCanopyLiquid/canopyDepth + & ! liquid water component
+ Cp_ice*scalarCanopyIce/canopyDepth ! ice component
+ end if
+
+ ! loop through layers
+ do iLayer=1,nLayers
+
+ ! get the soil layer
+ if(iLayer>nSnow) iSoil = iLayer-nSnow
+
+ ! *****
+ ! * compute the volumetric heat capacity of each layer (J m-3 K-1)...
+ ! *******************************************************************
+ select case(layerType(iLayer))
+ ! * soil
+ case(iname_soil)
+ mLayerHeatCap(iLayer) = iden_soil(iSoil) * Cp_soil * ( 1._rkind - theta_sat(iSoil) ) + & ! soil component
+ iden_ice * Cp_ice * mLayerVolFracIce(iLayer) + & ! ice component
+ iden_water * Cp_water * mLayerVolFracLiq(iLayer) + & ! liquid water component
+ iden_air * Cp_air * ( theta_sat(iSoil) - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer)) )! air component
+ case(iname_snow)
+ mLayerHeatCap(iLayer) = iden_ice * Cp_ice * mLayerVolFracIce(iLayer) + & ! ice component
+ iden_water * Cp_water * mLayerVolFracLiq(iLayer) + & ! liquid water component
+ iden_air * Cp_air * ( 1._rkind - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer)) ) ! air component
+ case default; err=20; message=trim(message)//'unable to identify type of layer (snow or soil) to compute olumetric heat capacity'; return
+ end select
+
+ end do ! looping through layers
+ !pause
+
+ ! end association to variables in the data structure
+ end associate
+
+ end subroutine computHeatCapAnalytic
+
+ ! **********************************************************************************************************
+ ! public subroutine computCm
+ ! **********************************************************************************************************
+ subroutine computCm(&
+ ! input: control variables
+ 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 (-)
+ mLayerMatricHead, & ! intent(in)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ ! output
+ scalarCanopyCm, & ! intent(out): Cm for vegetation
+ mLayerCm, & ! intent(out): Cm for soil and snow
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to external subroutines
+ USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: computeVegFlux ! logical flag to denote if computing the vegetation flux
+ real(rkind),intent(in) :: scalarCanopyTemp ! value of canopy ice content (kg m-2)
+ real(rkind),intent(in) :: mLayerTemp(:) ! vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerMatricHead(:) ! vector of total water matric potential (m)
+ ! input/output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! model layer indices
+ ! output: error control
+ real(qp),intent(out) :: scalarCanopyCm
+ real(qp),intent(out) :: mLayerCm(:)
+ 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) :: iLayer ! index of model layer
+ integer(i4b) :: iSoil ! index of soil layer
+ real(rkind) :: g1
+ real(rkind) :: g2
+ real(rkind) :: Tcrit ! temperature where all water is unfrozen (K)
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! associate variables in data structure
+ associate(&
+ ! input: coordinate variables
+ 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)
+snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) & ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ) ! end associate statement
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="computCm/"
+
+ ! initialize the soil layer
+ iSoil=integerMissing
+
+ ! compute Cm of vegetation
+ ! Note that scalarCanopyCm/iden_water is computed
+ if(computeVegFlux)then
+ g2 = scalarCanopyTemp - Tfreeze
+ g1 = (1._rkind/snowfrz_scale) * atan(snowfrz_scale * g2)
+ if(scalarCanopyTemp < Tfreeze)then
+ scalarCanopyCm = Cp_water * g1 + Cp_ice * (g2 - g1)
+ else
+ scalarCanopyCm = Cp_water * g2
+ end if
+ end if
+
+ ! loop through layers
+ do iLayer=1,nLayers
+
+ ! get the soil layer
+ if(iLayer>nSnow) iSoil = iLayer-nSnow
+
+ ! *****
+ ! * compute Cm of of each layer
+ ! *******************************************************************
+ select case(layerType(iLayer))
+ ! * soil
+ case(iname_soil)
+ 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
+ else
+ mLayerCm(iLayer) = (iden_water * Cp_water - iden_air * Cp_air) * g2
+ end if
+
+ case(iname_snow)
+ g2 = mLayerTemp(iLayer) - Tfreeze
+ g1 = (1._rkind/snowfrz_scale) * atan(snowfrz_scale * g2)
+ mLayerCm(iLayer) = (iden_ice * Cp_ice - iden_air * Cp_air * iden_water/iden_ice) * ( g2 - g1 ) &
+ + (iden_water * Cp_water - iden_air * Cp_air) * g1
+
+ case default; err=20; message=trim(message)//'unable to identify type of layer (snow or soil) to compute Cm'; return
+ end select
+
+ end do ! looping through layers
+ !pause
+
+ ! end association to variables in the data structure
+ end associate
+
+ end subroutine computCm
+
+
+end module computHeatCap_module
diff --git a/build/source/engine/sundials/computJacDAE.f90 b/build/source/engine/sundials/computJacDAE.f90
new file mode 100644
index 0000000..4929203
--- /dev/null
+++ b/build/source/engine/sundials/computJacDAE.f90
@@ -0,0 +1,738 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 computJacDAE_module
+
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! access named variables to describe the form and structure of the matrices used in the numerical solver
+USE globalData,only: ku ! number of super-diagonal bands
+USE globalData,only: kl ! number of sub-diagonal bands
+USE globalData,only: ixDiag ! index for the diagonal band
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_water, & ! intrinsic density of liquid water (kg m-3)
+ ! specific heat
+ Cp_ice, & ! specific heat of ice (J kg-1 K-1)
+ Cp_water ! specific heat of liquid water (J kg-1 K-1)
+
+implicit none
+! define constants
+real(rkind),parameter :: verySmall=tiny(1.0_rkind) ! a very small number
+integer(i4b),parameter :: ixBandOffset=kl+ku+1 ! offset in the band Jacobian matrix
+
+private
+public::computJacDAE
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine computJacDAE: compute the Jacobian matrix
+ ! **********************************************************************************************************
+ subroutine computJacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ computeBaseflow, & ! intent(in): flag to indicate if we need to compute baseflow
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ mLayerTemp, & ! intent(in): vector of layer temperature (K)
+ mLayerTempPrime, & ! intent(in)
+ mLayerMatricHeadPrime, & ! intent(in)
+ mLayerMatricHeadLiqPrime, & ! intent(in)
+ mLayerVolFracWatPrime, & ! intent(in)
+ scalarCanopyTemp, & ! intent(in)
+ scalarCanopyTempPrime, & ! intent(in) derivative value for temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & ! intent(in)
+ ! input-output: Jacobian and its diagonal
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix
+ aJac, & ! intent(out): Jacobian matrix
+ ! output: error control
+ err,message) ! intent(out): error code and error message
+ ! -----------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ real(rkind),intent(in) :: cj
+ real(rkind),intent(in) :: dt ! length of the time step (seconds)
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers in the snow+soil domain
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: computeBaseflow ! flag to indicate if computing baseflow
+ integer(i4b),intent(in) :: ixMatrix ! form of the Jacobian matrix
+ real(rkind),intent(in) :: specificStorage ! specific storage coefficient (m-1)
+ real(rkind),intent(in) :: theta_sat(:) ! soil porosity (-)
+ integer(i4b),intent(in) :: ixRichards ! choice of option for Richards' equation
+ ! input: data structures
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ 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(in) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ real(rkind),intent(in) :: mLayerTemp(:)
+ real(rkind),intent(in) :: mLayerTempPrime(:)
+ real(rkind),intent(in) :: mLayerMatricHeadPrime(:)
+ real(rkind),intent(in) :: mLayerMatricHeadLiqPrime(:)
+ real(rkind),intent(in) :: mLayerVolFracWatPrime(:)
+ real(rkind),intent(in) :: scalarCanopyTemp
+ real(rkind),intent(in) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyWatPrime
+
+ ! input-output: Jacobian and its diagonal
+ real(rkind),intent(inout) :: dMat(:) ! diagonal of the Jacobian matrix
+ real(rkind),intent(out) :: aJac(:,:) ! Jacobian matrix
+ ! output variables
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------
+ ! * local variables
+ ! --------------------------------------------------------------
+ ! indices of model state variables
+ integer(i4b) :: jState ! index of state within the state subset
+ integer(i4b) :: qState ! index of cross-derivative state variable for baseflow
+ integer(i4b) :: nrgState ! energy state variable
+ integer(i4b) :: watState ! hydrology state variable
+ integer(i4b) :: nState ! number of state variables
+ ! indices of model layers
+ integer(i4b) :: iLayer ! index of model layer
+ integer(i4b) :: jLayer ! index of model layer within the full state vector (hydrology)
+ integer(i4b) :: pLayer ! indices of soil layers (used for the baseflow derivatives)
+ ! conversion factors
+ real(rkind) :: convLiq2tot ! factor to convert liquid water derivative to total water derivative
+ !
+ real(rkind) :: dVolFracWat_dPsi0_iLayer
+
+ ! --------------------------------------------------------------
+ ! associate variables from data structures
+ associate(&
+ ! indices of model state variables
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixTopNrg => indx_data%var(iLookINDEX%ixTopNrg)%dat(1) ,& ! intent(in): [i4b] index of upper-most energy state in the snow+soil subdomain
+ ixTopHyd => indx_data%var(iLookINDEX%ixTopHyd)%dat(1) ,& ! intent(in): [i4b] index of upper-most hydrology state in the snow+soil subdomain
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of water storage in the aquifer
+ ! vectors of indices for specfic state types within specific sub-domains IN THE FULL STATE VECTOR
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ! vector of energy indices for the snow and soil domains
+ ! NOTE: states not in the subset are equal to integerMissing
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow domain
+ ixSoilOnlyNrg => indx_data%var(iLookINDEX%ixSoilOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the soil domain
+ ! vector of hydrology indices for the snow and soil domains
+ ! NOTE: states not in the subset are equal to integerMissing
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ ixSnowOnlyHyd => indx_data%var(iLookINDEX%ixSnowOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow domain
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the soil domain
+ ! number of state variables of a specific type
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowOnlyNrg => indx_data%var(iLookINDEX%nSnowOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow domain
+ nSoilOnlyNrg => indx_data%var(iLookINDEX%nSoilOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ nSnowOnlyHyd => indx_data%var(iLookINDEX%nSnowOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow domain
+ nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
+ ! type and index of model control volume
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of the control volume for specific model domains
+ ! mapping between states and model layers
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the full state vector that are in the state subset
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset in each element of the full state vector
+ ! derivatives in net vegetation energy fluxes w.r.t. relevant state variables
+ dCanairNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy air temperature
+ dCanairNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy temperature
+ dCanairNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. ground temperature
+ dCanopyNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy air temperature
+ dCanopyNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy temperature
+ dCanopyNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. ground temperature
+ dCanopyNetFlux_dCanWat => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net canopy fluxes w.r.t. canopy total water content
+ dGroundNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy air temperature
+ dGroundNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy temperature
+ dGroundNetFlux_dCanWat => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net ground fluxes w.r.t. canopy total water content
+ ! derivatives in evaporative fluxes w.r.t. relevant state variables
+ dCanopyEvaporation_dTCanair => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy air temperature
+ dCanopyEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy temperature
+ dCanopyEvaporation_dTGround => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. ground temperature
+ dCanopyEvaporation_dCanWat => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy total water content
+ dGroundEvaporation_dTCanair => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy air temperature
+ dGroundEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy temperature
+ dGroundEvaporation_dTGround => deriv_data%var(iLookDERIV%dGroundEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. ground temperature
+ dGroundEvaporation_dCanWat => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy total water content
+ ! derivatives in canopy water w.r.t canopy temperature
+ dCanLiq_dTcanopy => deriv_data%var(iLookDERIV%dCanLiq_dTcanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy liquid storage w.r.t. temperature
+ dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in volumetric liquid water content w.r.t. temperature
+ d2Theta_dTkCanopy2 => deriv_data%var(iLookDERIV%d2Theta_dTkCanopy2 )%dat(1) ,& ! intent(in): [dp] second derivative of volumetric liquid water content w.r.t. temperature
+ dFracLiqVeg_dTkCanopy => deriv_data%var(iLookDERIV%dFracLiqVeg_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in fraction of (throughfall + drainage) w.r.t. temperature
+ ! derivatives in canopy liquid fluxes w.r.t. canopy water
+ scalarCanopyLiqDeriv => deriv_data%var(iLookDERIV%scalarCanopyLiqDeriv )%dat(1) ,& ! intent(in): [dp] derivative in (throughfall + drainage) w.r.t. canopy liquid water
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
+ dNrgFlux_dTempAbove => deriv_data%var(iLookDERIV%dNrgFlux_dTempAbove )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. temperature in the layer above
+ dNrgFlux_dTempBelow => deriv_data%var(iLookDERIV%dNrgFlux_dTempBelow )%dat ,& ! intent(in): [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(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer above
+ dNrgFlux_dWatBelow => deriv_data%var(iLookDERIV%dNrgFlux_dWatBelow )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer below
+ ! derivatives in soil transpiration w.r.t. canopy state variables
+ mLayerdTrans_dTCanair => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanair )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ mLayerdTrans_dTCanopy => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanopy )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ mLayerdTrans_dTGround => deriv_data%var(iLookDERIV%mLayerdTrans_dTGround )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ mLayerdTrans_dCanWat => deriv_data%var(iLookDERIV%mLayerdTrans_dCanWat )%dat ,& ! intent(in): 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
+ ! 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(in): [dp(:)] derivative in vertical liquid water flux at layer interfaces
+ ! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ d2VolTot_d2Psi0 => deriv_data%var(iLookDERIV%d2VolTot_d2Psi0 )%dat ,& ! intent(in): [dp(:)] second derivative in total water content w.r.t. total water matric potential
+ dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi )%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t matric head
+ dq_dHydStateAbove => deriv_data%var(iLookDERIV%dq_dHydStateAbove )%dat ,& ! intent(in): [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(in): [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(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
+ ! derivative in baseflow flux w.r.t. aquifer storage
+ dBaseflow_dAquifer => deriv_data%var(iLookDERIV%dBaseflow_dAquifer )%dat(1) ,& ! intent(out): [dp(:)] derivative in baseflow flux w.r.t. aquifer storage (s-1)
+ ! 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(in): [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(in): [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(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
+ ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
+ dFracLiqSnow_dTk => deriv_data%var(iLookDERIV%dFracLiqSnow_dTk )%dat ,& ! intent(in): [dp(:)] derivative in fraction of liquid snow w.r.t. temperature
+ mLayerdTheta_dTk => deriv_data%var(iLookDERIV%mLayerdTheta_dTk )%dat ,& ! intent(in): [dp(:)] derivative in volumetric liquid water content w.r.t. temperature
+ mLayerd2Theta_dTk2 => deriv_data%var(iLookDERIV%mLayerd2Theta_dTk2 )%dat ,& ! intent(in): [dp(:)] second derivative of volumetric liquid water content w.r.t. temperature
+ ! derivate in bulk heat capacity w.r.t. relevant state variables
+ dVolHtCapBulk_dPsi0 => deriv_data%var(iLookDERIV%dVolHtCapBulk_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. matric potential
+ dVolHtCapBulk_dTheta => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTheta )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dCanWat => deriv_data%var(iLookDERIV%dVolHtCapBulk_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dTk => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTk )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. temperature
+ dVolHtCapBulk_dTkCanopy => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. temperature
+ ! diagnostic variables
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg )%dat(1) ,& ! intent(in): [dp] fraction of liquid water on vegetation (-)
+ scalarBulkVolHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg )%dat(1) ,& ! intent(in): [dp] bulk volumetric heat capacity of vegetation (J m-3 K-1)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow )%dat ,& ! intent(in): [dp(:)] fraction of liquid water in each snow layer (-)
+ mLayerVolHtCapBulk => diag_data%var(iLookDIAG%mLayerVolHtCapBulk )%dat ,& ! intent(in): [dp(:)] bulk volumetric heat capacity in each snow and soil layer (J m-3 K-1)
+ scalarSoilControl => diag_data%var(iLookDIAG%scalarSoilControl )%dat(1) ,& ! intent(in): [dp] soil control on infiltration, zero or one
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth )%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth )%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ layerType => indx_data%var(iLookINDEX%layerType )%dat & ! intent(in): [i4b(:)] named variables defining the type of layer in snow+soil domain
+ ) ! making association with data in structures
+ ! --------------------------------------------------------------
+ ! initialize error control
+ err=0; message='computJacDAE/'
+
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! * PART 0: PRELIMINARIES (INITIALIZE JACOBIAN AND COMPUTE TIME-VARIABLE DIAGONAL TERMS)
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+
+ ! get the number of state variables
+ nState = size(dMat)
+
+ ! initialize the Jacobian
+ ! NOTE: this needs to be done every time, since Jacobian matrix is modified in the solver
+ aJac(:,:) = 0._rkind ! analytical Jacobian matrix
+
+ ! compute terms in the Jacobian for vegetation (excluding fluxes)
+ ! NOTE: energy for vegetation is computed *within* the iteration loop as it includes phase change
+ if(ixVegNrg/=integerMissing)then
+ dMat(ixVegNrg) = ( scalarBulkVolHeatCapVeg + LH_fus*iden_water*dTheta_dTkCanopy ) * cj &
+ + dVolHtCapBulk_dTkCanopy * scalarCanopyTempPrime &
+ + LH_fus*iden_water * scalarCanopyTempPrime * d2Theta_dTkCanopy2 &
+ + LH_fus * dFracLiqVeg_dTkCanopy * scalarCanopyWatPrime / canopyDepth
+ end if
+
+ ! compute additional terms for the Jacobian for the snow-soil domain (excluding fluxes)
+ ! NOTE: energy for snow+soil is computed *within* the iteration loop as it includes phase change
+ do iLayer=1,nLayers
+ if(ixSnowSoilNrg(iLayer)/=integerMissing) then
+ dMat(ixSnowSoilNrg(iLayer)) = ( mLayerVolHtCapBulk(iLayer) + LH_fus*iden_water*mLayerdTheta_dTk(iLayer) ) * cj &
+ + dVolHtCapBulk_dTk(iLayer) * mLayerTempPrime(iLayer) &
+ + LH_fus*iden_water * mLayerTempPrime(iLayer) * mLayerd2Theta_dTk2(iLayer) &
+ + LH_fus*iden_water * dFracLiqSnow_dTk(iLayer) * mLayerVolFracWatPrime(iLayer)
+ end if
+ end do
+
+ ! compute additional terms for the Jacobian for the soil domain (excluding fluxes)
+ do iLayer=1,nSoil
+ if(ixSoilOnlyHyd(iLayer)/=integerMissing)then
+ dMat(ixSoilOnlyHyd(iLayer)) = ( dVolTot_dPsi0(iLayer) + dCompress_dPsi(iLayer) ) * cj + d2VolTot_d2Psi0(iLayer) * mLayerMatricHeadPrime(iLayer)
+
+ if(ixRichards==mixdform)then
+ dMat(ixSoilOnlyHyd(iLayer)) = dMat(ixSoilOnlyHyd(iLayer)) + specificStorage * dVolTot_dPsi0(iLayer) * mLayerMatricHeadPrime(iLayer) / theta_sat(iLayer)
+ end if
+
+ end if
+ end do
+
+ ! define the form of the matrix
+ select case(ixMatrix)
+
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! * PART 1: BAND MATRIX
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ case(ixBandMatrix) ! ixBandMatrix ixFullMatrix
+ print *, 'banded jacobian matrix needs to be implemented'
+ stop 1
+
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! * PART 2: FULL MATRIX
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ case(ixFullMatrix) ! ixFullMatrix ixBandMatrix
+
+ ! check
+ if(size(aJac,1)/=size(dMat) .or. size(aJac,2)/=size(dMat))then
+ message=trim(message)//'unexpected shape of the Jacobian matrix: expect aJac(nState,nState)'
+ err=20; return
+ end if
+
+ ! -----
+ ! * energy and liquid fluxes over vegetation...
+ ! ---------------------------------------------
+ if(computeVegFlux)then ! (derivatives only defined when vegetation protrudes over the surface)
+
+ ! * liquid water fluxes for vegetation canopy (-), dt*scalarFracLiqVeg*scalarCanopyLiqDeriv is the derivative in throughfall and canopy drainage with canopy water
+ if(ixVegHyd/=integerMissing) aJac(ixVegHyd,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._rkind * cj
+
+ ! * cross-derivative terms for canopy water
+ if(ixVegHyd/=integerMissing)then
+
+ ! cross-derivative terms w.r.t. system temperatures (kg m-2 K-1)
+ if(ixCasNrg/=integerMissing) aJac(ixVegHyd,ixCasNrg) = -dCanopyEvaporation_dTCanair*dt
+ ! dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy is the derivative in throughfall and canopy drainage with canopy temperature
+ if(ixVegNrg/=integerMissing) aJac(ixVegHyd,ixVegNrg) = -dCanopyEvaporation_dTCanopy*dt + dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy
+ if(ixTopNrg/=integerMissing) aJac(ixVegHyd,ixTopNrg) = -dCanopyEvaporation_dTGround*dt
+
+ ! cross-derivative terms w.r.t. canopy water (kg-1 m2)
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
+
+ ! cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
+ ! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
+ if(ixVegNrg/=integerMissing) aJac(ixVegNrg,ixVegHyd) = (-1._rkind + scalarFracLiqVeg)*LH_fus/canopyDepth * cj &
+ + dVolHtCapBulk_dCanWat * scalarCanopyTempPrime - (dt/canopyDepth) * dCanopyNetFlux_dCanWat &
+ + LH_fus * scalarCanopyTempPrime * dFracLiqVeg_dTkCanopy / canopyDepth ! dF/dLiq
+ if(ixTopNrg/=integerMissing) aJac(ixTopNrg,ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
+ endif
+
+ ! cross-derivative terms w.r.t. canopy temperature (K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarCanopyLiqDeriv*dCanLiq_dTcanopy)/iden_water
+ endif
+
+ ! energy fluxes with the canopy air space (J m-3 K-1)
+ if(ixCasNrg/=integerMissing)then
+ aJac(ixCasNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanairTemp) + dMat(ixCasNrg) * cj
+ if(ixVegNrg/=integerMissing) aJac(ixCasNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanopyTemp)
+ if(ixTopNrg/=integerMissing) aJac(ixCasNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dGroundTemp)
+ endif
+
+ ! energy fluxes with the vegetation canopy (J m-3 K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixVegNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanairTemp)
+ aJac(ixVegNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanopyTemp) + dMat(ixVegNrg)
+ if(ixTopNrg/=integerMissing) aJac(ixVegNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dGroundTemp)
+ endif
+
+ ! energy fluxes with the surface (J m-3 K-1)
+ if(ixTopNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixTopNrg,ixCasNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanairTemp)
+ if(ixVegNrg/=integerMissing) aJac(ixTopNrg,ixVegNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanopyTemp)
+ endif
+
+ endif ! if there is a need to compute energy fluxes within vegetation
+
+ ! -----
+ ! * energy fluxes for the snow+soil domain...
+ ! -------------------------------------------
+ if(nSnowSoilNrg>0)then
+ do iLayer=1,nLayers ! loop through all layers in the snow+soil domain
+
+ ! check if the state is in the subset
+ if(ixSnowSoilNrg(iLayer)==integerMissing) cycle
+
+ ! - define index within the state subset and the full state vector
+ jState = ixSnowSoilNrg(iLayer) ! index within the state subset
+
+ ! - diagonal elements
+ aJac(jState,jState) = (dt/mLayerDepth(iLayer))*(-dNrgFlux_dTempBelow(iLayer-1) + dNrgFlux_dTempAbove(iLayer)) + dMat(jState)
+
+ ! - lower-diagonal elements
+ if(iLayer > 1)then
+ if(ixSnowSoilNrg(iLayer-1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer-1),jState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dTempBelow(iLayer-1) )
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer < nLayers)then
+ if(ixSnowSoilNrg(iLayer+1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer+1),jState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dTempAbove(iLayer ) )
+ endif
+
+ end do ! (looping through energy states in the snow+soil domain)
+ endif ! (if the subset includes energy state variables in the snow+soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the snow domain...
+ ! --------------------------------------------
+ if(nSnowOnlyHyd>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! compute factor to convert liquid water derivative to total water derivative
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); convLiq2tot = mLayerFracLiqSnow(iLayer)
+ case default; convLiq2tot = 1._rkind
+ end select
+
+ ! - diagonal elements
+ aJac(watState,watState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot + dMat(watState) * cj
+
+ ! - lower-diagonal elements
+ if(iLayer > 1)then
+ if(ixSnowOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer-1),watState) = 0._rkind ! sub-diagonal: no dependence on other layers
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer < nSnow)then
+ if(ixSnowOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer+1),watState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot ! dVol(below)/dLiq(above) -- (-)
+ endif
+
+ end do ! (looping through liquid water states in the snow domain)
+ endif ! (if the subset includes hydrology state variables in the snow domain)
+
+ ! -----
+ ! * cross derivatives in the snow domain...
+ ! ----------------------------------------
+ if(nSnowOnlyHyd>0 .and. nSnowOnlyNrg>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! (define the energy state)
+ nrgState = ixSnowOnlyNrg(iLayer) ! index within the full state vector
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ if(watstate/=integerMissing)then ! (energy state for the current layer is within the state subset)
+
+ ! - include derivatives of energy fluxes w.r.t water fluxes for current layer
+ aJac(nrgState,watState) = (-1._rkind + mLayerFracLiqSnow(iLayer))*LH_fus*iden_water * cj &
+ + dVolHtCapBulk_dTheta(iLayer) * mLayerTempPrime(iLayer) &
+ + (dt/mLayerDepth(iLayer))*(-dNrgFlux_dWatBelow(iLayer-1) + dNrgFlux_dWatAbove(iLayer)) &
+ + LH_fus*iden_water * mLayerTempPrime(iLayer) * dFracLiqSnow_dTk(iLayer) ! (dF/dLiq)
+
+ ! - include derivatives of water fluxes w.r.t energy fluxes for current layer
+ aJac(watState,nrgState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! (dVol/dT)
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ aJac(ixSnowOnlyHyd(iLayer+1),nrgState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! dVol(below)/dT(above) -- K-1
+ endif ! (if there is a water state in the layer below the current layer in the given state subset)
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSnowOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dWatBelow(iLayer-1) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ if(ixSnowOnlyNrg(iLayer+1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dWatAbove(iLayer ) )
+ elseif(iLayer==nSnow .and. nSoilOnlyNrg>0)then !bottom snow layer and there is soil below
+ if(ixSoilOnlyNrg(1)/=integerMissing) aJac(ixSoilOnlyNrg(1),watState) = (dt/mLayerDepth(nSnow+1))*(-dNrgFlux_dWatAbove(nSnow) )
+ endif
+
+ endif ! (if the energy state for the current layer is within the state subset)
+
+ end do ! (looping through snow layers)
+
+ endif ! (if there are state variables for both water and energy in the snow domain)
+
+ ! -----
+ ! * liquid water fluxes for the soil domain...
+ ! --------------------------------------------
+ if(nSoilOnlyHyd>0)then
+ do iLayer=1,nSoil
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices
+ watState = ixSoilOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - compute the diagonal elements
+ ! all terms *excluding* baseflow
+ aJac(watState,watState) = (dt/mLayerDepth(jLayer))*(-dq_dHydStateBelow(iLayer-1) + dq_dHydStateAbove(iLayer)) + dMat(watState)
+
+ ! - compute the lower-diagonal elements
+ if(iLayer > 1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dq_dHydStateBelow(iLayer-1))
+ endif
+
+ ! - compute the upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dq_dHydStateAbove(iLayer))
+ endif
+
+ ! - include terms for baseflow
+ if(computeBaseflow .and. nSoilOnlyHyd==nSoil)then
+ do pLayer=1,nSoil
+ qState = ixSoilOnlyHyd(pLayer) ! hydrology state index within the state subset
+ aJac(watState,qState) = (dt/mLayerDepth(jLayer))*dBaseflow_dMatric(iLayer,pLayer) + aJac(watState,qState)
+ end do
+ endif
+
+ ! - include terms for surface infiltration below surface
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),watState) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),watState)
+
+ end do ! (looping through hydrology states in the soil domain)
+
+ ! - include terms for surface infiltration above surface
+ if(nSnowOnlyHyd>0 .and. ixSnowOnlyHyd(nSnow)/=integerMissing)then
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyHyd(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0)
+ elseif(computeVegFlux .and. ixVegHyd/=integerMissing)then !ixTopHyd = ixSoilOnlyHyd(1)
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegNrg)
+ endif
+
+ endif ! (if the subset includes hydrology state variables in the soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the aquifer...
+ ! ----------------------------------------
+ if(ixAqWat/=integerMissing) then
+ aJac(ixAqWat,ixAqWat) = -dBaseflow_dAquifer*dt + dMat(ixAqWat) * cj
+ aJac(ixAqWat,ixSoilOnlyHyd(nSoil)) = -dq_dHydStateAbove(nSoil)*dt ! dAquiferRecharge_dWat = d_iLayerLiqFluxSoil(nSoil)_dWat
+ aJac(ixAqWat,ixSoilOnlyNrg(nSoil)) = -dq_dNrgStateAbove(nSoil)*dt ! dAquiferRecharge_dTk = d_iLayerLiqFluxSoil(nSoil)_dTk
+ ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
+ if(computeVegFlux)then
+ aJac(ixAqWat,ixVegHyd) = -dAquiferTrans_dCanWat*dt ! dVol/dLiq (kg m-2)-1
+ aJac(ixAqWat,ixCasNrg) = -dAquiferTrans_dTCanair*dt ! dVol/dT (K-1)
+ aJac(ixAqWat,ixVegNrg) = -dAquiferTrans_dTCanopy*dt ! dVol/dT (K-1)
+ aJac(ixAqWat,ixTopNrg) = -dAquiferTrans_dTGround*dt ! dVol/dT (K-1)
+ endif
+ endif
+
+ ! -----
+ ! * cross derivatives in the soil domain...
+ ! ----------------------------------------
+ if(nSoilOnlyHyd>0 .and. nSoilOnlyNrg>0)then
+ do iLayer=1,nSoilOnlyNrg
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - define the energy state variable
+ nrgState = ixNrgLayer(jLayer) ! index within the full state vector
+
+ ! - define index of hydrology state variable within the state subset
+ watState = ixSoilOnlyHyd(iLayer)
+
+ ! only compute derivatives if the energy state for the current layer is within the state subset
+ if(watstate/=integerMissing)then
+
+ ! - include derivatives in liquid water fluxes w.r.t. temperature for current layer
+ aJac(watState,nrgState) = (dt/mLayerDepth(jLayer))*(-dq_dNrgStateBelow(iLayer-1) + dq_dNrgStateAbove(iLayer)) ! dVol/dT (K-1) -- flux depends on ice impedance
+
+ ! - compute lower diagonal elements
+ if(iLayer>1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),nrgState) = (dt/mLayerDepth(jLayer-1))*( dq_dNrgStateBelow(iLayer-1)) ! K-1
+ endif
+
+ ! compute upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),nrgState) = (dt/mLayerDepth(jLayer+1))*(-dq_dNrgStateAbove(iLayer)) ! K-1
+ endif
+
+ ! - include derivatives of energy w.r.t. ground evaporation
+ if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
+ if(computeVegFlux)then
+ aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
+ aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
+ aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
+ endif
+ aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTGround/iden_water) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+ endif
+
+ ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
+ if(computeVegFlux)then
+ aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dCanWat(iLayer)) + aJac(watState,ixVegHyd) ! dVol/dLiq (kg m-2)-1
+ aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanair(iLayer)) + aJac(watState,ixCasNrg) ! dVol/dT (K-1)
+ aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanopy(iLayer)) + aJac(watState,ixVegNrg) ! dVol/dT (K-1)
+ aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTGround(iLayer)) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+ endif
+
+ ! - include derivatives in energy fluxes w.r.t. with respect to water for current layer
+ aJac(nrgState,watState) = dVolHtCapBulk_dPsi0(iLayer) * mLayerTempPrime(jLayer) &
+ + (dt/mLayerDepth(jLayer))*(-dNrgFlux_dWatBelow(jLayer-1) + dNrgFlux_dWatAbove(jLayer))
+ if(mLayerdTheta_dTk(jLayer) > verySmall)then ! ice is present
+ aJac(nrgState,watState) = -LH_fus*iden_water * dVolTot_dPsi0(iLayer) * cj &
+ - LH_fus*iden_water * mLayerMatricHeadPrime(iLayer) * d2VolTot_d2Psi0(iLayer) + aJac(nrgState,watState) ! dNrg/dMat (J m-3 m-1) -- dMat changes volumetric water, and hence ice content
+ endif
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSoilOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dNrgFlux_dWatBelow(jLayer-1) )
+ elseif(iLayer==1 .and. nSnowOnlyNrg>0)then !top soil layer and there is snow above
+ if(ixSnowOnlyNrg(nSnow)/=integerMissing) aJac(ixSnowOnlyNrg(nSnow),watState) = (dt/mLayerDepth(nSnow))*( dNrgFlux_dWatBelow(nSnow) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dNrgFlux_dWatAbove(jLayer ) )
+ endif
+
+ endif ! (if the water state for the current layer is within the state subset)
+
+ ! - include terms for surface infiltration below surface
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),nrgState) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),nrgState)
+
+ end do ! (looping through soil layers)
+
+ ! - include terms for surface infiltration above surface
+ if(nSnowOnlyHyd>0 .and. ixSnowOnlyNrg(nSnow)/=integerMissing)then
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyNrg(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0)
+ elseif(computeVegFlux .and. ixVegNrg/=integerMissing) then !ixTopHyd = ixSoilOnlyHyd(1)
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegNrg)
+ endif
+
+ endif ! (if there are state variables for both water and energy in the soil domain)
+
+ ! print the Jacobian
+ if(globalPrintFlag)then
+ print*, '** analytical Jacobian (full):'
+ write(*,'(a4,1x,100(i12,1x))') 'xCol', (iLayer, iLayer=min(iJac1,nState),min(iJac2,nState))
+ do iLayer=min(iJac1,nState),min(iJac2,nState)
+ write(*,'(i4,1x,100(e12.5,1x))') iLayer, aJac(min(iJac1,nState):min(iJac2,nState),iLayer)
+ end do
+ end if
+
+ !print*, '** analytical Jacobian (full):'
+ !write(*,'(a4,1x,100(i12,1x))') 'xCol', (iLayer, iLayer=1,size(aJac,2))
+ !do iLayer=1,size(aJac,1)
+ ! write(*,'(i4,1x,100(e12.5,1x))') iLayer, aJac(iLayer,1:size(aJac,2))
+ !end do
+ !print *, '--------------------------------------------------------------'
+
+ ! ***
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify option for the type of matrix'; return
+
+ end select ! type of matrix
+
+ if(any(isNan(aJac)))then
+ print *, '******************************* WE FOUND NAN IN JACOBIAN ************************************'
+ stop 1
+ message=trim(message)//'we found NaN'
+ err=20; return
+ endif
+
+ ! end association to variables in the data structures
+ end associate
+
+ end subroutine computJacDAE
+
+
+ ! **********************************************************************************************************
+ ! private function: get the off-diagonal index in the band-diagonal matrix
+ ! **********************************************************************************************************
+ function ixOffDiag(jState,iState)
+ implicit none
+ integer(i4b),intent(in) :: jState ! off-diagonal state
+ integer(i4b),intent(in) :: iState ! diagonal state
+ integer(i4b) :: ixOffDiag ! off-diagonal index in gthe band-diagonal matrix
+ ixOffDiag = ixBandOffset + jState - iState
+ end function ixOffDiag
+
+end module computJacDAE_module
diff --git a/build/source/engine/sundials/computResidDAE.f90 b/build/source/engine/sundials/computResidDAE.f90
new file mode 100644
index 0000000..a87b2e7
--- /dev/null
+++ b/build/source/engine/sundials/computResidDAE.f90
@@ -0,0 +1,346 @@
+
+
+module computResidDAE_module
+
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! 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:iLookINDEX ! named variables for structure elements
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+! privacy
+implicit none
+private::printResidDAE
+public::computResidDAE
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine computResidDAE: compute the residual vector
+ ! **********************************************************************************************************
+ subroutine computResidDAE(&
+ ! input: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ! input: flux vectors
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ fVec, & ! intent(in): flux vector
+ ! input: state variables (already disaggregated into scalars and vectors)
+ scalarCanopyTempTrial, & ! intent(in):
+ mLayerTempTrial, & ! intent(in)
+ scalarCanairTempPrime, & ! intent(in): trial value for the temperature of the canopy air space (K)
+ scalarCanopyTempPrime, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & !
+ mLayerTempPrime, & ! intent(in): trial value for the temperature of each snow and soil layer (K) water content
+ scalarAquiferStoragePrime, & ! intent(in): trial value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ scalarCanopyIcePrime, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(in):
+ mLayerVolFracIcePrime, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
+ mLayerVolFracWatPrime, &
+ mLayerVolFracLiqPrime, &
+ scalarCanopyCmTrial, &
+ mLayerCmTrial, & ! intent(in)
+ ! input: data structures
+ 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(in): model fluxes for a local HRU
+ indx_data, & ! intent(in): index data
+ ! output
+ rAdd, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input: model control
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers in the snow+soil domain
+ ! input: flux vectors
+ real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ real(rkind),intent(in) :: fVec(:) ! flux vector
+ ! input: state variables (already disaggregated into scalars and vectors)
+ real(rkind),intent(in) :: scalarCanopyTempTrial
+ real(rkind),intent(in) :: mLayerTempTrial(:)
+ real(rkind),intent(in) :: scalarCanairTempPrime ! trial value for temperature of the canopy air space (K)
+ real(rkind),intent(in) :: scalarCanopyTempPrime ! trial value for temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),intent(in) :: mLayerTempPrime(:) ! trial value for temperature of each snow/soil layer (K) content
+ real(rkind),intent(in) :: scalarAquiferStoragePrime ! trial value of aquifer storage (m)
+ ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ real(rkind),intent(in) :: scalarCanopyIcePrime ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiqPrime
+ real(rkind),intent(in) :: mLayerVolFracIcePrime(:) ! trial value for volumetric fraction of ice (-)
+ real(rkind),intent(in) :: mLayerVolFracLiqPrime(:)
+ real(rkind),intent(in) :: mLayerVolFracWatPrime(:)
+ real(qp),intent(in) :: scalarCanopyCmTrial
+ real(qp),intent(in) :: mLayerCmTrial(:)
+ ! input: data structures
+ 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(in) :: flux_data ! model fluxes for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ ! output
+ real(rkind),intent(out) :: rAdd(:) ! additional (sink) terms on the RHS of the state equation
+ real(qp),intent(out) :: rVec(:) ! NOTE: qp ! residual vector
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
+ real(rkind),dimension(nLayers) :: mLayerVolFracHydPrime ! vector of volumetric water content (-), either liquid water content or total water content
+ real(rkind) :: scalarCanopyHydPrime ! trial value for canopy water (kg m-2), either liquid water content or total water content
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! link to the necessary variables for the residual computations
+ associate(&
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model fluxes (sink terms in the soil domain)
+ mLayerTranspire => flux_data%var(iLookFLUX%mLayerTranspire)%dat ,& ! intent(in): [dp] transpiration loss from each soil layer (m s-1)
+ mLayerBaseflow => flux_data%var(iLookFLUX%mLayerBaseflow)%dat ,& ! intent(in): [dp(:)] baseflow from each soil layer (m s-1)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
+ ! number of state variables of a specific type
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
+ ! model indices
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of water storage in the aquifer
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the soil subdomain
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] named variables defining the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat & ! intent(in): [i4b(:)] named variables defining the type of layer in snow+soil domain
+ ) ! association to necessary variables for the residual computations
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="computResidDAE/"
+
+ ! ---
+ ! * compute sink terms...
+ ! -----------------------
+
+ ! intialize additional terms on the RHS as zero
+ rAdd(:) = 0._rkind
+
+ ! compute energy associated with melt freeze for the vegetation canopy
+ if(ixVegNrg/=integerMissing) rAdd(ixVegNrg) = rAdd(ixVegNrg) + LH_fus*scalarCanopyIcePrime/canopyDepth ! energy associated with melt/freeze (J m-3)
+ ! compute energy associated with melt/freeze for snow
+ ! NOTE: allow expansion of ice during melt-freeze for snow; deny expansion of ice during melt-freeze for soil
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ select case( layerType(iLayer) )
+ case(iname_snow); rAdd( ixSnowSoilNrg(iLayer) ) = rAdd( ixSnowSoilNrg(iLayer) ) + LH_fus*iden_ice * mLayerVolFracIcePrime(iLayer)
+ case(iname_soil); rAdd( ixSnowSoilNrg(iLayer) ) = rAdd( ixSnowSoilNrg(iLayer) ) + LH_fus*iden_water * mLayerVolFracIcePrime(iLayer)
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! sink terms soil hydrology (-)
+ ! NOTE 1: state variable is volumetric water content, so melt-freeze is not included
+ ! NOTE 2: ground evaporation was already included in the flux at the upper boundary
+ ! NOTE 3: rAdd(ixSnowOnlyWat)=0, and is defined in the initialization above
+ ! NOTE 4: same sink terms for matric head and liquid matric potential
+ if(nSoilOnlyHyd>0)then
+ do concurrent (iLayer=1:nSoil,ixSoilOnlyHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ rAdd( ixSoilOnlyHyd(iLayer) ) = rAdd( ixSoilOnlyHyd(iLayer) ) + (mLayerTranspire(iLayer) - mLayerBaseflow(iLayer) )/mLayerDepth(iLayer+nSnow) - mLayerCompress(iLayer)
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! ---
+ ! * compute the residual vector...
+ ! --------------------------------
+
+ ! compute the residual vector for the vegetation canopy
+ ! NOTE: sMul(ixVegHyd) = 1, but include as it converts all variables to quadruple precision
+ ! --> energy balance
+ if(ixCasNrg/=integerMissing) rVec(ixCasNrg) = sMul(ixCasNrg)*scalarCanairTempPrime - ( fVec(ixCasNrg) + rAdd(ixCasNrg) )
+ if(ixVegNrg/=integerMissing) rVec(ixVegNrg) = sMul(ixVegNrg) * scalarCanopyTempPrime + scalarCanopyCmTrial * scalarCanopyWatPrime/canopyDepth - ( fVec(ixVegNrg) + rAdd(ixVegNrg) )
+ ! --> mass balance
+ if(ixVegHyd/=integerMissing)then
+ scalarCanopyHydPrime = merge(scalarCanopyWatPrime, scalarCanopyLiqPrime, (ixStateType( ixHydCanopy(ixVegVolume) )==iname_watCanopy) )
+ rVec(ixVegHyd) = sMul(ixVegHyd)*scalarCanopyHydPrime - ( fVec(ixVegHyd) + rAdd(ixVegHyd) )
+ endif
+
+ ! compute the residual vector for the snow and soil sub-domains for energy
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ rVec( ixSnowSoilNrg(iLayer) ) = sMul( ixSnowSoilNrg(iLayer) ) * mLayerTempPrime(iLayer) + mLayerCmTrial(iLayer) * mLayerVolFracWatPrime(iLayer) - ( fVec( ixSnowSoilNrg(iLayer) ) + rAdd( ixSnowSoilNrg(iLayer) ) )
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! compute the residual vector for the snow and soil sub-domains for hydrology
+ ! NOTE: residual depends on choice of state variable
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ ! (get the correct state variable)
+ mLayerVolFracHydPrime(iLayer) = merge(mLayerVolFracWatPrime(iLayer), mLayerVolFracLiqPrime(iLayer), (ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_matLayer) )
+ ! (compute the residual)
+ rVec( ixSnowSoilHyd(iLayer) ) = mLayerVolFracHydPrime(iLayer) - ( fVec( ixSnowSoilHyd(iLayer) ) + rAdd( ixSnowSoilHyd(iLayer) ) )
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! compute the residual vector for the aquifer
+ if(ixAqWat/=integerMissing) rVec(ixAqWat) = sMul(ixAqWat)*scalarAquiferStoragePrime - ( fVec(ixAqWat) + rAdd(ixAqWat) )
+
+ ! print result
+ if(globalPrintFlag)then
+ write(*,'(a,1x,100(e12.5,1x))') 'rVec = ', rVec(min(iJac1,size(rVec)):min(iJac2,size(rVec)))
+ write(*,'(a,1x,100(e12.5,1x))') 'fVec = ', fVec(min(iJac1,size(rVec)):min(iJac2,size(rVec)))
+ !print*, 'PAUSE:'; read(*,*)
+ endif
+
+ !call printResidDAE(nSnow,nSoil,nLayers,indx_data,rAdd,rVec)
+
+ ! check
+ if(any(isNan(rVec)))then
+ call printResidDAE(nSnow,nSoil,nLayers,indx_data,rAdd,rVec)
+ message=trim(message)//'we found NaN'
+ err=20; return
+ endif
+
+ ! end association with the necessary variabiles for the residual calculations
+ end associate
+
+ end subroutine computResidDAE
+
+ ! **********************************************************************************************************
+ ! private subroutine printResidDAE: print the residual vector mainly for debugging
+ ! **********************************************************************************************************
+ subroutine printResidDAE( &
+ ! input: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ ! output
+ rAdd, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec) ! intent(out): residual vector
+
+! --------------------------------------------------------------------------------------------------------------------------------
+implicit none
+! input: model control
+integer(i4b),intent(in) :: nSnow ! number of snow layers
+integer(i4b),intent(in) :: nSoil ! number of soil layers
+integer(i4b),intent(in) :: nLayers ! total number of layers in the snow+soil domain
+type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+! output
+real(rkind),intent(in) :: rAdd(:) ! additional (sink) terms on the RHS of the state equation
+real(qp),intent(in) :: rVec(:) ! NOTE: qp ! residual vector
+! --------------------------------------------------------------------------------------------------------------------------------
+! local variables
+! --------------------------------------------------------------------------------------------------------------------------------
+integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+! --------------------------------------------------------------------------------------------------------------------------------
+! link to the necessary variables for the residual computations
+associate(&
+! number of state variables of a specific type
+nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
+! model indices
+ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of water storage in the aquifer
+ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow+soil subdomain
+ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the soil subdomain
+ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
+ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] named variables defining the type of hydrology states in snow+soil domain
+layerType => indx_data%var(iLookINDEX%layerType)%dat & ! intent(in): [i4b(:)] named variables defining the type of layer in snow+soil domain
+) ! association to necessary variables for the residual computations
+! --------------------------------------------------------------------------------------------------------------------------------
+
+if(ixVegNrg/=integerMissing) print *, 'rAdd(ixVegNrg) = ', rAdd(ixVegNrg)
+
+if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing)
+ select case( layerType(iLayer) )
+ case(iname_snow)
+ print *, 'rAdd( ixSnowSoilNrg(iLayer) ) = ', rAdd( ixSnowSoilNrg(iLayer) )
+ case(iname_soil); print *, 'rAdd( ixSnowSoilNrg(iLayer) ) = ', rAdd( ixSnowSoilNrg(iLayer) )
+ end select
+ end do
+endif
+
+if(nSoilOnlyHyd>0)then
+ do concurrent (iLayer=1:nSoil,ixSoilOnlyHyd(iLayer)/=integerMissing)
+ print *, 'rAdd( ixSoilOnlyHyd(iLayer) ) = ', rAdd( ixSoilOnlyHyd(iLayer) )
+ end do
+endif
+
+if(ixCasNrg/=integerMissing) print *, 'rVec(ixCasNrg) = ', rVec(ixCasNrg)
+if(ixVegNrg/=integerMissing) print *, 'rVec(ixVegNrg) = ', rVec(ixVegNrg)
+if(ixVegHyd/=integerMissing)then
+ print *, 'rVec(ixVegHyd) = ', rVec(ixVegHyd)
+endif
+
+if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing)
+ print *, 'rVec( ixSnowSoilNrg(iLayer) ) = ', rVec( ixSnowSoilNrg(iLayer) )
+ end do
+endif
+
+if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
+ print *, 'rVec( ixSnowSoilHyd(iLayer) ) = ', rVec( ixSnowSoilHyd(iLayer) )
+ end do
+endif
+
+if(ixAqWat/=integerMissing) print *, ' rVec(ixAqWat) = ', rVec(ixAqWat)
+
+end associate
+
+end subroutine printResidDAE
+
+end module computResidDAE_module
diff --git a/build/source/engine/sundials/computThermConduct.f90 b/build/source/engine/sundials/computThermConduct.f90
new file mode 100644
index 0000000..843806e
--- /dev/null
+++ b/build/source/engine/sundials/computThermConduct.f90
@@ -0,0 +1,287 @@
+
+module computThermConduct_module
+
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! named variables defining elements in the data structures
+USE var_lookup,only:iLookPARAM,iLookPROG,iLookDIAG,iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+! physical constants
+USE multiconst,only:&
+ 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)
+ ! 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 that define the layer type
+USE globalData,only:iname_snow ! snow
+USE globalData,only:iname_soil ! soil
+
+! provide access to named variables for thermal conductivity of soil
+USE globalData,only:model_decisions ! model decision structure
+
+! decisions for thermal conductivity of soil
+USE mDecisions_module,only:Smirnova2000 ! option for temporally constant thermal conductivity
+
+! decisions for thermal conductivity of soil
+USE mDecisions_module,only: funcSoilWet, & ! function of soil wetness
+ mixConstit, & ! mixture of constituents
+ hanssonVZJ ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
+
+! privacy
+implicit none
+private
+public::computThermConduct
+
+! algorithmic parameters
+real(rkind),parameter :: valueMissing=-9999._rkind ! missing value, used when diagnostic or state variables are undefined
+real(rkind),parameter :: verySmall=1.e-6_rkind ! used as an additive constant to check if substantial difference among real numbers
+real(rkind),parameter :: mpe=1.e-6_rkind ! prevents overflow error if division by zero
+real(rkind),parameter :: dx=1.e-6_rkind ! finite difference increment
+contains
+
+
+ ! **********************************************************************************************************
+ ! public subroutine computThermConduct: compute diagnostic energy variables (thermal conductivity and heat capacity)
+ ! **********************************************************************************************************
+ subroutine computThermConduct(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input: state variables
+ scalarCanopyIce, & ! intent(in): canopy ice content (kg m-2)
+ scalarCanopyLiquid, & ! intent(in): canopy liquid water content (kg m-2)
+ mLayerVolFracIce, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiq, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ ! input/output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to external subroutines
+ USE snow_utils_module,only:tcond_snow ! compute thermal conductivity of snow
+ ! --------------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ logical(lgt),intent(in) :: computeVegFlux ! logical flag to denote if computing the vegetation flux
+ real(rkind),intent(in) :: canopyDepth ! depth of the vegetation canopy (m)
+ real(rkind),intent(in) :: scalarCanopyIce ! trial value of canopy ice content (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiquid
+ real(rkind),intent(in) :: mLayerVolFracLiq(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerVolFracIce(:) ! trial vector of volumetric ice water content (-)
+ ! input/output: data structures
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! model layer indices
+ type(var_dlength),intent(in) :: prog_data ! model prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! model diagnostic variables for a local HRU
+ ! 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) :: iLayer ! index of model layer
+ integer(i4b) :: iSoil ! index of soil 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
+ ! 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)
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! associate variables in data structure
+ associate(&
+ ! input: model decisions
+ 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: coordinate variables
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1), & ! intent(in): number of soil 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)
+ mLayerHeight => prog_data%var(iLookPROG%mLayerHeight)%dat, & ! intent(in): height at the mid-point of each layer (m)
+ iLayerHeight => prog_data%var(iLookPROG%iLayerHeight)%dat, & ! intent(in): height at the interface of each layer (m)
+ ! input: heat capacity and thermal conductivity
+ specificHeatVeg => mpar_data%var(iLookPARAM%specificHeatVeg)%dat(1), & ! intent(in): specific heat of vegetation (J kg-1 K-1)
+ maxMassVegetation => mpar_data%var(iLookPARAM%maxMassVegetation)%dat(1), & ! intent(in): maximum mass of vegetation (kg m-2)
+ fixedThermalCond_snow => mpar_data%var(iLookPARAM%fixedThermalCond_snow)%dat(1), & ! intent(in): temporally constant thermal conductivity of snow (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_silt => mpar_data%var(iLookPARAM%frac_silt)%dat, & ! intent(in): fraction of silt (-)
+ frac_clay => mpar_data%var(iLookPARAM%frac_clay)%dat, & ! intent(in): fraction of clay (-)
+ ! output: diagnostic variables
+ mLayerThermalC => diag_data%var(iLookDIAG%mLayerThermalC)%dat, & ! intent(out): thermal conductivity at the mid-point of each layer (W m-1 K-1)
+ iLayerThermalC => diag_data%var(iLookDIAG%iLayerThermalC)%dat, & ! intent(out): thermal conductivity at the interface of each layer (W m-1 K-1)
+ mLayerVolFracAir => diag_data%var(iLookDIAG%mLayerVolFracAir)%dat & ! intent(out): volumetric fraction of air in each layer (-)
+ ) ! end associate statement
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="computThermConduct/"
+
+ ! initialize the soil layer
+ iSoil=integerMissing
+
+ ! loop through layers
+ do iLayer=1,nLayers
+
+ ! get the soil layer
+ if(iLayer>nSnow) iSoil = iLayer-nSnow
+
+ ! 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(iSoil)*( 1._rkind - theta_sat(iSoil) )
+ lambda_drysoil = (0.135_rkind*bulkden_soil + 64.7_rkind) / (iden_soil(iSoil) - 0.947_rkind*bulkden_soil)
+ lambda_wetsoil = (8.80_rkind*frac_sand(iSoil) + 2.92_rkind*frac_clay(iSoil)) / (frac_sand(iSoil) + frac_clay(iSoil))
+ end if
+
+ ! *****
+ ! * compute the volumetric fraction of air in each layer...
+ ! *********************************************************
+ select case(layerType(iLayer))
+ case(iname_soil); mLayerVolFracAir(iLayer) = theta_sat(iSoil) - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer))
+ case(iname_snow); mLayerVolFracAir(iLayer) = 1._rkind - (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer))
+ 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
+
+ ! *****
+ ! * compute the thermal conductivity of snow and soil at the mid-point of each layer...
+ ! *************************************************************************************
+ select case(layerType(iLayer))
+
+ ! ***** soil
+ case(iname_soil)
+
+ ! 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(iSoil) ) * lambda_water**theta_sat(iSoil) * lambda_ice**(theta_sat(iSoil) - mLayerVolFracLiq(iLayer))
+ relativeSat = (mLayerVolFracIce(iLayer) + mLayerVolFracLiq(iLayer))/theta_sat(iSoil) ! relative saturation
+ ! compute the Kersten number (-)
+ if(relativeSat > 0.1_rkind)then ! log10(0.1) = -1
+ kerstenNum = log10(relativeSat) + 1._rkind
+ else
+ kerstenNum = 0._rkind ! dry thermal conductivity
+ endif
+ ! ...and, compute the thermal conductivity
+ mLayerThermalC(iLayer) = kerstenNum*lambda_wet + (1._rkind - kerstenNum)*lambda_drysoil
+
+ ! ** mixture of constituents
+ case(mixConstit)
+ mLayerThermalC(iLayer) = thCond_soil(iSoil) * ( 1._rkind - theta_sat(iSoil) ) + & ! soil component
+ lambda_ice * mLayerVolFracIce(iLayer) + & ! ice component
+ lambda_water * mLayerVolFracLiq(iLayer) + & ! liquid water component
+ lambda_air * mLayerVolFracAir(iLayer) ! air component
+
+ ! ** test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
+ case(hanssonVZJ)
+ fArg = 1._rkind + f1*mLayerVolFracIce(iLayer)**f2
+ xArg = mLayerVolFracLiq(iLayer) + fArg*mLayerVolFracIce(iLayer)
+ mLayerThermalC(iLayer) = c1 + c2*xArg + (c1 - c4)*exp(-(c3*xArg)**c5)
+
+ ! ** 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)
+ ! temporally constant thermal conductivity
+ if(ixThCondSnow==Smirnova2000)then
+ mLayerThermalC(iLayer) = fixedThermalCond_snow
+ ! thermal conductivity as a function of snow density
+ else
+ call tcond_snow(mLayerVolFracIce(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
+ endif
+
+ ! * 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...
+ ! ****************************************************************************
+ do iLayer=1,nLayers-1 ! (loop through layers)
+ ! get temporary variables
+ TCn = mLayerThermalC(iLayer) ! thermal conductivity below the layer interface (W m-1 K-1)
+ TCp = mLayerThermalC(iLayer+1) ! thermal conductivity above the layer interface (W m-1 K-1)
+ zdn = iLayerHeight(iLayer) - mLayerHeight(iLayer) ! height difference between interface and lower value (m)
+ zdp = mLayerHeight(iLayer+1) - iLayerHeight(iLayer) ! height difference between interface and upper value (m)
+ den = TCn*zdp + TCp*zdn ! denominator
+ ! compute thermal conductivity
+ if(TCn+TCp > epsilon(TCn))then
+ iLayerThermalC(iLayer) = (TCn*TCp*(zdn + zdp)) / den
+ else
+ iLayerThermalC(iLayer) = (TCn*zdn + TCp*zdp) / (zdn + zdp)
+ endif
+ !write(*,'(a,1x,i4,1x,10(f9.3,1x))') 'iLayer, TCn, TCp, zdn, zdp, iLayerThermalC(iLayer) = ', iLayer, TCn, TCp, zdn, zdp, iLayerThermalC(iLayer)
+ end do ! looping through layers
+
+ ! special case of hansson
+ if(ixThCondSoil==hanssonVZJ)then
+ iLayerThermalC(0) = 28._rkind*(0.5_rkind*(iLayerHeight(1) - iLayerHeight(0)))
+ else
+ iLayerThermalC(0) = mLayerThermalC(1)
+ end if
+
+ ! assume the thermal conductivity at the domain boundaries is equal to the thermal conductivity of the layer
+ iLayerThermalC(nLayers) = mLayerThermalC(nLayers)
+
+ ! end association to variables in the data structure
+ end associate
+
+ end subroutine computThermConduct
+
+
+end module computThermConduct_module
diff --git a/build/source/engine/sundials/eval8DAE.f90 b/build/source/engine/sundials/eval8DAE.f90
new file mode 100644
index 0000000..a83f8ac
--- /dev/null
+++ b/build/source/engine/sundials/eval8DAE.f90
@@ -0,0 +1,764 @@
+
+module eval8DAE_module
+
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:model_decisions ! model decision structure
+
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ 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)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zlookup, &
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! 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:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin, & ! single groundwater store over the entire basin
+ enthalpyFD ! heat capacity using enthalpy
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8DAE
+
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine eval8DAE: compute the residual vector
+ ! **********************************************************************************************************
+ subroutine eval8DAE(&
+ ! input: model control
+ dt_cur, & ! intent(in): current stepsize
+ dt, & ! intent(in): entire time step
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nState, & ! intent(in): total number of state variables
+ checkFeas, & ! intent(in): flag to indicate if we are checking for feasibility
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout) flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(inout) flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ requireLWBal, & ! intent(in): flag to indicate if we need longwave to be balanced
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): derivative of model state vector
+ sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup data
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output:
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyTempPrev, & ! intent(in): value of canopy temperature (K)
+ scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ scalarCanopyEnthalpyPrev,& ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ mLayerMatricHeadLiqTrial,& ! intent(out): trial value for liquid water matric potential (m)
+ mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ scalarAquiferStoragePrev,& ! intent(in): value of storage of water in the aquifer (m)
+ mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ fluxVec, & ! intent(out): flux vector
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE varExtrSundials_module, only:varExtract2 ! extract variables from the state vector
+ USE varExtrSundials_module, only:varExtractSundials
+ USE updateVarsSundials_module, only:updateVarsSundials ! update variables
+ USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
+ USE computFlux_module, only:soilCmpresSundials ! compute soil compression
+ USE computFlux_module, only:computFlux ! compute fluxes given a state vector
+ USE computHeatCap_module,only:computHeatCap ! compute heat capacity
+ USE computHeatCap_module,only:computHeatCapAnalytic ! compute heat capacity
+ USE computHeatCap_module,only:computCm
+ USE computHeatCap_module, only:computStatMult
+ USE computResidDAE_module,only:computResidDAE ! compute residuals given a state vector
+ USE computThermConduct_module,only:computThermConduct
+ USE computEnthalpy_module,only:computEnthalpy
+ USE computEnthalpy_module,only:computEnthalpyPrime
+ implicit none
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt_cur
+ real(rkind),intent(in) :: dt ! time step
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer,intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: checkFeas ! flag to indicate if we are checking for feasibility
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall
+ logical(lgt),intent(inout) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ logical(lgt),intent(in) :: requireLWBal ! flag to indicate if we need longwave to be balanced
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVec(:) ! model state vector
+ real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
+ real(qp),intent(inout) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i), intent(in) :: type_data ! type of vegetation and soil
+ type(var_d), intent(in) :: attr_data ! spatial attributes
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_d), intent(in) :: forc_data ! model forcing data
+ type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ 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
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ real(rkind),intent(out) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ real(rkind),intent(out) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyTempPrev ! previous value for temperature of the vegetation canopy (K)
+ real(rkind),intent(out) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyIcePrev ! previous value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyLiqTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiqPrev ! previous value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyEnthalpyTrial ! trial value for enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(in) :: scalarCanopyEnthalpyPrev ! previous value of enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(out) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(in) :: mLayerTempPrev(:)
+ real(rkind),intent(out) :: mLayerMatricHeadLiqTrial(:) ! trial value for liquid water matric potential (m)
+ real(rkind),intent(out) :: mLayerMatricHeadTrial(:) ! trial value for total water matric potential (m)
+ real(rkind),intent(in) :: mLayerMatricHeadPrev(:) ! value for total water matric potential (m)
+ real(rkind),intent(out) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(in) :: mLayerVolFracWatPrev(:) ! vector of volumetric total water content (-)
+ real(rkind),intent(out) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
+ real(rkind),intent(in) :: mLayerVolFracIcePrev(:) ! vector of volumetric ice water content (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerVolFracLiqPrev(:) ! vector of volumetric liquid water content (-)
+ real(rkind),intent(out) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ real(rkind),intent(in) :: scalarAquiferStoragePrev ! value of storage of water in the aquifer (m)
+ real(rkind),intent(in) :: mLayerEnthalpyPrev(:) ! vector of enthalpy for snow+soil layers (J m-3)
+ real(rkind),intent(out) :: mLayerEnthalpyTrial(:) ! trial vector of enthalpy for snow+soil layers (J m-3)
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
+ logical(lgt),intent(out) :: feasible ! flag to denote the feasibility of the solution
+ real(rkind),intent(out) :: fluxVec(:) ! flux vector
+ real(rkind),intent(out) :: resSink(:) ! sink terms on the RHS of the flux equation
+ real(qp),intent(out) :: resVec(:) ! NOTE: qp ! residual vector
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
+ ! derivative of diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
+ ! enthalpy
+ real(rkind) :: scalarCanairEnthalpy ! enthalpy of the canopy air space (J m-3)
+ real(rkind),dimension(nLayers) :: mLayerEnthalpyPrime ! enthalpy of each snow+soil layer (J m-3)
+ ! other local variables
+ integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
+ integer(i4b) :: jState(1) ! index of model state for the scalar solution within the soil domain
+ integer(i4b) :: ixBeg,ixEnd ! index of indices for the soil compression routine
+ integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
+ real(rkind) :: xMin,xMax ! minimum and maximum values for water content
+ real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ real(rkind) :: scalarCanopyCmTrial ! trial value of Cm for the canopy
+ real(rkind),dimension(nLayers) :: mLayerCmTrial ! trial vector of Cm for snow+soil
+ logical(lgt),parameter :: updateCp=.true. ! flag to indicate if we update Cp at each step
+ logical(lgt),parameter :: needCm=.false. ! flag to indicate if the energy equation contains Cm = dH_T/dTheta_m
+
+
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model state variables
+ scalarSfcMeltPond => prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) ,& ! intent(in): [dp] ponded water caused by melt of the "snow without a layer" (kg m-2)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ ! soil compression
+ scalarSoilCompress => diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ,& ! intent(in): [dp] total change in storage associated with compression of the soil matrix (kg m-2)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
+ ! derivatives
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0)%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi)%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t. matric head (m-1)
+ ! mapping
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ! indices
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable (nrg)
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable (nrg)
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
+ heatCapVegTrial => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1) ,& ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat & ! intent(out): heat capacity for snow and soil
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8DAE/"
+ feasible=.true.
+
+ ! check the feasibility of the solution
+ if (checkFeas) then
+ ! check that the canopy air space temperature is reasonable
+ if(ixCasNrg/=integerMissing)then
+ if(stateVec(ixCasNrg) > canopyTempMax) feasible=.false.
+ if(stateVec(ixCasNrg) > canopyTempMax) message=trim(message)//'canopy air space temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixCasNrg )', feasible, canopyTempMax, stateVec(ixCasNrg)
+ endif
+
+ ! check that the canopy temperature is reasonable
+ if(ixVegNrg/=integerMissing)then
+ if(stateVec(ixVegNrg) > canopyTempMax) feasible=.false.
+ if(stateVec(ixVegNrg) > canopyTempMax) message=trim(message)//'canopy temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixVegNrg )', feasible, canopyTempMax, stateVec(ixVegNrg)
+ endif
+
+ ! check canopy liquid water is not negative
+ if(ixVegHyd/=integerMissing)then
+ if(stateVec(ixVegHyd) < 0._rkind) feasible=.false.
+ if(stateVec(ixVegHyd) < 0._rkind) message=trim(message)//'canopy water negative,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, min, stateVec( ixVegHyd )', feasible, 0._rkind, stateVec(ixVegHyd)
+ end if
+
+ ! check snow temperature is below freezing
+ if(count(ixSnowOnlyNrg/=integerMissing)>0)then
+ if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) feasible=.false.
+ if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) message=trim(message)//'snow temp above freezing,'
+ do iLayer=1,nSnow
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, max, stateVec( ixSnowOnlyNrg(iLayer) )', iLayer, feasible, Tfreeze, stateVec( ixSnowOnlyNrg(iLayer) )
+ enddo
+ endif
+
+ ! loop through non-missing hydrology state variables in the snow+soil domain
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
+
+ ! check the minimum and maximum water constraints
+ if(ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_liqLayer)then
+
+ ! --> minimum
+ if (layerType(iLayer) == iname_soil) then
+ xMin = theta_res(iLayer-nSnow)
+ else
+ xMin = 0._rkind
+ endif
+
+ ! --> maximum
+ select case( layerType(iLayer) )
+ case(iname_snow); xMax = merge(iden_ice, 1._rkind - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ case(iname_soil); xMax = merge(theta_sat(iLayer-nSnow), theta_sat(iLayer-nSnow) - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ end select
+
+ ! --> check
+ if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) feasible=.false.
+ if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) message=trim(message)//'layer water outside bounds,'
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax = ', iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax
+
+ endif ! if water states
+
+ end do ! loop through non-missing hydrology state variables in the snow+soil domain
+
+ ! early return for non-feasible solutions
+ if(.not.feasible)then
+ fluxVec(:) = realMissing
+ resVec(:) = quadMissing
+ message=trim(message)//'non-feasible'
+ err=20; return
+ end if
+
+ end if ! ( feasibility check )
+
+ ! get the start and end indices for the soil compression calculations
+ if(scalarSolution)then
+ jState = pack(ixControlVolume, ixMapFull2Subset/=integerMissing)
+ ixBeg = jState(1)
+ ixEnd = jState(1)
+ else
+ ixBeg = 1
+ ixEnd = nSoil
+ endif
+
+ ! initialize to state variable from the last update
+ scalarCanopyTempTrial = scalarCanopyTempPrev
+ scalarCanopyLiqTrial = scalarCanopyLiqPrev
+ scalarCanopyIceTrial = scalarCanopyIcePrev
+ mLayerTempTrial = mLayerTempPrev
+ mLayerVolFracWatTrial = mLayerVolFracWatPrev
+ mLayerVolFracLiqTrial = mLayerVolFracLiqPrev
+ mLayerVolFracIceTrial = mLayerVolFracIcePrev
+ mLayerMatricHeadTrial = mLayerMatricHeadPrev
+ scalarAquiferStorageTrial = scalarAquiferStoragePrev
+
+ ! extract variables from the model state vector
+ call varExtract2(&
+ ! 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: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ call varExtractSundials(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of 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: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ call updateVarsSundials(&
+ ! input
+ dt_cur, &
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ mLayerVolFracWatPrev, & ! intent(in)
+ mLayerMatricHeadPrev, & ! intent(in)
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & !
+ mLayerVolFracWatPrime, & ! intent(inout): Prime vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): Prime vector of volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & !
+ mLayerMatricHeadPrime, & ! intent(inout): Prime vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): Prime vector of liquid water matric potential (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ ! print the water content
+ if(globalPrintFlag)then
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(iJac2,nSnow))
+ endif
+
+
+ if(updateCp)then
+ ! *** compute volumetric heat capacity C_p
+ if(model_decisions(iLookDECISIONS%howHeatCap)%iDecision == enthalpyFD)then
+ ! compute H_T
+ call t2enthalpy_T(&
+ ! input: data structures
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ mpar_data, & ! intent(in): parameter data structure
+ indx_data, & ! intent(in): model indices
+ lookup_data, & ! intent(in): lookup table data structure
+ ! input: state variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(in): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(in): trial value of canopy total water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(in): trial value for canopy ice content (kg m-2)
+ ! input: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(in): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(in): trial vector of volumetric total water content (-)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
+ mLayerVolFracIceTrial, & ! intent(in): trial vector of volumetric fraction of ice (-)
+ ! output: enthalpy
+ scalarCanairEnthalpy, & ! intent(out): enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpyTrial, & ! intent(out): enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpyTrial, & ! intent(out): enthalpy of each snow+soil layer (J m-3)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** compute volumetric heat capacity C_p = dH_T/dT
+ call computHeatCap(&
+ ! input: control variables
+ nLayers, & ! intent(in): number of layers (soil+snow)
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ ! input: state variables
+ scalarCanopyIceTrial, & ! intent(in): trial value for canopy ice content (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ scalarCanopyEnthalpyTrial, & ! intent(in): trial enthalpy of the vegetation canopy (J m-3)
+ scalarCanopyEnthalpyPrev, & ! intent(in): previous enthalpy of the vegetation canopy (J m-3)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerTempTrial, & ! intent(in): trial temperature
+ mLayerTempPrev, & ! intent(in): previous temperature
+ mLayerEnthalpyTrial, & ! intent(in): trial enthalpy for snow and soil
+ mLayerEnthalpyPrev, & ! intent(in): previous enthalpy for snow and soil
+ ! output
+ heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(out): heat capacity for snow and soil
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ ! to conserve energy compute finite difference approximation of (theta_ice)'
+ if(dt_cur > 1e-14_rkind) then
+ scalarCanopyIcePrime = ( scalarCanopyIceTrial - scalarCanopyIcePrev ) / dt_cur
+ do concurrent (iLayer=1:nLayers)
+ mLayerVolFracIcePrime(iLayer) = ( mLayerVolFracIceTrial(iLayer) - mLayerVolFracIcePrev(iLayer) ) / dt_cur
+ end do
+ endif ! if dt_cur is not too samll
+ else ! if using closed formula of heat capacity
+ call computHeatCapAnalytic(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input: state variables
+ scalarCanopyIceTrial, & ! intent(in)
+ scalarCanopyLiqTrial, & ! intent(in)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): fraction of liquid water at the start of the sub-step (-)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ ! output
+ heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(out): volumetric heat capacity of soil and snow
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ endif
+
+ ! compute multiplier of state vector
+ call computStatMult(&
+ ! input
+ heatCapVegTrial, & ! intent(in): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(in): volumetric heat capacity of soil and snow
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! update thermal conductivity
+ call computThermConduct(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input: state variables
+ scalarCanopyIceTrial, & ! intent(in)
+ scalarCanopyLiqTrial, & ! intent(in)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ ! input/output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; err=55; message=trim(message)//trim(cmessage); return; end if
+
+ end if ! updateCp
+
+
+ if(needCm)then
+ ! compute C_m
+ call computCm(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ ! input: state variables
+ scalarCanopyTempTrial, & ! intent(in)
+ mLayerTempTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerMatricHeadTrial, & ! intent(in)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ ! output
+ scalarCanopyCmTrial, & ! intent(out): Cm for vegetation
+ mLayerCmTrial, & ! intent(out): Cm for soil and snow
+ err,cmessage) ! intent(out): error control
+ else
+ scalarCanopyCmTrial = 0._qp
+ mLayerCmTrial = 0._qp
+ end if ! needCm
+
+
+ ! save the number of flux calls per time step
+ indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) = indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) + 1
+ ! compute the fluxes for a given state vector
+ call computFlux(&
+ ! input-output: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to denote the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ requireLWBal, & ! intent(in): flag to indicate if we need longwave to be balanced
+ scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
+ ! input: state variables
+ scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
+ scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
+ scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content
+ scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
+ mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each snow and soil layer (-)
+ mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): index data
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(out): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: flux vector and baseflow derivatives
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later in computeJacobSundials
+ fluxVec, & ! intent(out): flux vector (mixed units)
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ firstSplitOper = .true.
+
+
+ ! compute soil compressibility (-) and its derivative w.r.t. matric head (m)
+ ! NOTE: we already extracted trial matrix head and volumetric liquid water as part of the flux calculations
+ call soilCmpresSundials(&
+ ! input:
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
+ mLayerMatricHeadPrime(1:nSoil), & ! intent(in): matric head at the start of the time step (m)
+ mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ! output:
+ mLayerCompress, & ! intent(inout): compressibility of the soil matrix (-)
+ dCompress_dPsi, & ! intent(inout): derivative in compressibility w.r.t. matric head (m-1)
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+! print *, 'dt = ', dt
+! print *, 'dt_cur = ', dt_cur
+
+ ! compute the residual vector
+ call computResidDAE(&
+ ! input: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ! input: flux vectors
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ fluxVec, & ! intent(in): flux vector
+ ! input: state variables (already disaggregated into scalars and vectors)
+ scalarCanopyTempTrial, & ! intent(in):
+ mLayerTempTrial, & ! intent(in)
+ scalarCanairTempPrime, & ! intent(in): Prime value for the temperature of the canopy air space (K)
+ scalarCanopyTempPrime, & ! intent(in): Prime value for the temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, &
+ mLayerTempPrime, & ! intent(in): Prime value for the temperature of each snow and soil layer (K)
+ scalarAquiferStoragePrime, & ! intent(in): Prime value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ scalarCanopyIcePrime, & ! intent(in): Prime value for the ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(in):
+ mLayerVolFracIcePrime, & ! intent(in): Prime value for the volumetric ice in each snow and soil layer (-)
+ mLayerVolFracWatPrime, &
+ mLayerVolFracLiqPrime, &
+ scalarCanopyCmTrial, & ! intent(in) Cm of vegetation canopy
+ mLayerCmTrial, & ! intent(in) Cm of soil and snow
+ ! input: data structures
+ 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(in): model fluxes for a local HRU
+ indx_data, & ! intent(in): index data
+ ! output
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ !print *, '====================================================================================='
+
+
+ ! end association with the information in the data structures
+ end associate
+
+
+ end subroutine eval8DAE
+end module eval8DAE_module
diff --git a/build/source/engine/sundials/eval8JacDAE copy.f90 b/build/source/engine/sundials/eval8JacDAE copy.f90
new file mode 100644
index 0000000..f407581
--- /dev/null
+++ b/build/source/engine/sundials/eval8JacDAE copy.f90
@@ -0,0 +1,352 @@
+
+module eval8JacDAE_module
+
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only:model_decisions ! model decision structure
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ 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)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! 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:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8JacDAE
+
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine eval8JacDAE: compute the Jacobian matrix
+ ! **********************************************************************************************************
+ subroutine eval8JacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt, & ! intent(in): time step
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): derivative of model state vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ mpar_data, & ! intent(in): model parameters
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input: baseflow
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ dMat, & ! intent(inout): diagonal of Jacobian Matrix
+ Jac, & ! intent(out): jacobian matrix
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE varExtrSundials_module, only:varExtract2 ! extract variables from the state vector
+ USE varExtrSundials_module, only:varExtractSundials
+ USE updateVars4JacDAE_module, only:updateVars4JacDAE ! update prognostic variables
+ USE computJacDAE_module,only:computJacDAE
+ implicit none
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: cj ! this scalar changes whenever the step size or method order changes
+ real(rkind),intent(in) :: dt ! time step
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVec(:) ! model state vector
+ real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
+ real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: Jacobian
+ real(rkind), intent(inout) :: dMat(:)
+ real(rkind), intent(out) :: Jac(:,:) ! jacobian matrix
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
+ ! derivative of diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
+ ! other local variables
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ real(rkind) :: dt1
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! model state variables
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision &
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8JacDAE/"
+
+
+ ! extract variables from the model state vector
+ call varExtract2(&
+ ! 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: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! extract derivative of variables from derivative of the model state vector
+ call varExtractSundials(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of 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: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+
+ call updateVars4JacDAE(&
+ ! input
+ dt, & ! intent(in): time step
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & !
+ mLayerVolFracWatPrime, & ! intent(inout): Prime vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): Prime vector of volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & !
+ mLayerMatricHeadPrime, & ! intent(inout): Prime vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): Prime vector of liquid water matric potential (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! -----
+ ! * compute the Jacobian matrix...
+ ! --------------------------------
+
+ ! compute the analytical Jacobian matrix
+ ! NOTE: The derivatives were computed in the previous call to computFlux
+ ! This occurred either at the call to eval8DAE at the start of sysSolveSundials
+ ! or in the call to eval8DAE in the previous iteration
+ dt1 = 1._qp
+ call computJacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt1, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ (ixGroundwater==qbaseTopmodel), & ! intent(in): flag to indicate if we need to compute baseflow
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerTempPrime, & ! intent(in)
+ mLayerMatricHeadPrime, & ! intent(in)
+ mLayerMatricHeadLiqPrime, & ! intent(in)
+ mLayerVolFracWatPrime, & ! intent(in)
+ scalarCanopyTempTrial, & ! intent(in)
+ scalarCanopyTempPrime, & ! intent(in) derivative value for temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & ! intetn(in)
+ ! input-output: Jacobian and its diagonal
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix
+ Jac, & ! intent(out): Jacobian matrix
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! end association with the information in the data structures
+ end associate
+
+
+ end subroutine eval8JacDAE
+end module eval8JacDAE_module
diff --git a/build/source/engine/sundials/eval8JacDAE.f90 b/build/source/engine/sundials/eval8JacDAE.f90
new file mode 100644
index 0000000..f407581
--- /dev/null
+++ b/build/source/engine/sundials/eval8JacDAE.f90
@@ -0,0 +1,352 @@
+
+module eval8JacDAE_module
+
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only:model_decisions ! model decision structure
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ 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)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! 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:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8JacDAE
+
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine eval8JacDAE: compute the Jacobian matrix
+ ! **********************************************************************************************************
+ subroutine eval8JacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt, & ! intent(in): time step
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): derivative of model state vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ mpar_data, & ! intent(in): model parameters
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input: baseflow
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ dMat, & ! intent(inout): diagonal of Jacobian Matrix
+ Jac, & ! intent(out): jacobian matrix
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE varExtrSundials_module, only:varExtract2 ! extract variables from the state vector
+ USE varExtrSundials_module, only:varExtractSundials
+ USE updateVars4JacDAE_module, only:updateVars4JacDAE ! update prognostic variables
+ USE computJacDAE_module,only:computJacDAE
+ implicit none
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: cj ! this scalar changes whenever the step size or method order changes
+ real(rkind),intent(in) :: dt ! time step
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVec(:) ! model state vector
+ real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
+ real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: Jacobian
+ real(rkind), intent(inout) :: dMat(:)
+ real(rkind), intent(out) :: Jac(:,:) ! jacobian matrix
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
+ ! derivative of diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
+ ! other local variables
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ real(rkind) :: dt1
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! model state variables
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision &
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8JacDAE/"
+
+
+ ! extract variables from the model state vector
+ call varExtract2(&
+ ! 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: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! extract derivative of variables from derivative of the model state vector
+ call varExtractSundials(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of 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: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+
+ call updateVars4JacDAE(&
+ ! input
+ dt, & ! intent(in): time step
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & !
+ mLayerVolFracWatPrime, & ! intent(inout): Prime vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): Prime vector of volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & !
+ mLayerMatricHeadPrime, & ! intent(inout): Prime vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): Prime vector of liquid water matric potential (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! -----
+ ! * compute the Jacobian matrix...
+ ! --------------------------------
+
+ ! compute the analytical Jacobian matrix
+ ! NOTE: The derivatives were computed in the previous call to computFlux
+ ! This occurred either at the call to eval8DAE at the start of sysSolveSundials
+ ! or in the call to eval8DAE in the previous iteration
+ dt1 = 1._qp
+ call computJacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt1, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ (ixGroundwater==qbaseTopmodel), & ! intent(in): flag to indicate if we need to compute baseflow
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerTempPrime, & ! intent(in)
+ mLayerMatricHeadPrime, & ! intent(in)
+ mLayerMatricHeadLiqPrime, & ! intent(in)
+ mLayerVolFracWatPrime, & ! intent(in)
+ scalarCanopyTempTrial, & ! intent(in)
+ scalarCanopyTempPrime, & ! intent(in) derivative value for temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & ! intetn(in)
+ ! input-output: Jacobian and its diagonal
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix
+ Jac, & ! intent(out): Jacobian matrix
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! end association with the information in the data structures
+ end associate
+
+
+ end subroutine eval8JacDAE
+end module eval8JacDAE_module
diff --git a/build/source/engine/sundials/evalDAE4IDA.f90 b/build/source/engine/sundials/evalDAE4IDA.f90
new file mode 100644
index 0000000..349d364
--- /dev/null
+++ b/build/source/engine/sundials/evalDAE4IDA.f90
@@ -0,0 +1,167 @@
+
+
+module evalDAE4IDA_module
+
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use nrtype
+ use type4IDA
+ USE globalData,only:model_decisions ! model decision structure
+ USE globalData,only:flux_meta ! metadata on the model fluxes
+ ! provide access to the derived types to define the data structures
+ USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+ USE multiconst,only:iden_water ! intrinsic density of liquid water (kg m-3)
+ USE var_lookup,only:iLookDIAG
+ USE var_lookup,only:iLookPROG
+ USE var_lookup,only:iLookINDEX ! named variables for structure elements
+ USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+
+ ! privacy
+ implicit none
+ private
+ public::evalDAE4IDA
+
+
+contains
+
+ ! **********************************************************************************************************
+ ! public function evalDAE4IDA: compute the residual vector F(t,y,y') required for IDA solver
+ ! **********************************************************************************************************
+ ! Return values:
+ ! 0 = success,
+ ! 1 = recoverable error,
+ ! -1 = non-recoverable error
+ ! ----------------------------------------------------------------
+ integer(c_int) function evalDAE4IDA(tres, sunvec_y, sunvec_yp, sunvec_r, user_data) &
+ result(ierr) bind(C,name='evalDAE4IDA')
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use fida_mod
+ use fsundials_nvector_mod
+ use fnvector_serial_mod
+ use nrtype
+ use type4IDA
+ use eval8DAE_module,only:eval8DAE
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind), value :: tres ! current time t
+ type(N_Vector) :: sunvec_y ! solution N_Vector y
+ type(N_Vector) :: sunvec_yp ! derivative N_Vector y'
+ type(N_Vector) :: sunvec_r ! residual N_Vector F(t,y,y')
+ type(c_ptr), value :: user_data ! user-defined data
+
+
+ ! pointers to data in SUNDIALS vectors
+ type(eqnsData), pointer :: eqns_data ! equations data
+ real(rkind), pointer :: stateVec(:)
+ real(rkind), pointer :: stateVecPrime(:)
+ real(rkind), pointer :: rVec(:)
+ logical(lgt) :: feasible
+ integer(i4b) :: retval
+ real(c_double) :: stepsize_next(1)
+ !======= Internals ============
+
+ ! get equations data from user-defined data
+ call c_f_pointer(user_data, eqns_data)
+
+ ! get data arrays from SUNDIALS vectors
+ stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
+ stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
+ rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
+
+ retval = FIDAGetCurrentStep(eqns_data%ida_mem, stepsize_next)
+ if (retval /= 0) then
+ print *, 'Error in FIDAGetCurrentStep, retval = ', retval, '; halting'
+ stop 1
+ end if
+
+ ! compute the flux and the residual vector for a given state vector
+ call eval8DAE(&
+ ! input: model control
+ stepsize_next(1), & ! intent(in): current stepsize
+ eqns_data%dt, & ! intent(in): data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%nState, & ! intent(in): number of state variables in the current subset
+ .false., & ! intent(in): do not check for feasibility inside Sundials loop
+ eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ .false., & ! intent(in): do not require that longwave is balanced inside Sundials loop
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%lookup_data, & ! intent(in): lookup data
+ eqns_data%type_data, & ! intent(in): type of vegetation and soil
+ eqns_data%attr_data, & ! intent(in): spatial attributes
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%forc_data, & ! intent(in): model forcing data
+ eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inou): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later for Jacobian
+ eqns_data%scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ eqns_data%scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ eqns_data%scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%scalarCanopyEnthalpyPrev, & ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ eqns_data%mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ eqns_data%mLayerMatricHeadLiqTrial,& ! intent(out): trial value for liquid water matric potential (m)
+ eqns_data%mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ eqns_data%mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ eqns_data%mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ eqns_data%mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ eqns_data%scalarAquiferStorageTrial, & ! intent(out): trial value of storage of water in the aquifer (m)
+ eqns_data%scalarAquiferStoragePrev, & ! intent(in): value of storage of water in the aquifer (m)
+ eqns_data%mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ eqns_data%fluxVec, & ! intent(out): flux vector
+ eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
+ if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
+ if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
+ if(.not.feasible)then; eqns_data%message=trim(eqns_data%message)//'state vector not feasible'; ierr = 1; return; endif
+
+ ! return success
+ ierr = 0
+ return
+
+ end function evalDAE4IDA
+
+
+end module evalDAE4IDA_module
diff --git a/build/source/engine/sundials/evalJac4IDA.f90 b/build/source/engine/sundials/evalJac4IDA.f90
new file mode 100644
index 0000000..ca87031
--- /dev/null
+++ b/build/source/engine/sundials/evalJac4IDA.f90
@@ -0,0 +1,128 @@
+
+
+module evalJac4IDA_module
+
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use nrtype
+ use type4IDA
+ USE globalData,only:model_decisions ! model decision structure
+ ! provide access to the derived types to define the data structures
+ USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+
+
+ ! privacy
+ implicit none
+ private
+ public::evalJac4IDA
+
+
+contains
+
+ ! **********************************************************************************************************
+ ! public function evalJac4IDA: the interface to compute the Jacobian matrix dF/dy + c dF/dy' for IDA solver
+ ! **********************************************************************************************************
+ ! Return values:
+ ! 0 = success,
+ ! 1 = recoverable error,
+ ! -1 = non-recoverable error
+ ! ----------------------------------------------------------------
+ integer(c_int) function evalJac4IDA(t, cj, sunvec_y, sunvec_yp, sunvec_r, &
+ sunmat_J, user_data, sunvec_temp1, sunvec_temp2, sunvec_temp3) &
+ result(ierr) bind(C,name='evalJac4IDA')
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use fsundials_nvector_mod
+ use fsundials_matrix_mod
+ use fnvector_serial_mod
+ use fsunmatrix_dense_mod
+ use nrtype
+ use type4IDA
+ use eval8JacDAE_module,only:eval8JacDAE ! compute Jacobian matrix
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind), value :: t ! current time
+ real(rkind), value :: cj ! step size scaling factor
+ type(N_Vector) :: sunvec_y ! solution N_Vector
+ type(N_Vector) :: sunvec_yp ! derivative N_Vector
+ type(N_Vector) :: sunvec_r ! residual N_Vector
+ type(SUNMatrix) :: sunmat_J ! Jacobian SUNMatrix
+ type(c_ptr), value :: user_data ! user-defined data
+ type(N_Vector) :: sunvec_temp1 ! temporary N_Vector
+ type(N_Vector) :: sunvec_temp2 ! temporary N_Vector
+ type(N_Vector) :: sunvec_temp3 ! temporary N_Vector
+
+ ! pointers to data in SUNDIALS vectors
+ real(rkind), pointer :: stateVec(:) ! state vector
+ real(rkind), pointer :: stateVecPrime(:)! derivative of the state vector
+ real(rkind), pointer :: rVec(:) ! residual vector
+ real(rkind), pointer :: Jac(:,:) ! Jacobian matrix
+ type(eqnsData), pointer :: eqns_data ! equations data
+
+
+
+ !======= Internals ============
+
+ ! get equations data from user-defined data
+ call c_f_pointer(user_data, eqns_data)
+
+
+ ! get data arrays from SUNDIALS vectors
+ stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
+ stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
+ rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
+ Jac(1:eqns_data%nState, 1:eqns_data%nState) => FSUNDenseMatrix_Data(sunmat_J)
+
+ ! compute Jacobian matrix
+ call eval8JacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ eqns_data%dt, & ! intent(in): data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inou): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input: baseflow
+ eqns_data%dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! output
+ eqns_data%dMat, & ! intetn(inout): diagonal of the Jacobian matrix
+ Jac, & ! intent(out): Jacobian matrix
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
+ if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
+ if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
+
+ ! return success
+ ierr = 0
+ return
+
+
+
+ end function evalJac4IDA
+
+
+end module evalJac4IDA_module
diff --git a/build/source/engine/sundials/soil_utilsSundials.f90 b/build/source/engine/sundials/soil_utilsSundials.f90
new file mode 100644
index 0000000..b7c0490
--- /dev/null
+++ b/build/source/engine/sundials/soil_utilsSundials.f90
@@ -0,0 +1,234 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 soil_utilsSundials_module
+
+! data types
+USE nrtype
+
+USE multiconst,only: gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ LH_fus, & ! latent heat of fusion (J kg-1, or m2 s-2)
+ R_wv ! gas constant for water vapor (J kg-1 K-1; [J = Pa m3])
+USE soil_utils_module,only:matricHead
+USE soil_utils_module,only:dPsi_dTheta
+USE soil_utils_module,only:volFracLiq
+USE soil_utils_module,only:dTheta_dPsi
+
+! privacy
+implicit none
+private
+
+! routines to make public
+
+public::liquidHeadSundials
+public::d2Theta_dPsi2
+public::d2Theta_dTk2
+
+! constant parameters
+real(rkind),parameter :: verySmall=epsilon(1.0_rkind) ! a very small number (used to avoid divide by zero)
+contains
+
+
+ ! ******************************************************************************************************************************
+ ! public subroutine: compute the liquid water matric potential (and the derivatives w.r.t. total matric potential and temperature)
+ ! ******************************************************************************************************************************
+ subroutine liquidHeadSundials(&
+ ! input
+ matricHeadTotal ,& ! intent(in) : total water matric potential (m)
+ matricHeadTotalPrime ,& ! intent(in)
+ volFracLiq ,& ! intent(in) : volumetric fraction of liquid water (-)
+ volFracIce ,& ! intent(in) : volumetric fraction of ice (-)
+ 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
+ matricHeadLiq ,& ! intent(out) : liquid water matric potential (m)
+ matricHeadLiqPrime ,& ! intent(out)
+ dPsiLiq_dPsi0 ,& ! intent(out) : derivative in the liquid water matric potential w.r.t. the total water matric potential (-)
+ dPsiLiq_dTemp ,& ! intent(out) : derivative in the liquid water matric potential w.r.t. temperature (m K-1)
+ err,message) ! intent(out) : error control
+ ! computes the liquid water matric potential (and the derivatives w.r.t. total matric potential and temperature)
+ implicit none
+ ! input
+ real(rkind),intent(in) :: matricHeadTotal ! total water matric potential (m)
+ real(rkind),intent(in) :: matricHeadTotalPrime
+ real(rkind),intent(in) :: volFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind),intent(in) :: volFracIce ! volumetric fraction of ice (-)
+ 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
+ real(rkind),intent(out) :: matricHeadLiq ! liquid water matric potential (m)
+ real(rkind),intent(out) :: matricHeadLiqPrime
+ real(rkind),intent(out) ,optional :: dPsiLiq_dPsi0 ! derivative in the liquid water matric potential w.r.t. the total water matric potential (-)
+ real(rkind),intent(out) ,optional :: dPsiLiq_dTemp ! derivative in the liquid water matric potential w.r.t. temperature (m K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local
+ real(rkind) :: xNum,xDen ! temporary variables (numeratir, denominator)
+ real(rkind) :: effSat ! effective saturation (-)
+ real(rkind) :: dPsiLiq_dEffSat ! derivative in liquid water matric potential w.r.t. effective saturation (m)
+ real(rkind) :: dEffSat_dTemp ! derivative in effective saturation w.r.t. temperature (K-1)
+ real(rkind) :: dEffSat_dFracLiq
+ real(rkind) :: effSatPrime
+ ! ------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='liquidHeadSundials/'
+
+ ! ** partially frozen soil
+ if(volFracIce > verySmall .and. matricHeadTotal < 0._rkind)then ! check that ice exists and that the soil is unsaturated
+
+
+ ! -----
+ ! - compute liquid water matric potential...
+ ! ------------------------------------------
+
+ ! - compute effective saturation
+ ! NOTE: include ice content as part of the solid porosity - major effect of ice is to reduce the pore size; ensure that effSat=1 at saturation
+ ! (from Zhao et al., J. Hydrol., 1997: Numerical analysis of simultaneous heat and mass transfer...)
+ xNum = volFracLiq - theta_res
+ xDen = theta_sat - volFracIce - theta_res
+ effSat = xNum/xDen ! effective saturation
+
+ ! - matric head associated with liquid water
+ matricHeadLiq = matricHead(effSat,vGn_alpha,0._rkind,1._rkind,vGn_n,vGn_m) ! argument is effective saturation, so theta_res=0 and theta_sat=1
+ if (effSat < 1._rkind .and. effSat > 0._rkind)then
+ effSatPrime = (volFracLiqPrime * xDen + volFracIcePrime * xNum) / xDen**2._rkind
+ matricHeadLiqPrime = -( 1._rkind/(vGn_alpha*vGn_n*vGn_m) ) * effSat**(-1._rkind-1._rkind/vGn_m) * ( effSat**(-1._rkind/vGn_m) - 1._rkind )**(-1._rkind+1._rkind/vGn_n) * effSatPrime
+ else
+ matricHeadLiqPrime = 0._rkind
+ endif
+
+
+ ! compute derivative in liquid water matric potential w.r.t. effective saturation (m)
+ if(present(dPsiLiq_dPsi0).or.present(dPsiLiq_dTemp))then
+ dPsiLiq_dEffSat = dPsi_dTheta(effSat,vGn_alpha,0._rkind,1._rkind,vGn_n,vGn_m)
+ endif
+
+ ! -----
+ ! - compute derivative in the liquid water matric potential w.r.t. the total water matric potential...
+ ! ----------------------------------------------------------------------------------------------------
+
+ ! check if the derivative is desired
+ if(present(dPsiLiq_dTemp))then
+ ! (check required input derivative is present)
+ if(.not.present(dVolTot_dPsi0))then
+ message=trim(message)//'dVolTot_dPsi0 argument is missing'
+ err=20; return
+ endif
+
+ ! (compute derivative in the liquid water matric potential w.r.t. the total water matric potential)
+ dPsiLiq_dPsi0 = dVolTot_dPsi0*dPsiLiq_dEffSat*xNum/(xDen**2._rkind)
+ ! matricHeadLiqPrime = dPsiLiq_dPsi0 * matricHeadTotalPrime
+
+ endif ! if dPsiLiq_dTemp is desired
+
+ ! -----
+ ! - compute the derivative in the liquid water matric potential w.r.t. temperature...
+ ! -----------------------------------------------------------------------------------
+
+ ! check if the derivative is desired
+ if(present(dPsiLiq_dTemp))then
+
+ ! (check required input derivative is present)
+ if(.not.present(dTheta_dT))then
+ message=trim(message)//'dTheta_dT argument is missing'
+ err=20; return
+ endif
+ ! (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
+ else ! (no ice)
+ matricHeadLiq = matricHeadTotal
+ matricHeadLiqPrime = matricHeadTotalPrime
+ if(present(dPsiLiq_dTemp)) dPsiLiq_dPsi0 = 1._rkind ! derivative=1 because values are identical
+ if(present(dPsiLiq_dTemp)) dPsiLiq_dTemp = 0._rkind ! derivative=0 because no impact of temperature for unfrozen conditions
+ end if ! (if ice exists)
+
+ end subroutine liquidHeadSundials
+
+
+ ! ******************************************************************************************************************************
+ ! public function d2Theta_dPsi2: compute the second derivative of the soil water characteristic (m-1)
+ ! ******************************************************************************************************************************
+ function d2Theta_dPsi2(psi,alpha,theta_res,theta_sat,n,m)
+ implicit none
+ real(rkind),intent(in) :: psi ! soil water suction (m)
+ real(rkind),intent(in) :: alpha ! scaling parameter (m-1)
+ real(rkind),intent(in) :: theta_res ! residual volumetric water content (-)
+ real(rkind),intent(in) :: theta_sat ! porosity (-)
+ real(rkind),intent(in) :: n ! vGn "n" parameter (-)
+ real(rkind),intent(in) :: m ! vGn "m" parameter (-)
+ real(rkind) :: d2Theta_dPsi2 ! derivative of the soil water characteristic (m-1)
+ real(rkind) :: mult_fcn
+ real(rkind) :: mult_fcnp
+ if(psi<0._rkind)then
+ mult_fcn = (-m*n*alpha*(alpha*psi)**(n-1._rkind)) * ( 1._rkind + (psi*alpha)**n )**(-1._rkind)
+ mult_fcnp = -m*n*alpha*(n-1._rkind)*alpha*(alpha*psi)**(n-2._rkind)*( 1._rkind + (psi*alpha)**n )**(-1._rkind) - &
+ ( n*alpha*(alpha*psi)**(n-1._rkind)*(1._rkind + (psi*alpha)**n)**(-2._rkind) ) * ( -m*n*alpha*(alpha*psi)**(n-1._rkind) )
+ d2Theta_dPsi2 = mult_fcn * dTheta_dPsi(psi,alpha,theta_res,theta_sat,n,m) + &
+ mult_fcnp * ( volFracLiq(psi,alpha,theta_res,theta_sat,n,m) - theta_res )
+ else
+ d2Theta_dPsi2 = 0._rkind
+ end if
+ end function d2Theta_dPsi2
+
+
+ ! ******************************************************************************************************************************
+ ! public function d2Theta_dTk2: differentiate the freezing curve w.r.t. temperature
+ ! ******************************************************************************************************************************
+ function d2Theta_dTk2(Tk,theta_res,theta_sat,alpha,n,m)
+ implicit none
+ real(rkind),intent(in) :: Tk ! temperature (K)
+ real(rkind),intent(in) :: theta_res ! residual liquid water content (-)
+ real(rkind),intent(in) :: theta_sat ! porosity (-)
+ real(rkind),intent(in) :: alpha ! vGn scaling parameter (m-1)
+ real(rkind),intent(in) :: n ! vGn "n" parameter (-)
+ real(rkind),intent(in) :: m ! vGn "m" parameter (-)
+ real(rkind) :: d2Theta_dTk2 ! derivative of the freezing curve w.r.t. temperature (K-1)
+ ! local variables
+ real(rkind) :: kappa ! constant (m K-1)
+ real(rkind) :: xtemp ! alpha*kappa*(Tk-Tfreeze) -- dimensionless variable (used more than once)
+ ! compute kappa (m K-1)
+ kappa = LH_fus/(gravity*Tfreeze) ! NOTE: J = kg m2 s-2
+ ! define a tempory variable that is used more than once (-)
+ xtemp = alpha*kappa*(Tk-Tfreeze)
+ ! differentiate the freezing curve w.r.t. temperature -- making use of the chain rule
+ d2Theta_dTk2 = (-alpha*kappa*m*n*alpha*kappa)* (theta_sat - theta_res) * ( (n-1)*xtemp**(n - 2._rkind) * (1._rkind + xtemp**n)**(-m - 1._rkind) &
+ + n*(-m-1)*xtemp**(2*n - 2._rkind) * (1._rkind + xtemp**n)**(-m - 2._rkind) )
+ end function d2Theta_dTk2
+
+
+end module soil_utilsSundials_module
diff --git a/build/source/engine/sundials/solveByIDA.f90 b/build/source/engine/sundials/solveByIDA.f90
new file mode 100644
index 0000000..c5f439a
--- /dev/null
+++ b/build/source/engine/sundials/solveByIDA.f90
@@ -0,0 +1,742 @@
+
+
+
+module solveByIDA_module
+
+
+!======= Inclusions ===========
+USE, intrinsic :: iso_c_binding
+USE nrtype
+USE type4IDA
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access matrix information
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+USE globalData,only: ku ! number of super-diagonal bands
+USE globalData,only: kl ! number of sub-diagonal bands
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:model_decisions ! model decision structure
+
+! global metadata
+USE globalData,only:flux_meta ! metadata on the model fluxes
+USE globalData,only:diag_meta ! metadata on the model diagnostic variables
+USE globalData,only:prog_meta ! metadata on the model prognostic variables
+USE globalData,only:deriv_meta ! metadata on the model derivatives
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J K-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Tfreeze, & ! temperature at freezing (K)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookDERIV ! 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
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup ! data vector
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: qbaseTopmodel ! TOPMODEL-ish baseflow parameterization
+
+! privacy
+ implicit none
+ private::setInitialCondition
+ private::setSolverParams
+ public::solveByIDA
+
+contains
+
+ !-------------------
+ ! * public subroutine solveByIDA: solve F(y,y') = 0 by IDA (y is the state vector)
+ ! ------------------
+ subroutine solveByIDA( &
+ dt, & ! intent(in): data time step
+ atol, & ! intent(in): absolute telerance
+ rtol, & ! intent(in): relative tolerance
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nStat, & ! intent(in): total number of state variables
+ ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVecInit, & ! intent(in): initial state vector
+ sMul, & ! intent(inout): state vector multiplier (USEd in the residual calculations)
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix (excludes fluxes)
+ ! input: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(in): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output
+ ixSaturation, & ! intent(inout) index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
+ tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
+ mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
+ dt_out, & ! intent(out): time step
+ stateVec, & ! intent(out): model state vector
+ stateVecPrime, & ! intent(out): derivative of model state vector
+ err,message & ! intent(out): error control
+ )
+
+ !======= Inclusions ===========
+ USE fida_mod ! Fortran interface to IDA
+ USE fnvector_serial_mod ! Fortran interface to serial N_Vector
+ USE fsunmatrix_dense_mod ! Fortran interface to dense SUNMatrix
+ USE fsunlinsol_dense_mod ! Fortran interface to dense SUNLinearSolver
+ USE fsunmatrix_band_mod ! Fortran interface to banded SUNMatrix
+ USE fsunlinsol_band_mod ! Fortran interface to banded SUNLinearSolver
+ USE fsunnonlinsol_newton_mod ! Fortran interface to Newton SUNNonlinearSolver
+ USE fsundials_matrix_mod ! Fortran interface to generic SUNMatrix
+ USE fsundials_nvector_mod ! Fortran interface to generic N_Vector
+ USE fsundials_linearsolver_mod ! Fortran interface to generic SUNLinearSolver
+ USE fsundials_nonlinearsolver_mod ! Fortran interface to generic SUNNonlinearSolver
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ USE evalDAE4IDA_module,only:evalDAE4IDA ! DAE/ODE functions
+ USE evalJac4IDA_module,only:evalJac4IDA ! system Jacobian
+ USE tol4IDA_module,only:computWeight4IDA ! weigth required for tolerances
+ USE eval8DAE_module,only:eval8DAE ! residual of DAE
+ USE var_derive_module,only:calcHeight ! height at layer interfaces and layer mid-point
+
+ !======= Declarations =========
+ implicit none
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! calling variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(qp),intent(in) :: dt ! data time step
+ real(qp),intent(inout) :: atol(:) ! vector of absolute tolerances
+ real(qp),intent(inout) :: rtol(:) ! vector of relative tolerances
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b),intent(in) :: nStat ! total number of state variables
+ integer(i4b),intent(in) :: ixMatrix ! form of matrix (dense or banded)
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVecInit(:) ! model state vector
+ real(qp),intent(in) :: sMul(:) ! state vector multiplier (used in the residual calculations)
+ real(rkind), intent(inout) :: dMat(:)
+ ! input: data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i), intent(in) :: type_data ! type of vegetation and soil
+ type(var_d), intent(in) :: attr_data ! spatial attributes
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_d), intent(in) :: forc_data ! model forcing data
+ type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
+ 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
+ ! input-output: data structures
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_temp ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: flux_sum ! sum of fluxes
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind),intent(inout) :: mLayerCmpress_sum(:) ! sum of soil compress
+ ! output: state vectors
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
+ real(rkind),intent(inout) :: stateVec(:) ! model state vector (y)
+ real(rkind),intent(inout) :: stateVecPrime(:) ! model state vector (y')
+ logical(lgt),intent(out) :: idaSucceeds ! flag to indicate if IDA is successful
+ logical(lgt),intent(inout) :: tooMuchMelt ! flag to denote that there was too much melt
+ real(qp),intent(out) :: dt_out ! time step
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ type(N_Vector), pointer :: sunvec_y ! sundials solution vector
+ type(N_Vector), pointer :: sunvec_yp ! sundials derivative vector
+ type(N_Vector), pointer :: sunvec_av ! sundials tolerance vector
+ type(SUNMatrix), pointer :: sunmat_A ! sundials matrix
+ type(SUNLinearSolver), pointer :: sunlinsol_LS ! sundials linear solver
+ type(SUNNonLinearSolver), pointer :: sunnonlin_NLS ! sundials nonlinear solver
+ type(c_ptr) :: ida_mem ! IDA memory
+ type(eqnsData), target :: eqns_data ! IDA type
+ integer(i4b) :: retval, retvalr ! return value
+ integer(i4b) :: rootsfound(3) ! crossing direction of discontinuities
+ logical(lgt) :: feasible ! feasibility flag
+ real(qp) :: t0 ! staring time
+ real(qp) :: dt_last(1) ! last time step
+ integer(kind = 8) :: mu, lu ! in banded matrix mode
+ integer(i4b) :: iVar
+ logical(lgt) :: startQuadrature
+ real(rkind) :: mLayerMatricHeadLiqPrev(nSoil)
+ real(qp) :: h_init
+ integer(c_long) :: nState ! total number of state variables
+ real(rkind) :: rVec(nStat)
+ real(qp) :: tret(1)
+ logical(lgt) :: mergedLayers
+ logical(lgt),parameter :: offErrWarnMessage = .false.
+ real(rkind) :: superflousSub ! superflous sublimation (kg m-2 s-1)
+ real(rkind) :: superflousNrg ! superflous energy that cannot be used for sublimation (W m-2 [J m-2 s-1])
+ integer(i4b) :: i
+
+ ! -----------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message="solveByIDA/"
+
+ nState = nStat
+ idaSucceeds = .true.
+ ! fill eqns_data which will be required later to call eval8DAE
+ eqns_data%dt = dt
+ eqns_data%nSnow = nSnow
+ eqns_data%nSoil = nSoil
+ eqns_data%nLayers = nLayers
+ eqns_data%nState = nState
+ eqns_data%ixMatrix = ixMatrix
+ eqns_data%firstSubStep = firstSubStep
+ eqns_data%computeVegFlux = computeVegFlux
+ eqns_data%scalarSolution = scalarSolution
+
+ allocate( eqns_data%atol(nState) )
+ eqns_data%atol = atol
+
+ allocate( eqns_data%rtol(nState) )
+ eqns_data%rtol = rtol
+
+ allocate( eqns_data%sMul(nState) )
+ eqns_data%sMul = sMul
+
+ allocate( eqns_data%dMat(nState) )
+ eqns_data%dMat = dMat
+
+ ! allocate space for the temporary prognostic variable structure
+ call allocLocal(prog_meta(:),eqns_data%prog_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%prog_data = prog_data
+
+ ! allocate space for the temporary diagnostic variable structure
+ call allocLocal(diag_meta(:),eqns_data%diag_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%diag_data = diag_data
+
+ ! allocate space for the temporary flux variable structure
+ call allocLocal(flux_meta(:),eqns_data%flux_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%flux_data = flux_data
+
+ ! allocate space for the derivative structure
+ call allocLocal(deriv_meta(:),eqns_data%deriv_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; end if
+ eqns_data%deriv_data = deriv_data
+
+ eqns_data%lookup_data = lookup_data
+ eqns_data%type_data = type_data
+ eqns_data%attr_data = attr_data
+ eqns_data%mpar_data = mpar_data
+ eqns_data%forc_data = forc_data
+ eqns_data%bvar_data = bvar_data
+ eqns_data%indx_data = indx_data
+
+ ! allocate space
+ if(model_decisions(iLookDECISIONS%groundwatr)%iDecision==qbaseTopmodel)then
+ allocate(eqns_data%dBaseflow_dMatric(nSoil,nSoil),stat=err)
+ else
+ allocate(eqns_data%dBaseflow_dMatric(0,0),stat=err)
+ end if
+ allocate( eqns_data%mLayerMatricHeadLiqTrial(nSoil) )
+ allocate( eqns_data%mLayerMatricHeadTrial(nSoil) )
+ allocate( eqns_data%mLayerMatricHeadPrev(nSoil) )
+ allocate( eqns_data%mLayerVolFracWatTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracWatPrev(nLayers) )
+ allocate( eqns_data%mLayerTempTrial(nLayers) )
+ allocate( eqns_data%mLayerTempPrev(nLayers) )
+ allocate( eqns_data%mLayerVolFracIceTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracIcePrev(nLayers) )
+ allocate( eqns_data%mLayerVolFracLiqTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracLiqPrev(nLayers) )
+ allocate( eqns_data%mLayerEnthalpyTrial(nLayers) )
+ allocate( eqns_data%mLayerEnthalpyPrev(nLayers) )
+ allocate( eqns_data%fluxVec(nState) )
+ allocate( eqns_data%resSink(nState) )
+
+ startQuadrature = .true.
+
+ ! create serial vectors
+ sunvec_y => FN_VMake_Serial(nState, stateVec)
+ if (.not. associated(sunvec_y)) then; err=20; message='solveByIDA: sunvec = NULL'; return; endif
+
+ sunvec_yp => FN_VMake_Serial(nState, stateVecPrime)
+ if (.not. associated(sunvec_yp)) then; err=20; message='solveByIDA: sunvec = NULL'; return; endif
+
+ ! Initialize solution vectors
+ call setInitialCondition(nState, stateVecInit, sunvec_y, sunvec_yp)
+
+ ! Create memory
+ ida_mem = FIDACreate()
+ if (.not. c_associated(ida_mem)) then; err=20; message='solveByIDA: ida_mem = NULL'; return; endif
+
+ ! Attach user data to memory
+ eqns_data%ida_mem = ida_mem
+ retval = FIDASetUserData(ida_mem, c_loc(eqns_data))
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDASetUserData'; return; endif
+
+ ! Initialize memory
+ t0 = 0._rkind
+ retval = FIDAInit(ida_mem, c_funloc(evalDAE4IDA), t0, sunvec_y, sunvec_yp)
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDAInit'; return; endif
+
+ ! set tolerances
+ retval = FIDAWFtolerances(ida_mem, c_funloc(computWeight4IDA))
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDAWFtolerances'; return; endif
+
+ ! define the form of the matrix
+ select case(ixMatrix)
+ case(ixBandMatrix)
+ mu = ku; lu = kl;
+ ! Create banded SUNMatrix for use in linear solves
+ sunmat_A => FSUNBandMatrix(nState, mu, lu)
+ if (.not. associated(sunmat_A)) then; err=20; message='solveByIDA: sunmat = NULL'; return; endif
+
+ ! Create banded SUNLinearSolver object
+ sunlinsol_LS => FSUNLinSol_Band(sunvec_y, sunmat_A)
+ if (.not. associated(sunlinsol_LS)) then; err=20; message='solveByIDA: sunlinsol = NULL'; return; endif
+
+ case(ixFullMatrix)
+ ! Create dense SUNMatrix for use in linear solves
+ sunmat_A => FSUNDenseMatrix(nState, nState)
+ if (.not. associated(sunmat_A)) then; err=20; message='solveByIDA: sunmat = NULL'; return; endif
+
+ ! Create dense SUNLinearSolver object
+ sunlinsol_LS => FSUNDenseLinearSolver(sunvec_y, sunmat_A)
+ if (.not. associated(sunlinsol_LS)) then; err=20; message='solveByIDA: sunlinsol = NULL'; return; endif
+
+ ! check
+ case default; err=20; message='solveByIDA: error in type of matrix'; return
+
+ end select ! form of matrix
+
+ ! Attach the matrix and linear solver
+ retval = FIDASetLinearSolver(ida_mem, sunlinsol_LS, sunmat_A);
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDASetLinearSolver'; return; endif
+
+ if(ixMatrix == ixFullMatrix)then
+ ! Set the user-supplied Jacobian routine
+ !comment this line out to use FD Jacobian
+ retval = FIDASetJacFn(ida_mem, c_funloc(evalJac4IDA))
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDASetJacFn'; return; endif
+ endif
+
+ ! Create Newton SUNNonlinearSolver object
+ sunnonlin_NLS => FSUNNonlinSol_Newton(sunvec_y)
+ if (.not. associated(sunnonlin_NLS)) then; err=20; message='solveByIDA: sunnonlinsol = NULL'; return; endif
+
+ ! Attach the nonlinear solver
+ retval = FIDASetNonlinearSolver(ida_mem, sunnonlin_NLS)
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDASetNonlinearSolver'; return; endif
+
+ ! Enforce the solver to stop at end of the time step
+ retval = FIDASetStopTime(ida_mem, dt)
+ if (retval /= 0) then; err=20; message='solveByIDA: error in FIDASetStopTime'; return; endif
+
+ ! Set solver parameters such as maximum order, number of iterations, ...
+ call setSolverParams(dt, ida_mem, retval)
+ if (retval /= 0) then; err=20; message='solveByIDA: error in setSolverParams'; return; endif
+
+ ! Disable error messages and warnings
+ if(offErrWarnMessage) then
+ retval = FIDASetErrFile(ida_mem, c_null_ptr)
+ retval = FIDASetNoInactiveRootWarn(ida_mem)
+ endif
+
+ ! need the following values for the first substep
+ eqns_data%scalarCanopyTempPrev = prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1)
+ eqns_data%scalarCanopyIcePrev = prog_data%var(iLookPROG%scalarCanopyIce)%dat(1)
+ eqns_data%scalarCanopyLiqPrev = prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1)
+ eqns_data%mLayerVolFracWatPrev(:) = prog_data%var(iLookPROG%mLayerVolFracWat)%dat(:)
+ eqns_data%mLayerTempPrev(:) = prog_data%var(iLookPROG%mLayerTemp)%dat(:)
+ eqns_data%mLayerVolFracIcePrev(:) = prog_data%var(iLookPROG%mLayerVolFracIce)%dat(:)
+ eqns_data%mLayerVolFracLiqPrev(:) = prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(:)
+ eqns_data%mLayerMatricHeadPrev(:) = prog_data%var(iLookPROG%mLayerMatricHead)%dat(:)
+ eqns_data%scalarAquiferStoragePrev = prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1)
+ eqns_data%mLayerEnthalpyPrev(:) = diag_data%var(iLookDIAG%mLayerEnthalpy)%dat(:)
+ eqns_data%scalarCanopyEnthalpyPrev = diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1)
+ mLayerMatricHeadLiqPrev(:) = diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat(:)
+ eqns_data%ixSaturation = ixSaturation
+
+ !**********************************************************************************
+ !****************************** Main Solver ***************************************
+ !************************* loop on one_step mode **********************************
+ !**********************************************************************************
+
+ tret(1) = t0 ! intial time
+ do while(tret(1) < dt)
+ eqns_data%firstFluxCall = .false.
+ eqns_data%firstSplitOper = .true.
+ ! call IDASolve, advance solver just one internal step
+ retvalr = FIDASolve(ida_mem, dt, tret, sunvec_y, sunvec_yp, IDA_ONE_STEP)
+ if( retvalr < 0 )then
+ idaSucceeds = .false.
+ exit
+ endif
+
+ tooMuchMelt = .false.
+ feasible = .true.
+ ! loop through non-missing energy state variables in the snow domain to see if need to merge
+ do concurrent (i=1:nSnow,indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat(i)/=integerMissing)
+ if (stateVec(indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat(i)) > Tfreeze) tooMuchMelt = .true. !need to merge
+ enddo
+ if(tooMuchMelt)exit
+
+ ! get the last stepsize
+ retval = FIDAGetLastStep(ida_mem, dt_last)
+
+ ! compute the flux and the residual vector for a given state vector
+ call eval8DAE(&
+ ! input: model control
+ dt_last(1), & ! intent(in): current stepsize
+ eqns_data%dt, & ! intent(in): total data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%nState, & ! intent(in): number of state variables in the current subset
+ .true., & ! intent(in): check for feasibility once outside Sundials loop
+ eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ .true., & ! intent(in): require that longwave is balanced once outside Sundials loop
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%lookup_data, & ! intent(in): lookup data
+ eqns_data%type_data, & ! intent(in): type of vegetation and soil
+ eqns_data%attr_data, & ! intent(in): spatial attributes
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%forc_data, & ! intent(in): model forcing data
+ eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inout): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output
+ eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later for Jacobian
+ eqns_data%scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ eqns_data%scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ eqns_data%scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%scalarCanopyEnthalpyPrev, & ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ eqns_data%mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ eqns_data%mLayerMatricHeadLiqTrial, & ! intent(out): trial value for liquid water matric potential (m)
+ eqns_data%mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ eqns_data%mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ eqns_data%mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ eqns_data%mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ eqns_data%scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ eqns_data%scalarAquiferStoragePrev, & ! intent(in): value of storage of water in the aquifer (m)
+ eqns_data%mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ eqns_data%fluxVec, & ! intent(out): flux vector
+ eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
+ ! sum of fluxes
+ do iVar=1,size(flux_meta)
+ flux_sum%var(iVar)%dat(:) = flux_sum%var(iVar)%dat(:) + eqns_data%flux_data%var(iVar)%dat(:) * dt_last(1)
+ end do
+
+ ! do iVar=1,size(flux_meta)
+ ! flux_data%var(iVar)%dat(:) = ( flux_sum%var(iVar)%dat(:) ) / tret(1)
+ ! end do
+
+ ! sum of mLayerCmpress
+ mLayerCmpress_sum(:) = mLayerCmpress_sum(:) + eqns_data%deriv_data%var(iLookDERIV%dCompress_dPsi)%dat(:) &
+ * ( eqns_data%mLayerMatricHeadLiqTrial(:) - mLayerMatricHeadLiqPrev(:) )
+
+ ! save required quantities for next step
+ eqns_data%scalarCanopyTempPrev = eqns_data%scalarCanopyTempTrial
+ eqns_data%scalarCanopyIcePrev = eqns_data%scalarCanopyIceTrial
+ eqns_data%scalarCanopyLiqPrev = eqns_data%scalarCanopyLiqTrial
+ eqns_data%mLayerTempPrev(:) = eqns_data%mLayerTempTrial(:)
+ mLayerMatricHeadLiqPrev(:) = eqns_data%mLayerMatricHeadLiqTrial(:)
+ eqns_data%mLayerMatricHeadPrev(:) = eqns_data%mLayerMatricHeadTrial(:)
+ eqns_data%mLayerVolFracWatPrev(:) = eqns_data%mLayerVolFracWatTrial(:)
+ eqns_data%mLayerVolFracIcePrev(:) = eqns_data%mLayerVolFracIceTrial(:)
+ eqns_data%mLayerVolFracLiqPrev(:) = eqns_data%mLayerVolFracLiqTrial(:)
+ eqns_data%scalarAquiferStoragePrev = eqns_data%scalarAquiferStorageTrial
+ eqns_data%mLayerEnthalpyPrev(:) = eqns_data%mLayerEnthalpyTrial(:)
+ eqns_data%scalarCanopyEnthalpyPrev = eqns_data%scalarCanopyEnthalpyTrial
+
+ enddo ! while loop on one_step mode until time dt
+
+ !****************************** End of Main Solver ***************************************
+
+ err = eqns_data%err
+ message = eqns_data%message
+ if( .not. feasible) idaSucceeds = .false.
+
+ if(idaSucceeds)then
+ ! copy to output data
+ diag_data = eqns_data%diag_data
+ flux_data = eqns_data%flux_data
+ deriv_data = eqns_data%deriv_data
+ ixSaturation = eqns_data%ixSaturation
+ dt_out = tret(1)
+ endif
+
+ ! free memory
+ deallocate( eqns_data%sMul )
+ deallocate( eqns_data%dMat )
+ deallocate( eqns_data%dBaseflow_dMatric )
+ deallocate( eqns_data%mLayerMatricHeadLiqTrial )
+ deallocate( eqns_data%mLayerMatricHeadTrial )
+ deallocate( eqns_data%mLayerMatricHeadPrev )
+ deallocate( eqns_data%fluxVec )
+ deallocate( eqns_data%resSink )
+ deallocate( eqns_data%mLayerVolFracWatTrial )
+ deallocate( eqns_data%mLayerVolFracWatPrev )
+ deallocate( eqns_data%mLayerVolFracIceTrial )
+ deallocate( eqns_data%mLayerTempPrev )
+ deallocate( eqns_data%mLayerTempTrial )
+ deallocate( eqns_data%mLayerVolFracIcePrev )
+ deallocate( eqns_data%mLayerVolFracLiqPrev )
+ deallocate( eqns_data%mLayerEnthalpyTrial )
+ deallocate( eqns_data%mLayerEnthalpyPrev )
+
+ call FIDAFree(ida_mem)
+ retval = FSUNNonlinSolFree(sunnonlin_NLS)
+ retval = FSUNLinSolFree(sunlinsol_LS)
+ call FSUNMatDestroy(sunmat_A)
+ call FN_VDestroy(sunvec_y)
+ call FN_VDestroy(sunvec_yp)
+
+ end subroutine solveByIDA
+
+! ----------------------------------------------------------------
+! SetInitialCondition: routine to initialize u and up vectors.
+! ----------------------------------------------------------------
+ subroutine setInitialCondition(neq, y, sunvec_u, sunvec_up)
+
+ !======= Inclusions ===========
+ USE, intrinsic :: iso_c_binding
+ USE fsundials_nvector_mod
+ USE fnvector_serial_mod
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ type(N_Vector) :: sunvec_u ! solution N_Vector
+ type(N_Vector) :: sunvec_up ! derivative N_Vector
+ integer(c_long) :: neq
+ real(rkind) :: y(neq)
+
+ ! pointers to data in SUNDIALS vectors
+ real(c_double), pointer :: uu(:)
+ real(c_double), pointer :: up(:)
+
+ ! get data arrays from SUNDIALS vectors
+ uu(1:neq) => FN_VGetArrayPointer(sunvec_u)
+ up(1:neq) => FN_VGetArrayPointer(sunvec_up)
+
+ uu = y
+ up = 0._rkind
+
+ end subroutine setInitialCondition
+
+! ----------------------------------------------------------------
+! setSolverParams: private routine to set parameters in ida solver
+! ----------------------------------------------------------------
+ subroutine setSolverParams(dt,ida_mem,retval)
+
+ !======= Inclusions ===========
+ USE, intrinsic :: iso_c_binding
+ USE fida_mod ! Fortran interface to IDA
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind),intent(in) :: dt ! time step
+ type(c_ptr),intent(inout) :: ida_mem ! IDA memory
+ integer(i4b),intent(out) :: retval ! return value
+
+ !======= Internals ============
+ real(qp),parameter :: coef_nonlin = 0.33 ! Coeff. in the nonlinear convergence test, default = 0.33
+ integer,parameter :: max_order = 1 ! maximum BDF order, default = 5
+ integer,parameter :: nonlin_iter = 100 ! maximun number of nonliear iterations, default = 4
+ integer,parameter :: acurtest_fail = 50 ! maximum number of error test failures, default = 10
+ integer,parameter :: convtest_fail = 50 ! maximum number of convergence test failures, default = 10
+ integer(kind = 8),parameter :: max_step = 999999 ! maximum number of steps, dafault = 500
+ real(qp),parameter :: h_init = 0 ! initial stepsize
+ real(qp) :: h_max ! maximum stepsize, dafault = infinity
+
+ ! Set the maximum BDF order
+ retval = FIDASetMaxOrd(ida_mem, max_order)
+ if (retval /= 0) return
+
+ ! Set Coeff. in the nonlinear convergence test
+ retval = FIDASetNonlinConvCoef(ida_mem, coef_nonlin)
+ if (retval /= 0) return
+
+ ! Set maximun number of nonliear iterations
+ retval = FIDASetMaxNonlinIters(ida_mem, nonlin_iter)
+ if (retval /= 0) return
+
+ ! Set maximum number of convergence test failures
+ retval = FIDASetMaxConvFails(ida_mem, convtest_fail)
+ if (retval /= 0) return
+
+ ! Set maximum number of error test failures
+ retval = FIDASetMaxErrTestFails(ida_mem, acurtest_fail)
+ if (retval /= 0) return
+
+ ! Set maximum number of steps
+ retval = FIDASetMaxNumSteps(ida_mem, max_step)
+ if (retval /= 0) return
+
+ ! Set maximum stepsize
+ h_max = dt
+ retval = FIDASetMaxStep(ida_mem, h_max)
+ if (retval /= 0) return
+
+ ! Set initial stepsize
+ retval = FIDASetInitStep(ida_mem, h_init)
+ if (retval /= 0) return
+
+ ! scaling on 1 and off 0
+ ! retval = FIDASetLinearSolutionScaling(ida_mem, 0)
+ ! if (retval /= 0) return
+
+ end subroutine setSolverParams
+
+ ! *********************************************************************************************************
+ ! private subroutine implctMelt: compute melt of the "snow without a layer"
+ ! *********************************************************************************************************
+ subroutine implctMelt(&
+ ! input/output: integrated snowpack properties
+ scalarSWE, & ! intent(inout): snow water equivalent (kg m-2)
+ scalarSnowDepth, & ! intent(inout): snow depth (m)
+ scalarSfcMeltPond, & ! intent(inout): surface melt pond (kg m-2)
+ ! input/output: properties of the upper-most soil layer
+ soilTemp, & ! intent(inout): surface layer temperature (K)
+ soilDepth, & ! intent(inout): surface layer depth (m)
+ soilHeatcap, & ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
+ ! output: error control
+ err,message ) ! intent(out): error control
+ implicit none
+ ! input/output: integrated snowpack properties
+ real(rkind),intent(inout) :: scalarSWE ! snow water equivalent (kg m-2)
+ real(rkind),intent(inout) :: scalarSnowDepth ! snow depth (m)
+ real(rkind),intent(inout) :: scalarSfcMeltPond ! surface melt pond (kg m-2)
+ ! input/output: properties of the upper-most soil layer
+ real(rkind),intent(inout) :: soilTemp ! surface layer temperature (K)
+ real(rkind),intent(inout) :: soilDepth ! surface layer depth (m)
+ real(rkind),intent(inout) :: soilHeatcap ! surface layer volumetric heat capacity (J m-3 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local variables
+ real(rkind) :: nrgRequired ! energy required to melt all the snow (J m-2)
+ real(rkind) :: nrgAvailable ! energy available to melt the snow (J m-2)
+ real(rkind) :: snwDensity ! snow density (kg m-3)
+ ! initialize error control
+ err=0; message='implctMelt/'
+
+ if(scalarSWE > 0._rkind)then
+ ! only melt if temperature of the top soil layer is greater than Tfreeze
+ if(soilTemp > Tfreeze)then
+ ! compute the energy required to melt all the snow (J m-2)
+ nrgRequired = scalarSWE*LH_fus
+ ! compute the energy available to melt the snow (J m-2)
+ nrgAvailable = soilHeatcap*(soilTemp - Tfreeze)*soilDepth
+ ! compute the snow density (not saved)
+ snwDensity = scalarSWE/scalarSnowDepth
+ ! compute the amount of melt, and update SWE (kg m-2)
+ if(nrgAvailable > nrgRequired)then
+ scalarSfcMeltPond = scalarSWE
+ scalarSWE = 0._rkind
+ else
+ scalarSfcMeltPond = nrgAvailable/LH_fus
+ scalarSWE = scalarSWE - scalarSfcMeltPond
+ end if
+ ! update depth
+ scalarSnowDepth = scalarSWE/snwDensity
+ ! update temperature of the top soil layer (K)
+ soilTemp = soilTemp - (LH_fus*scalarSfcMeltPond/soilDepth)/soilHeatcap
+ else ! melt is zero if the temperature of the top soil layer is less than Tfreeze
+ scalarSfcMeltPond = 0._rkind ! kg m-2
+ end if ! (if the temperature of the top soil layer is greater than Tfreeze)
+ else ! melt is zero if the "snow without a layer" does not exist
+ scalarSfcMeltPond = 0._rkind ! kg m-2
+ end if ! (if the "snow without a layer" exists)
+
+ end subroutine implctMelt
+
+end module solveByIDA_module
diff --git a/build/source/engine/sundials/systemSolvSundials.f90 b/build/source/engine/sundials/systemSolvSundials.f90
new file mode 100644
index 0000000..be96070
--- /dev/null
+++ b/build/source/engine/sundials/systemSolvSundials.f90
@@ -0,0 +1,553 @@
+
+
+module systemSolvSundials_module
+
+! data types
+USE nrtype
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access matrix information
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! global metadata
+USE globalData,only:flux_meta ! metadata on the model fluxes
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J K-1)
+ Tfreeze, & ! temperature at freezing (K)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to indices that define elements of the data structures
+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:iLookFORCE ! 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
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+
+! safety: set private unless specified otherwise
+implicit none
+private
+public::systemSolvSundials
+
+! control parameters
+real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
+real(rkind),parameter :: verySmall=1.e-12_rkind ! a very small number (used to check consistency)
+real(rkind),parameter :: veryBig=1.e+20_rkind ! a very big number
+real(rkind),parameter :: dx = 1.e-8_rkind ! finite difference increment
+
+contains
+
+
+! **********************************************************************************************************
+! public subroutine systemSolvSundials: run the coupled energy-mass model for one timestep
+! **********************************************************************************************************
+subroutine systemSolvSundials(&
+ ! input: model control
+ dt, & ! intent(in): time step (s)
+ nState, & ! intent(in): total number of state variables
+ firstSubStep, & ! intent(in): flag to denote first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
+ scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ forc_data, & ! intent(in): model forcing data
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(inout): index data
+ prog_data, & ! intent(inout): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ bvar_data, & ! intent(in): model variables for the local basin
+ model_decisions, & ! intent(in): model decisions
+ stateVecInit, & ! intent(in): initial state vector
+ ! output
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ stateVecTrial, & ! intent(out): updated state vector
+ stateVecPrime, & ! intent(out): updated state vector
+ reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out): flag to denote that there was too much melt
+ dt_out, & ! intent(out)
+ err,message) ! intent(out): error code and error message
+ ! ---------------------------------------------------------------------------------------
+ ! structure allocations
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ ! simulation of fluxes and residuals given a trial state vector
+ USE eval8summa_module,only:eval8summa ! simulation of fluxes and residuals given a trial state vector
+ USE eval8DAE_module,only:eval8DAE
+ USE summaSolve_module,only:summaSolve ! calculate the iteration increment, evaluate the new state, and refine if necessary
+ USE getVectorz_module,only:getScaling ! get the scaling vectors
+ USE convE2Temp_module,only:temp2ethpy ! convert temperature to enthalpy
+ USE tol4IDA_module,only:popTol4IDA ! pop tolerances
+ USE solveByIDA_module,only:solveByIDA ! solve DAE by IDA
+ USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
+ USE, intrinsic :: iso_c_binding
+ implicit none
+ ! ---------------------------------------------------------------------------------------
+ ! * dummy variables
+ ! ---------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt ! time step (seconds)
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall ! flag to define the first flux call
+ logical(lgt),intent(in) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i),intent(in) :: type_data ! type of vegetation and soil
+ type(var_d),intent(in) :: attr_data ! spatial attributes
+ type(var_d),intent(in) :: forc_data ! model forcing data
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: 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_temp ! model fluxes for a local HRU
+ type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ real(rkind),intent(in) :: stateVecInit(:) ! initial state vector (mixed units)
+ ! output: model control
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ real(rkind),intent(out) :: stateVecTrial(:) ! trial state vector (mixed units)
+ real(rkind),intent(out) :: stateVecPrime(:) ! trial state vector (mixed units)
+ logical(lgt),intent(out) :: reduceCoupledStep ! flag to reduce the length of the coupled step
+ logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that there was too much melt
+ real(qp),intent(out) :: dt_out ! time step
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! ---------------------------------------------------------------------------------------
+ ! * general local variables
+ ! ---------------------------------------------------------------------------------------
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: iVar ! index of variable
+ integer(i4b) :: local_ixGroundwater ! local index for groundwater representation
+ real(rkind) :: bulkDensity ! bulk density of a given layer (kg m-3)
+ real(rkind) :: volEnthalpy ! volumetric enthalpy of a given layer (J m-3)
+ real(rkind),parameter :: tempAccelerate=0.00_rkind ! factor to force initial canopy temperatures to be close to air temperature
+ real(rkind),parameter :: xMinCanopyWater=0.0001_rkind ! minimum value to initialize canopy water (kg m-2)
+ real(rkind),parameter :: tinyStep=0.000001_rkind ! stupidly small time step (s)
+
+ ! ------------------------------------------------------------------------------------------------------
+ ! * model solver
+ ! ------------------------------------------------------------------------------------------------------
+ logical(lgt),parameter :: forceFullMatrix=.true. ! flag to force the use of the full Jacobian matrix
+ integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
+ type(var_dlength) :: flux_init ! model fluxes at the start of the time step
+ real(rkind),allocatable :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1) ! NOTE: allocatable, since not always needed
+ real(rkind) :: stateVecNew(nState) ! new state vector (mixed units)
+ real(rkind) :: fluxVec0(nState) ! flux vector (mixed units)
+ real(rkind) :: fScale(nState) ! characteristic scale of the function evaluations (mixed units)
+ real(rkind) :: xScale(nState) ! characteristic scale of the state vector (mixed units)
+ real(rkind) :: dMat(nState) ! diagonal matrix (excludes flux derivatives)
+ real(qp) :: sMul(nState) ! NOTE: qp ! multiplier for state vector for the residual calculations
+ real(qp) :: rVec(nState) ! NOTE: qp ! residual vector
+ real(rkind) :: rAdd(nState) ! additional terms in the residual vector
+ real(rkind) :: fOld ! function values (-); NOTE: dimensionless because scaled
+ logical(lgt) :: feasible ! feasibility flag
+ real(rkind) :: atol(nState) ! absolute telerance
+ real(rkind) :: rtol(nState) ! relative tolerance
+ integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
+ real(rkind) :: xMin,xMax ! minimum and maximum values for water content
+ real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
+ type(var_dlength) :: flux_sum ! sum of fluxes model fluxes for a local HRU over a data step
+ integer(i4b) :: tol_iter ! iteration index
+ real(rkind), allocatable :: mLayerCmpress_sum(:) ! sum of compression of the soil matrix
+ logical(lgt) :: idaSucceeds ! flag to indicate if ida successfully solved the problem in current data step
+
+
+ ! ---------------------------------------------------------------------------------------
+ ! point to variables in the data structures
+ ! ---------------------------------------------------------------------------------------
+ globalVars: associate(&
+ ! model decisions
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
+ ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
+ ! enthalpy
+ scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(out): [dp(:)] enthalpy of the snow+soil layers (J m-3)
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
+ ! model state variables
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout): [dp(:)] matric head (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow+soil subdomain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in): [i4b] total number of layers
+ )
+ ! ---------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="systemSolvSundials/"
+
+ ! *****
+ ! (0) PRELIMINARIES...
+ ! ********************
+
+ ! -----
+ ! * initialize...
+ ! ---------------
+
+ ! check
+ if(dt < tinyStep)then
+ message=trim(message)//'dt is tiny'
+ err=20; return
+ endif
+
+ ! initialize the flags
+ tooMuchMelt = .false. ! too much melt
+ reduceCoupledStep = .false. ! need to reduce the length of the coupled step
+
+
+ ! modify the groundwater representation for this single-column implementation
+ select case(ixSpatialGroundwater)
+ case(singleBasin); local_ixGroundwater = noExplicit ! force no explicit representation of groundwater at the local scale
+ case(localColumn); local_ixGroundwater = ixGroundwater ! go with the specified decision
+ case default; err=20; message=trim(message)//'unable to identify spatial representation of groundwater'; return
+ end select ! (modify the groundwater representation for this single-column implementation)
+
+ ! allocate space for the model fluxes at the start of the time step
+ call allocLocal(flux_meta(:),flux_init,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the baseflow derivatives
+ ! NOTE: needs allocation because only used when baseflow sinks are active
+ if(ixGroundwater==qbaseTopmodel)then
+ allocate(dBaseflow_dMatric(nSoil,nSoil),stat=err) ! baseflow depends on total storage in the soil column, hence on matric head in every soil layer
+ else
+ allocate(dBaseflow_dMatric(0,0),stat=err) ! allocate zero-length dimnensions to avoid passing around an unallocated matrix
+ end if
+ if(err/=0)then; err=20; message=trim(message)//'unable to allocate space for the baseflow derivatives'; return; end if
+
+
+ ! identify the matrix solution method
+ ! (the type of matrix used to solve the linear system A.X=B)
+ if(local_ixGroundwater==qbaseTopmodel .or. scalarSolution .or. forceFullMatrix)then
+ ixMatrix=ixFullMatrix ! named variable to denote the full Jacobian matrix
+ else
+ ixMatrix=ixBandMatrix ! named variable to denote the band-diagonal matrix
+ endif
+
+ ! initialize the model fluxes (some model fluxes are not computed in the iterations)
+ do iVar=1,size(flux_temp%var)
+ flux_init%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
+ end do
+
+ ! -----
+ ! * get scaling vectors...
+ ! ------------------------
+
+ ! initialize state vectors
+ call getScaling(&
+ ! input
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ fScale, & ! intent(out): function scaling vector (mixed units)
+ xScale, & ! intent(out): variable scaling vector (mixed units)
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ dMat, & ! intent(out): diagonal of the Jacobian matrix (excludes fluxes)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! initialize the trial state vectors
+ stateVecTrial = stateVecInit
+
+ ! need to intialize canopy water at a positive value
+ if(ixVegHyd/=integerMissing)then
+ if(stateVecTrial(ixVegHyd) < xMinCanopyWater) stateVecTrial(ixVegHyd) = stateVecTrial(ixVegHyd) + xMinCanopyWater
+ endif
+
+ ! try to accelerate solution for energy
+ if(ixCasNrg/=integerMissing) stateVecTrial(ixCasNrg) = stateVecInit(ixCasNrg) + (airtemp - stateVecInit(ixCasNrg))*tempAccelerate
+ if(ixVegNrg/=integerMissing) stateVecTrial(ixVegNrg) = stateVecInit(ixVegNrg) + (airtemp - stateVecInit(ixVegNrg))*tempAccelerate
+
+ ! compute H_T at the beginning of the data step
+ call t2enthalpy_T(&
+ ! input: data structures
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ mpar_data, & ! intent(in): parameter data structure
+ indx_data, & ! intent(in): model indices
+ lookup_data, & ! intent(in): lookup table data structure
+ ! input: state variables for the vegetation canopy
+ scalarCanairTemp, & ! intent(in): value of canopy air temperature (K)
+ scalarCanopyTemp, & ! intent(in): value of canopy temperature (K)
+ scalarCanopyWat, & ! intent(in): value of canopy total water (kg m-2)
+ scalarCanopyIce, & ! intent(in): value for canopy ice content (kg m-2)
+ ! input: variables for the snow-soil domain
+ mLayerTemp, & ! intent(in): vector of layer temperature (K)
+ mLayerVolFracWat, & ! intent(in): vector of volumetric total water content (-)
+ mLayerMatricHead, & ! intent(in): vector of total water matric potential (m)
+ mLayerVolFracIce, & ! intent(in): vector of volumetric fraction of ice (-)
+ ! output: enthalpy
+ scalarCanairEnthalpy, & ! intent(out): temperature component of enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy, & ! intent(out): temperature component of enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy, & ! intent(out): temperature component of enthalpy of each snow+soil layer (J m-3)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! compute the flux and the residual vector for a given state vector
+ ! NOTE 1: The derivatives computed in eval8summa are used to calculate the Jacobian matrix for the first iteration
+ ! NOTE 2: The Jacobian matrix together with the residual vector is used to calculate the first iteration increment
+
+ call eval8summa(&
+ ! input: model control
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): number of layers
+ nState, & ! intent(in): number of state variables in the current subset
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVecTrial, & ! intent(in): model state vector
+ fScale, & ! intent(in): function scaling vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): index data
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ fluxVec0, & ! intent(out): flux vector
+ rAdd, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ fOld, & ! intent(out): function evaluation
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+ if(.not.feasible)then; message=trim(message)//'state vector not feasible'; err=20; return; endif
+
+ ! copy over the initial flux structure since some model fluxes are not computed in the iterations
+ do concurrent ( iVar=1:size(flux_meta) )
+ flux_temp%var(iVar)%dat(:) = flux_init%var(iVar)%dat(:)
+ end do
+
+ ! allocate space for the temporary flux_sum structure
+ call allocLocal(flux_meta(:),flux_sum,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for mLayerCmpress_sum
+ allocate( mLayerCmpress_sum(nSoil) )
+
+ ! check the need to merge snow layers
+ if(nSnow>0)then
+ ! compute the energy required to melt the top snow layer (J m-2)
+ bulkDensity = mLayerVolFracIce(1)*iden_ice + mLayerVolFracLiq(1)*iden_water
+ volEnthalpy = temp2ethpy(mLayerTemp(1),bulkDensity,snowfrz_scale)
+ ! set flag and error codes for too much melt
+ if(-volEnthalpy < flux_init%var(iLookFLUX%mLayerNrgFlux)%dat(1)*dt)then
+ tooMuchMelt=.true.
+ message=trim(message)//'net flux in the top snow layer can melt all the snow in the top layer'
+ err=-20; return ! negative error code to denote a warning
+ endif
+ endif
+
+ ! get tolerance vectors
+ call popTol4IDA(&
+ ! input
+ nState, & ! intent(in): number of desired state variables
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ mpar_data, & ! intent(in): model parameters
+ ! output
+ atol, & ! intent(out): absolute tolerances vector (mixed units)
+ rtol, & ! intent(out): relative tolerances vector (mixed units)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ !-------------------
+ ! * solving F(y,y') = 0 by IDA. Here, y is the state vector
+ ! ------------------
+
+ do tol_iter=1,3
+
+ ! initialize flux_sum
+ do concurrent ( iVar=1:size(flux_meta) )
+ flux_sum%var(iVar)%dat(:) = 0._rkind
+ end do
+
+ ! initialize sum of compression of the soil matrix
+ mLayerCmpress_sum(:) = 0._rkind
+
+ call solveByIDA(&
+ dt, & ! intent (in) data time step
+ atol, & ! intent (in) absolute telerance
+ rtol, & ! intent (in) relative tolerance
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): number of snow+soil layers
+ nState, & ! intent(in): number of state variables in the current subset
+ ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vector
+ stateVecTrial, & ! intent(in): model state vector at the beginning of the data time step
+ sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ dMat, & ! intent(inout) diagonal of the Jacobian matrix (excludes fluxes)
+ ! input: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): index data
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
+ tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
+ mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
+ dt_out, & ! intent(out): time step
+ stateVecNew, & ! intent(out): model state vector (y) at the end of the data time step
+ stateVecPrime, & ! intent(out): derivative of model state vector (y') at the end of the data time step
+ err,cmessage) ! intent(out): error control
+
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+ if (idaSucceeds)then
+ exit
+ else
+ atol = atol * 0.1
+ rtol = rtol * 0.1
+ endif
+ if( .not.idaSucceeds .and. tol_iter==3) message=trim(message)//'IDA did not succeed after reducing tolerance by 2 magnitudes'
+
+ end do ! iteration over tolerances
+
+ ! check if IDA is successful
+ if( .not.idaSucceeds )then
+ err = 20
+ message=trim(message)//trim(cmessage)
+! reduceCoupledStep = .true.
+ return
+ else
+ if (tooMuchMelt) return !exit to start same step over after merge
+ endif
+
+ ! compute average flux
+ do iVar=1,size(flux_meta)
+ flux_temp%var(iVar)%dat(:) = ( flux_sum%var(iVar)%dat(:) ) / dt_out
+ end do
+
+ diag_data%var(iLookDIAG%mLayerCompress)%dat(:) = mLayerCmpress_sum(:)
+
+ ! compute the total change in storage associated with compression of the soil matrix (kg m-2)
+ diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) = sum(diag_data%var(iLookDIAG%mLayerCompress)%dat(1:nSoil)*mLayerDepth(nSnow+1:nLayers))*iden_water
+
+ ! save the computed solution
+ stateVecTrial = stateVecNew
+
+ ! free memory
+ deallocate(mLayerCmpress_sum)
+ deallocate(dBaseflow_dMatric)
+
+ ! end associate statements
+ end associate globalVars
+
+ end subroutine systemSolvSundials
+
+end module systemSolvSundials_module
diff --git a/build/source/engine/sundials/tol4IDA.f90 b/build/source/engine/sundials/tol4IDA.f90
new file mode 100644
index 0000000..4674c31
--- /dev/null
+++ b/build/source/engine/sundials/tol4IDA.f90
@@ -0,0 +1,291 @@
+
+
+
+module tol4IDA_module
+
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use nrtype
+ use type4IDA
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation canopy
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:iname_watAquifer ! named variable defining the water storage in the aquifer
+
+! metadata for information in the data structures
+USE globalData,only:indx_meta ! metadata for the variables in the index structure
+
+! constants
+USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! 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
+
+
+ ! privacy
+ implicit none
+ private
+ public::computWeight4IDA
+ public::popTol4IDA
+
+
+contains
+
+ ! **********************************************************************************************************
+ ! public function computWeight4IDA: compute w_i = 1 / ( rtol_i * y_i + atol_i )
+ ! **********************************************************************************************************
+ ! Return values:
+ ! 0 = success,
+ ! -1 = non-recoverable error, NaN or negative values
+ ! ----------------------------------------------------------------
+ integer(c_int) function computWeight4IDA(sunvec_y, sunvec_ewt, user_data) &
+ result(ierr) bind(C,name='computWeight4IDA')
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use fsundials_nvector_mod
+ use fnvector_serial_mod
+ use nrtype
+ use type4IDA
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ type(N_Vector) :: sunvec_y ! solution N_Vector y
+ type(N_Vector) :: sunvec_ewt ! derivative N_Vector W
+ type(c_ptr), value :: user_data ! user-defined data
+
+
+ ! pointers to data in SUNDIALS vectors
+ type(eqnsData), pointer :: tol_data ! equations data
+ real(rkind), pointer :: stateVec(:)
+ real(rkind), pointer :: weightVec(:)
+ integer(c_int) :: iState
+
+ !======= Internals ============
+
+ ! get equations data from user-defined data
+ call c_f_pointer(user_data, tol_data)
+
+
+ ! get data arrays from SUNDIALS vectors
+ stateVec(1:tol_data%nState) => FN_VGetArrayPointer(sunvec_y)
+ weightVec(1:tol_data%nState) => FN_VGetArrayPointer(sunvec_ewt)
+
+
+ do iState = 1,tol_data%nState
+ weightVec(iState) = tol_data%rtol(iState) * abs( stateVec(iState) ) + tol_data%atol(iState)
+ weightVec(iState) = 1._rkind / weightVec(iState)
+ end do
+
+ ierr = 0
+ return
+
+ end function computWeight4IDA
+
+
+ ! **********************************************************************************************************
+ ! public subroutine popTol4IDA: populate tolerances for state vectors
+ ! **********************************************************************************************************
+ subroutine popTol4IDA(&
+ ! input: data structures
+ nState, & ! intent(in): number of desired state variables
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ mpar_data, & ! intent(in)
+ ! output
+ absTol, & ! intent(out): model state vector
+ relTol, &
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: data structures
+ integer(i4b),intent(in) :: nState ! number of desired state variables
+ 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_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ ! output
+ real(rkind),intent(out) :: absTol(:) ! model state vector (mixed units)
+ real(rkind),intent(out) :: relTol(:) ! model state vector (mixed units)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state subsets
+ integer(i4b) :: iState ! index of state within the snow+soil domain
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: ixStateSubset ! index within the state subset
+ logical(lgt),dimension(nState) :: tolFlag ! flag to denote that the state is populated
+ real(rkind) :: absTolTempCas = 1e-6
+ real(rkind) :: relTolTempCas = 1e-6
+ real(rkind) :: absTolTempVeg = 1e-6
+ real(rkind) :: relTolTempVeg = 1e-6
+ real(rkind) :: absTolWatVeg = 1e-6
+ real(rkind) :: relTolWatVeg = 1e-6
+ real(rkind) :: absTolTempSoilSnow = 1e-6
+ real(rkind) :: relTolTempSoilSnow = 1e-6
+ real(rkind) :: absTolWatSnow = 1e-6
+ real(rkind) :: relTolWatSnow = 1e-6
+ real(rkind) :: absTolMatric = 1e-6
+ real(rkind) :: relTolMatric = 1e-6
+ real(rkind) :: absTolAquifr = 1e-6
+ real(rkind) :: relTolAquifr = 1e-6
+
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ fixedLength: associate(&
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in) : [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in) : [dp] temperature of the vegetation canopy (K)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in) : [dp] mass of total water on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(in) : [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ ! model state variable vectors for the snow-soil layers
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in) : [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of total water (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of liquid water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in) : [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in) : [dp(:)] matric potential of liquid water (m)
+ ! model state variables for the aquifer
+ scalarAquiferStorage=> prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(in) : [dp] storage of water in the aquifer (m)
+ ! indices defining specific model states
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of aquifer storage state variable
+ ! vector of energy and hydrology indices for the snow and soil domains
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in) : [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in) : [i4b] number of hydrology state variables in the snow+soil domain
+ ! type of model state variabless
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in) : [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in) : [i4b(:)] index of the type of hydrology states in snow+soil domain
+ ! number of layers
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in) : [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in) : [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in) : [i4b] total number of layers
+ ) ! end association with variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='popTol4IDA/'
+
+ ! -----
+ ! * initialize state vectors...
+ ! -----------------------------
+
+ ! initialize flags
+ tolFlag(:) = .false.
+
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixCasNrg),ixCasNrg(iState)/=integerMissing)
+ absTol( ixCasNrg(iState) ) = absTolTempCas ! transfer canopy air temperature to the state vector
+ relTol( ixCasNrg(iState) ) = relTolTempCas
+ tolFlag( ixCasNrg(iState) ) = .true. ! flag to denote that tolerances are populated
+ end do
+
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixVegNrg),ixVegNrg(iState)/=integerMissing)
+ absTol( ixVegNrg(iState) ) = absTolTempVeg ! transfer vegetation temperature to the state vector
+ relTol( ixVegNrg(iState) ) = relTolTempVeg ! transfer vegetation temperature to the state vector
+ tolFlag( ixVegNrg(iState) ) = .true. ! flag to denote that tolerances are populated
+ end do
+
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixVegHyd),ixVegHyd(iState)/=integerMissing)
+ tolFlag( ixVegHyd(iState) ) = .true. ! flag to denote that tolerances are populated
+ select case(ixStateType_subset( ixVegHyd(iState) ))
+ case(iname_watCanopy); absTol( ixVegHyd(iState) ) = absTolWatVeg ; relTol( ixVegHyd(iState) ) = relTolWatVeg
+ case(iname_liqCanopy); absTol( ixVegHyd(iState) ) = absTolWatVeg ; relTol( ixVegHyd(iState) ) = relTolWatVeg ! transfer liquid canopy water to the state vector
+ case default; tolFlag( ixVegHyd(iState) ) = .false. ! flag to denote that tolerances are populated
+ end select
+ end do
+
+ ! tolerance for tempreture of the snow and soil domain
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilNrg(iLayer) ! index within the state vector
+ absTol(ixStateSubset) = absTolTempSoilSnow ! transfer temperature from a layer to the state vector
+ relTol(ixStateSubset) = relTolTempSoilSnow
+ tolFlag(ixStateSubset) = .true. ! flag to denote that tolerances are populated
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! NOTE: ixVolFracWat and ixVolFracLiq can also include states in the soil domain, hence enable primary variable switching
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilHyd(iLayer) ! index within the state vector
+ tolFlag(ixStateSubset) = .true. ! flag to denote that tolerances are populated
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); absTol(ixStateSubset) = absTolWatSnow ; relTol(ixStateSubset) = relTolWatSnow
+ case(iname_liqLayer); absTol(ixStateSubset) = absTolWatSnow ; relTol(ixStateSubset) = relTolWatSnow
+ case(iname_matLayer); absTol(ixStateSubset) = absTolMatric ; relTol(ixStateSubset) = relTolMatric
+ case(iname_lmpLayer); absTol(ixStateSubset) = absTolMatric ; relTol(ixStateSubset) = relTolMatric
+ case default; tolFlag(ixStateSubset) = .false. ! flag to denote that tolerances are populated
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! build the state vector for the aquifer storage
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer aquifer
+ do concurrent (iState=1:size(ixAqWat),ixAqWat(iState)/=integerMissing)
+ absTol( ixAqWat(iState) ) = absTolAquifr ! transfer aquifer storage to the state vector
+ relTol( ixAqWat(iState) ) = relTolAquifr
+ tolFlag( ixAqWat(iState) ) = .true. ! flag to denote that tolerances are populated
+ end do
+
+ ! check that we specified tolerances for all state variables
+ if(count(tolFlag)/=nState)then
+ print*, 'tolFlag = ', tolFlag
+ message=trim(message)//'tolerances not specified for some state variables'
+ err=20; return
+ endif
+
+ end associate fixedLength ! end association to variables in the data structure where vector length does not change
+ end subroutine popTol4IDA
+
+
+end module tol4IDA_module
diff --git a/build/source/engine/sundials/type4IDA.f90 b/build/source/engine/sundials/type4IDA.f90
new file mode 100644
index 0000000..7251a29
--- /dev/null
+++ b/build/source/engine/sundials/type4IDA.f90
@@ -0,0 +1,84 @@
+
+
+module type4IDA
+
+! data types
+USE nrtype
+USE, intrinsic :: iso_c_binding
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup ! data vector with variable length dimension (rkind)
+
+implicit none
+
+ type eqnsData
+ type(c_ptr) :: ida_mem ! IDA memory
+ real(rkind) :: dt ! time step
+ integer(i4b) :: nSnow ! number of snow layers
+ integer(i4b) :: nSoil ! number of soil layers
+ integer(i4b) :: nLayers ! total number of layers
+ integer :: nState ! total number of state variables
+ integer(i4b) :: ixMatrix ! form of matrix (dense or banded)
+ logical(lgt) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt) :: firstFluxCall
+ logical(lgt) :: firstSplitOper
+ logical(lgt) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt) :: scalarSolution ! flag to denote if implementing the scalar solution
+ type(zLookup) :: lookup_data ! lookup tables
+ type(var_i) :: type_data ! type of vegetation and soil
+ type(var_d) :: attr_data ! spatial attributes
+ type(var_dlength) :: mpar_data ! model parameters
+ type(var_d) :: forc_data ! model forcing data
+ type(var_dlength) :: bvar_data ! model variables for the local basin
+ type(var_dlength) :: prog_data ! prognostic variables for a local HRU
+ type(var_ilength) :: indx_data ! indices defining model states and layers
+ type(var_dlength) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ real(rkind) :: scalarCanopyTempPrev ! previous value of canopy temperature (K)
+ real(rkind) :: scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+ real(rkind) :: scalarCanopyIcePrev ! value of canopy ice content (kg m-2) at previous step
+ real(rkind) :: scalarCanopyLiqTrial ! trial value of canopy ice content (kg m-2)
+ real(rkind) :: scalarCanopyLiqPrev ! value of canopy ice content (kg m-2) at previous step
+ real(rkind) :: scalarCanopyEnthalpyTrial ! trial enthalpy of the vegetation canopy (J m-3)
+ real(rkind) :: scalarCanopyEnthalpyPrev ! previous enthalpy of the vegetation canopy (J m-3)
+ real(qp), allocatable :: sMul(:) ! state vector multiplier (used in the residual calculations)
+ real(rkind), allocatable :: dMat(:) ! diagonal of the Jacobian matrix
+ real(rkind), allocatable :: fluxVec(:) ! flux vector
+ real(qp), allocatable :: resSink(:) ! additional (sink) terms on the RHS of the state equation
+ real(rkind), allocatable :: atol(:) ! vector of absolute tolerances
+ real(rkind), allocatable :: rtol(:) ! vector of relative tolerances
+ real(rkind), allocatable :: mLayerMatricHeadLiqTrial(:) ! trial value for liquid water matric potential (m)
+ real(rkind), allocatable :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
+ real(rkind), allocatable :: mLayerMatricHeadPrev(:) ! vector of total water matric potential (m) at previous step
+ real(rkind), allocatable :: mLayerVolFracWatTrial(:) ! trial value for volumetric fraction of total water (-)
+ real(rkind), allocatable :: mLayerVolFracWatPrev(:) ! value for volumetric fraction of total water (-) at previous step
+ real(rkind), allocatable :: mLayerVolFracIceTrial(:) ! trial value for volumetric fraction of ice (-)
+ real(rkind), allocatable :: mLayerVolFracIcePrev(:) ! value for volumetric fraction of ice (-) at previous step
+ real(rkind), allocatable :: mLayerVolFracLiqTrial(:) ! trial value for volumetric fraction of liquid water (-)
+ real(rkind), allocatable :: mLayerVolFracLiqPrev(:) ! value for volumetric fraction of liquid water (-) at previous step
+ real(rkind) :: scalarAquiferStoragePrev
+ real(rkind) :: scalarAquiferStorageTrial
+ real(rkind), allocatable :: mLayerEnthalpyTrial(:) ! trial enthalpy of snow and soil (J m-3)
+ real(rkind), allocatable :: mLayerEnthalpyPrev(:) ! enthalpy of snow and soil (J m-3) at previous step
+ real(rkind), allocatable :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind), allocatable :: mLayerTempPrev(:) ! vector of layer temperature (K) at previous step
+ real(rkind), allocatable :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ integer :: ixSaturation
+ integer(i4b) :: err ! error code
+ character(len = 50) :: message ! error message
+ end type eqnsData
+
+
+end module type4IDA
+
+
+
+
+
diff --git a/build/source/engine/sundials/updatStateSundials.f90 b/build/source/engine/sundials/updatStateSundials.f90
new file mode 100644
index 0000000..51a3ead
--- /dev/null
+++ b/build/source/engine/sundials/updatStateSundials.f90
@@ -0,0 +1,320 @@
+
+module updatStateSundials_module
+USE nrtype
+! physical constants
+USE multiconst,only:&
+ 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)
+ gravity, & ! gravitational acceleteration (m s-2)
+ LH_fus ! latent heat of fusion (J kg-1)
+implicit none
+private
+public::updateSnowSundials
+public::updateSoilSundials
+public::updateSoilSundials2
+public::updateVegSundials
+
+real(rkind),parameter :: verySmall=1e-14_rkind ! a very small number (used to avoid divide by zero)
+
+contains
+
+
+ ! *************************************************************************************************************
+ ! public subroutine updateVegSundials: compute phase change impacts on volumetric liquid water and ice
+ ! Input: Theta * canopyDepth * iden_water
+ ! Outputs: VolFracLiq * canopyDepth * iden_water and VolFracIce * canopyDepth * iden_ice
+ ! *************************************************************************************************************
+ subroutine updateVegSundials(&
+ ! input
+ Temp ,& ! intent(in): temperature (K)
+ Theta ,& ! intent(in): volume fraction of total water (-)
+ snowfrz_scale ,& ! intent(in): scaling parameter for the snow freezing curve (K-1)
+ TempPrime ,& ! intent(in): temperature (K)
+ ThetaPrime ,& ! intent(in): volume fraction of total water (-)
+ ! output
+ VolFracLiq ,& ! intent(out): volumetric fraction of liquid water (-)
+ VolFracIce ,& ! intent(out): volumetric fraction of ice (-)
+ VolFracLiqPrime ,& ! intent(out): volumetric fraction of liquid water (-)
+ VolFracIcePrime ,& ! intent(out): volumetric fraction of ice (-)
+ fLiq ,& ! intent(out): fraction of liquid water (-)
+ err,message) ! intent(out): error control
+ ! utility routines
+ USE snow_utils_module,only:fracliquid ! compute volumetric fraction of liquid water
+ USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+ implicit none
+ ! input variables
+ real(rkind),intent(in) :: Temp ! temperature (K)
+ real(rkind),intent(in) :: Theta ! volume fraction of total water (-)
+ real(rkind),intent(in) :: snowfrz_scale ! scaling parameter for the snow freezing curve (K-1)
+ real(rkind),intent(in) :: TempPrime ! temperature (K)
+ real(rkind),intent(in) :: ThetaPrime ! volume fraction of total water (-)
+ ! output variables
+ real(rkind),intent(out) :: VolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: VolFracIce ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: VolFracLiqPrime ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: VolFracIcePrime ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: fLiq ! fraction of liquid water (-)
+ ! error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! initialize error control
+ err=0; message="updateVegSundials/"
+
+ ! compute the volumetric fraction of liquid water and ice (-)
+ fLiq = fracliquid(Temp,snowfrz_scale)
+ VolFracLiq = fLiq*Theta
+ VolFracIce = (1._rkind - fLiq)*Theta
+ VolFracLiqPrime = fLiq * ThetaPrime + dFracLiq_dTk(Temp,snowfrz_scale) * Theta * TempPrime
+ VolFracIcePrime = ( ThetaPrime - VolFracLiqPrime )
+
+
+ end subroutine updateVegSundials
+
+
+ ! *************************************************************************************************************
+ ! public subroutine updateSnowSundials: compute phase change impacts on volumetric liquid water and ice
+ ! *************************************************************************************************************
+ subroutine updateSnowSundials(&
+ ! input
+ mLayerTemp ,& ! intent(in): temperature (K)
+ mLayerTheta ,& ! intent(in): volume fraction of total water (-)
+ snowfrz_scale ,& ! intent(in): scaling parameter for the snow freezing curve (K-1)
+ mLayerTempPrime ,& ! intent(in): temperature (K)
+ mLayerThetaPrime ,& ! intent(in): volume fraction of total water (-)
+ ! output
+ mLayerVolFracLiq ,& ! intent(out): volumetric fraction of liquid water (-)
+ mLayerVolFracIce ,& ! intent(out): volumetric fraction of ice (-)
+ mLayerVolFracLiqPrime ,& ! intent(out): volumetric fraction of liquid water (-)
+ mLayerVolFracIcePrime ,& ! intent(out): volumetric fraction of ice (-)
+ fLiq ,& ! intent(out): fraction of liquid water (-)
+ err,message) ! intent(out): error control
+ ! utility routines
+ USE snow_utils_module,only:fracliquid ! compute volumetric fraction of liquid water
+ USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+ implicit none
+ ! input variables
+ real(rkind),intent(in) :: mLayerTemp ! temperature (K)
+ real(rkind),intent(in) :: mLayerTheta ! volume fraction of total water (-)
+ real(rkind),intent(in) :: snowfrz_scale ! scaling parameter for the snow freezing curve (K-1)
+ real(rkind),intent(in) :: mLayerTempPrime ! temperature (K)
+ real(rkind),intent(in) :: mLayerThetaPrime ! volume fraction of total water (-)
+ ! output variables
+ real(rkind),intent(out) :: mLayerVolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: mLayerVolFracIce ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqPrime ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: mLayerVolFracIcePrime ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: fLiq ! fraction of liquid water (-)
+ ! error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! initialize error control
+ err=0; message="updateSnowSundials/"
+
+ ! compute the volumetric fraction of liquid water and ice (-)
+ fLiq = fracliquid(mLayerTemp,snowfrz_scale)
+ mLayerVolFracLiq = fLiq*mLayerTheta
+ mLayerVolFracIce = (1._rkind - fLiq)*mLayerTheta*(iden_water/iden_ice)
+ mLayerVolFracLiqPrime = fLiq * mLayerThetaPrime + dFracLiq_dTk(mLayerTemp,snowfrz_scale) * mLayerTheta * mLayerTempPrime
+ mLayerVolFracIcePrime = ( mLayerThetaPrime - mLayerVolFracLiqPrime ) * (iden_water/iden_ice)
+
+
+ end subroutine updateSnowSundials
+
+ ! *************************************************************************************************************
+ ! public subroutine updateSoilSundials: compute phase change impacts on matric head and volumetric liquid water and ice
+ ! uses mLayerMatricHeadPrev and mLayerVolFracWatPrev to get dt_cur, or use dt_cur as it can change here
+ ! *************************************************************************************************************
+ subroutine updateSoilSundials(&
+ ! input
+ dt_cur, &
+ mLayerTemp ,& ! intent(in): temperature (K)
+ mLayerMatricHead ,& ! intent(in): total water matric potential (m)
+ mLayerMatricHeadPrev ,& ! intent(in): total water matric potential previous time step (m)
+ mLayerVolFracWatPrev ,& ! intent(in): volumetric fraction of total water previous time step (-)
+ mLayerTempPrime ,& ! intent(in): temperature time derivative (K/s)
+ mLayerMatricHeadPrime, & ! intent(in): total water matric potential time derivative (m/s)
+ vGn_alpha ,& ! intent(in): van Genutchen "alpha" parameter
+ vGn_n ,& ! intent(in): van Genutchen "n" parameter
+ theta_sat ,& ! intent(in): soil porosity (-)
+ theta_res ,& ! intent(in): soil residual volumetric water content (-)
+ vGn_m ,& ! intent(in): van Genutchen "m" parameter (-)
+ ! output
+ mLayerVolFracWat ,& ! intent(out): volumetric fraction of total water (-)
+ mLayerVolFracLiq ,& ! intent(out): volumetric fraction of liquid water (-)
+ mLayerVolFracIce ,& ! intent(out): volumetric fraction of ice (-)
+ mLayerVolFracWatPrime ,& ! intent(out): volumetric fraction of total water time derivative (-)
+ mLayerVolFracLiqPrime ,& ! intent(out): volumetric fraction of liquid water time derivative (-)
+ mLayerVolFracIcePrime ,& ! intent(out): volumetric fraction of ice time derivative (-)
+ err,message) ! intent(out): error control
+ ! utility routines
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water based on matric head
+ USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric liquid water content
+ 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) :: mLayerMatricHeadPrev ! matric head previous time step (m)
+ real(rkind),intent(in) :: mLayerVolFracWatPrev ! volumetric fraction of total waterprevious time step (m)
+ real(rkind),intent(in) :: mLayerTempPrime ! temperature time derivative (K/s)
+ real(rkind),intent(in) :: mLayerMatricHeadPrime ! matric head time derivative (m/s)
+ real(rkind),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter
+ real(rkind),intent(in) :: vGn_n ! van Genutchen "n" parameter
+ real(rkind),intent(in) :: theta_sat ! soil porosity (-)
+ real(rkind),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(rkind),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ ! output variables
+ real(rkind),intent(out) :: mLayerVolFracWat ! fractional volume of total water (-)
+ real(rkind),intent(out) :: mLayerVolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: mLayerVolFracIce ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: mLayerVolFracWatPrime ! fractional volume of total water (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqPrime ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: mLayerVolFracIcePrime ! volumetric fraction of ice (-)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! define local variables
+ real(rkind) :: TcSoil ! critical soil temperature when all water is unfrozen (K)
+ real(rkind) :: xConst ! constant in the freezing curve function (m K-1)
+ real(rkind) :: mLayerPsiLiq ! liquid water matric potential (m)
+ real(rkind) :: dt_inv ! inverse of timestep
+ ! initialize error control
+ err=0; message="updateSoilSundials/"
+
+ ! compute fractional **volume** of total water (liquid plus ice)
+ mLayerVolFracWat = volFracLiq(mLayerMatricHead,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ ! mLayerVolFracWatPrime = dTheta_dPsi(mLayerMatricHead,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * mLayerMatricHeadPrime
+ if( abs(mLayerMatricHead - mLayerMatricHeadPrev) < verySmall )then
+ dt_inv = 1._rkind/ dt_cur !WHY NOT JUST USE THIS
+ else
+ dt_inv = mLayerMatricHeadPrime / (mLayerMatricHead - mLayerMatricHeadPrev)
+ endif
+ mLayerVolFracWatPrime = (mLayerVolFracWat - mLayerVolFracWatPrev)*dt_inv
+
+ if(mLayerVolFracWat > theta_sat)then; err=20; message=trim(message)//'volume of liquid and ice exceeds porosity'; return; end if
+
+ ! compute the critical soil temperature where all water is unfrozen (K)
+ ! (eq 17 in Dall'Amico 2011)
+ TcSoil = Tfreeze + min(mLayerMatricHead,0._rkind)*gravity*Tfreeze/LH_fus ! (NOTE: J = kg m2 s-2, so LH_fus is in units of m2 s-2)
+
+ ! *** compute volumetric fraction of liquid water for partially frozen soil
+ if(mLayerTemp < TcSoil)then ! (check if soil temperature is less than the critical temperature)
+ ! NOTE: mLayerPsiLiq is the liquid water matric potential from the Clapeyron equation, used to separate the total water into liquid water and ice
+ ! mLayerPsiLiq is DIFFERENT from the liquid water matric potential used in the flux calculations
+ xConst = LH_fus/(gravity*Tfreeze) ! m K-1 (NOTE: J = kg m2 s-2)
+ mLayerPsiLiq = xConst*(mLayerTemp - Tfreeze) ! liquid water matric potential from the Clapeyron eqution
+ mLayerVolFracLiq = volFracLiq(mLayerPsiLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ if(mLayerPsiLiq<0._rkind)then
+ mLayerVolFracLiqPrime = dTheta_dPsi(mLayerPsiLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * xConst * mLayerTempPrime
+ else
+ mLayerVolFracLiqPrime = 0._rkind
+ endif
+
+ ! *** compute volumetric fraction of liquid water for unfrozen soil
+ else !( mLayerTemp >= TcSoil, all water is unfrozen )
+ mLayerVolFracLiq = mLayerVolFracWat
+ mLayerVolFracLiqPrime = mLayerVolFracWatPrime
+ mLayerVolFracIcePrime = 0._rkind
+
+ end if ! (check if soil is partially frozen)
+
+ ! - volumetric ice content (-)
+ mLayerVolFracIce = mLayerVolFracWat - mLayerVolFracLiq
+ mLayerVolFracIcePrime = mLayerVolFracWatPrime - mLayerVolFracLiqPrime
+
+ end subroutine updateSoilSundials
+
+ ! *************************************************************************************************************
+ ! public subroutine updateSoilSundials: compute phase change impacts on matric head and volumetric liquid water and ice
+ ! uses mLayerMatricHeadPrime, and wants instantaneous dt, dt_cur will always be a full step size as input here
+ ! *************************************************************************************************************
+ 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)
+ mLayerMatricHeadPrime, & ! intent(in): total water matric potential time derivative (m/s)
+ vGn_alpha ,& ! intent(in): van Genutchen "alpha" parameter
+ vGn_n ,& ! intent(in): van Genutchen "n" parameter
+ theta_sat ,& ! intent(in): soil porosity (-)
+ theta_res ,& ! intent(in): soil residual volumetric water content (-)
+ vGn_m ,& ! intent(in): van Genutchen "m" parameter (-)
+ ! output
+ mLayerVolFracWat ,& ! intent(out): volumetric fraction of total water (-)
+ mLayerVolFracLiq ,& ! intent(out): volumetric fraction of liquid water (-)
+ mLayerVolFracIce ,& ! intent(out): volumetric fraction of ice (-)
+ mLayerVolFracWatPrime ,& ! intent(out): volumetric fraction of total water (-)
+ mLayerVolFracLiqPrime ,& ! intent(out): volumetric fraction of liquid water (-)
+ mLayerVolFracIcePrime ,& ! intent(out): volumetric fraction of ice (-)
+ err,message) ! intent(out): error control
+ ! utility routines
+ USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water based on matric head
+ USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric liquid water content
+ 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)
+ real(rkind),intent(in) :: mLayerMatricHeadPrime ! matric head time derivative (m/s)
+ real(rkind),intent(in) :: vGn_alpha ! van Genutchen "alpha" parameter
+ real(rkind),intent(in) :: vGn_n ! van Genutchen "n" parameter
+ real(rkind),intent(in) :: theta_sat ! soil porosity (-)
+ real(rkind),intent(in) :: theta_res ! soil residual volumetric water content (-)
+ real(rkind),intent(in) :: vGn_m ! van Genutchen "m" parameter (-)
+ ! output variables
+ real(rkind),intent(out) :: mLayerVolFracWat ! fractional volume of total water (-)
+ real(rkind),intent(out) :: mLayerVolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind),intent(out) :: mLayerVolFracIce ! volumetric fraction of ice (-)
+ real(rkind),intent(out) :: mLayerVolFracWatPrime ! fractional volume of total water time derivative (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqPrime ! volumetric fraction of liquid water time derivative (-)
+ real(rkind),intent(out) :: mLayerVolFracIcePrime ! volumetric fraction of ice time derivative (-)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! define local variables
+ real(rkind) :: TcSoil ! critical soil temperature when all water is unfrozen (K)
+ real(rkind) :: xConst ! constant in the freezing curve function (m K-1)
+ real(rkind) :: mLayerPsiLiq ! liquid water matric potential (m)
+ ! initialize error control
+ err=0; message="updateSoilSundials2/"
+
+ ! compute fractional **volume** of total water (liquid plus ice)
+ mLayerVolFracWat = volFracLiq(mLayerMatricHead,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ mLayerVolFracWatPrime = dTheta_dPsi(mLayerMatricHead,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * mLayerMatricHeadPrime
+
+ if(mLayerVolFracWat > theta_sat)then; err=20; message=trim(message)//'volume of liquid and ice exceeds porosity'; return; end if
+
+ ! compute the critical soil temperature where all water is unfrozen (K)
+ ! (eq 17 in Dall'Amico 2011)
+ TcSoil = Tfreeze + min(mLayerMatricHead,0._rkind)*gravity*Tfreeze/LH_fus ! (NOTE: J = kg m2 s-2, so LH_fus is in units of m2 s-2)
+
+ ! *** compute volumetric fraction of liquid water for partially frozen soil
+ if( mLayerTemp < TcSoil )then ! (check if soil temperature is less than the critical temperature)
+ ! NOTE: mLayerPsiLiq is the liquid water matric potential from the Clapeyron equation, used to separate the total water into liquid water and ice
+ ! mLayerPsiLiq is DIFFERENT from the liquid water matric potential used in the flux calculations
+ xConst = LH_fus/(gravity*Tfreeze) ! m K-1 (NOTE: J = kg m2 s-2)
+ mLayerPsiLiq = xConst*(mLayerTemp - Tfreeze) ! liquid water matric potential from the Clapeyron eqution
+ mLayerVolFracLiq = volFracLiq(mLayerPsiLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m)
+ if(mLayerPsiLiq<0._rkind)then
+ mLayerVolFracLiqPrime = dTheta_dPsi(mLayerPsiLiq,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * xConst * mLayerTempPrime
+ else
+ mLayerVolFracLiqPrime = 0._rkind
+ endif
+
+ ! *** compute volumetric fraction of liquid water for unfrozen soil
+ else !( mLayerTemp >= TcSoil, all water is unfrozen )
+ mLayerVolFracLiq = mLayerVolFracWat
+ mLayerVolFracLiqPrime = mLayerVolFracWatPrime
+
+ end if ! (check if soil is partially frozen)
+
+ ! - volumetric ice content (-)
+ mLayerVolFracIce = mLayerVolFracWat - mLayerVolFracLiq
+ mLayerVolFracIcePrime = mLayerVolFracWatPrime - mLayerVolFracLiqPrime
+
+ end subroutine updateSoilSundials2
+end module updatStateSundials_module
diff --git a/build/source/engine/sundials/updateVars4JacDAE.f90 b/build/source/engine/sundials/updateVars4JacDAE.f90
new file mode 100644
index 0000000..734483c
--- /dev/null
+++ b/build/source/engine/sundials/updateVars4JacDAE.f90
@@ -0,0 +1,820 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 updateVars4JacDAE_module
+
+! data types
+USE nrtype
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation canopy
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+USE globalData,only:iname_aquifer ! named variables for the aquifer
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! metadata for information in the data structures
+USE globalData,only:indx_meta ! metadata for the variables in the index structure
+
+! constants
+USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ Cp_ice, & ! specific heat of ice (J kg-1 K-1)
+ Cp_water, & ! specific heat of liquid water (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! 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
+
+! provide access to routines to update states
+USE updatStateSundials_module,only:updateVegSundials ! update snow states
+USE updatStateSundials_module,only:updateSnowSundials ! update snow states
+USE updatStateSundials_module,only:updateSoilSundials2 ! update soil states
+
+! provide access to functions for the constitutive functions and derivatives
+USE snow_utils_module,only:fracliquid ! compute the fraction of liquid water (snow)
+USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+USE soil_utils_module,only:dTheta_dTk ! differentiate the freezing curve w.r.t. temperature (soil)
+USE soil_utils_module,only:dTheta_dPsi ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:dPsi_dTheta ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+USE soil_utilsSundials_module,only:liquidHeadSundials ! compute the liquid water matric potential
+USE soil_utilsSundials_module,only:d2Theta_dPsi2
+USE soil_utilsSundials_module,only:d2Theta_dTk2
+
+! IEEE checks
+USE, intrinsic :: ieee_arithmetic ! check values (NaN, etc.)
+
+implicit none
+private
+public::updateVars4JacDAE
+
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine updateVars4JacDAE: compute diagnostic variables
+ ! **********************************************************************************************************
+ subroutine updateVars4JacDAE(&
+ ! input
+ dt, & ! intent(in): time step
+ do_adjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & ! reza
+ mLayerVolFracWatPrime, & ! reza
+ mLayerVolFracLiqPrime, & ! reza
+ mLayerVolFracIcePrime, & ! reza
+ mLayerMatricHeadPrime, & ! reza
+ mLayerMatricHeadLiqPrime, & ! reza
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input
+ real(rkind) ,intent(in) :: dt ! time step
+ logical(lgt) ,intent(in) :: do_adjustTemp ! flag to adjust temperature to account for the energy used in melt+freeze
+ type(var_dlength),intent(in) :: mpar_data ! model parameters for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ 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) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ real(rkind),intent(inout) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ real(rkind),intent(inout) :: scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyTempPrime ! trial value of canopy temperature (K)
+ real(rkind),intent(inout) :: scalarCanopyWatPrime ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyLiqPrime ! trial value of canopy liquid water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyIcePrime ! trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ real(rkind),intent(inout) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(inout) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
+ real(rkind),intent(inout) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(inout) :: mLayerMatricHeadLiqTrial(:) ! trial vector of liquid water matric potential (m)
+
+ real(rkind),intent(inout) :: mLayerTempPrime(:)
+ real(rkind),intent(inout) :: mLayerVolFracWatPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerVolFracLiqPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerVolFracIcePrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerMatricHeadPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerMatricHeadLiqPrime(:) ! reza
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! general local variables
+ integer(i4b) :: iState ! index of model state variable
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: ixFullVector ! index within full state vector
+ integer(i4b) :: ixDomainType ! name of a given model domain
+ integer(i4b) :: ixControlIndex ! index within a given model domain
+ integer(i4b) :: ixOther,ixOtherLocal ! index of the coupled state variable within the (full, local) vector
+ logical(lgt) :: isCoupled ! .true. if a given variable shared another state variable in the same control volume
+ logical(lgt) :: isNrgState ! .true. if a given variable is an energy state
+ logical(lgt),allocatable :: computedCoupling(:) ! .true. if computed the coupling for a given state variable
+ real(rkind) :: scalarVolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind) :: scalarVolFracIce ! volumetric fraction of ice (-)
+ real(rkind) :: scalarVolFracLiqPrime ! volumetric fraction of liquid water (-)
+ real(rkind) :: scalarVolFracIcePrime ! volumetric fraction of ice (-)
+ real(rkind) :: Tcrit ! critical soil temperature below which ice exists (K)
+ real(rkind) :: xTemp ! temporary temperature (K)
+ real(rkind) :: fLiq ! fraction of liquid water (-)
+ real(rkind) :: effSat ! effective saturation (-)
+ real(rkind) :: avPore ! available pore space (-)
+ character(len=256) :: cMessage ! error message of downwind routine
+ logical(lgt),parameter :: printFlag=.false. ! flag to turn on printing
+ ! iterative solution for temperature
+ real(rkind) :: meltNrg ! energy for melt+freeze (J m-3)
+ real(rkind) :: residual ! residual in the energy equation (J m-3)
+ real(rkind) :: derivative ! derivative in the energy equation (J m-3 K-1)
+ real(rkind) :: tempInc ! iteration increment (K)
+ integer(i4b) :: iter ! iteration index
+ integer(i4b) :: niter ! number of iterations
+ integer(i4b),parameter :: maxiter=100 ! maximum number of iterations
+ real(rkind),parameter :: nrgConvTol=1.e-4_rkind ! convergence tolerance for energy (J m-3)
+ real(rkind),parameter :: tempConvTol=1.e-6_rkind ! convergence tolerance for temperature (K)
+ real(rkind) :: critDiff ! temperature difference from critical (K)
+ real(rkind) :: tempMin ! minimum bracket for temperature (K)
+ real(rkind) :: tempMax ! maximum bracket for temperature (K)
+ logical(lgt) :: bFlag ! flag to denote that iteration increment was constrained using bi-section
+ real(rkind),parameter :: epsT=1.e-7_rkind ! small interval above/below critical temperature (K)
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! indices defining model states and layers
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ! indices in the full vector for specific domains
+ ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
+ ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ! mapping between the full state vector and the state subset
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset for each state in the full state vector
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] [state subset] list of indices of the full state vector in the state subset
+ ! type of domain, type of state variable, and index of control volume within domain
+ ixDomainType_subset => indx_data%var(iLookINDEX%ixDomainType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] id of domain for desired model state variables
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of the control volume for different domains (veg, snow, soil)
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! depth-varying model parameters
+ 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_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
+ ! model diagnostic variables (heat capacity)
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ scalarBulkVolHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1),& ! intent(in): [dp ] volumetric heat capacity of the vegetation (J m-3 K-1)
+ mLayerVolHtCapBulk => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat ,& ! intent(in): [dp(:)] volumetric heat capacity in each layer (J m-3 K-1)
+ ! model diagnostic variables (fraction of liquid water)
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
+ ! model states for the vegetation canopy
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variable vectors for the snow-soil layers
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in): [dp(:)] total water matric potential (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
+ ! model diagnostic variables from a previous solution
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(in): [dp(:)] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp(:)] mass of ice on the vegetation canopy (kg m-2)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ ! derivatives
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ dPsiLiq_dPsi0 => deriv_data%var(iLookDERIV%dPsiLiq_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in liquid water matric pot w.r.t. the total water matric pot (-)
+ dPsiLiq_dTemp => deriv_data%var(iLookDERIV%dPsiLiq_dTemp )%dat ,& ! intent(out): [dp(:)] derivative in the liquid water matric potential w.r.t. temperature
+ mLayerdTheta_dTk => deriv_data%var(iLookDERIV%mLayerdTheta_dTk)%dat ,& ! intent(out): [dp(:)] derivative of volumetric liquid water content w.r.t. temperature
+ dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy)%dat(1) ,& ! intent(out): [dp] derivative of volumetric liquid water content w.r.t. temperature
+ d2VolTot_d2Psi0 => deriv_data%var(iLookDERIV%d2VolTot_d2Psi0 )%dat ,& ! intent(out): [dp(:)] second derivative in total water content w.r.t. total water matric potential
+ mLayerd2Theta_dTk2 => deriv_data%var(iLookDERIV%mLayerd2Theta_dTk2 )%dat ,& ! intent(out): [dp(:)] second derivative of volumetric liquid water content w.r.t. temperature
+ d2Theta_dTkCanopy2 => deriv_data%var(iLookDERIV%d2Theta_dTkCanopy2 )%dat(1) ,& ! intent(out): [dp ] second derivative of volumetric liquid water content w.r.t. temperature
+ dFracLiqSnow_dTk => deriv_data%var(iLookDERIV%dFracLiqSnow_dTk )%dat ,& ! intent(out): [dp(:)] derivative in fraction of liquid snow w.r.t. temperature
+ dFracLiqVeg_dTkCanopy => deriv_data%var(iLookDERIV%dFracLiqVeg_dTkCanopy )%dat(1) ,& ! intent(out): [dp ] derivative in fraction of (throughfall + drainage) w.r.t. temperature
+ dVolHtCapBulk_dPsi0 => deriv_data%var(iLookDERIV%dVolHtCapBulk_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in bulk heat capacity w.r.t. matric potential
+ dVolHtCapBulk_dTheta => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTheta )%dat ,& ! intent(out): [dp(:)] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dCanWat => deriv_data%var(iLookDERIV%dVolHtCapBulk_dCanWat)%dat(1) ,& ! intent(out): [dp ] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dTk => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTk )%dat ,& ! intent(out): [dp(:)] derivative in bulk heat capacity w.r.t. temperature
+ dVolHtCapBulk_dTkCanopy => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTkCanopy)%dat(1) & ! intent(out): [dp ] derivative in bulk heat capacity w.r.t. temperature
+) ! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='updateVars4JacDAE/'
+
+ ! allocate space and assign values to the flag vector
+ allocate(computedCoupling(size(ixMapSubset2Full)),stat=err) ! .true. if computed the coupling for a given state variable
+ if(err/=0)then; message=trim(message)//'problem allocating computedCoupling'; return; endif
+ computedCoupling(:)=.false.
+
+ ! loop through model state variables
+ do iState=1,size(ixMapSubset2Full)
+
+ ! check the need for the computations
+ if(computedCoupling(iState)) cycle
+
+ ! -----
+ ! - compute indices...
+ ! --------------------
+
+ ! get domain type, and index of the control volume within the domain
+ ixFullVector = ixMapSubset2Full(iState) ! index within full state vector
+ ixDomainType = ixDomainType_subset(iState) ! named variables defining the domain (iname_cas, iname_veg, etc.)
+ ixControlIndex = ixControlVolume(ixFullVector) ! index within a given domain
+
+ ! get the layer index
+ select case(ixDomainType)
+ case(iname_cas); cycle ! canopy air space: do nothing
+ case(iname_veg); iLayer = 0
+ case(iname_snow); iLayer = ixControlIndex
+ case(iname_soil); iLayer = ixControlIndex + nSnow
+ case(iname_aquifer); cycle ! aquifer: do nothing
+ case default; err=20; message=trim(message)//'expect case to be iname_cas, iname_veg, iname_snow, iname_soil, iname_aquifer'; return
+ end select
+
+ ! get the index of the other (energy or mass) state variable within the full state vector
+ select case(ixDomainType)
+ case(iname_veg) ; ixOther = merge(ixHydCanopy(1), ixNrgCanopy(1), ixStateType(ixFullVector)==iname_nrgCanopy)
+ case(iname_snow, iname_soil); ixOther = merge(ixHydLayer(iLayer),ixNrgLayer(iLayer),ixStateType(ixFullVector)==iname_nrgLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! get the index in the local state vector
+ ixOtherLocal = ixMapFull2Subset(ixOther) ! ixOtherLocal could equal integerMissing
+ if(ixOtherLocal/=integerMissing) computedCoupling(ixOtherLocal)=.true.
+
+ ! check if we have a coupled solution
+ isCoupled = (ixOtherLocal/=integerMissing)
+
+ ! check if we are an energy state
+ isNrgState = (ixStateType(ixFullVector)==iname_nrgCanopy .or. ixStateType(ixFullVector)==iname_nrgLayer)
+
+ if(printFlag)then
+ print*, 'iState = ', iState, size(ixMapSubset2Full)
+ print*, 'ixFullVector = ', ixFullVector
+ print*, 'ixDomainType = ', ixDomainType
+ print*, 'ixControlIndex = ', ixControlIndex
+ print*, 'ixOther = ', ixOther
+ print*, 'ixOtherLocal = ', ixOtherLocal
+ print*, 'do_adjustTemp = ', do_adjustTemp
+ print*, 'isCoupled = ', isCoupled
+ print*, 'isNrgState = ', isNrgState
+ endif
+
+
+
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+
+ ! update hydrology state variables for the uncoupled solution
+ if(.not.isNrgState .and. .not.isCoupled)then
+
+ ! update the total water from volumetric liquid water
+ if(ixStateType(ixFullVector)==iname_liqCanopy .or. ixStateType(ixFullVector)==iname_liqLayer)then
+ select case(ixDomainType)
+ case(iname_veg)
+ scalarCanopyWatTrial = scalarCanopyLiqTrial + scalarCanopyIceTrial
+ scalarCanopyWatPrime = scalarCanopyLiqPrime + scalarCanopyIcePrime
+ case(iname_snow)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer)*iden_ice/iden_water
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)*iden_ice/iden_water
+ case(iname_soil)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer) ! no volume expansion
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, or iname_soil'; return
+ end select
+ endif
+
+ ! update the total water and the total water matric potential
+ if(ixDomainType==iname_soil)then
+ select case( ixStateType(ixFullVector) )
+ ! --> update the total water from the liquid water matric potential
+ case(iname_lmpLayer)
+
+ effSat = volFracLiq(mLayerMatricHeadLiqTrial(ixControlIndex),vGn_alpha(ixControlIndex),0._rkind,1._rkind,vGn_n(ixControlIndex),vGn_m(ixControlIndex)) ! effective saturation
+ avPore = theta_sat(ixControlIndex) - mLayerVolFracIceTrial(iLayer) - theta_res(ixControlIndex) ! available pore space
+ mLayerVolFracLiqTrial(iLayer) = effSat*avPore + theta_res(ixControlIndex)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer) ! no volume expansion
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)
+ mLayerMatricHeadTrial(ixControlIndex) = matricHead(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerMatricHeadPrime(ixControlIndex) = dPsi_dTheta(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) * mLayerVolFracWatPrime(iLayer)
+ !write(*,'(a,1x,i4,1x,3(f20.10,1x))') 'mLayerVolFracLiqTrial(iLayer) 1 = ', iLayer, mLayerVolFracLiqTrial(iLayer), mLayerVolFracIceTrial(iLayer), mLayerVolFracWatTrial(iLayer)
+ ! --> update the total water from the total water matric potential
+ case(iname_matLayer)
+
+ mLayerVolFracWatTrial(iLayer) = volFracLiq(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerVolFracWatPrime(iLayer) = dTheta_dPsi(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) *mLayerMatricHeadPrime(ixControlIndex)
+ ! --> update the total water matric potential (assume already have mLayerVolFracWatTrial given block above)
+ case(iname_liqLayer, iname_watLayer)
+
+ mLayerMatricHeadTrial(ixControlIndex) = matricHead(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerMatricHeadPrime(ixControlIndex) = dPsi_dTheta(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) * mLayerVolFracWatPrime(iLayer)
+ case default; err=20; message=trim(message)//'expect iname_lmpLayer, iname_matLayer, iname_liqLayer, or iname_watLayer'; return
+ end select
+ endif ! if in the soil domain
+
+ endif ! if hydrology state variable or uncoupled solution
+
+ ! compute the critical soil temperature below which ice exists
+ select case(ixDomainType)
+ case(iname_veg, iname_snow); Tcrit = Tfreeze;
+ case(iname_soil); Tcrit = crit_soilT( mLayerMatricHeadTrial(ixControlIndex) );
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! initialize temperature
+ select case(ixDomainType)
+ case(iname_veg); xTemp = scalarCanopyTempTrial
+ case(iname_snow, iname_soil); xTemp = mLayerTempTrial(iLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! define brackets for the root
+ ! NOTE: start with an enormous range; updated quickly in the iterations
+ tempMin = xTemp - 10._rkind
+ tempMax = xTemp + 10._rkind
+
+ ! get iterations (set to maximum iterations if adjusting the temperature)
+ niter = merge(maxiter, 1, do_adjustTemp)
+
+ ! iterate
+ iterations: do iter=1,niter
+
+ ! restrict temperature
+ if(xTemp <= tempMin .or. xTemp >= tempMax)then
+ xTemp = 0.5_rkind*(tempMin + tempMax) ! new value
+ bFlag = .true.
+ else
+ bFlag = .false.
+ endif
+
+ ! -----
+ ! - compute derivatives...
+ ! ------------------------
+
+ ! compute the derivative in bulk heat capacity w.r.t. total water content or water matric potential (m-1)
+ ! compute the derivative in total water content w.r.t. total water matric potential (m-1)
+ ! NOTE 1: valid for frozen and unfrozen conditions
+ ! NOTE 2: for case "iname_lmpLayer", dVolTot_dPsi0 = dVolLiq_dPsi, dVolHtCapBulk_dPsi0 may be wrong
+ select case(ixDomainType)
+ case(iname_veg)
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ dVolHtCapBulk_dCanWat = ( -Cp_ice*( fLiq-1._rkind ) + Cp_water*fLiq )/canopyDepth !this is iden_water/(iden_water*canopyDepth)
+ case(iname_snow)
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ dVolHtCapBulk_dTheta(iLayer) = iden_water * ( -Cp_ice*( fLiq-1._rkind ) + Cp_water*fLiq ) + iden_air * ( ( fLiq-1._rkind )*iden_water/iden_ice - fLiq ) * Cp_air
+ case(iname_soil)
+ select case( ixStateType(ixFullVector) )
+ case(iname_lmpLayer)
+ dVolTot_dPsi0(ixControlIndex) = dTheta_dPsi(mLayerMatricHeadLiqTrial(ixControlIndex),vGn_alpha(ixControlIndex),0._rkind,1._rkind,vGn_n(ixControlIndex),vGn_m(ixControlIndex))*avPore
+ d2VolTot_d2Psi0(ixControlIndex) = d2Theta_dPsi2(mLayerMatricHeadLiqTrial(ixControlIndex),vGn_alpha(ixControlIndex),0._rkind,1._rkind,vGn_n(ixControlIndex),vGn_m(ixControlIndex))*avPore
+ case default
+ dVolTot_dPsi0(ixControlIndex) = dTheta_dPsi(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ d2VolTot_d2Psi0(ixControlIndex) = d2Theta_dPsi2(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),&
+ vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ end select
+ ! dVolHtCapBulk_dPsi0 uses the derivative in water retention curve above critical temp w.r.t.state variable dVolTot_dPsi0
+ dVolHtCapBulk_dTheta(iLayer) = realMissing ! do not use
+ if(xTemp< Tcrit) dVolHtCapBulk_dPsi0(ixControlIndex) = (iden_ice * Cp_ice - iden_air * Cp_air) * dVolTot_dPsi0(ixControlIndex)
+ if(xTemp>=Tcrit) dVolHtCapBulk_dPsi0(ixControlIndex) = (iden_water * Cp_water - iden_air * Cp_air) * dVolTot_dPsi0(ixControlIndex)
+ end select
+
+ ! compute the derivative in liquid water content w.r.t. temperature
+ ! --> partially frozen: dependence of liquid water on temperature
+ ! compute the derivative in bulk heat capacity w.r.t. temperature
+ if(xTemp<Tcrit)then
+ select case(ixDomainType)
+ case(iname_veg)
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ dFracLiqVeg_dTkCanopy = dFracLiq_dTk(xTemp,snowfrz_scale)
+ dTheta_dTkCanopy = dFracLiqVeg_dTkCanopy * scalarCanopyWatTrial/(iden_water*canopyDepth)
+ d2Theta_dTkCanopy2 = 2._rkind * snowfrz_scale**2._rkind * ( (Tfreeze - xTemp) * 2._rkind * fLiq * dFracLiqVeg_dTkCanopy - fLiq**2._rkind ) * scalarCanopyWatTrial/(iden_water*canopyDepth)
+ dVolHtCapBulk_dTkCanopy = iden_water * (-Cp_ice + Cp_water) * dTheta_dTkCanopy !same as snow but there is no derivative in air
+ case(iname_snow)
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ dFracLiqSnow_dTk(iLayer) = dFracLiq_dTk(xTemp,snowfrz_scale)
+ mLayerdTheta_dTk(iLayer) = dFracLiqSnow_dTk(iLayer) * mLayerVolFracWatTrial(iLayer)
+ mLayerd2Theta_dTk2(iLayer) = 2._rkind * snowfrz_scale**2._rkind * ( (Tfreeze - xTemp) * 2._rkind * fLiq * dFracLiqSnow_dTk(iLayer) - fLiq**2._rkind ) * mLayerVolFracWatTrial(iLayer)
+ dVolHtCapBulk_dTk(iLayer) = ( iden_water * (-Cp_ice + Cp_water) + iden_air * (iden_water/iden_ice - 1._rkind) * Cp_air ) * mLayerdTheta_dTk(iLayer)
+ case(iname_soil)
+ dFracLiqSnow_dTk(iLayer) = 0._rkind !dTheta_dTk(xTemp,theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))/ mLayerVolFracWatTrial(iLayer)
+ mLayerdTheta_dTk(iLayer) = dTheta_dTk(xTemp,theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerd2Theta_dTk2(iLayer) = d2Theta_dTk2(xTemp,theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ dVolHtCapBulk_dTk(iLayer) = (-iden_ice * Cp_ice + iden_water * Cp_water) * mLayerdTheta_dTk(iLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select ! domain type
+
+ ! --> unfrozen: no dependence of liquid water on temperature
+ else
+ select case(ixDomainType)
+ case(iname_veg); dTheta_dTkCanopy = 0._rkind; d2Theta_dTkCanopy2 = 0._rkind; dFracLiqVeg_dTkCanopy = 0._rkind; dVolHtCapBulk_dTkCanopy = 0._rkind
+ case(iname_snow); mLayerdTheta_dTk(iLayer) = 0._rkind; mLayerd2Theta_dTk2(iLayer) = 0._rkind; dFracLiqSnow_dTk(iLayer) = 0._rkind; dVolHtCapBulk_dTk(iLayer) = 0._rkind
+ case(iname_soil); mLayerdTheta_dTk(iLayer) = 0._rkind; mLayerd2Theta_dTk2(iLayer) = 0._rkind; dFracLiqSnow_dTk(iLayer) = 0._rkind; dVolHtCapBulk_dTk(iLayer) = 0._rkind
+ end select ! domain type
+ endif
+
+ ! -----
+ ! - update volumetric fraction of liquid water and ice...
+ ! => case of hydrology state uncoupled with energy (and when not adjusting the temperature)...
+ ! -----------------------------------------------------------------------------------------------
+
+ ! case of hydrology state uncoupled with energy (and when not adjusting the temperature)
+ if(.not.do_adjustTemp .and. .not.isNrgState .and. .not.isCoupled)then
+
+ ! compute the fraction of snow
+ select case(ixDomainType)
+ case(iname_veg); scalarFracLiqVeg = fracliquid(xTemp,snowfrz_scale)
+ case(iname_snow); mLayerFracLiqSnow(iLayer) = fracliquid(xTemp,snowfrz_scale)
+ case(iname_soil) ! do nothing
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select ! domain type
+
+ ! -----
+ ! - update volumetric fraction of liquid water and ice...
+ ! => case of energy state or coupled solution (or adjusting the temperature)...
+ ! --------------------------------------------------------------------------------
+
+ ! case of energy state OR coupled solution (or adjusting the temperature)
+ elseif(do_adjustTemp .or. ( (isNrgState .or. isCoupled) ) )then
+
+ ! identify domain type
+ select case(ixDomainType)
+
+ ! *** vegetation canopy
+ case(iname_veg)
+ ! compute volumetric fraction of liquid water and ice
+ call updateVegSundials(&
+ xTemp, & ! intent(in) : temperature (K)
+ scalarCanopyWatTrial, & ! intent(in) : canopy total water (kg m-2)
+ snowfrz_scale, & ! intent(in) : scaling parameter for the snow freezing curve (K-1)
+ scalarCanopyTempPrime, & ! intent(in) : canopy temperature time derivative (K/s)
+ scalarCanopyWatPrime, & ! intent(in) : canopy total water time derivative (kg m-2 /s)
+ scalarVolFracLiq, & ! intent(out) : trial canopy liquid water (-)
+ scalarVolFracIce, & ! intent(out) : trial volumetric canopy ice (-)
+ scalarVolFracLiqPrime, & ! intent(out) : trial volumetric canopy liquid water (-)
+ scalarVolFracIcePrime, & ! intent(out) : trial volumetric canopy ice (-)
+ scalarFracLiqVeg, & ! intent(out) : fraction of liquid water (-)
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** snow layers
+ case(iname_snow)
+
+ call updateSnowSundials(&
+ xTemp, & ! intent(in) : temperature (K)
+ mLayerVolFracWatTrial(iLayer), & ! intent(in) : mass state variable = trial volumetric fraction of water (-)
+ snowfrz_scale, & ! intent(in) : scaling parameter for the snow freezing curve (K-1)
+ mLayerTempPrime(iLayer), & ! intent(in) : temperature time derivative (K/s)
+ mLayerVolFracWatPrime(iLayer), & ! intent(in) : volumetric fraction of total water time derivative (-)
+ mLayerVolFracLiqTrial(iLayer), & ! intent(out) : trial volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer), & ! intent(out) : trial volumetric fraction if ice (-)
+ mLayerVolFracLiqPrime(iLayer), & ! intent(out) : volumetric fraction of liquid water time derivative (-)
+ mLayerVolFracIcePrime(iLayer), & ! intent(out) : volumetric fraction of ice time derivative (-)
+ mLayerFracLiqSnow(iLayer), & ! intent(out) : fraction of liquid water (-)
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** soil layers
+ case(iname_soil)
+
+ ! 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)
+ mLayerMatricHeadPrime(ixControlIndex), & ! intent(in) : total water matric potential time derivative (m/s)
+ ! intent(in) : soil parameters
+ vGn_alpha(ixControlIndex), & ! intent(in) : van Genutchen "alpha" parameter
+ vGn_n(ixControlIndex), & ! intent(in) : van Genutchen "n" parameter
+ theta_sat(ixControlIndex), & ! intent(in) : soil porosity (-)
+ theta_res(ixControlIndex), & ! intent(in) : soil residual volumetric water content (-)
+ vGn_m(ixControlIndex), & ! intent(in) : van Genutchen "m" parameter (-)
+ mLayerVolFracWatTrial(iLayer), & ! intent(in) : mass state variable = trial volumetric fraction of water (-)
+ mLayerVolFracLiqTrial(iLayer), & ! intent(out) : trial volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer), & ! intent(out) : trial volumetric fraction if ice (-)
+ mLayerVolFracWatPrime(iLayer), & ! intent(out) : volumetric fraction of total water time derivative (-)
+ mLayerVolFracLiqPrime(iLayer), & ! intent(out) : volumetric fraction of liquid water time derivative (-)
+ mLayerVolFracIcePrime(iLayer), & ! intent(out) : volumetric fraction of ice time derivative (-)
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! check
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+
+ end select ! domain type
+
+ ! final check
+ else
+
+ ! do nothing (input = output) -- and check that we got here correctly
+ if( (isNrgState .or. isCoupled) )then
+ scalarVolFracLiq = realMissing
+ scalarVolFracIce = realMissing
+ else
+ message=trim(message)//'unexpected else branch'
+ err=20; return
+ endif
+
+ endif ! if energy state or solution is coupled
+
+ ! -----
+ ! - update temperatures...
+ ! ------------------------
+
+ ! check the need to adjust temperature
+ if(do_adjustTemp)then
+
+ ! get the melt energy
+ meltNrg = merge(LH_fus*iden_ice, LH_fus*iden_water, ixDomainType==iname_snow)
+
+ ! compute the residual and the derivative
+ select case(ixDomainType)
+
+ ! * vegetation
+ case(iname_veg)
+ call xTempSolve(&
+ ! constant over iterations
+ meltNrg = meltNrg ,& ! intent(in) : energy for melt+freeze (J m-3)
+ heatCap = scalarBulkVolHeatCapVeg ,& ! intent(in) : volumetric heat capacity (J m-3 K-1)
+ tempInit = scalarCanopyTemp ,& ! intent(in) : initial temperature (K)
+ volFracIceInit = scalarCanopyIce/(iden_water*canopyDepth),& ! intent(in) : initial volumetric fraction of ice (-)
+ ! trial values
+ xTemp = xTemp ,& ! intent(inout) : trial value of temperature
+ dLiq_dT = dTheta_dTkCanopy ,& ! intent(in) : derivative in liquid water content w.r.t. temperature (K-1)
+ volFracIceTrial = scalarVolFracIce ,& ! intent(in) : trial value for volumetric fraction of ice
+ ! residual and derivative
+ residual = residual ,& ! intent(out) : residual (J m-3)
+ derivative = derivative ) ! intent(out) : derivative (J m-3 K-1)
+
+ ! * snow and soil
+ case(iname_snow, iname_soil)
+ call xTempSolve(&
+ ! constant over iterations
+ meltNrg = meltNrg ,& ! intent(in) : energy for melt+freeze (J m-3)
+ heatCap = mLayerVolHtCapBulk(iLayer) ,& ! intent(in) : volumetric heat capacity (J m-3 K-1)
+ tempInit = mLayerTemp(iLayer) ,& ! intent(in) : initial temperature (K)
+ volFracIceInit = mLayerVolFracIce(iLayer) ,& ! intent(in) : initial volumetric fraction of ice (-)
+ ! trial values
+ xTemp = xTemp ,& ! intent(inout) : trial value of temperature
+ dLiq_dT = mLayerdTheta_dTk(iLayer) ,& ! intent(in) : derivative in liquid water content w.r.t. temperature (K-1)
+ volFracIceTrial = mLayerVolFracIceTrial(iLayer) ,& ! intent(in) : trial value for volumetric fraction of ice
+ ! residual and derivative
+ residual = residual ,& ! intent(out) : residual (J m-3)
+ derivative = derivative ) ! intent(out) : derivative (J m-3 K-1)
+
+ ! * check
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+
+ end select ! domain type
+
+ ! check validity of residual
+ if( ieee_is_nan(residual) )then
+ message=trim(message)//'residual is not valid'
+ err=20; return
+ endif
+
+ ! update bracket
+ if(residual < 0._rkind)then
+ tempMax = min(xTemp,tempMax)
+ else
+ tempMin = max(tempMin,xTemp)
+ end if
+
+ ! compute iteration increment
+ tempInc = residual/derivative ! K
+
+ ! check
+ if(globalPrintFlag)&
+ write(*,'(i4,1x,e20.10,1x,5(f20.10,1x),L1)') iter, residual, xTemp-Tcrit, tempInc, Tcrit, tempMin, tempMax, bFlag
+
+ ! check convergence
+ if(abs(residual) < nrgConvTol .or. abs(tempInc) < tempConvTol) exit iterations
+
+ ! add constraints for snow temperature
+ if(ixDomainType==iname_veg .or. ixDomainType==iname_snow)then
+ if(tempInc > Tcrit - xTemp) tempInc=(Tcrit - xTemp)*0.5_rkind ! simple bi-section method
+ endif ! if the domain is vegetation or snow
+
+ ! deal with the discontinuity between partially frozen and unfrozen soil
+ if(ixDomainType==iname_soil)then
+ ! difference from the temperature below which ice exists
+ critDiff = Tcrit - xTemp
+ ! --> initially frozen (T < Tcrit)
+ if(critDiff > 0._rkind)then
+ if(tempInc > critDiff) tempInc = critDiff + epsT ! set iteration increment to slightly above critical temperature
+ ! --> initially unfrozen (T > Tcrit)
+ else
+ if(tempInc < critDiff) tempInc = critDiff - epsT ! set iteration increment to slightly below critical temperature
+ endif
+ endif ! if the domain is soil
+
+ ! update the temperature trial
+ xTemp = xTemp + tempInc
+
+ ! check failed convergence
+ if(iter==maxiter)then
+ message=trim(message)//'failed to converge'
+ err=-20; return ! negative error code = try to recover
+ endif
+
+ endif ! if adjusting the temperature
+
+ end do iterations ! iterating
+
+ ! save temperature
+ select case(ixDomainType)
+ case(iname_veg); scalarCanopyTempTrial = xTemp
+ case(iname_snow, iname_soil); mLayerTempTrial(iLayer) = xTemp
+ end select
+
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+
+ ! -----
+ ! - compute the liquid water matric potential (and necessay derivatives)...
+ ! -------------------------------------------------------------------------
+
+ ! only for soil
+ if(ixDomainType==iname_soil)then
+
+ ! check liquid water
+ if(mLayerVolFracLiqTrial(iLayer) > theta_sat(ixControlIndex) )then
+ message=trim(message)//'liquid water greater than porosity'
+ err=20; return
+ endif
+
+ ! case of hydrology state uncoupled with energy
+ if(.not.isNrgState .and. .not.isCoupled)then
+
+ ! derivatives relating liquid water matric potential to total water matric potential and temperature
+ dPsiLiq_dPsi0(ixControlIndex) = 1._rkind ! exact correspondence (psiLiq=psi0)
+ dPsiLiq_dTemp(ixControlIndex) = 0._rkind ! no relationship between liquid water matric potential and temperature
+
+ ! case of energy state or coupled solution
+ else
+ ! compute the liquid matric potential (and the derivatives w.r.t. total matric potential and temperature)
+ call liquidHeadSundials(&
+ ! input
+ mLayerMatricHeadTrial(ixControlIndex) ,& ! intent(in) : total water matric potential (m)
+ mLayerMatricHeadPrime(ixControlIndex) ,& !
+ mLayerVolFracLiqTrial(iLayer) ,& ! intent(in) : volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer) ,& ! intent(in) : volumetric fraction of ice (-)
+ 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
+ mLayerMatricHeadLiqTrial(ixControlIndex) ,& ! intent(out): liquid water matric potential (m)
+ mLayerMatricHeadLiqPrime(ixControlIndex) ,& !
+ dPsiLiq_dPsi0(ixControlIndex) ,& ! intent(out): derivative in the liquid water matric potential w.r.t. the total water matric potential (-)
+ dPsiLiq_dTemp(ixControlIndex) ,& ! intent(out): derivative in the liquid water matric potential w.r.t. temperature (m K-1)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ endif ! switch between hydrology and energy state
+
+ endif ! if domain is soil
+
+ end do ! looping through state variables
+
+ ! deallocate space
+ deallocate(computedCoupling,stat=err) ! .true. if computed the coupling for a given state variable
+ if(err/=0)then; message=trim(message)//'problem deallocating computedCoupling'; return; endif
+
+ ! end association to the variables in the data structures
+ end associate
+
+ end subroutine updateVars4JacDAE
+
+
+ ! **********************************************************************************************************
+ ! private subroutine xTempSolve: compute residual and derivative for temperature
+ ! **********************************************************************************************************
+ subroutine xTempSolve(&
+ ! input: constant over iterations
+ meltNrg ,& ! intent(in) : energy for melt+freeze (J m-3)
+ heatCap ,& ! intent(in) : volumetric heat capacity (J m-3 K-1)
+ tempInit ,& ! intent(in) : initial temperature (K)
+ volFracIceInit ,& ! intent(in) : initial volumetric fraction of ice (-)
+ ! input-output: trial values
+ xTemp ,& ! intent(inout) : trial value of temperature
+ dLiq_dT ,& ! intent(in) : derivative in liquid water content w.r.t. temperature (K-1)
+ volFracIceTrial ,& ! intent(in) : trial value for volumetric fraction of ice
+ ! output: residual and derivative
+ residual ,& ! intent(out) : residual (J m-3)
+ derivative ) ! intent(out) : derivative (J m-3 K-1)
+ implicit none
+ ! input: constant over iterations
+ real(rkind),intent(in) :: meltNrg ! energy for melt+freeze (J m-3)
+ real(rkind),intent(in) :: heatCap ! volumetric heat capacity (J m-3 K-1)
+ real(rkind),intent(in) :: tempInit ! initial temperature (K)
+ real(rkind),intent(in) :: volFracIceInit ! initial volumetric fraction of ice (-)
+ ! input-output: trial values
+ real(rkind),intent(inout) :: xTemp ! trial value for temperature
+ real(rkind),intent(in) :: dLiq_dT ! derivative in liquid water content w.r.t. temperature (K-1)
+ real(rkind),intent(in) :: volFracIceTrial ! trial value for the volumetric fraction of ice (-)
+ ! output: residual and derivative
+ real(rkind),intent(out) :: residual ! residual (J m-3)
+ real(rkind),intent(out) :: derivative ! derivative (J m-3 K-1)
+ ! subroutine starts here
+ residual = -heatCap*(xTemp - tempInit) + meltNrg*(volFracIceTrial - volFracIceInit) ! J m-3
+ derivative = heatCap + LH_fus*iden_water*dLiq_dT ! J m-3 K-1
+ end subroutine xTempSolve
+
+end module updateVars4JacDAE_module
diff --git a/build/source/engine/sundials/updateVarsSundials.f90 b/build/source/engine/sundials/updateVarsSundials.f90
new file mode 100644
index 0000000..35a7d4c
--- /dev/null
+++ b/build/source/engine/sundials/updateVarsSundials.f90
@@ -0,0 +1,655 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 updateVarsSundials_module
+
+! data types
+USE nrtype
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation canopy
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+USE globalData,only:iname_aquifer ! named variables for the aquifer
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! metadata for information in the data structures
+USE globalData,only:indx_meta ! metadata for the variables in the index structure
+
+! constants
+USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! 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
+
+! provide access to routines to update states
+USE updatStateSundials_module,only:updateVegSundials ! update snow states
+USE updatStateSundials_module,only:updateSnowSundials ! update snow states
+USE updatStateSundials_module,only:updateSoilSundials ! update soil states
+
+! provide access to functions for the constitutive functions and derivatives
+USE snow_utils_module,only:fracliquid ! compute the fraction of liquid water (snow)
+USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+USE soil_utils_module,only:dTheta_dTk ! differentiate the freezing curve w.r.t. temperature (soil)
+USE soil_utils_module,only:dTheta_dPsi ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:dPsi_dTheta ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+USE soil_utilsSundials_module,only:liquidHeadSundials ! compute the liquid water matric potential
+
+! IEEE checks
+USE, intrinsic :: ieee_arithmetic ! check values (NaN, etc.)
+
+implicit none
+private
+public::updateVarsSundials
+
+contains
+
+ ! **********************************************************************************************************
+ ! public subroutine updateVarsSundials: compute diagnostic variables
+ ! **********************************************************************************************************
+ subroutine updateVarsSundials(&
+ ! input
+ dt_cur, &
+ do_adjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ mLayerVolFracWatPrev, & ! intent(in)
+ mLayerMatricHeadPrev, & ! intent(in)
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & ! reza
+ mLayerVolFracWatPrime, & ! reza
+ mLayerVolFracLiqPrime, & ! reza
+ mLayerVolFracIcePrime, & ! reza
+ mLayerMatricHeadPrime, & ! reza
+ mLayerMatricHeadLiqPrime, & ! reza
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input
+ real(rkind),intent(in) :: dt_cur
+ logical(lgt) ,intent(in) :: do_adjustTemp ! flag to adjust temperature to account for the energy used in melt+freeze
+ type(var_dlength),intent(in) :: mpar_data ! model parameters for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ real(rkind),intent(in) :: mLayerVolFracWatPrev(:)
+ real(rkind),intent(in) :: mLayerMatricHeadPrev(:)
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ real(rkind),intent(inout) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ real(rkind),intent(inout) :: scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+
+ real(rkind),intent(inout) :: scalarCanopyTempPrime ! trial value of canopy temperature (K)
+ real(rkind),intent(inout) :: scalarCanopyWatPrime ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyLiqPrime ! trial value of canopy liquid water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyIcePrime ! trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ real(rkind),intent(inout) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(inout) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
+ real(rkind),intent(inout) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(inout) :: mLayerMatricHeadLiqTrial(:) ! trial vector of liquid water matric potential (m)
+
+ real(rkind),intent(inout) :: mLayerTempPrime(:)
+ real(rkind),intent(inout) :: mLayerVolFracWatPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerVolFracLiqPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerVolFracIcePrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerMatricHeadPrime(:) ! reza
+ real(rkind),intent(inout) :: mLayerMatricHeadLiqPrime(:) ! reza
+
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! general local variables
+ integer(i4b) :: iState ! index of model state variable
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: ixFullVector ! index within full state vector
+ integer(i4b) :: ixDomainType ! name of a given model domain
+ integer(i4b) :: ixControlIndex ! index within a given model domain
+ integer(i4b) :: ixOther,ixOtherLocal ! index of the coupled state variable within the (full, local) vector
+ logical(lgt) :: isCoupled ! .true. if a given variable shared another state variable in the same control volume
+ logical(lgt) :: isNrgState ! .true. if a given variable is an energy state
+ logical(lgt),allocatable :: computedCoupling(:) ! .true. if computed the coupling for a given state variable
+ real(rkind) :: scalarVolFracLiq ! volumetric fraction of liquid water (-)
+ real(rkind) :: scalarVolFracIce ! volumetric fraction of ice (-)
+ real(rkind) :: scalarVolFracLiqPrime ! volumetric fraction of liquid water (-)
+ real(rkind) :: scalarVolFracIcePrime ! volumetric fraction of ice (-)
+ real(rkind) :: Tcrit ! critical soil temperature below which ice exists (K)
+ real(rkind) :: xTemp ! temporary temperature (K)
+ real(rkind) :: effSat ! effective saturation (-)
+ real(rkind) :: avPore ! available pore space (-)
+ character(len=256) :: cMessage ! error message of downwind routine
+ logical(lgt),parameter :: printFlag=.false. ! flag to turn on printing
+ ! iterative solution for temperature
+ real(rkind) :: meltNrg ! energy for melt+freeze (J m-3)
+ real(rkind) :: residual ! residual in the energy equation (J m-3)
+ real(rkind) :: derivative ! derivative in the energy equation (J m-3 K-1)
+ real(rkind) :: tempInc ! iteration increment (K)
+ integer(i4b) :: iter ! iteration index
+ integer(i4b) :: niter ! number of iterations
+ integer(i4b),parameter :: maxiter=100 ! maximum number of iterations
+ real(rkind),parameter :: nrgConvTol=1.e-4_rkind ! convergence tolerance for energy (J m-3)
+ real(rkind),parameter :: tempConvTol=1.e-6_rkind ! convergence tolerance for temperature (K)
+ real(rkind) :: critDiff ! temperature difference from critical (K)
+ real(rkind) :: tempMin ! minimum bracket for temperature (K)
+ real(rkind) :: tempMax ! maximum bracket for temperature (K)
+ logical(lgt) :: bFlag ! flag to denote that iteration increment was constrained using bi-section
+ real(rkind),parameter :: epsT=1.e-7_rkind ! small interval above/below critical temperature (K)
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! indices defining model states and layers
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ! indices in the full vector for specific domains
+ ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
+ ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ! mapping between the full state vector and the state subset
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset for each state in the full state vector
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] [state subset] list of indices of the full state vector in the state subset
+ ! type of domain, type of state variable, and index of control volume within domain
+ ixDomainType_subset => indx_data%var(iLookINDEX%ixDomainType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] id of domain for desired model state variables
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of the control volume for different domains (veg, snow, soil)
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! depth-varying model parameters
+ 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_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
+ ! model diagnostic variables (heat capacity)
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ scalarBulkVolHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1),& ! intent(in): [dp ] volumetric heat capacity of the vegetation (J m-3 K-1)
+ mLayerVolHtCapBulk => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat ,& ! intent(in): [dp(:)] volumetric heat capacity in each layer (J m-3 K-1)
+ ! model diagnostic variables (fraction of liquid water)
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
+ ! model states for the vegetation canopy
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variable vectors for the snow-soil layers
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in): [dp(:)] total water matric potential (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
+ ! model diagnostic variables from a previous solution
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(in): [dp(:)] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp(:)] mass of ice on the vegetation canopy (kg m-2)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ ! derivatives
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ dPsiLiq_dPsi0 => deriv_data%var(iLookDERIV%dPsiLiq_dPsi0 )%dat ,& ! intent(out): [dp(:)] derivative in liquid water matric pot w.r.t. the total water matric pot (-)
+ dPsiLiq_dTemp => deriv_data%var(iLookDERIV%dPsiLiq_dTemp )%dat ,& ! intent(out): [dp(:)] derivative in the liquid water matric potential w.r.t. temperature
+ mLayerdTheta_dTk => deriv_data%var(iLookDERIV%mLayerdTheta_dTk)%dat ,& ! intent(out): [dp(:)] derivative of volumetric liquid water content w.r.t. temperature
+ dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy)%dat(1) & ! intent(out): [dp] derivative of volumetric liquid water content w.r.t. temperature
+ ) ! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='updateVarsSundials/'
+
+ ! allocate space and assign values to the flag vector
+ allocate(computedCoupling(size(ixMapSubset2Full)),stat=err) ! .true. if computed the coupling for a given state variable
+ if(err/=0)then; message=trim(message)//'problem allocating computedCoupling'; return; endif
+ computedCoupling(:)=.false.
+
+ ! loop through model state variables
+ do iState=1,size(ixMapSubset2Full)
+
+ ! check the need for the computations
+ if(computedCoupling(iState)) cycle
+
+ ! -----
+ ! - compute indices...
+ ! --------------------
+
+ ! get domain type, and index of the control volume within the domain
+ ixFullVector = ixMapSubset2Full(iState) ! index within full state vector
+ ixDomainType = ixDomainType_subset(iState) ! named variables defining the domain (iname_cas, iname_veg, etc.)
+ ixControlIndex = ixControlVolume(ixFullVector) ! index within a given domain
+
+ ! get the layer index
+ select case(ixDomainType)
+ case(iname_cas); cycle ! canopy air space: do nothing
+ case(iname_veg); iLayer = 0
+ case(iname_snow); iLayer = ixControlIndex
+ case(iname_soil); iLayer = ixControlIndex + nSnow
+ case(iname_aquifer); cycle ! aquifer: do nothing
+ case default; err=20; message=trim(message)//'expect case to be iname_cas, iname_veg, iname_snow, iname_soil, iname_aquifer'; return
+ end select
+
+ ! get the index of the other (energy or mass) state variable within the full state vector
+ select case(ixDomainType)
+ case(iname_veg) ; ixOther = merge(ixHydCanopy(1), ixNrgCanopy(1), ixStateType(ixFullVector)==iname_nrgCanopy)
+ case(iname_snow, iname_soil); ixOther = merge(ixHydLayer(iLayer),ixNrgLayer(iLayer),ixStateType(ixFullVector)==iname_nrgLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! get the index in the local state vector
+ ixOtherLocal = ixMapFull2Subset(ixOther) ! ixOtherLocal could equal integerMissing
+ if(ixOtherLocal/=integerMissing) computedCoupling(ixOtherLocal)=.true.
+
+ ! check if we have a coupled solution
+ isCoupled = (ixOtherLocal/=integerMissing)
+
+ ! check if we are an energy state
+ isNrgState = (ixStateType(ixFullVector)==iname_nrgCanopy .or. ixStateType(ixFullVector)==iname_nrgLayer)
+
+ if(printFlag)then
+ print*, 'iState = ', iState, size(ixMapSubset2Full)
+ print*, 'ixFullVector = ', ixFullVector
+ print*, 'ixDomainType = ', ixDomainType
+ print*, 'ixControlIndex = ', ixControlIndex
+ print*, 'ixOther = ', ixOther
+ print*, 'ixOtherLocal = ', ixOtherLocal
+ print*, 'do_adjustTemp = ', do_adjustTemp
+ print*, 'isCoupled = ', isCoupled
+ print*, 'isNrgState = ', isNrgState
+ endif
+
+
+
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+
+ ! update hydrology state variables for the uncoupled solution
+ if(.not.isNrgState .and. .not.isCoupled)then
+
+ stop 1
+
+ ! update the total water from volumetric liquid water
+ if(ixStateType(ixFullVector)==iname_liqCanopy .or. ixStateType(ixFullVector)==iname_liqLayer)then
+ select case(ixDomainType)
+ case(iname_veg)
+ scalarCanopyWatTrial = scalarCanopyLiqTrial + scalarCanopyIceTrial
+ scalarCanopyWatPrime = scalarCanopyLiqPrime + scalarCanopyIcePrime
+ case(iname_snow)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer)*iden_ice/iden_water
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)*iden_ice/iden_water
+ case(iname_soil)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer) ! no volume expansion
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, or iname_soil'; return
+ end select
+ endif
+
+ ! update the total water and the total water matric potential
+ if(ixDomainType==iname_soil)then
+ select case( ixStateType(ixFullVector) )
+ ! --> update the total water from the liquid water matric potential
+ case(iname_lmpLayer)
+
+ effSat = volFracLiq(mLayerMatricHeadLiqTrial(ixControlIndex),vGn_alpha(ixControlIndex),0._rkind,1._rkind,vGn_n(ixControlIndex),vGn_m(ixControlIndex)) ! effective saturation
+ avPore = theta_sat(ixControlIndex) - mLayerVolFracIceTrial(iLayer) - theta_res(ixControlIndex) ! available pore space
+ mLayerVolFracLiqTrial(iLayer) = effSat*avPore + theta_res(ixControlIndex)
+ mLayerVolFracWatTrial(iLayer) = mLayerVolFracLiqTrial(iLayer) + mLayerVolFracIceTrial(iLayer) ! no volume expansion
+ mLayerVolFracWatPrime(iLayer) = mLayerVolFracLiqPrime(iLayer) + mLayerVolFracIcePrime(iLayer)
+ mLayerMatricHeadTrial(ixControlIndex) = matricHead(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerMatricHeadPrime(ixControlIndex) = dPsi_dTheta(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) * mLayerVolFracWatPrime(iLayer)
+ !write(*,'(a,1x,i4,1x,3(f20.10,1x))') 'mLayerVolFracLiqTrial(iLayer) 1 = ', iLayer, mLayerVolFracLiqTrial(iLayer), mLayerVolFracIceTrial(iLayer), mLayerVolFracWatTrial(iLayer)
+ ! --> update the total water from the total water matric potential
+ case(iname_matLayer)
+
+ mLayerVolFracWatTrial(iLayer) = volFracLiq(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerVolFracWatPrime(iLayer) = dTheta_dPsi(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) *mLayerMatricHeadPrime(ixControlIndex)
+ ! --> update the total water matric potential (assume already have mLayerVolFracWatTrial given block above)
+ case(iname_liqLayer, iname_watLayer)
+
+ mLayerMatricHeadTrial(ixControlIndex) = matricHead(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ mLayerMatricHeadPrime(ixControlIndex) = dPsi_dTheta(mLayerVolFracWatTrial(iLayer),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex)) * mLayerVolFracWatPrime(iLayer)
+ case default; err=20; message=trim(message)//'expect iname_lmpLayer, iname_matLayer, iname_liqLayer, or iname_watLayer'; return
+ end select
+ endif ! if in the soil domain
+
+ endif ! if hydrology state variable or uncoupled solution
+
+
+ ! compute the critical soil temperature below which ice exists
+ select case(ixDomainType)
+ case(iname_veg, iname_snow); Tcrit = Tfreeze
+ case(iname_soil); Tcrit = crit_soilT( mLayerMatricHeadTrial(ixControlIndex) )
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! initialize temperature
+ select case(ixDomainType)
+ case(iname_veg); xTemp = scalarCanopyTempTrial
+ case(iname_snow, iname_soil); xTemp = mLayerTempTrial(iLayer)
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select
+
+ ! define brackets for the root
+ ! NOTE: start with an enormous range; updated quickly in the iterations
+ tempMin = xTemp - 10._rkind
+ tempMax = xTemp + 10._rkind
+
+ ! get iterations (set to maximum iterations if adjusting the temperature)
+ niter = merge(maxiter, 1, do_adjustTemp)
+
+ ! iterate
+ iterations: do iter=1,niter
+
+ ! restrict temperature
+ if(xTemp <= tempMin .or. xTemp >= tempMax)then
+ xTemp = 0.5_rkind*(tempMin + tempMax) ! new value
+ bFlag = .true.
+ else
+ bFlag = .false.
+ endif
+
+ ! -----
+ ! - compute derivatives...
+ ! ------------------------
+
+ ! compute the derivative in total water content w.r.t. total water matric potential (m-1)
+ ! NOTE 1: valid for frozen and unfrozen conditions
+ ! NOTE 2: for case "iname_lmpLayer", dVolTot_dPsi0 = dVolLiq_dPsi
+ if(ixDomainType==iname_soil)then
+ select case( ixStateType(ixFullVector) )
+ case(iname_lmpLayer); dVolTot_dPsi0(ixControlIndex) = dTheta_dPsi(mLayerMatricHeadLiqTrial(ixControlIndex),vGn_alpha(ixControlIndex),0._rkind,1._rkind,vGn_n(ixControlIndex),vGn_m(ixControlIndex))*avPore
+ case default; dVolTot_dPsi0(ixControlIndex) = dTheta_dPsi(mLayerMatricHeadTrial(ixControlIndex),vGn_alpha(ixControlIndex),theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ end select
+ endif
+
+ ! compute the derivative in liquid water content w.r.t. temperature
+ ! --> partially frozen: dependence of liquid water on temperature
+ if(xTemp<Tcrit)then
+ select case(ixDomainType)
+ case(iname_veg); dTheta_dTkCanopy = dFracLiq_dTk(xTemp,snowfrz_scale)*scalarCanopyWat/(iden_water*canopyDepth)
+ case(iname_snow); mLayerdTheta_dTk(iLayer) = dFracLiq_dTk(xTemp,snowfrz_scale)*mLayerVolFracWatTrial(iLayer)
+ case(iname_soil); mLayerdTheta_dTk(iLayer) = dTheta_dTk(xTemp,theta_res(ixControlIndex),theta_sat(ixControlIndex),vGn_alpha(ixControlIndex),vGn_n(ixControlIndex),vGn_m(ixControlIndex))
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select ! domain type
+
+ ! --> unfrozen: no dependence of liquid water on temperature
+ else
+ select case(ixDomainType)
+ case(iname_veg); dTheta_dTkCanopy = 0._rkind
+ case(iname_snow, iname_soil); mLayerdTheta_dTk(iLayer) = 0._rkind
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select ! domain type
+ endif
+
+
+
+
+ ! -----
+ ! - update volumetric fraction of liquid water and ice...
+ ! => case of hydrology state uncoupled with energy (and when not adjusting the temperature)...
+ ! -----------------------------------------------------------------------------------------------
+
+ ! case of hydrology state uncoupled with energy (and when not adjusting the temperature)
+ if(.not.do_adjustTemp .and. .not.isNrgState .and. .not.isCoupled)then
+ ! compute the fraction of snow
+ select case(ixDomainType)
+ case(iname_veg); scalarFracLiqVeg = fracliquid(xTemp,snowfrz_scale)
+ case(iname_snow); mLayerFracLiqSnow(iLayer) = fracliquid(xTemp,snowfrz_scale)
+ case(iname_soil) ! do nothing
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+ end select ! domain type
+
+ ! -----
+ ! - update volumetric fraction of liquid water and ice...
+ ! => case of energy state or coupled solution (or adjusting the temperature)...
+ ! --------------------------------------------------------------------------------
+
+ ! case of energy state OR coupled solution (or adjusting the temperature)
+ elseif(do_adjustTemp .or. ( (isNrgState .or. isCoupled) ) )then
+
+ ! identify domain type
+ select case(ixDomainType)
+
+ ! *** vegetation canopy
+ case(iname_veg)
+ ! compute mass of liquid water and ice
+ call updateVegSundials(&
+ xTemp, & ! intent(in) : temperature (K)
+ scalarCanopyWatTrial, & ! intent(in) : mass of total water (-)
+ snowfrz_scale, & ! intent(in) : scaling parameter for the snow freezing curve (K-1)
+ scalarCanopyTempPrime, & ! intent(in)
+ scalarCanopyWatPrime, & ! intent(in) : mass of total water (-)
+ scalarCanopyLiqTrial, & ! intent(out) : trial mass of liquid water (-)
+ scalarCanopyIceTrial, & ! intent(out) : trial mass of ice (-)
+ scalarCanopyLiqPrime, & ! intent(out) : trial mass of liquid water (-)
+ scalarCanopyIcePrime, & ! intent(out) : trial mass of ice (-)
+ scalarFracLiqVeg, & ! intent(out) : fraction of liquid water (-)
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** snow layers
+ case(iname_snow)
+
+ call updateSnowSundials(&
+ xTemp, & ! intent(in) : temperature (K)
+ mLayerVolFracWatTrial(iLayer), & ! intent(in) : mass state variable = trial volumetric fraction of water (-)
+ snowfrz_scale, & ! intent(in) : scaling parameter for the snow freezing curve (K-1)
+ mLayerTempPrime(iLayer), & !
+ mLayerVolFracWatPrime(iLayer), & ! intent(in)
+ mLayerVolFracLiqTrial(iLayer), & ! intent(out) : trial volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer), & ! intent(out) : trial volumetric fraction if ice (-)
+ mLayerVolFracLiqPrime(iLayer), & ! intent(out)
+ mLayerVolFracIcePrime(iLayer), & ! intent(out)
+ mLayerFracLiqSnow(iLayer), & ! intent(out) : fraction of liquid water (-)
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** soil layers
+ case(iname_soil)
+
+ ! compute volumetric fraction of liquid water and ice, step size dt_cur changes here
+ call updateSoilSundials(&
+ dt_cur, &
+ xTemp, & ! intent(in) : temperature (K)
+ mLayerMatricHeadTrial(ixControlIndex), & ! intent(in) : total water matric potential (m)
+ mLayerMatricHeadPrev(ixControlIndex), & ! intent(in)
+ mLayerVolFracWatPrev(iLayer), & ! intent(in)
+ mLayerTempPrime(iLayer), &
+ mLayerMatricHeadPrime(ixControlIndex), &
+ ! intent(in) : soil parameters
+ vGn_alpha(ixControlIndex), &
+ vGn_n(ixControlIndex), &
+ theta_sat(ixControlIndex), &
+ theta_res(ixControlIndex), &
+ vGn_m(ixControlIndex), &
+ mLayerVolFracWatTrial(iLayer), & ! intent(in) : mass state variable = trial volumetric fraction of water (-)
+ mLayerVolFracLiqTrial(iLayer), & ! intent(out) : trial volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer), & ! intent(out) : trial volumetric fraction if ice (-)
+ mLayerVolFracWatPrime(iLayer), &
+ mLayerVolFracLiqPrime(iLayer), &
+ mLayerVolFracIcePrime(iLayer), &
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! check
+ case default; err=20; message=trim(message)//'expect case to be iname_veg, iname_snow, iname_soil'; return
+
+ end select ! domain type
+
+ ! final check
+ else
+
+ ! do nothing (input = output) -- and check that we got here correctly
+ if( (isNrgState .or. isCoupled) )then
+ scalarVolFracLiq = realMissing
+ scalarVolFracIce = realMissing
+ else
+ message=trim(message)//'unexpected else branch'
+ err=20; return
+ endif
+
+ endif ! if energy state or solution is coupled
+
+ ! -----
+ ! - update temperatures...
+ ! ------------------------
+
+
+ end do iterations ! iterating
+
+ ! save temperature
+ select case(ixDomainType)
+ case(iname_veg); scalarCanopyTempTrial = xTemp
+ case(iname_snow, iname_soil); mLayerTempTrial(iLayer) = xTemp
+ end select
+
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+
+ ! -----
+ ! - compute the liquid water matric potential (and necessay derivatives)...
+ ! -------------------------------------------------------------------------
+
+ ! only for soil
+ if(ixDomainType==iname_soil)then
+
+ ! check liquid water
+ if(mLayerVolFracLiqTrial(iLayer) > theta_sat(ixControlIndex) )then
+ message=trim(message)//'liquid water greater than porosity'
+ err=20; return
+ endif
+
+ ! case of hydrology state uncoupled with energy
+ if(.not.isNrgState .and. .not.isCoupled)then
+
+ ! derivatives relating liquid water matric potential to total water matric potential and temperature
+ dPsiLiq_dPsi0(ixControlIndex) = 1._rkind ! exact correspondence (psiLiq=psi0)
+ dPsiLiq_dTemp(ixControlIndex) = 0._rkind ! no relationship between liquid water matric potential and temperature
+
+ ! case of energy state or coupled solution
+ else
+ ! compute the liquid matric potential (and the derivatives w.r.t. total matric potential and temperature)
+ call liquidHeadSundials(&
+ ! input
+ mLayerMatricHeadTrial(ixControlIndex) ,& ! intent(in) : total water matric potential (m)
+ mLayerMatricHeadPrime(ixControlIndex) ,& !
+ mLayerVolFracLiqTrial(iLayer) ,& ! intent(in) : volumetric fraction of liquid water (-)
+ mLayerVolFracIceTrial(iLayer) ,& ! intent(in) : volumetric fraction of ice (-)
+ 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
+ mLayerMatricHeadLiqTrial(ixControlIndex) ,& ! intent(out): liquid water matric potential (m)
+ mLayerMatricHeadLiqPrime(ixControlIndex) ,& !
+ dPsiLiq_dPsi0(ixControlIndex) ,& ! intent(out): derivative in the liquid water matric potential w.r.t. the total water matric potential (-)
+ dPsiLiq_dTemp(ixControlIndex) ,& ! intent(out): derivative in the liquid water matric potential w.r.t. temperature (m K-1)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ endif ! switch between hydrology and energy state
+
+ endif ! if domain is soil
+
+ end do ! looping through state variables
+
+ ! deallocate space
+ deallocate(computedCoupling,stat=err) ! .true. if computed the coupling for a given state variable
+ if(err/=0)then; message=trim(message)//'problem deallocating computedCoupling'; return; endif
+
+ ! end association to the variables in the data structures
+ end associate
+
+ end subroutine updateVarsSundials
+
+
+end module updateVarsSundials_module
diff --git a/build/source/engine/sundials/varExtrSundials.f90 b/build/source/engine/sundials/varExtrSundials.f90
new file mode 100644
index 0000000..0760b51
--- /dev/null
+++ b/build/source/engine/sundials/varExtrSundials.f90
@@ -0,0 +1,515 @@
+
+
+module varExtrSundials_module
+
+! data types
+USE nrtype
+
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation canopy
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! 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
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:iname_watAquifer ! named variable defining the water storage in the aquifer
+
+! metadata for information in the data structures
+USE globalData,only:indx_meta ! metadata for the variables in the index structure
+
+! constants
+USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! 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
+
+! provide access to routines to update states
+USE updatState_module,only:updateSnow ! update snow states
+USE updatState_module,only:updateSoil ! update soil states
+
+! provide access to functions for the constitutive functions and derivatives
+USE snow_utils_module,only:fracliquid ! compute the fraction of liquid water (snow)
+USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+USE soil_utils_module,only:dTheta_dTk ! differentiate the freezing curve w.r.t. temperature (soil)
+USE soil_utils_module,only:dTheta_dPsi ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:dPsi_dTheta ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
+
+implicit none
+private
+public::varExtract2
+public::varExtractSundials
+public::residDiscontinuity
+public::countDiscontinuity
+
+
+contains
+
+
+ ! **********************************************************************************************************
+ ! public subroutine varExtract2: extract variables from the state vector and compute diagnostic variables
+ ! This routine does not initialize any of the variables and is to be used inside the Sundials iteration, vs varExtract
+ ! **********************************************************************************************************
+ subroutine varExtract2(&
+ ! 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: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial, & ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ 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
+ ! output: variables for the vegetation canopy
+ real(rkind),intent(out) :: scalarCanairTempTrial ! trial value of canopy air temperature (K)
+ real(rkind),intent(out) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ real(rkind),intent(out) :: scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ real(rkind),intent(out) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(out) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(out) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(out) :: mLayerMatricHeadLiqTrial(:) ! trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ real(rkind),intent(out) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+)! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='varExtract2/'
+
+ ! *** extract state variables for the vegetation canopy
+
+
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing .or. ixVegHyd/=integerMissing)then
+
+ ! extract temperature of the canopy air space
+ if(ixCasNrg/=integerMissing) scalarCanairTempTrial = stateVec(ixCasNrg)
+
+ ! extract canopy temperature
+ if(ixVegNrg/=integerMissing) scalarCanopyTempTrial = stateVec(ixVegNrg)
+
+ ! extract intercepted water
+ if(ixVegHyd/=integerMissing)then
+ select case( ixStateType_subset(ixVegHyd) )
+ case(iname_liqCanopy); scalarCanopyLiqTrial = stateVec(ixVegHyd)
+ case(iname_watCanopy); scalarCanopyWatTrial = stateVec(ixVegHyd)
+ case default; err=20; message=trim(message)//'case not found: expect iname_liqCanopy or iname_watCanopy'; return
+ end select
+ endif
+
+ endif ! not computing the vegetation flux
+
+ ! *** extract state variables from the snow+soil sub-domain
+
+
+ ! overwrite with the energy values from the state vector
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ mLayerTempTrial(iLayer) = stateVec( ixSnowSoilNrg(iLayer) )
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! overwrite with the hydrology values from the state vector
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); mLayerVolFracWatTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
+ case(iname_liqLayer); mLayerVolFracLiqTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
+ case(iname_matLayer); mLayerMatricHeadTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
+ case(iname_lmpLayer); mLayerMatricHeadLiqTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
+ case default ! do nothing
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! extract temperature of the canopy air space
+ if(ixAqWat/=integerMissing) scalarAquiferStorageTrial = stateVec(ixAqWat)
+
+ end associate
+
+ end subroutine varExtract2
+
+ ! **********************************************************************************************************
+ ! public subroutine varExtractSundials: extract prime variables from the state vector and compute diagnostic variables
+ ! **********************************************************************************************************
+ subroutine varExtractSundials(&
+ ! input
+ stateVecPrime, & ! 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: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime, & ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input
+ real(rkind),intent(in) :: stateVecPrime(:) ! 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
+ ! output: variables for the vegetation canopy
+ real(rkind),intent(out) :: scalarCanairTempPrime ! trial value of canopy air temperature (K)
+ real(rkind),intent(out) :: scalarCanopyTempPrime ! trial value of canopy temperature (K)
+ real(rkind),intent(out) :: scalarCanopyWatPrime ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyLiqPrime ! trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ real(rkind),intent(out) :: mLayerTempPrime(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(out) :: mLayerVolFracWatPrime(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqPrime(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(out) :: mLayerMatricHeadPrime(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(out) :: mLayerMatricHeadLiqPrime(:) ! trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ real(rkind),intent(out) :: scalarAquiferStoragePrime ! trial value of storage of water in the aquifer (m)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+) ! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='varExtractSundials/'
+
+
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing .or. ixVegHyd/=integerMissing)then
+
+ ! extract temperature of the canopy air space
+ if(ixCasNrg/=integerMissing) scalarCanairTempPrime = stateVecPrime(ixCasNrg)
+
+ ! extract canopy temperature
+ if(ixVegNrg/=integerMissing) scalarCanopyTempPrime = stateVecPrime(ixVegNrg)
+
+ ! extract intercepted water
+ if(ixVegHyd/=integerMissing)then
+ select case( ixStateType_subset(ixVegHyd) )
+ case(iname_liqCanopy); scalarCanopyLiqPrime = stateVecPrime(ixVegHyd)
+ case(iname_watCanopy); scalarCanopyWatPrime = stateVecPrime(ixVegHyd)
+ case default; err=20; message=trim(message)//'case not found: expect iname_liqCanopy or iname_watCanopy'; return
+ end select
+ endif
+
+ endif ! not computing the vegetation flux
+
+
+ ! overwrite with the energy values from the state vector
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ mLayerTempPrime(iLayer) = stateVecPrime( ixSnowSoilNrg(iLayer) )
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! overwrite with the hydrology values from the state vector
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); mLayerVolFracWatPrime(iLayer) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
+ case(iname_liqLayer); mLayerVolFracLiqPrime(iLayer) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
+ case(iname_matLayer); mLayerMatricHeadPrime(iLayer-nSnow) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
+ case(iname_lmpLayer); mLayerMatricHeadLiqPrime(iLayer-nSnow) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
+ case default ! do nothing
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! extract temperature of the canopy air space
+ if(ixAqWat/=integerMissing) scalarAquiferStoragePrime = stateVecPrime(ixAqWat)
+
+ end associate
+
+ end subroutine varExtractSundials
+
+
+ ! **********************************************************************************************************
+ ! public subroutine residDiscontinuity:
+ ! **********************************************************************************************************
+ 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)
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ 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
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: iCount
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+)! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='residDiscontinuity/'
+
+ iCount = 1
+
+
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing)then
+
+ ! temperature of the canopy air space
+ if(ixCasNrg/=integerMissing)then
+ resid(iCount) = stateVec(ixCasNrg) - Tfreeze ! scalarCanairTempTrial - Tfreeze
+ iCount = iCount + 1
+ endif
+
+ ! canopy temperature
+ if(ixVegNrg/=integerMissing)then
+ resid(iCount) = stateVec(ixVegNrg) - Tfreeze ! scalarCanopyTempTrial - Tfreeze
+ iCount = iCount + 1
+ endif
+
+
+ endif ! not computing the vegetation flux
+
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ resid( iCount ) = stateVec( ixSnowSoilNrg(iLayer) ) - Tfreeze ! mLayerTempTrial(iLayer) - Tfreeze
+ iCount = iCount + 1
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ end associate
+
+
+ end subroutine residDiscontinuity
+
+ ! **********************************************************************************************************
+ ! public subroutine countDiscontinuity:
+ ! **********************************************************************************************************
+ 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)
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ 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
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+)! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='countDiscontinuity/'
+
+ ! *** extract state variables for the vegetation canopy
+
+ countD = 0
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing)then
+
+ ! temperature of the canopy air space
+ if(ixCasNrg/=integerMissing) countD = countD + 1
+
+ ! canopy temperature
+ if(ixVegNrg/=integerMissing) countD = countD + 1
+
+
+ endif ! not computing the vegetation flux
+
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ countD = countD + 1
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ end associate
+
+ end subroutine countDiscontinuity
+
+
+
+end module varExtrSundials_module
diff --git a/build/source/engine/sundials/varSubstepSundials.f90 b/build/source/engine/sundials/varSubstepSundials.f90
new file mode 100644
index 0000000..9b857f7
--- /dev/null
+++ b/build/source/engine/sundials/varSubstepSundials.f90
@@ -0,0 +1,1094 @@
+! SUMMA - Structure for Unifying Multiple Modeling Alternatives
+! Copyright (C) 2014-2015 NCAR/RAL
+!
+! 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 varSubstepSundials_module
+
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for the canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! global metadata
+USE globalData,only:flux_meta ! metadata on the model fluxes
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_flagVec, & ! data vector with variable length dimension (i4b)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! 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
+
+! look up structure for variable types
+USE var_lookup,only:iLookVarType
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! freezing temperature (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water, & ! intrinsic density of liquid 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)
+
+! safety: set private unless specified otherwise
+implicit none
+private
+public::varSubstepSundials
+
+! algorithmic parameters
+real(rkind),parameter :: verySmall=1.e-6_rkind ! used as an additive constant to check if substantial difference among real numbers
+
+contains
+
+
+! **********************************************************************************************************
+! public subroutine varSubstepSundials: run the model for a collection of substeps for a given state subset
+! **********************************************************************************************************
+subroutine varSubstepSundials(&
+ ! input: model control
+ dt, & ! intent(in) : time step (s)
+ dtInit, & ! intent(in) : initial time step (seconds)
+ dt_min, & ! intent(in) : minimum time step (seconds)
+ nState, & ! intent(in) : total number of state variables
+ doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
+ firstSubStep, & ! intent(in) : flag to denote first sub-step
+ firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
+ computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
+ scalarSolution, & ! intent(in) : flag to denote implementing the scalar solution
+ iStateSplit, & ! intent(in) : index of the state in the splitting operation
+ fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
+ fluxCount, & ! intent(inout) : number of times that fluxes are updated (should equal nSubsteps)
+ ! input/output: data structures
+ model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
+ type_data, & ! intent(in) : type of vegetation and soil
+ attr_data, & ! intent(in) : spatial attributes
+ forc_data, & ! intent(in) : model forcing data
+ mpar_data, & ! intent(in) : model parameters
+ indx_data, & ! intent(inout) : index data
+ 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
+ deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
+ bvar_data, & ! intent(in) : model variables for the local basin
+ ! output: model control
+ ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dtMultiplier, & ! intent(out) : substep multiplier (-)
+ nSubsteps, & ! intent(out) : number of substeps taken for a given split
+ failedMinimumStep, & ! intent(out) : flag to denote success of substepping for a given split
+ reduceCoupledStep, & ! intent(out) : flag to denote need to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
+ dt_out, & ! intent(out)
+ err,message) ! intent(out) : error code and error message
+ ! ---------------------------------------------------------------------------------------
+ ! structure allocations
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ ! simulation of fluxes and residuals given a trial state vector
+ USE systemSolv_module,only:systemSolv ! solve the system of equations for one time step
+ USE getVectorz_module,only:popStateVec ! populate the state vector
+ USE getVectorz_module,only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
+ USE varExtrSundials_module, only:varExtractSundials
+ ! identify name of variable type (for error message)
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+ USE systemSolvSundials_module,only:systemSolvSundials
+ implicit none
+ ! ---------------------------------------------------------------------------------------
+ ! * dummy variables
+ ! ---------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt ! time step (seconds)
+ real(rkind),intent(in) :: dtInit ! initial time step (seconds)
+ real(rkind),intent(in) :: dt_min ! minimum time step (seconds)
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: doAdjustTemp ! flag to indicate if we adjust the temperature
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall ! flag to define the first flux call
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote implementing the scalar solution
+ integer(i4b),intent(in) :: iStateSplit ! index of the state in the splitting operation
+ type(var_flagVec),intent(in) :: fluxMask ! flags to denote if the flux is calculated in the given state subset
+ type(var_ilength),intent(inout) :: fluxCount ! number of times that the flux is updated (should equal nSubsteps)
+ ! input/output: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i),intent(in) :: type_data ! type of vegetation and soil
+ type(var_d),intent(in) :: attr_data ! spatial attributes
+ type(var_d),intent(in) :: forc_data ! model forcing data
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: 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
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
+ ! output: model control
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ real(rkind),intent(out) :: dtMultiplier ! substep multiplier (-)
+ integer(i4b),intent(out) :: nSubsteps ! number of substeps taken for a given split
+ logical(lgt),intent(out) :: failedMinimumStep ! flag to denote success of substepping for a given split
+ logical(lgt),intent(out) :: reduceCoupledStep ! flag to denote need to reduce the length of the coupled step
+ logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that ice is insufficient to support melt
+ real(qp),intent(out) :: dt_out
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ---------------------------------------------------------------------------------------
+ ! * general local variables
+ ! ---------------------------------------------------------------------------------------
+ ! error control
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ ! general local variables
+ integer(i4b) :: iVar ! index of variables in data structures
+ integer(i4b) :: iSoil ! index of soil layers
+ integer(i4b) :: ixLayer ! index in a given domain
+ integer(i4b), dimension(1) :: ixMin,ixMax ! bounds of a given flux vector
+ ! time stepping
+ real(rkind) :: dtSum ! sum of time from successful steps (seconds)
+ real(rkind) :: dt_wght ! weight given to a given flux calculation
+ real(rkind) :: dtSubstep ! length of a substep (s)
+ ! adaptive sub-stepping for the explicit solution
+ logical(lgt) :: failedSubstep ! flag to denote success of substepping for a given split
+ real(rkind),parameter :: safety=0.85_rkind ! safety factor in adaptive sub-stepping
+ real(rkind),parameter :: reduceMin=0.1_rkind ! mimimum factor that time step is reduced
+ real(rkind),parameter :: increaseMax=4.0_rkind ! maximum factor that time step is increased
+ ! adaptive sub-stepping for the implicit solution
+ integer(i4b),parameter :: n_inc=5 ! minimum number of iterations to increase time step
+ integer(i4b),parameter :: n_dec=15 ! maximum number of iterations to decrease time step
+ real(rkind),parameter :: F_inc = 1.25_rkind ! factor used to increase time step
+ real(rkind),parameter :: F_dec = 0.90_rkind ! factor used to decrease time step
+ ! state and flux vectors
+ real(rkind) :: untappedMelt(nState) ! un-tapped melt energy (J m-3 s-1)
+ real(rkind) :: stateVecInit(nState) ! initial state vector (mixed units)
+ real(rkind) :: stateVecTrial(nState) ! trial state vector (mixed units)
+ real(rkind) :: stateVecPrime(nState) ! trial state vector (mixed units)
+ type(var_dlength) :: flux_temp ! temporary model fluxes
+ ! flags
+ logical(lgt) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt) :: checkMassBalance ! flag to check the mass balance
+ logical(lgt) :: checkNrgBalance
+ logical(lgt) :: waterBalanceError ! flag to denote that there is a water balance error
+ logical(lgt) :: nrgFluxModified ! flag to denote that the energy fluxes were modified
+ ! energy fluxes
+ real(rkind) :: sumCanopyEvaporation ! sum of canopy evaporation/condensation (kg m-2 s-1)
+ real(rkind) :: sumLatHeatCanopyEvap ! sum of latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ real(rkind) :: sumSenHeatCanopy ! sum of sensible heat flux from the canopy to the canopy air space (W m-2)
+ real(rkind) :: sumSoilCompress
+ real(rkind),allocatable :: sumLayerCompress(:)
+ ! ---------------------------------------------------------------------------------------
+ ! point to variables in the data structures
+ ! ---------------------------------------------------------------------------------------
+ globalVars: associate(&
+ ! number of layers
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of layers
+ nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! mapping between state vectors and control volumes
+ ixLayerActive => indx_data%var(iLookINDEX%ixLayerActive)%dat ,& ! intent(in): [i4b(:)] list of indices for all active layers (inactive=integerMissing)
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ! model state variables (vegetation canopy)
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(inout): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(inout): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(inout): [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(inout): [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(inout): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(inout): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(inout): [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(inout): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(inout): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout): [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(inout): [dp(:)] matric potential of liquid water (m)
+ ) ! end association with variables in the data structures
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! Procedure starts here
+
+ ! initialize error control
+ err=0; message='varSubstepSundials/'
+
+ ! initialize flag for the success of the substepping
+ failedMinimumStep=.false.
+
+ ! initialize the length of the substep
+ dtSubstep = dtInit
+
+ ! allocate space for the temporary model flux structure
+ call allocLocal(flux_meta(:),flux_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then
+ err=20
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ endif
+
+ ! initialize the model fluxes (some model fluxes are not computed in the iterations)
+ do iVar=1,size(flux_data%var)
+ flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
+ end do
+
+ ! initialize the total energy fluxes (modified in updateProgSundials)
+ sumCanopyEvaporation = 0._rkind ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = 0._rkind ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ sumSenHeatCanopy = 0._rkind ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ sumSoilCompress = 0._rkind ! total soil compression
+ allocate(sumLayerCompress(nSoil)); sumLayerCompress = 0._rkind ! soil compression by layer
+
+ ! define the first flux call in a splitting operation
+ firstSplitOper = (.not.scalarSolution .or. iStateSplit==1)
+
+ ! initialize subStep
+ dtSum = 0._rkind ! keep track of the portion of the time step that is completed
+ nSubsteps = 0
+
+ ! loop through substeps
+ ! NOTE: continuous do statement with exit clause
+ substeps: do
+
+ ! initialize error control
+ err=0; message='varSubstepSundials/'
+
+ !write(*,'(a,1x,3(f13.2,1x))') '***** new subStep: dtSubstep, dtSum, dt = ', dtSubstep, dtSum, dt
+ !print*, 'scalarCanopyIce = ', prog_data%var(iLookPROG%scalarCanopyIce)%dat(1)
+ !print*, 'scalarCanopyTemp = ', prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1)
+
+ ! -----
+ ! * populate state vectors...
+ ! ---------------------------
+
+ ! initialize state vectors
+ call popStateVec(&
+ ! input
+ nState, & ! intent(in): number of desired state variables
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ stateVecInit, & ! intent(out): initial model state vector (mixed units)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! -----
+ ! * iterative solution...
+ ! -----------------------
+ ! solve the system of equations for a given state subset
+ call systemSolvSundials(&
+ ! input: model control
+ dtSubstep, & ! intent(in): time step (s)
+ nState, & ! intent(in): total number of state variables
+ firstSubStep, & ! intent(in): flag to denote first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
+ scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ forc_data, & ! intent(in): model forcing data
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(inout): index data
+ prog_data, & ! intent(inout): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ bvar_data, & ! intent(in): model variables for the local basin
+ model_decisions, & ! intent(in): model decisions
+ stateVecInit, & ! intent(in): initial state vector
+ ! output: model control
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ stateVecTrial, & ! intent(out): updated state vector
+ stateVecPrime, & ! intent(out): updated state vector
+ reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out): flag to denote that ice is insufficient to support melt
+ dt_out, & ! intent(out): time step (s)
+ err,cmessage) ! intent(out): error code and error message
+
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ if(err>0) return
+ endif
+
+ ! set untapped melt energy to zero
+ untappedMelt(:) = 0._rkind
+
+ ! if too much melt or need to reduce length of the coupled step then return
+ ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
+ if(tooMuchMelt .or. reduceCoupledStep) return
+
+ ! identify failure
+ failedSubstep = (err<0)
+
+ ! reduce step based on failure
+ if(failedSubstep)then
+ err=0; message='varSubstepSundials/' ! recover from failed convergence
+ dtMultiplier = 0.5_rkind ! system failure: step halving
+ else
+
+ endif ! switch between failure and success
+
+ ! check if we failed the substep
+ if(failedSubstep)then
+
+ ! check that the substep is greater than the minimum step
+ if(dtSubstep*dtMultiplier<dt_min)then
+ ! --> exit, and either (1) try another solution method; or (2) reduce coupled step
+ failedMinimumStep=.true.
+ exit subSteps
+
+ else ! step is still OK
+ dtSubstep = dtSubstep*dtMultiplier
+ cycle subSteps
+ endif ! if step is less than the minimum
+
+ endif ! if failed the substep
+
+ ! -----
+ ! * update model fluxes...
+ ! ------------------------
+
+ ! NOTE: if we get to here then we are accepting the step
+
+ ! NOTE: we get to here if iterations are successful
+ if(err/=0)then
+ message=trim(message)//'expect err=0 if updating fluxes'
+ return
+ endif
+
+ ! identify the need to check the mass balance
+ checkMassBalance = .true. ! (.not.scalarSolution)
+ checkNrgBalance = .true.
+
+ ! update prognostic variables
+ call updateProgSundials(dt_out,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,stateVecPrime,checkMassBalance, checkNrgBalance, & ! input: model control
+ lookup_data,mpar_data,indx_data,flux_temp,prog_data,diag_data,deriv_data, & ! input-output: data structures
+ waterBalanceError,nrgFluxModified,err,cmessage) ! output: flags and error control
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ if(err>0) return
+ endif
+
+ ! if water balance error then reduce the length of the coupled step
+ if(waterBalanceError)then
+ message=trim(message)//'water balance error'
+ reduceCoupledStep=.true.
+ err=-20; return
+ endif
+
+ if(globalPrintFlag)&
+ print*, trim(cmessage)//': dt = ', dtSubstep
+
+ ! recover from errors in prognostic update
+ if(err<0)then
+
+ ! modify step
+ err=0 ! error recovery
+ dtSubstep = dtSubstep/2._rkind
+
+ ! check minimum: fail minimum step if there is an error in the update
+ if(dtSubstep<dt_min)then
+ failedMinimumStep=.true.
+ exit subSteps
+ ! minimum OK -- try again
+ else
+ cycle substeps
+ endif
+
+ endif ! if errors in prognostic update
+
+ ! get the total energy fluxes (modified in updateProgSundials)
+ if(nrgFluxModified .or. indx_data%var(iLookINDEX%ixVegNrg)%dat(1)/=integerMissing)then
+ sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_temp%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_temp%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_temp%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ else
+ sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ endif ! if energy fluxes were modified
+
+ ! get the total soil compression
+ if (count(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat/=integerMissing)>0) then
+ ! scalar compression
+ if(.not.scalarSolution .or. iStateSplit==nSoil)&
+ sumSoilCompress = sumSoilCompress + diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ! total soil compression
+ ! vector compression
+ do iSoil=1,nSoil
+ if(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat(iSoil)/=integerMissing)&
+ sumLayerCompress(iSoil) = sumLayerCompress(iSoil) + diag_data%var(iLookDIAG%mLayerCompress)%dat(iSoil) ! soil compression in layers
+ end do
+ endif
+
+ ! print progress
+ if(globalPrintFlag)&
+ write(*,'(a,1x,3(f13.2,1x))') 'updating: dtSubstep, dtSum, dt = ', dtSubstep, dtSum, dt
+
+ ! increment fluxes
+ dt_wght = 1._qp !dt_out/dt ! (define weight applied to each splitting operation)
+ do iVar=1,size(flux_meta)
+ if(count(fluxMask%var(iVar)%dat)>0) then
+
+ !print*, flux_meta(iVar)%varname, fluxMask%var(iVar)%dat
+
+ ! ** no domain splitting
+ if(count(ixLayerActive/=integerMissing)==nLayers)then
+ flux_data%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:) + flux_temp%var(iVar)%dat(:)*dt_wght
+ fluxCount%var(iVar)%dat(:) = fluxCount%var(iVar)%dat(:) + 1
+
+ ! ** domain splitting
+ else
+ ixMin=lbound(flux_data%var(iVar)%dat)
+ ixMax=ubound(flux_data%var(iVar)%dat)
+ do ixLayer=ixMin(1),ixMax(1)
+ if(fluxMask%var(iVar)%dat(ixLayer)) then
+ flux_data%var(iVar)%dat(ixLayer) = flux_data%var(iVar)%dat(ixLayer) + flux_temp%var(iVar)%dat(ixLayer)*dt_wght
+ fluxCount%var(iVar)%dat(ixLayer) = fluxCount%var(iVar)%dat(ixLayer) + 1
+ endif
+ end do
+ endif ! (domain splitting)
+
+ endif ! (if the flux is desired)
+ end do ! (loop through fluxes)
+
+ ! ------------------------------------------------------
+ ! ------------------------------------------------------
+
+ ! increment the number of substeps
+ nSubsteps = nSubsteps+1
+
+ ! increment the sub-step legth
+ dtSum = dtSum + dtSubstep
+ !print*, 'dtSum, dtSubstep, dt, nSubsteps = ', dtSum, dtSubstep, dt, nSubsteps
+
+ ! check that we have completed the sub-step
+ if(dtSum >= dt-verySmall)then
+ failedMinimumStep=.false.
+ exit subSteps
+ endif
+
+ ! adjust length of the sub-step (make sure that we don't exceed the step)
+ dtSubstep = min(dt - dtSum, max(dtSubstep*dtMultiplier, dt_min) )
+
+ end do substeps ! time steps for variable-dependent sub-stepping
+
+ ! save the energy fluxes
+ flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) = sumCanopyEvaporation /dt_out ! canopy evaporation/condensation (kg m-2 s-1)
+ flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) = sumLatHeatCanopyEvap /dt_out ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) = sumSenHeatCanopy /dt_out ! sensible heat flux from the canopy to the canopy air space (W m-2)
+
+ ! save the soil compression diagnostics
+ diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) = sumSoilCompress
+ do iSoil=1,nSoil
+ if(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat(iSoil)/=integerMissing)&
+ diag_data%var(iLookDIAG%mLayerCompress)%dat(iSoil) = sumLayerCompress(iSoil)
+ end do
+ deallocate(sumLayerCompress)
+
+ ! end associate statements
+ end associate globalVars
+
+ ! update error codes
+ if(failedMinimumStep)then
+ err=-20 ! negative = recoverable error
+ message=trim(message)//'failed minimum step'
+ endif
+
+
+ end subroutine varSubstepSundials
+
+
+! **********************************************************************************************************
+! private subroutine updateProgSundials: update prognostic variables
+! **********************************************************************************************************
+subroutine updateProgSundials(dt,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,stateVecPrime,checkMassBalance, checkNrgBalance, & ! input: model control
+ lookup_data,mpar_data,indx_data,flux_data,prog_data,diag_data,deriv_data, & ! input-output: data structures
+ waterBalanceError,nrgFluxModified,err,message) ! output: flags and error control
+ USE getVectorz_module,only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
+ USE varExtrSundials_module, only:varExtractSundials
+ USE computEnthalpy_module,only:computEnthalpy
+ USE t2enthalpy_module, only:t2enthalpy ! compute enthalpy
+ implicit none
+ ! model control
+ real(rkind) ,intent(in) :: dt ! time step (s)
+ integer(i4b) ,intent(in) :: nSnow ! number of snow layers
+ integer(i4b) ,intent(in) :: nSoil ! number of soil layers
+ integer(i4b) ,intent(in) :: nLayers ! total number of layers
+ logical(lgt) ,intent(in) :: doAdjustTemp ! flag to indicate if we adjust the temperature
+ logical(lgt) ,intent(in) :: computeVegFlux ! flag to compute the vegetation flux
+ real(rkind) ,intent(in) :: untappedMelt(:) ! un-tapped melt energy (J m-3 s-1)
+ real(rkind) ,intent(in) :: stateVecTrial(:) ! trial state vector (mixed units)
+ real(rkind) ,intent(in) :: stateVecPrime(:) ! trial state vector (mixed units)
+ logical(lgt) ,intent(in) :: checkMassBalance ! flag to check the mass balance
+ logical(lgt) ,intent(in) :: checkNrgBalance ! flag to check the energy balance
+ ! data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: 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) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! flags and error control
+ logical(lgt) ,intent(out) :: waterBalanceError ! flag to denote that there is a water balance error
+ logical(lgt) ,intent(out) :: nrgFluxModified ! flag to denote that the energy fluxes were modified
+ integer(i4b) ,intent(out) :: err ! error code
+ character(*) ,intent(out) :: message ! error message
+ ! ==================================================================================================================
+ ! general
+ integer(i4b) :: iState ! index of model state variable
+ integer(i4b) :: ixSubset ! index within the state subset
+ integer(i4b) :: ixFullVector ! index within full state vector
+ integer(i4b) :: ixControlIndex ! index within a given domain
+ real(rkind) :: volMelt ! volumetric melt (kg m-3)
+ real(rkind),parameter :: verySmall=epsilon(1._rkind)*2._rkind ! a very small number (deal with precision issues)
+ ! mass balance
+ real(rkind) :: canopyBalance0,canopyBalance1 ! canopy storage at start/end of time step
+ real(rkind) :: soilBalance0,soilBalance1 ! soil storage at start/end of time step
+ real(rkind) :: vertFlux ! change in storage due to vertical fluxes
+ real(rkind) :: tranSink,baseSink,compSink ! change in storage due to sink terms
+ real(rkind) :: liqError ! water balance error
+ real(rkind) :: fluxNet ! net water fluxes (kg m-2 s-1)
+ real(rkind) :: superflousWat ! superflous water used for evaporation (kg m-2 s-1)
+ real(rkind) :: superflousNrg ! superflous energy that cannot be used for evaporation (W m-2 [J m-2 s-1])
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ ! trial state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial vector for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial vector for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial vector for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial vector for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value for storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial vector for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial vector for volumetric fraction of ice (-)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! trial vector for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! trial vector for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! trial vector for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! trial vector for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! trial value for storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! trial vector for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! trial vector for volumetric fraction of ice (-)
+ real(rkind) :: scalarCanairEnthalpyTrial ! enthalpy of the canopy air space (J m-3)
+ real(rkind) :: scalarCanopyEnthalpyTrial ! enthalpy of the vegetation canopy (J m-3)
+ real(rkind),dimension(nLayers) :: mLayerEnthalpyTrial ! enthalpy of snow + soil (J m-3)
+ ! -------------------------------------------------------------------------------------------------------------------
+
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! point to flux variables in the data structure
+ associate(&
+ ! get indices for mass balance
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in) : [i4b] index of canopy hydrology state variable (mass)
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the soil domain
+ ! get indices for the un-tapped melt
+ ixNrgOnly => indx_data%var(iLookINDEX%ixNrgOnly)%dat ,& ! intent(in) : [i4b(:)] list of indices for all energy states
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ,& ! intent(in) : [i4b(:)] indices defining the domain of the state (iname_veg, iname_snow, iname_soil)
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in) : [i4b(:)] index of the control volume for different domains (veg, snow, soil)
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in) : [i4b(:)] [state subset] list of indices of the full state vector in the state subset
+ ! water fluxes
+ scalarRainfall => flux_data%var(iLookFLUX%scalarRainfall)%dat(1) ,& ! intent(in) : [dp] rainfall rate (kg m-2 s-1)
+ scalarThroughfallRain => flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) ,& ! intent(in) : [dp] rain reaches ground without touching the canopy (kg m-2 s-1)
+ scalarCanopyEvaporation => flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ,& ! intent(in) : [dp] canopy evaporation/condensation (kg m-2 s-1)
+ scalarCanopyTranspiration => flux_data%var(iLookFLUX%scalarCanopyTranspiration)%dat(1) ,& ! intent(in) : [dp] canopy transpiration (kg m-2 s-1)
+ scalarCanopyLiqDrainage => flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) ,& ! intent(in) : [dp] drainage liquid water from vegetation canopy (kg m-2 s-1)
+ iLayerLiqFluxSoil => flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat ,& ! intent(in) : [dp(0:)] vertical liquid water flux at soil layer interfaces (-)
+ iLayerNrgFlux => flux_data%var(iLookFLUX%iLayerNrgFlux)%dat ,& ! intent(in) :
+ mLayerNrgFlux => flux_data%var(iLookFLUX%mLayerNrgFlux)%dat ,& ! intent(out): [dp] net energy flux for each layer within the snow+soil domain (J m-3 s-1)
+ mLayerTranspire => flux_data%var(iLookFLUX%mLayerTranspire)%dat ,& ! intent(in) : [dp(:)] transpiration loss from each soil layer (m s-1)
+ mLayerBaseflow => flux_data%var(iLookFLUX%mLayerBaseflow)%dat ,& ! intent(in) : [dp(:)] baseflow from each soil layer (m s-1)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in) : [dp(:)] change in storage associated with compression of the soil matrix (-)
+ scalarCanopySublimation => flux_data%var(iLookFLUX%scalarCanopySublimation)%dat(1) ,& ! intent(in) : [dp] sublimation of ice from the vegetation canopy (kg m-2 s-1)
+ scalarSnowSublimation => flux_data%var(iLookFLUX%scalarSnowSublimation)%dat(1) ,& ! intent(in) : [dp] sublimation of ice from the snow surface (kg m-2 s-1)
+ ! energy fluxes
+ scalarLatHeatCanopyEvap => flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ,& ! intent(in) : [dp] latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ scalarSenHeatCanopy => flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ,& ! intent(in) : [dp] sensible heat flux from the canopy to the canopy air space (W m-2)
+ ! domain depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in) : [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in) : [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model state variables (vegetation canopy)
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(inout) : [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(inout) : [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(inout) : [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(inout) : [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(inout) : [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(inout) : [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout) : [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(inout) : [dp(:)] matric potential of liquid water (m)
+ ! enthalpy
+ scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(inout): [dp] enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(inout): [dp] enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(inout): [dp(:)] enthalpy of the snow+soil layers (J m-3)
+ ! model state variables (aquifer)
+ scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(inout) : [dp(:)] storage of water in the aquifer (m)
+ ! error tolerance
+ absConvTol_liquid => mpar_data%var(iLookPARAM%absConvTol_liquid)%dat(1) & ! intent(in) : [dp] absolute convergence tolerance for vol frac liq water (-)
+ ) ! associating flux variables in the data structure
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='updateProgSundials/'
+
+ ! initialize water balancmLayerVolFracWatTriale error
+ waterBalanceError=.false.
+
+ ! get storage at the start of the step
+ canopyBalance0 = merge(scalarCanopyWat, realMissing, computeVegFlux)
+ soilBalance0 = sum( (mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
+
+ ! -----
+ ! * update states...
+ ! ------------------
+ ! extract states from the state vector
+ call varExtract(&
+ ! input
+ stateVecTrial, & ! 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: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(out): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ call varExtractSundials(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of 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: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ ! update diagnostic variables
+ call updateVarsSundials(&
+ ! input
+ dt, &
+ doAdjustTemp, & ! intent(in): logical flag to adjust temperature to accou melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ mLayerVolFracWatTrial, &
+ mLayerMatricHeadTrial, &
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output: variables for the vegetation canopy
+ scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ scalarCanopyTempPrime, & ! intent(inout): trial value of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & !
+ mLayerVolFracWatPrime, & ! intent(inout): Prime vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): Prime vector of volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & !
+ mLayerMatricHeadPrime, & ! intent(inout): Prime vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): Prime vector of liquid water matric potential (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! ----
+ ! * check energy balance
+ !------------------------
+ ! NOTE: for now, we just compute enthalpy
+ if(checkNrgBalance)then
+ ! compute enthalpy at t_{n+1}
+ call t2enthalpy(&
+ ! input: data structures
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ mpar_data, & ! intent(in): parameter data structure
+ indx_data, & ! intent(in): model indices
+ lookup_data, & ! intent(in): lookup table data structure
+ ! input: state variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(in): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(in): trial value of canopy total water (kg m-2)
+ scalarCanopyIceTrial, & ! intent(in): trial value of canopy ice content (kg m-2)
+ ! input: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(in): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(in): trial vector of volumetric total water content (-)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
+ mLayerVolFracIceTrial, & ! intent(in): trial vector of volumetric fraction of ice (-)
+ ! output: enthalpy
+ scalarCanairEnthalpyTrial, & ! intent(out): enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpyTrial, & ! intent(out): enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpyTrial, & ! intent(out): enthalpy of each snow+soil layer (J m-3)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ endif
+
+ ! -----
+ ! * check mass balance...
+ ! -----------------------
+
+ ! NOTE: should not need to do this, since mass balance is checked in the solver
+ if(checkMassBalance)then
+
+ ! check mass balance for the canopy
+ if(ixVegHyd/=integerMissing)then
+
+ ! handle cases where fluxes empty the canopy
+ fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
+ if(-fluxNet*dt > canopyBalance0)then
+
+ ! --> first add water
+ canopyBalance1 = canopyBalance0 + (scalarRainfall - scalarThroughfallRain)*dt
+
+ ! --> next, remove canopy evaporation -- put the unsatisfied evap into sensible heat
+ canopyBalance1 = canopyBalance1 + scalarCanopyEvaporation*dt
+ if(canopyBalance1 < 0._rkind)then
+ ! * get superfluous water and energy
+ superflousWat = -canopyBalance1/dt ! kg m-2 s-1
+ superflousNrg = superflousWat*LH_vap ! W m-2 (J m-2 s-1)
+ ! * update fluxes and states
+ canopyBalance1 = 0._rkind
+ scalarCanopyEvaporation = scalarCanopyEvaporation + superflousWat
+ scalarLatHeatCanopyEvap = scalarLatHeatCanopyEvap + superflousNrg
+ scalarSenHeatCanopy = scalarSenHeatCanopy - superflousNrg
+ endif
+
+ ! --> next, remove canopy drainage
+ canopyBalance1 = canopyBalance1 - scalarCanopyLiqDrainage*dt
+ if(canopyBalance1 < 0._rkind)then
+ superflousWat = -canopyBalance1/dt ! kg m-2 s-1
+ canopyBalance1 = 0._rkind
+ scalarCanopyLiqDrainage = scalarCanopyLiqDrainage + superflousWat
+ endif
+
+ ! update the trial state
+ scalarCanopyWatTrial = canopyBalance1
+
+ ! set the modification flag
+ nrgFluxModified = .true.
+
+ else
+ canopyBalance1 = canopyBalance0 + fluxNet*dt
+ nrgFluxModified = .false.
+ endif ! cases where fluxes empty the canopy
+
+ ! check the mass balance
+ fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
+ liqError = (canopyBalance0 + fluxNet*dt) - scalarCanopyWatTrial
+ if(abs(liqError) > absConvTol_liquid*10._rkind*iden_water)then ! *10 because of precision issues
+ !write(*,'(a,1x,f20.10)') 'dt = ', dt
+ !write(*,'(a,1x,f20.10)') 'scalarCanopyWatTrial = ', scalarCanopyWatTrial
+ !write(*,'(a,1x,f20.10)') 'canopyBalance0 = ', canopyBalance0
+ !write(*,'(a,1x,f20.10)') 'canopyBalance1 = ', canopyBalance1
+ !write(*,'(a,1x,f20.10)') 'scalarRainfall*dt = ', scalarRainfall*dt
+ !write(*,'(a,1x,f20.10)') 'scalarCanopyLiqDrainage*dt = ', scalarCanopyLiqDrainage*dt
+ !write(*,'(a,1x,f20.10)') 'scalarCanopyEvaporation*dt = ', scalarCanopyEvaporation*dt
+ !write(*,'(a,1x,f20.10)') 'scalarThroughfallRain*dt = ', scalarThroughfallRain*dt
+ !write(*,'(a,1x,f20.10)') 'liqError = ', liqError
+ waterBalanceError = .true.
+ return
+ endif ! if there is a water balance error
+ endif ! if veg canopy
+
+ ! check mass balance for soil
+ ! NOTE: fatal errors, though possible to recover using negative error codes
+ if(count(ixSoilOnlyHyd/=integerMissing)==nSoil)then
+ soilBalance1 = sum( (mLayerVolFracLiqTrial(nSnow+1:nLayers) + mLayerVolFracIceTrial(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
+ vertFlux = -(iLayerLiqFluxSoil(nSoil) - iLayerLiqFluxSoil(0))*dt ! m s-1 --> m
+ tranSink = sum(mLayerTranspire)*dt ! m s-1 --> m
+ baseSink = sum(mLayerBaseflow)*dt ! m s-1 --> m
+ compSink = sum(mLayerCompress(1:nSoil) * mLayerDepth(nSnow+1:nLayers) ) ! dimensionless --> m
+ liqError = soilBalance1 - (soilBalance0 + vertFlux + tranSink - baseSink - compSink)
+ if(abs(liqError) > absConvTol_liquid*10._rkind)then ! *10 because of precision issues
+ !write(*,'(a,1x,f20.10)') 'dt = ', dt
+ !write(*,'(a,1x,f20.10)') 'soilBalance0 = ', soilBalance0
+ !write(*,'(a,1x,f20.10)') 'soilBalance1 = ', soilBalance1
+ !write(*,'(a,1x,f20.10)') 'vertFlux = ', vertFlux
+ !write(*,'(a,1x,f20.10)') 'tranSink = ', tranSink
+ !write(*,'(a,1x,f20.10)') 'baseSink = ', baseSink
+ !write(*,'(a,1x,f20.10)') 'compSink = ', compSink
+ !write(*,'(a,1x,f20.10)') 'liqError = ', liqError
+ !write(*,'(a,1x,f20.10)') 'absConvTol_liquid = ', absConvTol_liquid
+ waterBalanceError = .true.
+ return
+ endif ! if there is a water balance error
+ endif ! if hydrology states exist in the soil domain
+
+ endif ! if checking the mass balance
+
+ ! -----
+ ! * remove untapped melt energy...
+ ! --------------------------------
+
+ ! only work with energy state variables
+ if(size(ixNrgOnly)>0)then ! energy state variables exist
+
+ ! loop through energy state variables
+ do iState=1,size(ixNrgOnly)
+
+ ! get index of the control volume within the domain
+ ixSubset = ixNrgOnly(iState) ! index within the state subset
+ ixFullVector = ixMapSubset2Full(ixSubset) ! index within full state vector
+ ixControlIndex = ixControlVolume(ixFullVector) ! index within a given domain
+
+ ! compute volumetric melt (kg m-3)
+ volMelt = dt*untappedMelt(ixSubset)/LH_fus ! (kg m-3)
+
+ ! update ice content
+ select case( ixDomainType(ixFullVector) )
+ case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
+ case(iname_veg); scalarCanopyIceTrial = scalarCanopyIceTrial - volMelt*canopyDepth ! (kg m-2)
+ case(iname_snow); mLayerVolFracIceTrial(ixControlIndex) = mLayerVolFracIceTrial(ixControlIndex) - volMelt/iden_ice ! (-)
+ case(iname_soil); mLayerVolFracIceTrial(ixControlIndex+nSnow) = mLayerVolFracIceTrial(ixControlIndex+nSnow) - volMelt/iden_water ! (-)
+ case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
+ end select
+
+ ! update liquid water content
+ select case( ixDomainType(ixFullVector) )
+ case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
+ case(iname_veg); scalarCanopyLiqTrial = scalarCanopyLiqTrial + volMelt*canopyDepth ! (kg m-2)
+ case(iname_snow); mLayerVolFracLiqTrial(ixControlIndex) = mLayerVolFracLiqTrial(ixControlIndex) + volMelt/iden_water ! (-)
+ case(iname_soil); mLayerVolFracLiqTrial(ixControlIndex+nSnow) = mLayerVolFracLiqTrial(ixControlIndex+nSnow) + volMelt/iden_water ! (-)
+ case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
+ end select
+
+ end do ! looping through energy variables
+
+ ! ========================================================================================================
+
+ ! *** ice
+
+ ! --> check if we removed too much water
+ if(scalarCanopyIceTrial < 0._rkind .or. any(mLayerVolFracIceTrial < 0._rkind) )then
+
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyIceTrial < 0._rkind)then
+
+ if(scalarCanopyIceTrial > -verySmall)then
+ scalarCanopyLiqTrial = scalarCanopyLiqTrial - scalarCanopyIceTrial
+ scalarCanopyIceTrial = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'scalarCanopyiceTrial = ', scalarCanopyIceTrial
+ message=trim(message)//'melted more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! if checking the canopy
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracIceTrial)
+
+ ! snow layer within numerical precision
+ if(mLayerVolFracIceTrial(iState) < 0._rkind)then
+
+ if(mLayerVolFracIceTrial(iState) > -verySmall)then
+ mLayerVolFracLiqTrial(iState) = mLayerVolFracLiqTrial(iState) - mLayerVolFracIceTrial(iState)
+ mLayerVolFracIceTrial(iState) = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial
+ message=trim(message)//'melted more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! if checking a snow layer
+
+ end do ! (looping through state variables)
+
+ endif ! (if we removed too much water)
+
+ ! ========================================================================================================
+
+ ! *** liquid water
+
+ ! --> check if we removed too much water
+ if(scalarCanopyLiqTrial < 0._rkind .or. any(mLayerVolFracLiqTrial < 0._rkind) )then
+
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyLiqTrial < 0._rkind)then
+
+ if(scalarCanopyLiqTrial > -verySmall)then
+ scalarCanopyIceTrial = scalarCanopyIceTrial - scalarCanopyLiqTrial
+ scalarCanopyLiqTrial = 0._rkind
+
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'scalarCanopyLiqTrial = ', scalarCanopyLiqTrial
+ message=trim(message)//'frozen more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! checking the canopy
+
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracLiqTrial)
+
+ ! snow layer within numerical precision
+ if(mLayerVolFracLiqTrial(iState) < 0._rkind)then
+
+ if(mLayerVolFracLiqTrial(iState) > -verySmall)then
+ mLayerVolFracIceTrial(iState) = mLayerVolFracIceTrial(iState) - mLayerVolFracLiqTrial(iState)
+ mLayerVolFracLiqTrial(iState) = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial
+ message=trim(message)//'frozen more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! checking a snow layer
+
+ end do ! (looping through state variables)
+
+ endif ! (if we removed too much water)
+
+ endif ! (if energy state variables exist)
+
+ ! -----
+ ! * update enthalpy as a diagnostic variable...
+ ! --------------------------------
+ scalarCanairEnthalpy = scalarCanairEnthalpyTrial
+ scalarCanopyEnthalpy = scalarCanopyEnthalpyTrial
+ mLayerEnthalpy = mLayerEnthalpyTrial
+
+ ! -----
+ ! * update prognostic variables...
+ ! --------------------------------
+ ! update state variables for the vegetation canopy
+ scalarCanairTemp = scalarCanairTempTrial ! trial value of canopy air temperature (K)
+ scalarCanopyTemp = scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ scalarCanopyWat = scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ scalarCanopyLiq = scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ scalarCanopyIce = scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+
+ ! update state variables for the snow+soil domain
+ mLayerTemp = mLayerTempTrial ! trial vector of layer temperature (K)
+ mLayerVolFracWat = mLayerVolFracWatTrial ! trial vector of volumetric total water content (-)
+ mLayerVolFracLiq = mLayerVolFracLiqTrial ! trial vector of volumetric liquid water content (-)
+ mLayerVolFracIce = mLayerVolFracIceTrial ! trial vector of volumetric ice water content (-)
+ mLayerMatricHead = mLayerMatricHeadTrial ! trial vector of matric head (m)
+ mLayerMatricHeadLiq = mLayerMatricHeadLiqTrial ! trial vector of matric head (m)
+
+ ! update state variables for the aquifer
+ scalarAquiferStorage = scalarAquiferStorageTrial
+
+ ! end associations to info in the data structures
+ end associate
+
+end subroutine updateProgSundials
+
+end module varSubstepSundials_module
diff --git a/build/source/engine/systemSolv.f90 b/build/source/engine/systemSolv.f90
index eb185f2..cf83051 100755
--- a/build/source/engine/systemSolv.f90
+++ b/build/source/engine/systemSolv.f90
@@ -79,6 +79,7 @@ USE data_types,only:&
var_d, & ! data vector (dp)
var_ilength, & ! data vector with variable length dimension (i4b)
var_dlength, & ! data vector with variable length dimension (dp)
+ zLookup, &
model_options ! defines the model decisions
! look-up values for the choice of groundwater representation (local-column, or single-basin)
@@ -119,6 +120,7 @@ contains
computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
forc_data, & ! intent(in): model forcing data
@@ -160,6 +162,7 @@ contains
logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
! input/output: data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
type(var_i),intent(in) :: type_data ! type of vegetation and soil
type(var_d),intent(in) :: attr_data ! spatial attributes
type(var_d),intent(in) :: forc_data ! model forcing data
@@ -381,6 +384,7 @@ contains
sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
! input: data structures
model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
mpar_data, & ! intent(in): model parameters
@@ -474,6 +478,7 @@ contains
fOld, & ! intent(in): old function evaluation
! input: data structures
model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
mpar_data, & ! intent(in): model parameters
diff --git a/build/source/engine/updateVars.f90 b/build/source/engine/updateVars.f90
index c024f1c..0e9f8b9 100755
--- a/build/source/engine/updateVars.f90
+++ b/build/source/engine/updateVars.f90
@@ -66,7 +66,8 @@ USE data_types,only:&
var_i, & ! data vector (i4b)
var_d, & ! data vector (dp)
var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength ! data vector with variable length dimension (dp)
+ var_dlength, & ! data vector with variable length dimension (dp)
+ zLookup
! provide access to indices that define elements of the data structures
USE var_lookup,only:iLookDIAG ! named variables for structure elements
@@ -105,6 +106,7 @@ contains
subroutine updateVars(&
! input
do_adjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ lookup_data, & ! intent(in): lookup tables for a local HRU
mpar_data, & ! intent(in): model parameters for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
prog_data, & ! intent(in): model prognostic variables for a local HRU
@@ -129,6 +131,7 @@ contains
implicit none
! input
logical(lgt) ,intent(in) :: do_adjustTemp ! flag to adjust temperature to account for the energy used in melt+freeze
+ type(zLookup), intent(in) :: lookup_data ! lookup tables for a local HRU
type(var_dlength),intent(in) :: mpar_data ! model parameters for a local HRU
type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
diff --git a/build/source/engine/varSubstep.f90 b/build/source/engine/varSubstep.f90
index 0d9c0c5..2065ba4 100755
--- a/build/source/engine/varSubstep.f90
+++ b/build/source/engine/varSubstep.f90
@@ -47,6 +47,7 @@ USE data_types,only:&
var_flagVec, & ! data vector with variable length dimension (i4b)
var_ilength, & ! data vector with variable length dimension (i4b)
var_dlength, & ! data vector with variable length dimension (dp)
+ zLookup, &
model_options ! defines the model decisions
! provide access to indices that define elements of the data structures
@@ -97,6 +98,7 @@ contains
fluxCount, & ! intent(inout) : number of times that fluxes are updated (should equal nSubsteps)
! input/output: data structures
model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
type_data, & ! intent(in) : type of vegetation and soil
attr_data, & ! intent(in) : spatial attributes
forc_data, & ! intent(in) : model forcing data
@@ -144,6 +146,7 @@ contains
type(var_ilength),intent(inout) :: fluxCount ! number of times that the flux is updated (should equal nSubsteps)
! input/output: data structures
type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
type(var_i),intent(in) :: type_data ! type of vegetation and soil
type(var_d),intent(in) :: attr_data ! spatial attributes
type(var_d),intent(in) :: forc_data ! model forcing data
@@ -311,6 +314,7 @@ contains
computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
type_data, & ! intent(in): type of vegetation and soil
attr_data, & ! intent(in): spatial attributes
forc_data, & ! intent(in): model forcing data
@@ -399,7 +403,7 @@ contains
! update prognostic variables
call updateProg(dtSubstep,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,checkMassBalance, & ! input: model control
- mpar_data,indx_data,flux_temp,prog_data,diag_data,deriv_data, & ! input-output: data structures
+ lookup_data,mpar_data,indx_data,flux_temp,prog_data,diag_data,deriv_data, & ! input-output: data structures
waterBalanceError,nrgFluxModified,tooMuchMelt,err,cmessage) ! output: flags and error control
if(err/=0)then
message=trim(message)//trim(cmessage)
@@ -547,7 +551,7 @@ contains
! private subroutine updateProg: update prognostic variables
! **********************************************************************************************************
subroutine updateProg(dt,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,checkMassBalance, & ! input: model control
- mpar_data,indx_data,flux_data,prog_data,diag_data,deriv_data, & ! input-output: data structures
+ lookup_data,mpar_data,indx_data,flux_data,prog_data,diag_data,deriv_data, & ! input-output: data structures
waterBalanceError,nrgFluxModified,tooMuchMelt,err,message) ! output: flags and error control
USE getVectorz_module,only:varExtract ! extract variables from the state vector
USE updateVars_module,only:updateVars ! update prognostic variables
@@ -563,6 +567,7 @@ contains
real(dp) ,intent(in) :: stateVecTrial(:) ! trial state vector (mixed units)
logical(lgt) ,intent(in) :: checkMassBalance ! flag to check the mass balance
! data structures
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
type(var_dlength),intent(in) :: mpar_data ! model parameters
type(var_ilength),intent(in) :: indx_data ! indices for a local HRU
type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
@@ -709,6 +714,7 @@ contains
call updateVars(&
! input
doAdjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ lookup_data, & ! intent(in): lookup tables for a local HRU
mpar_data, & ! intent(in): model parameters for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
prog_data, & ! intent(in): model prognostic variables for a local HRU
@@ -728,7 +734,11 @@ contains
mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
! output: error control
err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ print*, message
+ return
+ end if ! (check for errors)
!print*, 'after updateVars: scalarCanopyTempTrial =', scalarCanopyTempTrial ! trial value of canopy temperature (K)
!print*, 'after updateVars: scalarCanopyWatTrial =', scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
--
GitLab