From a21930ac2d0bda58d1b60f07622b6fea8e5ebbea Mon Sep 17 00:00:00 2001
From: Kyle <kyle.c.klenk@gmail.com>
Date: Fri, 9 Sep 2022 20:02:43 +0000
Subject: [PATCH] compiles after several additions
---
build/makefile_sundials | 17 +-
.../source/engine/sundials/computHeatCap.f90 | 965 ++++----
.../engine/sundials/computThermConduct.f90 | 563 ++---
.../engine/sundials/summaSolveSundialsIDA.f90 | 2 +-
.../engine/sundials/systemSolvSundials.f90 | 2 +-
build/source/engine/sundials/tol4IDA.f90 | 2 +
build/source/engine/sundials/type4IDA.f90 | 2 +-
.../engine/sundials/updatStateSundials.f90 | 492 ++---
.../engine/sundials/updateVarsSundials.f90 | 1888 +++++++---------
.../engine/sundials/varSubstepSundials.f90 | 1938 ++++++++---------
10 files changed, 2733 insertions(+), 3138 deletions(-)
diff --git a/build/makefile_sundials b/build/makefile_sundials
index 6775654..583ee6d 100644
--- a/build/makefile_sundials
+++ b/build/makefile_sundials
@@ -104,7 +104,7 @@ SUMMA_UTILMS= \
mDecisions.f90 \
snow_utils.f90 \
soil_utils.f90 \
- sundials/soil_utilsSundials.f90 \
+ sundials/soil_utilsAddSundials.f90 \
updatState.f90 \
sundials/updatStateSundials.f90 \
matrixOper.f90
@@ -138,15 +138,11 @@ SUMMA_SOLVER= \
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/computResidSundials.f90 \
+ sundials/eval8summaSundials.f90 \
+ sundials/computJacobSundials.f90 \
sundials/computSnowDepth.f90 \
- sundials/solveByIDA.f90 \
+ sundials/summaSolveSundialsIDA.f90 \
sundials/systemSolvSundials.f90 \
varSubstep.f90 \
sundials/varSubstepSundials.f90 \
@@ -221,11 +217,10 @@ NOAHMP = $(patsubst %, $(NOAHMP_DIR)/%, $(SUMMA_NOAHMP))
SUMMA_MODRUN = \
indexState.f90 \
getVectorz.f90 \
- sundials/varExtrSundials.f90 \
+ sundials/getVectorzAddSundials.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/engine/sundials/computHeatCap.f90 b/build/source/engine/sundials/computHeatCap.f90
index 87b7bd5..53997c8 100644
--- a/build/source/engine/sundials/computHeatCap.f90
+++ b/build/source/engine/sundials/computHeatCap.f90
@@ -20,487 +20,492 @@
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
- ! 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
- 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
+ ! 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
+ Cp_water*scalarCanopyLiquid/canopyDepth + & ! liquid water component
+ Cp_ice*scalarCanopyIce/canopyDepth ! ice component
+ else
+ delEnt = scalarCanopyEnthalpyTrial - scalarCanopyEnthalpyPrev
+ heatCapVeg = delEnt / delT
+ end if
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
+
+ ! 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
- 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
- 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
- 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
+
+ ! 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)
- 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
+ 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
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/computThermConduct.f90 b/build/source/engine/sundials/computThermConduct.f90
index 2a9c646..dc5ab72 100644
--- a/build/source/engine/sundials/computThermConduct.f90
+++ b/build/source/engine/sundials/computThermConduct.f90
@@ -1,285 +1,288 @@
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
- ! 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) :: 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
+ ! 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
- kerstenNum = 0._rkind ! dry thermal conductivity
+ iLayerThermalC(iLayer) = (TCn*zdn + TCp*zdp) / (zdn + zdp)
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
+ !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
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/summaSolveSundialsIDA.f90 b/build/source/engine/sundials/summaSolveSundialsIDA.f90
index 7f2fbb1..48cfe32 100644
--- a/build/source/engine/sundials/summaSolveSundialsIDA.f90
+++ b/build/source/engine/sundials/summaSolveSundialsIDA.f90
@@ -142,7 +142,7 @@ module summaSolveSundialsIDA_module
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 allocspace_module,only:allocLocal ! allocate local data structures
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
USE eval8summaSundials_module,only:eval8summa4IDA ! DAE/ODE functions
USE computJacobSundials_module,only:computJacob4IDA ! system Jacobian
USE tol4IDA_module,only:computWeight4IDA ! weight required for tolerances
diff --git a/build/source/engine/sundials/systemSolvSundials.f90 b/build/source/engine/sundials/systemSolvSundials.f90
index a941c72..308f741 100644
--- a/build/source/engine/sundials/systemSolvSundials.f90
+++ b/build/source/engine/sundials/systemSolvSundials.f90
@@ -127,7 +127,7 @@ module systemSolvSundials_module
err,message) ! intent(out): error code and error message
! ---------------------------------------------------------------------------------------
! structure allocations
- USE allocspace_module,only:allocLocal ! allocate local data structures
+ USE allocspace4chm_module,only:allocLocal ! allocate local data structures
! simulation of fluxes and residuals given a trial state vector
USE eval8summaSundials_module,only:eval8summaSundials ! simulation of fluxes and residuals given a trial state vector
USE getVectorz_module,only:getScaling ! get the scaling vectors
diff --git a/build/source/engine/sundials/tol4IDA.f90 b/build/source/engine/sundials/tol4IDA.f90
index 91080ba..4674c31 100644
--- a/build/source/engine/sundials/tol4IDA.f90
+++ b/build/source/engine/sundials/tol4IDA.f90
@@ -134,6 +134,7 @@ contains
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, &
@@ -144,6 +145,7 @@ contains
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)
diff --git a/build/source/engine/sundials/type4IDA.f90 b/build/source/engine/sundials/type4IDA.f90
index 842ef39..e0988f3 100644
--- a/build/source/engine/sundials/type4IDA.f90
+++ b/build/source/engine/sundials/type4IDA.f90
@@ -22,7 +22,7 @@ implicit none
integer(i4b) :: nSnow ! number of snow layers
integer(i4b) :: nSoil ! number of soil layers
integer(i4b) :: nLayers ! total number of layers
- integer(kind=8) :: nState ! total number of state variables
+ 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
diff --git a/build/source/engine/sundials/updatStateSundials.f90 b/build/source/engine/sundials/updatStateSundials.f90
index c02a1b0..fdd53e4 100644
--- a/build/source/engine/sundials/updatStateSundials.f90
+++ b/build/source/engine/sundials/updatStateSundials.f90
@@ -1,318 +1,180 @@
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
-
-
+ 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
+
+ real(rkind),parameter :: verySmall=1e-14_rkind ! a very small number (used to avoid divide by zero)
+
+ contains
+
+
! *************************************************************************************************************
- ! 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
- 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) :: 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
+ ! 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 (veg or soil)
+ ! ***********************************************************************************************************************************
+ subroutine updateSoilSundials(&
+ ! input
+ dt ,& ! intent(in): time step
+ insideIDA ,& ! intent(in): flag if inside Sundials solver
+ 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
+ logical(lgt),intent(in) :: insideIDA ! flag if inside Sundials solver
+ 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)
+ if (.not.insideIDA)then ! calculate dt current, or use dt current as it can change here
+ if( abs(mLayerMatricHead - mLayerMatricHeadPrev) < verySmall )then !this difference is set as 0 inside varSubstep
+ dt_inv = 1._rkind/dt
+ else
+ dt_inv = mLayerMatricHeadPrime / (mLayerMatricHead - mLayerMatricHeadPrev) !
+ endif
+ mLayerVolFracWatPrime = (mLayerVolFracWat - mLayerVolFracWatPrev)*dt_inv
+ else ! inside Sundials: instantaneous derivative will always be a full step size as input here
+ mLayerVolFracWatPrime = dTheta_dPsi(mLayerMatricHead,vGn_alpha,theta_res,theta_sat,vGn_n,vGn_m) * mLayerMatricHeadPrime
+ endif
+
+ 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
+
+ end module updatStateSundials_module
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/updateVarsSundials.f90 b/build/source/engine/sundials/updateVarsSundials.f90
index 3a33e4e..7d5a97f 100644
--- a/build/source/engine/sundials/updateVarsSundials.f90
+++ b/build/source/engine/sundials/updateVarsSundials.f90
@@ -18,1087 +18,831 @@
! 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
+module updateVarsSundials_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
+ ! 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: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_utilsAddSundials_module,only:liquidHeadSundials ! compute the liquid water matric potential
+ USE soil_utilsAddSundials_module,only:d2Theta_dPsi2
+ USE soil_utilsAddSundials_module,only:d2Theta_dTk2
+
+ ! IEEE checks
+ USE, intrinsic :: ieee_arithmetic ! check values (NaN, etc.)
+
+ implicit none
+ private
+ public::updateVarsSundials
+
+ contains
+
+ ! **********************************************************************************************************
+ ! public subroutine updateVarsSundials: compute diagnostic variables and derivatives for Sundials Jacobian
+ ! **********************************************************************************************************
+ subroutine updateVarsSundials(&
+ ! input
+ dt, & ! intent(in): time step
+ computJac, & ! intent(in): logical flag if computing Jacobian for Sundials solver
+ 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): previous vector of total water matric potential (m)
+ mLayerMatricHeadPrev, & ! intent(in): previous vector of volumetric total water content (-)
+ 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 time derivative canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of time derivative canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of time derivative canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of time derivative 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, & ! intent(inout): trial vector of time derivative layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(inout): trial vector of time derivative volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): trial vector of time derivative volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & ! intent(inout): trial vector of time derivative volumetric ice water content (-)
+ mLayerMatricHeadPrime, & ! intent(inout): trial vector of time derivative total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): trial vector of time derivative liquid water matric potential (m)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
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 allocspace_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 updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
- USE getVectorzAddSundials_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); 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
+ ! input
+ real(rkind) ,intent(in) :: dt ! time step
+ logical(lgt) ,intent(in) :: computJac ! flag if computing Jacobian for Sundials solver
+ 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(:) ! previous vector of total water matric potential (m)
+ real(rkind),intent(in) :: mLayerMatricHeadPrev(:) ! previous vector of volumetric total water content (-)
+ 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 time derivative canopy temperature (K)
+ real(rkind),intent(inout) :: scalarCanopyWatPrime ! trial value of time derivative canopy total water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyLiqPrime ! trial value of time derivative canopy liquid water (kg m-2)
+ real(rkind),intent(inout) :: scalarCanopyIcePrime ! trial value of time derivative 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(:) ! trial vector of time derivative layer temperature (K)
+ real(rkind),intent(inout) :: mLayerVolFracWatPrime(:) ! trial vector of time derivative volumetric total water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracLiqPrime(:) ! trial vector of time derivative volumetric liquid water content (-)
+ real(rkind),intent(inout) :: mLayerVolFracIcePrime(:) ! trial vector of time derivative volumetric ice water content (-)
+ real(rkind),intent(inout) :: mLayerMatricHeadPrime(:) ! trial vector of time derivative total water matric potential (m)
+ real(rkind),intent(inout) :: mLayerMatricHeadLiqPrime(:) ! trial vector of time derivative liquid water matric potential (m)
+ ! 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 ! time derivative volumetric fraction of liquid water (-)
+ real(rkind) :: scalarVolFracIcePrime ! time derivative 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
+ 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
+ ! derivatives inside solver for Jacobian only
+ 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
+ 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
+ ) ! 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
+
+ if(.not.computJac) stop 1 ! this does not work yet? FIX
+
+ ! 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
-
- ! 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
+
+ ! 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
-
- 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
-
+ bFlag = .false.
+ endif
+
! -----
- ! * update model fluxes...
+ ! - compute derivatives...
! ------------------------
-
- ! 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
+
+ ! 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)
+ if(computJac)then
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ dVolHtCapBulk_dCanWat = ( -Cp_ice*( fLiq-1._rkind ) + Cp_water*fLiq )/canopyDepth !this is iden_water/(iden_water*canopyDepth)
+ endif
+ case(iname_snow)
+ if(computJac)then
+ 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
+ endif
+ 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
+ if(computJac) 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))
+ if(computJac) 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
+ if(computJac)then
+ 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)
+ endif
+ 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)
+ dFracLiqVeg_dTkCanopy = dFracLiq_dTk(xTemp,snowfrz_scale)
+ dTheta_dTkCanopy = dFracLiqVeg_dTkCanopy * scalarCanopyWatTrial/(iden_water*canopyDepth)
+ if(computJac)then
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ 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
+ endif
+ case(iname_snow)
+ dFracLiqSnow_dTk(iLayer) = dFracLiq_dTk(xTemp,snowfrz_scale)
+ mLayerdTheta_dTk(iLayer) = dFracLiqSnow_dTk(iLayer) * mLayerVolFracWatTrial(iLayer)
+ if(computJac)then
+ fLiq = fracLiquid(xTemp,snowfrz_scale)
+ 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)
+ endif
+ 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))
+ if(computJac)then
+ 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)
+ endif
+ 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, 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
-
- 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
+
+ ! -----
+ ! - 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 updateSnowSundials(&
+ xTemp, & ! intent(in) : temperature (K)
+ scalarCanopyWatTrial/(iden_water*canopyDepth),& ! intent(in) : volumetric fraction of total water (-)
+ snowfrz_scale, & ! intent(in) : scaling parameter for the snow freezing curve (K-1)
+ scalarCanopyTempPrime, & ! intent(in) : canopy temperature time derivative (K/s)
+ scalarCanopyWatPrime/(iden_water*canopyDepth),& ! intent(in) : volumetric fraction of total water time derivative (-)
+ 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
+
+ ! compute mass of water on the canopy
+ ! NOTE: possibilities for speed-up here
+ scalarCanopyLiqTrial = scalarFracLiqVeg *scalarCanopyWatTrial !(kg m-2), scalarVolFracLiq*iden_water*canopyDepth
+ scalarCanopyLiqPrime = scalarVolFracLiqPrime*iden_water*canopyDepth
+ scalarCanopyIceTrial = (1._rkind - scalarFracLiqVeg)*scalarCanopyWatTrial !(kg m-2), scalarVolFracIce* iden_ice *canopyDepth
+ scalarCanopyIcePrime = scalarVolFracIcePrime* iden_ice *canopyDepth
+
+ ! *** snow layers
+ case(iname_snow)
+
+ ! compute volumetric fraction of liquid water and ice
+ 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 updateSoilSundials(&
+ dt, & ! intent(in) : time step
+ computJac, & ! intent(in) : logical flag if inside Sundials solver
+ xTemp, & ! intent(in) : temperature (K)
+ mLayerMatricHeadTrial(ixControlIndex), & ! intent(in) : total water matric potential (m)
+ mLayerMatricHeadPrev(ixControlIndex), & ! intent(in) : previous values, will be same as current if computJac
+ mLayerVolFracWatPrev(iLayer), & ! intent(in) : previous values, will be same as current if computJac
+ mLayerTempPrime(iLayer), & ! intent(in) : temperature time derivative (K/s)
+ mLayerMatricHeadPrime(ixControlIndex), & ! intent(in) : total water matric potential time derivative (m/s)
+ 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
- cycle substeps
+ message=trim(message)//'unexpected else branch'
+ err=20; return
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 getVectorzAddSundials_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 (-)
- 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)
- ! 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)
- ! derivative of 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 (-)
- ! -------------------------------------------------------------------------------------------------------------------
-
- ! -------------------------------------------------------------------------------------------------------------------
- ! 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...
- ! ------------------
- ! these will need to be initialized as they do not have updated prognostic structures in Sundials
- ! should all be set to previous values if splits, but for now operator splitting is not hooked up
- scalarCanairTempPrime = realMissing
- scalarCanopyTempPrime = realMissing
- scalarCanopyWatPrime = realMissing
- scalarCanopyLiqPrime = realMissing
- scalarCanopyIcePrime = realMissing
- mLayerTempPrime = realMissing
- mLayerVolFracWatPrime = realMissing
- mLayerVolFracLiqPrime = realMissing
- mLayerVolFracIcePrime = realMissing
- mLayerMatricHeadPrime = realMissing
- mLayerMatricHeadLiqPrime = realMissing
- scalarAquiferStoragePrime= realMissing
- ! set to previous value from prognostic structure, correct because outside Sundials
- scalarCanairTempTrial = scalarCanairTemp
- scalarCanopyTempTrial = scalarCanopyTemp
- scalarCanopyWatTrial = scalarCanopyWat
- scalarCanopyLiqTrial = scalarCanopyLiq
- scalarCanopyIceTrial = scalarCanopyIce
- mLayerTempTrial = mLayerTemp
- mLayerVolFracWatTrial = mLayerVolFracWat
- mLayerVolFracLiqTrial = mLayerVolFracLiq
- mLayerVolFracIceTrial = mLayerVolFracIce
- mLayerMatricHeadTrial = mLayerMatricHead
- mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq
- scalarAquiferStorageTrial= scalarAquiferStorage
-
- ! extract variables from the model state vector
- call varExtractSundials(&
- ! input
- stateVecTrial, & ! intent(in): model state vector (mixed units)
- 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
- scalarCanairTempTrial, & ! intent(inout): trial value of canopy air temperature (K)
- 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)
- scalarCanairTempPrime, & ! intent(inout): derivative of canopy air temperature (K)
- scalarCanopyTempPrime, & ! intent(inout): derivative of canopy temperature (K)
- scalarCanopyWatPrime, & ! intent(inout): derivative of canopy total water (kg m-2)
- scalarCanopyLiqPrime, & ! intent(inout): derivative of canopy liquid water (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 (-)
- mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
- mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
- mLayerTempPrime, & ! intent(inout): derivative of layer temperature (K)
- mLayerVolFracWatPrime, & ! intent(inout): derivative of volumetric total water content (-)
- mLayerVolFracLiqPrime, & ! intent(inout): derivative of volumetric liquid water content (-)
- mLayerMatricHeadPrime, & ! intent(inout): derivative of total water matric potential (m)
- mLayerMatricHeadLiqPrime, & ! intent(inout): derivative of liquid water matric potential (m)
- ! output: variables for the aquifer
- scalarAquiferStorageTrial,& ! intent(inout): trial value of storage of water in the aquifer (m)
- scalarAquiferStoragePrime,& ! intent(inout): 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, &
- .false., & ! intent(in): logical flag if computing Jacobian for Sundials solver
- doAdjustTemp, & ! 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
- mLayerVolFracWatTrial, & ! intent(in): use current vector for prev vector of volumetric total water content (-)
- mLayerMatricHeadTrial, & ! intent(in): use current vector for prev vector of total water matric potential (m)
- 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.
-
+
+ endif ! if energy state or solution is coupled
+
+ ! -----
+ ! ------------------------
+
+ ! check the need to adjust temperature (will always be false if inside solver)
+ ! can be true if inside varSubstepSundials, outside solver, but currently will not work so turn off
+ if(do_adjustTemp .and. computJac)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
- 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
+ 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
- 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
-
+ 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
+
+ ! =======================================================================================================================================
+ ! =======================================================================================================================================
+
! -----
- ! * 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
-
\ No newline at end of file
+ ! - 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
+
+
+ ! **********************************************************************************************************
+ ! 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 updateVarsSundials_module
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/varSubstepSundials.f90 b/build/source/engine/sundials/varSubstepSundials.f90
index 5e5f8da..3da718e 100644
--- a/build/source/engine/sundials/varSubstepSundials.f90
+++ b/build/source/engine/sundials/varSubstepSundials.f90
@@ -20,796 +20,787 @@
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
+ ! 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
- ! ---------------------------------------------------------------------------------------
- ! * 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=.false. ! 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)
+ 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 updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
+ USE getVectorzAddSundials_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); 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
-
+ 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)
- print*, message
- return
- endif ! (check for errors)
-
+ ! 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
-
+ ! 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)
- print*, message
- if(err>0) return
+ 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
-
+
+ ! 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
-
+
+ ! 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'
- print*, message
- return
+ 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
+ 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)
- print*, message
- if(err>0) return
+ 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
+ message=trim(message)//'water balance error'
+ reduceCoupledStep=.true.
+ err=-20; return
endif
-
+
if(globalPrintFlag)&
- print*, trim(cmessage)//': dt = ', dtSubstep
-
+ 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
-
+
+ ! 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)
+ 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)
+ 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
+ ! 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
-
+ 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)
+ 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
+ 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
+
+ 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
+ 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'
- print*, message
- 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)
+ 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 getVectorzAddSundials_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 (-)
+ 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)
+ ! 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)
+ ! derivative of 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 (-)
+ ! -------------------------------------------------------------------------------------------------------------------
+
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! 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)
- print*, message
- return
- end if ! (check for errors)
-
- call varExtractSundials(&
- ! input
- stateVecPrime, & ! intent(in): derivative of model state vector (mixed units)
- 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)
- print*, message
- return
- end if ! (check for errors)
-
-
+ 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...
+ ! ------------------
+ ! these will need to be initialized as they do not have updated prognostic structures in Sundials
+ ! should all be set to previous values if splits, but for now operator splitting is not hooked up
+ scalarCanairTempPrime = realMissing
+ scalarCanopyTempPrime = realMissing
+ scalarCanopyWatPrime = realMissing
+ scalarCanopyLiqPrime = realMissing
+ scalarCanopyIcePrime = realMissing
+ mLayerTempPrime = realMissing
+ mLayerVolFracWatPrime = realMissing
+ mLayerVolFracLiqPrime = realMissing
+ mLayerVolFracIcePrime = realMissing
+ mLayerMatricHeadPrime = realMissing
+ mLayerMatricHeadLiqPrime = realMissing
+ scalarAquiferStoragePrime= realMissing
+ ! set to previous value from prognostic structure, correct because outside Sundials
+ scalarCanairTempTrial = scalarCanairTemp
+ scalarCanopyTempTrial = scalarCanopyTemp
+ scalarCanopyWatTrial = scalarCanopyWat
+ scalarCanopyLiqTrial = scalarCanopyLiq
+ scalarCanopyIceTrial = scalarCanopyIce
+ mLayerTempTrial = mLayerTemp
+ mLayerVolFracWatTrial = mLayerVolFracWat
+ mLayerVolFracLiqTrial = mLayerVolFracLiq
+ mLayerVolFracIceTrial = mLayerVolFracIce
+ mLayerMatricHeadTrial = mLayerMatricHead
+ mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq
+ scalarAquiferStorageTrial= scalarAquiferStorage
+
+ ! extract variables from the model state vector
+ call varExtractSundials(&
+ ! input
+ stateVecTrial, & ! intent(in): model state vector (mixed units)
+ 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
+ scalarCanairTempTrial, & ! intent(inout): trial value of canopy air temperature (K)
+ 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)
+ scalarCanairTempPrime, & ! intent(inout): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(inout): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): derivative of canopy liquid water (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 (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & ! intent(inout): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(inout): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(inout): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(inout): trial value of storage of water in the aquifer (m)
+ scalarAquiferStoragePrime,& ! intent(inout): 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)
- print*, message
- 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(&
+ call updateVarsSundials(&
+ ! input
+ dt, &
+ .false., & ! intent(in): logical flag if computing Jacobian for Sundials solver
+ doAdjustTemp, & ! 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
+ mLayerVolFracWatTrial, & ! intent(in): use current vector for prev vector of volumetric total water content (-)
+ mLayerMatricHeadTrial, & ! intent(in): use current vector for prev vector of total water matric potential (m)
+ 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
@@ -831,290 +822,283 @@ subroutine updateProgSundials(dt,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux
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)
- print*, message
- return
- endif
-
- endif
-
- ! -----
- ! * check mass balance...
- ! -----------------------
-
- ! NOTE: should not need to do this, since mass balance is checked in the solver
- if(checkMassBalance)then
-
+ 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
+
+ ! 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
-
+ 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
-
+
+ ! -----
+ ! * 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]'; print*, message; 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]'; print*, message; return
- end select
-
+
+ ! 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'
- print*, message
- 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'
- print*, message
- err=20; return
- endif ! (inconsistency)
-
- endif ! if checking a snow layer
-
- end do ! (looping through state variables)
-
+
+ ! **
+ ! 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'
- print*, message
- 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)
-
+
+ ! **
+ ! 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...
- ! --------------------------------
+
+ 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
+ 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
+
\ No newline at end of file
--
GitLab