From eab9be49d857969ffd73498a05ed566b090ca457 Mon Sep 17 00:00:00 2001
From: Kyle <kyle.c.klenk@gmail.com>
Date: Tue, 27 Sep 2022 18:02:49 +0000
Subject: [PATCH] Can run the celia and colbeck tests
---
build/makefile_sundials | 11 +-
build/source/actors/job_actor/job_actor.f90 | 2 +-
build/source/driver/init_hru_actor.f90 | 4 +-
build/source/engine/allocspaceActors.f90 | 4 +-
build/source/engine/coupled_em.f90 | 4 +-
build/source/engine/eval8summa.f90 | 1096 ++++----
build/source/engine/ffile_info.f90 | 2 +-
build/source/engine/getVectorz.f90 | 880 +++----
build/source/engine/opSplittin.f90 | 2330 ++++++++---------
.../engine/sundials/computJacobSundials.f90 | 2055 +++++++--------
build/source/engine/sundials/eval8JacDAE.f90 | 343 +++
.../engine/sundials/eval8summaSundials.f90 | 1548 +++++------
build/source/engine/sundials/evalDAE4IDA.f90 | 165 ++
build/source/engine/sundials/evalJac4IDA.f90 | 132 +
.../engine/sundials/getVectorzAddSundials.f90 | 488 ++--
.../engine/sundials/summaSolveSundialsIDA.f90 | 1344 +++++-----
.../engine/sundials/systemSolvSundials.f90 | 1076 ++++----
.../engine/sundials/varSubstepSundials.f90 | 1909 +++++++-------
build/source/engine/systemSolv.f90 | 2 +-
build/source/engine/varSubstep.f90 | 1021 ++++----
.../BE/colbeck1976/run_test_summa_actors.sh | 4 +-
21 files changed, 7309 insertions(+), 7111 deletions(-)
create mode 100644 build/source/engine/sundials/eval8JacDAE.f90
create mode 100644 build/source/engine/sundials/evalDAE4IDA.f90
create mode 100644 build/source/engine/sundials/evalJac4IDA.f90
diff --git a/build/makefile_sundials b/build/makefile_sundials
index 583ee6d..d159927 100644
--- a/build/makefile_sundials
+++ b/build/makefile_sundials
@@ -19,10 +19,10 @@ ACTORS_LIBRARIES = -L/usr/lib -L/usr/local/lib -L/Summa-Actors/bin -lcaf_core -l
# Production runs
-FLAGS_NOAH = -g -O0 -ffree-form -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
-FLAGS_COMM = -g -O0 -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
-FLAGS_SUMMA = -g -O0 -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
-FLAGS_ACTORS = -g -O0 -Wfatal-errors -std=c++17
+FLAGS_NOAH = -g -O3 -ffree-form -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
+FLAGS_COMM = -g -O3 -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
+FLAGS_SUMMA = -g -O3 -ffree-line-length-none -fmax-errors=0 -fPIC -Wfatal-errors
+FLAGS_ACTORS = -g -O3 -Wfatal-errors -std=c++17
# Debug runs
# FLAGS_NOAH = -g -O0 -ffree-form -ffree-line-length-none -fmax-errors=0 -fbacktrace -Wno-unused -Wno-unused-dummy-argument -fPIC
@@ -140,7 +140,10 @@ SUMMA_SOLVER= \
sundials/computThermConduct.f90 \
sundials/computResidSundials.f90 \
sundials/eval8summaSundials.f90 \
+ sundials/evalDAE4IDA.f90 \
sundials/computJacobSundials.f90 \
+ sundials/eval8JacDAE.f90 \
+ sundials/evalJac4IDA.f90 \
sundials/computSnowDepth.f90 \
sundials/summaSolveSundialsIDA.f90 \
sundials/systemSolvSundials.f90 \
diff --git a/build/source/actors/job_actor/job_actor.f90 b/build/source/actors/job_actor/job_actor.f90
index eaffeb8..18f5fb7 100644
--- a/build/source/actors/job_actor/job_actor.f90
+++ b/build/source/actors/job_actor/job_actor.f90
@@ -10,7 +10,7 @@ module job_actor
subroutine allocateTimeStructure(err) bind(C, name="allocateTimeStructure")
USE globalData,only:startTime,finshTime,refTime,oldTime
- USE allocspace4chm_module,only:allocLocal
+ USE allocspace_module,only:allocLocal
USE globalData,only:time_meta
implicit none
diff --git a/build/source/driver/init_hru_actor.f90 b/build/source/driver/init_hru_actor.f90
index 961c385..cc4c37c 100755
--- a/build/source/driver/init_hru_actor.f90
+++ b/build/source/driver/init_hru_actor.f90
@@ -83,8 +83,8 @@ contains
USE nrtype ! variable types, etc.
USE time_utils_module,only:elapsedSec ! calculate the elapsed time
! subroutines and functions: allocate space
- USE allocspace4chm_module,only:allocGlobal ! module to allocate space for global data structures
- USE allocspace4chm_module,only:allocLocal
+ USE allocspace_module,only:allocGlobal ! module to allocate space for global data structures
+ USE allocspace_module,only:allocLocal
! timing variables
USE globalData,only:startInit,endInit ! date/time for the start and end of the initialization
USE globalData,only:elapsedRead ! elapsed time for the data read
diff --git a/build/source/engine/allocspaceActors.f90 b/build/source/engine/allocspaceActors.f90
index fcc3074..b2635b7 100755
--- a/build/source/engine/allocspaceActors.f90
+++ b/build/source/engine/allocspaceActors.f90
@@ -18,7 +18,7 @@
! 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 allocspace4chm_module
+module allocspace_module
! data types
USE nrtype
@@ -637,4 +637,4 @@ contains
end subroutine allocateDat_flag
-end module allocspace4chm_module
+end module allocspace_module
diff --git a/build/source/engine/coupled_em.f90 b/build/source/engine/coupled_em.f90
index 5891dac..f11a0a8 100755
--- a/build/source/engine/coupled_em.f90
+++ b/build/source/engine/coupled_em.f90
@@ -123,8 +123,8 @@ subroutine coupled_em(&
! error control
err,message) ! intent(out): error control
! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
- USE allocspace4chm_module,only:resizeData ! clone a data structure
+ USE allocspace_module,only:allocLocal ! allocate local data structures
+ USE allocspace_module,only:resizeData ! clone a data structure
! preliminary subroutines
USE vegPhenlgy_module,only:vegPhenlgy ! compute vegetation phenology
USE vegNrgFlux_module,only:wettedFrac ! compute wetted fraction of the canopy (used in sw radiation fluxes)
diff --git a/build/source/engine/eval8summa.f90 b/build/source/engine/eval8summa.f90
index 2c198cf..e6882cd 100755
--- a/build/source/engine/eval8summa.f90
+++ b/build/source/engine/eval8summa.f90
@@ -20,562 +20,570 @@
module eval8summa_module
- ! data types
- USE nrtype
-
- ! access missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing double precision number
- USE globalData,only:quadMissing ! missing quadruple precision number
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! define access to state variables to print
- USE globalData,only: iJac1 ! first layer of the Jacobian to print
- USE globalData,only: iJac2 ! last layer of the Jacobian to print
-
- ! domain types
- USE globalData,only:iname_veg ! named variables for vegetation
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! named variables to describe the state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
-
- ! constants
- USE multiconst,only:&
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! provide access to the derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (rkind)
- zLookup, & ! data vector with variable length dimension (rkind)
- model_options ! defines the model decisions
-
- ! indices that define elements of the data structures
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookFLUX ! named variables for structure elements
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
-
- ! look-up values for the choice of groundwater representation (local-column, or single-basin)
- USE mDecisions_module,only: &
- localColumn, & ! separate groundwater representation in each local soil column
- singleBasin ! single groundwater store over the entire basin
-
- ! look-up values for the choice of groundwater parameterization
- USE mDecisions_module,only: &
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit ! no explicit groundwater parameterization
-
- ! look-up values for the form of Richards' equation
- USE mDecisions_module,only: &
- moisture, & ! moisture-based form of Richards' equation
- mixdform ! mixed form of Richards' equation
-
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables to describe the state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8summa
+
+contains
+
+
+! **********************************************************************************************************
+! public subroutine eval8summa: compute the residual vector and the Jacobian matrix
+! **********************************************************************************************************
+subroutine eval8summa(&
+ ! input: model control
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nState, & ! intent(in): total number of state variables
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVecTrial, & ! intent(in): model state vector
+ fScale, & ! intent(in): function scaling vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ fluxVec, & ! intent(out): flux vector
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ fEval, & ! intent(out): function evaluation
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE getVectorz_module, only:varExtract ! extract variables from the state vector
+ USE updateVars_module, only:updateVars ! update prognostic variables
+ USE t2enthalpy_module, only:t2enthalpy ! compute enthalpy
+ USE computFlux_module, only:soilCmpres ! compute soil compression, use non-sundials version because sundials version needs mLayerMatricHeadPrime
+ USE computFlux_module, only:computFlux ! compute fluxes given a state vector
+ USE computResid_module,only:computResid ! compute residuals given a state vector
implicit none
- private
- public::eval8summa
-
- contains
-
-
- ! **********************************************************************************************************
- ! public subroutine eval8summa: compute the residual vector and the Jacobian matrix
- ! **********************************************************************************************************
- subroutine eval8summa(&
- ! input: model control
- dt, & ! intent(in): length of the time step (seconds)
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- nState, & ! intent(in): total number of state variables
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVecTrial, & ! intent(in): model state vector
- fScale, & ! intent(in): function scaling vector
- sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- indx_data, & ! intent(inout): index data
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: baseflow
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- feasible, & ! intent(out): flag to denote the feasibility of the solution
- fluxVec, & ! intent(out): flux vector
- resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- resVec, & ! intent(out): residual vector
- fEval, & ! intent(out): function evaluation
- err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! provide access to subroutines
- USE getVectorz_module, only:varExtract ! extract variables from the state vector
- USE updateVars_module, only:updateVars ! update prognostic variables
- USE t2enthalpy_module, only:t2enthalpy ! compute enthalpy
- USE computFlux_module, only:soilCmpres ! compute soil compression, use non-sundials version because sundials version needs mLayerMatricHeadPrime
- USE computFlux_module, only:computFlux ! compute fluxes given a state vector
- USE computResid_module,only:computResid ! compute residuals given a state vector
- implicit none
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- real(rkind),intent(in) :: dt ! length of the time step (seconds)
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer(i4b),intent(in) :: nState ! total number of state variables
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(inout) :: firstFluxCall ! flag to indicate if we are processing the first flux call
- logical(lgt),intent(in) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input: state vectors
- real(rkind),intent(in) :: stateVecTrial(:) ! model state vector
- real(rkind),intent(in) :: fScale(:) ! function scaling vector
- real(rkind),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
- ! input: data structures
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- type(zLookup), intent(in) :: lookup_data ! lookup tables
- type(var_i), intent(in) :: type_data ! type of vegetation and soil
- type(var_d), intent(in) :: attr_data ! spatial attributes
- type(var_dlength), intent(in) :: mpar_data ! model parameters
- type(var_d), intent(in) :: forc_data ! model forcing data
- type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
- type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
- ! output: data structures
- type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: baseflow
- integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
- real(rkind),intent(out) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- logical(lgt),intent(out) :: feasible ! flag to denote the feasibility of the solution
- real(rkind),intent(out) :: fluxVec(:) ! flux vector
- real(rkind),intent(out) :: resSink(:) ! sink terms on the RHS of the flux equation
- real(rkind),intent(out) :: resVec(:) ! NOTE: qp ! residual vector
- real(rkind),intent(out) :: fEval ! function evaluation
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! state variables
- real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
- real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
- real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
- real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
- real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
- ! diagnostic variables
- logical(lgt),parameter :: needEnthalpy=.true. ! flag to compute enthalpy
- real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
- real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
- real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
- ! other local variables
- integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
- integer(i4b) :: jState(1) ! index of model state for the scalar solution within the soil domain
- integer(i4b) :: ixBeg,ixEnd ! index of indices for the soil compression routine
- integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
- real(rkind) :: xMin,xMax ! minimum and maximum values for water content
- real(rkind) :: scalarCanopyHydTrial ! trial value for mass of water on the vegetation canopy (kg m-2)
- real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
- real(rkind),dimension(nLayers) :: mLayerVolFracHydTrial ! trial value for volumetric fraction of water (-), general vector merged from Wat and Liq
- real(rkind),dimension(nState) :: rVecScaled ! scaled residual vector
- character(LEN=256) :: cmessage ! error message of downwind routine
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- associate(&
- ! model decisions
- ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
- ! snow parameters
- snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
- ! soil parameters
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
- specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
- ! canopy and layer depth
- canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- ! model state variables from a previous solution
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in): [dp(:)] total water matric potential (m)
- ! model diagnostic variables from a previous solution
- scalarSfcMeltPond => prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) ,& ! intent(in): [dp] ponded water caused by melt of the "snow without a layer" (kg m-2)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
- ! enthalpy
- scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the canopy air space (J m-3)
- scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the vegetation canopy (J m-3)
- mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(out): [dp(:)] enthalpy of the snow+soil layers (J m-3)
- ! soil compression
- scalarSoilCompress => diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ,& ! intent(in): [dp] total change in storage associated with compression of the soil matrix (kg m-2)
- mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
- ! derivatives
- dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0)%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
- dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi)%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t. matric head (m-1)
- ! mapping
- ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
- ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
- ! indices
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable (nrg)
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable (nrg)
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
- ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
- ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- layerType => indx_data%var(iLookINDEX%layerType)%dat & ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
- ) ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="eval8summa/"
-
- ! check the feasibility of the solution
- feasible=.true.
-
- ! check that the canopy air space temperature is reasonable
- if(ixCasNrg/=integerMissing)then
- if(stateVecTrial(ixCasNrg) > canopyTempMax) feasible=.false.
- if(stateVecTrial(ixCasNrg) > canopyTempMax) message=trim(message)//'canopy air space temp high,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVecTrial( ixCasNrg )', feasible, canopyTempMax, stateVecTrial(ixCasNrg)
- endif
-
- ! check that the canopy air space temperature is reasonable
- if(ixVegNrg/=integerMissing)then
- if(stateVecTrial(ixVegNrg) > canopyTempMax) feasible=.false.
- if(stateVecTrial(ixVegNrg) > canopyTempMax) message=trim(message)//'canopy temp high,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVecTrial( ixVegNrg )', feasible, canopyTempMax, stateVecTrial(ixVegNrg)
- endif
-
- ! check canopy liquid water is not negative
- if(ixVegHyd/=integerMissing)then
- if(stateVecTrial(ixVegHyd) < 0._rkind) feasible=.false.
- if(stateVecTrial(ixVegHyd) < 0._rkind) message=trim(message)//'canopy water negative,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, min, stateVecTrial( ixVegHyd )', feasible, 0._rkind, stateVecTrial(ixVegHyd)
-
- end if
-
- ! check snow temperature is below freezing
- if(count(ixSnowOnlyNrg/=integerMissing)>0)then
- if(any(stateVecTrial( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) feasible=.false.
- if(any(stateVecTrial( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) message=trim(message)//'snow temp above freezing,'
- do iLayer=1,nSnow
- if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, max, stateVecTrial( ixSnowOnlyNrg(iLayer) )', iLayer, feasible, Tfreeze, stateVecTrial( ixSnowOnlyNrg(iLayer) )
- enddo
- endif
-
- ! loop through non-missing hydrology state variables in the snow+soil domain
- do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
-
- ! check the minimum and maximum water constraints
- if(ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_liqLayer)then
-
- ! --> minimum
- if (layerType(iLayer) == iname_soil) then
- xMin = theta_res(iLayer-nSnow)
- else
- xMin = 0._rkind
- endif
-
- ! --> maximum
- select case( layerType(iLayer) )
- case(iname_snow); xMax = merge(iden_ice, 1._rkind - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
- case(iname_soil); xMax = merge(theta_sat(iLayer-nSnow), theta_sat(iLayer-nSnow) - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
- end select
-
- ! --> check
- if(stateVecTrial( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVecTrial( ixSnowSoilHyd(iLayer) ) > xMax) feasible=.false.
- if(stateVecTrial( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVecTrial( ixSnowSoilHyd(iLayer) ) > xMax) message=trim(message)//'layer water outside bounds,'
- if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, stateVecTrial( ixSnowSoilHyd(iLayer) ), xMin, xMax = ', iLayer, feasible, stateVecTrial( ixSnowSoilHyd(iLayer) ), xMin, xMax
-
- endif ! if water states
-
- end do ! loop through non-missing hydrology state variables in the snow+soil domain
-
- ! early return for non-feasible solutions
- if(.not.feasible)then
- fluxVec(:) = realMissing
- resVec(:) = quadMissing
- fEval = realMissing
- message=trim(message)//'non-feasible'
- err=20; return
- endif
-
- ! get the start and end indices for the soil compression calculations
- if(scalarSolution)then
- jState = pack(ixControlVolume, ixMapFull2Subset/=integerMissing)
- ixBeg = jState(1)
- ixEnd = jState(1)
- else
- ixBeg = 1
- ixEnd = nSoil
- endif
-
- ! extract variables from the model state vector
- call varExtract(&
- ! input
- stateVecTrial, & ! intent(in): model state vector (mixed units)
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output: variables for the vegetation canopy
- scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
- scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
- scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
- scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
- scalarCanopyIceTrial, & ! intent(out): trial value of canopy ice content (kg m-2)
- ! output: variables for the snow-soil domain
- mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
- mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
- mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
- mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
- mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
- mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
- ! output: variables for the aquifer
- scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! update diagnostic variables and derivatives
- call updateVars(&
- ! input
- .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
- lookup_data, & ! intent(in): lookup tables for a local HRU
- mpar_data, & ! intent(in): model parameters for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- 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)
- ! 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)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! compute enthalpy (J m-3)
- if(needEnthalpy)then
- 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
- scalarCanairEnthalpy, & ! intent(out): enthalpy of the canopy air space (J m-3)
- scalarCanopyEnthalpy, & ! intent(out): enthalpy of the vegetation canopy (J m-3)
- mLayerEnthalpy, & ! intent(out): enthalpy of each snow+soil layer (J m-3)
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt ! length of the time step (seconds)
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall ! flag to indicate if we are processing the first flux call
+ logical(lgt),intent(in) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVecTrial(:) ! model state vector
+ real(rkind),intent(in) :: fScale(:) ! function scaling vector
+ real(rkind),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
+ type(var_i), intent(in) :: type_data ! type of vegetation and soil
+ type(var_d), intent(in) :: attr_data ! spatial attributes
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_d), intent(in) :: forc_data ! model forcing data
+ type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ real(rkind),intent(out) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ logical(lgt),intent(out) :: feasible ! flag to denote the feasibility of the solution
+ real(rkind),intent(out) :: fluxVec(:) ! flux vector
+ real(rkind),intent(out) :: resSink(:) ! sink terms on the RHS of the flux equation
+ real(rkind),intent(out) :: resVec(:) ! NOTE: qp ! residual vector
+ real(rkind),intent(out) :: fEval ! function evaluation
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! diagnostic variables
+ logical(lgt),parameter :: needEnthalpy=.true. ! flag to compute enthalpy
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
+ ! other local variables
+ integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
+ integer(i4b) :: jState(1) ! index of model state for the scalar solution within the soil domain
+ integer(i4b) :: ixBeg,ixEnd ! index of indices for the soil compression routine
+ integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
+ real(rkind) :: xMin,xMax ! minimum and maximum values for water content
+ real(rkind) :: scalarCanopyHydTrial ! trial value for mass of water on the vegetation canopy (kg m-2)
+ real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracHydTrial ! trial value for volumetric fraction of water (-), general vector merged from Wat and Liq
+ real(rkind),dimension(nState) :: rVecScaled ! scaled residual vector
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model state variables
+ 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)
+ 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)
+ scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(in): [dp] storage of water in the aquifer (m)
+ ! model diagnostic variables from a previous solution
+ scalarSfcMeltPond => prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) ,& ! intent(in): [dp] ponded water caused by melt of the "snow without a layer" (kg m-2)
+ 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 (-)
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(in): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(in): [dp(:)] fraction of liquid water in each snow layer (-)
+ ! enthalpy
+ scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(out): [dp(:)] enthalpy of the snow+soil layers (J m-3)
+ ! soil compression
+ scalarSoilCompress => diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ,& ! intent(in): [dp] total change in storage associated with compression of the soil matrix (kg m-2)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
+ ! derivatives
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0)%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi)%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t. matric head (m-1)
+ ! mapping
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ! indices
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable (nrg)
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable (nrg)
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat & ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8summa/"
+
+ ! check the feasibility of the solution
+ feasible=.true.
+
+ ! check that the canopy air space temperature is reasonable
+ if(ixCasNrg/=integerMissing)then
+ if(stateVecTrial(ixCasNrg) > canopyTempMax) feasible=.false.
+ if(stateVecTrial(ixCasNrg) > canopyTempMax) message=trim(message)//'canopy air space temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVecTrial( ixCasNrg )', feasible, canopyTempMax, stateVecTrial(ixCasNrg)
+ endif
+
+ ! check that the canopy air space temperature is reasonable
+ if(ixVegNrg/=integerMissing)then
+ if(stateVecTrial(ixVegNrg) > canopyTempMax) feasible=.false.
+ if(stateVecTrial(ixVegNrg) > canopyTempMax) message=trim(message)//'canopy temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVecTrial( ixVegNrg )', feasible, canopyTempMax, stateVecTrial(ixVegNrg)
+ endif
+
+ ! check canopy liquid water is not negative
+ if(ixVegHyd/=integerMissing)then
+ if(stateVecTrial(ixVegHyd) < 0._rkind) feasible=.false.
+ if(stateVecTrial(ixVegHyd) < 0._rkind) message=trim(message)//'canopy water negative,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, min, stateVecTrial( ixVegHyd )', feasible, 0._rkind, stateVecTrial(ixVegHyd)
+ end if
+
+ ! check snow temperature is below freezing
+ if(count(ixSnowOnlyNrg/=integerMissing)>0)then
+ if(any(stateVecTrial( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) feasible=.false.
+ if(any(stateVecTrial( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) message=trim(message)//'snow temp above freezing,'
+ do iLayer=1,nSnow
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, max, stateVecTrial( ixSnowOnlyNrg(iLayer) )', iLayer, feasible, Tfreeze, stateVecTrial( ixSnowOnlyNrg(iLayer) )
+ enddo
+ endif
+
+ ! loop through non-missing hydrology state variables in the snow+soil domain
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
+
+ ! check the minimum and maximum water constraints
+ if(ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_liqLayer)then
+
+ ! --> minimum
+ if (layerType(iLayer) == iname_soil) then
+ xMin = theta_res(iLayer-nSnow)
+ else
+ xMin = 0._rkind
+ endif
+
+ ! --> maximum
+ select case( layerType(iLayer) )
+ case(iname_snow); xMax = merge(iden_ice, 1._rkind - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ case(iname_soil); xMax = merge(theta_sat(iLayer-nSnow), theta_sat(iLayer-nSnow) - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ end select
+
+ ! --> check
+ if(stateVecTrial( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVecTrial( ixSnowSoilHyd(iLayer) ) > xMax) feasible=.false.
+ if(stateVecTrial( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVecTrial( ixSnowSoilHyd(iLayer) ) > xMax) message=trim(message)//'layer water outside bounds,'
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, stateVecTrial( ixSnowSoilHyd(iLayer) ), xMin, xMax = ', iLayer, feasible, stateVecTrial( ixSnowSoilHyd(iLayer) ), xMin, xMax
+
+ endif ! if water states
+
+ end do ! loop through non-missing hydrology state variables in the snow+soil domain
+
+ ! early return for non-feasible solutions
+ if(.not.feasible)then
+ fluxVec(:) = realMissing
+ resVec(:) = quadMissing
+ fEval = realMissing
+ message=trim(message)//'non-feasible'
+ err=20; return
+ endif
+
+ ! get the start and end indices for the soil compression calculations
+ if(scalarSolution)then
+ jState = pack(ixControlVolume, ixMapFull2Subset/=integerMissing)
+ ixBeg = jState(1)
+ ixEnd = jState(1)
+ else
+ ixBeg = 1
+ ixEnd = nSoil
+ endif
+
+ ! initialize to state variable from the last update
+ scalarCanairTempTrial = scalarCanairTemp
+ scalarCanopyTempTrial = scalarCanopyTemp
+ scalarCanopyWatTrial = scalarCanopyWat
+ scalarCanopyLiqTrial = scalarCanopyLiq
+ scalarCanopyIceTrial = scalarCanopyIce
+ mLayerTempTrial = mLayerTemp
+ mLayerVolFracWatTrial = mLayerVolFracWat
+ mLayerVolFracLiqTrial = mLayerVolFracLiq
+ mLayerVolFracIceTrial = mLayerVolFracIce
+ mLayerMatricHeadTrial = mLayerMatricHead ! total water matric potential
+ mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq ! liquid water matric potential
+ scalarAquiferStorageTrial = scalarAquiferStorage
+
+ ! extract variables from the model 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)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! update diagnostic variables and derivatives
+ call updateVars(&
+ ! input
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ lookup_data, & ! intent(in): lookup tables for a local HRU
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ 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)
+ ! 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)
! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- endif ! if computing enthalpy
-
- ! print the states in the canopy domain
- !print*, 'dt = ', dt
- !write(*,'(a,1x,10(f20.10,1x))') 'scalarCanopyTempTrial = ', scalarCanopyTempTrial
- !write(*,'(a,1x,10(f20.10,1x))') 'scalarCanopyWatTrial = ', scalarCanopyWatTrial
- !write(*,'(a,1x,10(f20.10,1x))') 'scalarCanopyLiqTrial = ', scalarCanopyLiqTrial
- !write(*,'(a,1x,10(f20.10,1x))') 'scalarCanopyIceTrial = ', scalarCanopyIceTrial
-
- ! print the states in the snow+soil domain
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerTempTrial = ', mLayerTempTrial(iJac1:min(nLayers,iJac2))
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(nLayers,iJac2))
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(nLayers,iJac2))
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(nLayers,iJac2))
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerMatricHeadTrial = ', mLayerMatricHeadTrial(iJac1:min(nSoil,iJac2))
- !write(*,'(a,1x,10(f20.10,1x))') 'mLayerMatricHeadLiqTrial = ', mLayerMatricHeadLiqTrial(iJac1:min(nSoil,iJac2))
-
- ! print the water content
- if(globalPrintFlag)then
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(iJac2,nSnow))
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(iJac2,nSnow))
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(iJac2,nSnow))
- endif
-
- ! save the number of flux calls per time step
- indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) = indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) + 1
-
- ! compute the fluxes for a given state vector
- call computFlux(&
- ! input-output: model control
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- firstFluxCall, & ! intent(inout): flag to denote the first flux call
- firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- .false., & ! intent(in): not inside Sundials solver loop
- scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
- ! input: state variables
- scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
- scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
- mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
- mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
- mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
- scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
- ! input: diagnostic variables defining the liquid water and ice content
- scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
- scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
- mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each snow and soil layer (-)
- mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): index data
- ! input-output: data structures
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- deriv_data, & ! intent(out): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: flux vector and baseflow derivatives
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- fluxVec, & ! intent(out): flux vector (mixed units)
- ! output: error control
- err,cmessage) ! intent(out): error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! compute soil compressibility (-) and its derivative w.r.t. matric head (m)
- ! NOTE: we already extracted trial matrix head and volumetric liquid water as part of the flux calculations
- ! use non-sundials version because sundials version needs mLayerMatricHeadPrime
- call soilCmpres(&
- ! input:
- ixRichards, & ! intent(in): choice of option for Richards' equation
- ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
- mLayerMatricHead(1:nSoil), & ! intent(in): matric head at the start of the time step (m)
- mLayerMatricHeadTrial(1:nSoil), & ! intent(in): trial value of matric head (m)
- mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
- mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
- specificStorage, & ! intent(in): specific storage coefficient (m-1)
- theta_sat, & ! intent(in): soil porosity (-)
- ! output:
- mLayerCompress, & ! intent(inout): compressibility of the soil matrix (-)
- dCompress_dPsi, & ! intent(inout): derivative in compressibility w.r.t. matric head (m-1)
- err,cmessage) ! intent(out): error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! compute the total change in storage associated with compression of the soil matrix (kg m-2)
- scalarSoilCompress = sum(mLayerCompress(1:nSoil)*mLayerDepth(nSnow+1:nLayers))*iden_water
-
- ! vegetation domain: get the correct water states (total water, or liquid water, depending on the state type)
- if(computeVegFlux)then
- scalarCanopyHydTrial = merge(scalarCanopyWatTrial, scalarCanopyLiqTrial, (ixStateType( ixHydCanopy(ixVegVolume) )==iname_watCanopy) )
- else
- scalarCanopyHydTrial = realMissing
- endif
-
- ! snow+soil domain: get the correct water states (total water, or liquid water, depending on the state type)
- mLayerVolFracHydTrial = merge(mLayerVolFracWatTrial, mLayerVolFracLiqTrial, (ixHydType==iname_watLayer .or. ixHydType==iname_matLayer) )
-
- ! compute the residual vector
- call computResid(&
- ! input: model control
- dt, & ! intent(in): length of the time step (seconds)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! compute enthalpy (J m-3)
+ if(needEnthalpy)then
+ 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
+ scalarCanairEnthalpy, & ! intent(out): enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy, & ! intent(out): enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy, & ! 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 ! if computing enthalpy
+
+ ! print the water content
+ if(globalPrintFlag)then
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(iJac2,nSnow))
+ endif
+
+ ! save the number of flux calls per time step
+ indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) = indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) + 1
+
+ ! compute the fluxes for a given state vector
+ call computFlux(&
+ ! input-output: model control
nSnow, & ! intent(in): number of snow layers
nSoil, & ! intent(in): number of soil layers
nLayers, & ! intent(in): total number of layers
- ! input: flux vectors
- sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
- fluxVec, & ! intent(in): flux vector
- ! input: state variables (already disaggregated into scalars and vectors)
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to denote the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ .true., & ! intent(in): balance longwave
+ scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
+ ! input: state variables
scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
- scalarCanopyHydTrial, & ! intent(in): trial value of canopy hydrology state variable (kg m-2)
mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
- mLayerVolFracHydTrial, & ! intent(in): trial vector of volumetric water content (-)
+ mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
- ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ ! input: diagnostic variables defining the liquid water and ice content
+ scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
+ mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each snow and soil layer (-)
mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- flux_data, & ! intent(in): model fluxes for a local HRU
indx_data, & ! intent(in): index data
- ! output
- resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- resVec, & ! intent(out): residual vector
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! compute the function evaluation
- rVecScaled = fScale(:)*real(resVec(:), rkind) ! scale the residual vector (NOTE: residual vector is in quadruple precision)
- fEval = 0.5_rkind*dot_product(rVecScaled,rVecScaled)
-
- ! end association with the information in the data structures
- end associate
-
- end subroutine eval8summa
-
- end module eval8summa_module
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(out): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: flux vector and baseflow derivatives
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ fluxVec, & ! intent(out): flux vector (mixed units)
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! compute soil compressibility (-) and its derivative w.r.t. matric head (m)
+ ! NOTE: we already extracted trial matrix head and volumetric liquid water as part of the flux calculations
+ ! use non-sundials version because sundials version needs mLayerMatricHeadPrime
+ call soilCmpres(&
+ ! input:
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
+ mLayerMatricHead(1:nSoil), & ! intent(in): matric head at the start of the time step (m)
+ mLayerMatricHeadTrial(1:nSoil), & ! intent(in): trial value of matric head (m)
+ mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ! output:
+ mLayerCompress, & ! intent(inout): compressibility of the soil matrix (-)
+ dCompress_dPsi, & ! intent(inout): derivative in compressibility w.r.t. matric head (m-1)
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! compute the total change in storage associated with compression of the soil matrix (kg m-2)
+ scalarSoilCompress = sum(mLayerCompress(1:nSoil)*mLayerDepth(nSnow+1:nLayers))*iden_water
+
+ ! vegetation domain: get the correct water states (total water, or liquid water, depending on the state type)
+ if(computeVegFlux)then
+ scalarCanopyHydTrial = merge(scalarCanopyWatTrial, scalarCanopyLiqTrial, (ixStateType( ixHydCanopy(ixVegVolume) )==iname_watCanopy) )
+ else
+ scalarCanopyHydTrial = realMissing
+ endif
+
+ ! snow+soil domain: get the correct water states (total water, or liquid water, depending on the state type)
+ mLayerVolFracHydTrial = merge(mLayerVolFracWatTrial, mLayerVolFracLiqTrial, (ixHydType==iname_watLayer .or. ixHydType==iname_matLayer) )
+
+ ! compute the residual vector
+ call computResid(&
+ ! input: model control
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ! input: flux vectors
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ fluxVec, & ! intent(in): flux vector
+ ! input: state variables (already disaggregated into scalars and vectors)
+ scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
+ scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
+ scalarCanopyHydTrial, & ! intent(in): trial value of canopy hydrology state variable (kg m-2)
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerVolFracHydTrial, & ! intent(in): trial vector of volumetric water content (-)
+ scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
+ mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
+ ! input: data structures
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ flux_data, & ! intent(in): model fluxes for a local HRU
+ indx_data, & ! intent(in): index data
+ ! output
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! compute the function evaluation
+ rVecScaled = fScale(:)*real(resVec(:), rkind) ! scale the residual vector (NOTE: residual vector is in quadruple precision)
+ fEval = 0.5_rkind*dot_product(rVecScaled,rVecScaled)
+
+ ! end association with the information in the data structures
+ end associate
+
+end subroutine eval8summa
+
+end module eval8summa_module
\ No newline at end of file
diff --git a/build/source/engine/ffile_info.f90 b/build/source/engine/ffile_info.f90
index 32ff329..a89c1a5 100755
--- a/build/source/engine/ffile_info.f90
+++ b/build/source/engine/ffile_info.f90
@@ -49,7 +49,7 @@ subroutine ffile_info(indxGRU,forcFileInfo,numFiles,err,message)
USE globalData,only:gru_struc ! gru-hru mapping structure
USE time_utils_module,only:extractTime
USE globalData,only:time_meta
- USE allocspace4chm_module,only:allocLocal
+ USE allocspace_module,only:allocLocal
USE time_utils_module,only:extractTime ! extract time info from units string
USE summaActors_FileManager,only: SIM_START_TM, SIM_END_TM, FORCING_START ! time info from control file module
USE var_lookup,only:iLookTIME ! named variables that identify indices in the time structures
diff --git a/build/source/engine/getVectorz.f90 b/build/source/engine/getVectorz.f90
index ba31b4b..70a47b5 100755
--- a/build/source/engine/getVectorz.f90
+++ b/build/source/engine/getVectorz.f90
@@ -64,9 +64,9 @@ USE multiconst,only:&
! provide access to the derived types to define the data structures
USE data_types,only:&
var_i, & ! data vector (i4b)
- var_d, & ! data vector (dp)
+ var_d, & ! data vector (rkind)
var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength ! data vector with variable length dimension (dp)
+ var_dlength ! data vector with variable length dimension (rkind)
! provide access to indices that define elements of the data structures
USE var_lookup,only:iLookDIAG ! named variables for structure elements
@@ -97,14 +97,14 @@ public::getScaling
public::varExtract
! common variables
-real(dp),parameter :: valueMissing=-9999._dp ! missing value
+real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
contains
- ! **********************************************************************************************************
- ! public subroutine popStateVec: populate model state vectors
- ! **********************************************************************************************************
- subroutine popStateVec(&
+! **********************************************************************************************************
+! public subroutine popStateVec: populate model state vectors
+! **********************************************************************************************************
+subroutine popStateVec(&
! input: data structures
nState, & ! intent(in): number of desired state variables
prog_data, & ! intent(in): model prognostic variables for a local HRU
@@ -113,457 +113,419 @@ contains
! output
stateVec, & ! intent(out): model state vector
err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! input: data structures
- integer(i4b),intent(in) :: nState ! number of desired state variables
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
- ! output
- real(dp),intent(out) :: stateVec(:) ! model state vector (mixed units)
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! state subsets
- integer(i4b) :: iState ! index of state within the snow+soil domain
- integer(i4b) :: iLayer ! index of layer within the snow+soil domain
- integer(i4b) :: ixStateSubset ! index within the state subset
- logical(lgt),dimension(nState) :: stateFlag ! flag to denote that the state is populated
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! make association with variables in the data structures
- fixedLength: associate(&
- ! 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)
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(in) : [dp] mass of liquid water on the vegetation canopy (kg m-2)
- ! model state variable vectors for the snow-soil layers
- mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in) : [dp(:)] temperature of each snow/soil layer (K)
- mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of total water (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of liquid water (-)
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in) : [dp(:)] matric head (m)
- mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in) : [dp(:)] matric potential of liquid water (m)
- ! model state variables for the aquifer
- scalarAquiferStorage=> prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(in) : [dp] storage of water in the aquifer (m)
- ! indices defining specific model states
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy hydrology state variable (mass)
- ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of aquifer storage state variable
- ! vector of energy and hydrology indices for the snow and soil domains
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in) : [i4b] number of energy state variables in the snow+soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in) : [i4b] number of hydrology state variables in the snow+soil domain
- ! type of model state variabless
- ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in) : [i4b(:)] [state subset] type of desired model state variables
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in) : [i4b(:)] index of the type of hydrology states in snow+soil domain
- ! number of layers
- nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in) : [i4b] number of snow layers
- nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in) : [i4b] number of soil layers
- nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in) : [i4b] total number of layers
- ) ! end association with variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='popStateVec/'
-
- ! -----
- ! * initialize state vectors...
- ! -----------------------------
-
- ! initialize flags
- stateFlag(:) = .false.
-
- ! build the state vector for the temperature of the canopy air space
- ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
- do concurrent (iState=1:size(ixCasNrg),ixCasNrg(iState)/=integerMissing)
- stateVec( ixCasNrg(iState) ) = scalarCanairTemp ! transfer canopy air temperature to the state vector
- stateFlag( ixCasNrg(iState) ) = .true. ! flag to denote that the state is populated
- end do
-
- ! build the state vector for the temperature of the vegetation canopy
- ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
- do concurrent (iState=1:size(ixVegNrg),ixVegNrg(iState)/=integerMissing)
- stateVec( ixVegNrg(iState) ) = scalarCanopyTemp ! transfer vegetation temperature to the state vector
- stateFlag( ixVegNrg(iState) ) = .true. ! flag to denote that the state is populated
- end do
-
- ! build the state vector for the water in the vegetation canopy
- ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
- do concurrent (iState=1:size(ixVegHyd),ixVegHyd(iState)/=integerMissing)
- stateFlag( ixVegHyd(iState) ) = .true. ! flag to denote that the state is populated
- select case(ixStateType_subset( ixVegHyd(iState) ))
- case(iname_watCanopy); stateVec( ixVegHyd(iState) ) = scalarCanopyWat ! transfer total canopy water to the state vector
- case(iname_liqCanopy); stateVec( ixVegHyd(iState) ) = scalarCanopyLiq ! transfer liquid canopy water to the state vector
- case default; stateFlag( ixVegHyd(iState) ) = .false. ! flag to denote that the state is populated
- end select
- end do
-
- ! build the energy state vector for the snow and soil domain
- if(nSnowSoilNrg>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
- ixStateSubset = ixSnowSoilNrg(iLayer) ! index within the state vector
- stateVec(ixStateSubset) = mLayerTemp(iLayer) ! transfer temperature from a layer to the state vector
- stateFlag(ixStateSubset) = .true. ! flag to denote that the state is populated
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! build the hydrology state vector for the snow+soil domains
- ! NOTE: ixVolFracWat and ixVolFracLiq can also include states in the soil domain, hence enable primary variable switching
- if(nSnowSoilHyd>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
- ixStateSubset = ixSnowSoilHyd(iLayer) ! index within the state vector
- stateFlag(ixStateSubset) = .true. ! flag to denote that the state is populated
- select case( ixHydType(iLayer) )
- case(iname_watLayer); stateVec(ixStateSubset) = mLayerVolFracWat(iLayer) ! total water state variable for snow+soil layers
- case(iname_liqLayer); stateVec(ixStateSubset) = mLayerVolFracLiq(iLayer) ! liquid water state variable for snow+soil layers
- case(iname_matLayer); stateVec(ixStateSubset) = mLayerMatricHead(iLayer-nSnow) ! total water matric potential variable for soil layers
- case(iname_lmpLayer); stateVec(ixStateSubset) = mLayerMatricHeadLiq(iLayer-nSnow) ! liquid matric potential state variable for soil layers
- case default; stateFlag(ixStateSubset) = .false. ! flag to denote that the state is populated
- end select
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! build the state vector for the aquifer storage
- ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer aquifer
- do concurrent (iState=1:size(ixAqWat),ixAqWat(iState)/=integerMissing)
- stateVec( ixAqWat(iState) ) = scalarAquiferStorage ! transfer aquifer storage to the state vector
- stateFlag( ixAqWat(iState) ) = .true. ! flag to denote that the state is populated
- end do
-
- ! check that we populated all state variables
- if(count(stateFlag)/=nState)then
- print*, 'stateFlag = ', stateFlag
- message=trim(message)//'some state variables unpopulated'
- err=20; return
- endif
-
- end associate fixedLength ! end association to variables in the data structure where vector length does not change
- end subroutine popStateVec
-
-
- ! **********************************************************************************************************
- ! public subroutine getScaling: get scale factors
- ! **********************************************************************************************************
- subroutine getScaling(&
- ! 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
- fScale, & ! intent(out): function scaling vector (mixed units)
- xScale, & ! intent(out): variable scaling vector (mixed units)
- sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
- dMat, & ! intent(out): diagonal of the Jacobian matrix (excludes fluxes)
- err,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
- 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(dp),intent(out) :: fScale(:) ! function scaling vector (mixed units)
- real(dp),intent(out) :: xScale(:) ! variable scaling vector (mixed units)
- real(qp),intent(out) :: sMul(:) ! NOTE: qp ! multiplier for state vector (used in the residual calculations)
- real(dp),intent(out) :: dMat(:) ! diagonal of the Jacobian matrix (excludes fluxes)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! scaling parameters
- real(dp),parameter :: fScaleLiq=0.01_dp ! func eval: characteristic scale for volumetric liquid water content (-)
- real(dp),parameter :: fScaleMat=10._dp ! func eval: characteristic scale for matric head (m)
- real(dp),parameter :: fScaleNrg=1000000._dp ! func eval: characteristic scale for energy (J m-3)
- real(dp),parameter :: xScaleLiq=0.1_dp ! state var: characteristic scale for volumetric liquid water content (-)
- real(dp),parameter :: xScaleMat=10._dp ! state var: characteristic scale for matric head (m)
- real(dp),parameter :: xScaleTemp=1._dp ! state var: characteristic scale for temperature (K)
- ! 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
- fixedLength: 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)
- mLayerVolHeatCap => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat ,& ! intent(in) : [dp(:)] bulk volumetric heat capacity in each snow and soil layer (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='getScaling/'
-
- ! -----
- ! * define scaling vectors...
- ! ---------------------------
-
- ! define the function and variable scaling factors for energy
- where(ixStateType_subset==iname_nrgCanair .or. ixStateType_subset==iname_nrgCanopy .or. ixStateType_subset==iname_nrgLayer)
- fScale = 1._dp / fScaleNrg ! 1/(J m-3)
- xScale = 1._dp ! K
- endwhere
-
- ! define the function and variable scaling factors for water on the vegetation canopy
- where(ixStateType_subset==iname_watCanopy .or. ixStateType_subset==iname_liqCanopy)
- fScale = 1._dp / (fScaleLiq*canopyDepth*iden_water) ! 1/(kg m-2)
- xScale = 1._dp ! (kg m-2)
- endwhere
-
- ! define the function and variable scaling factors for water in the snow+soil domain
- where(ixStateType_subset==iname_watLayer .or. ixStateType_subset==iname_liqLayer)
- fScale = 1._dp / fScaleLiq ! (-)
- xScale = 1._dp ! (-)
- end where
-
- ! define the function and variable scaling factors for water in the snow+soil domain
- where(ixStateType_subset==iname_matLayer .or. ixStateType_subset==iname_lmpLayer)
- fScale = 1._dp / fScaleLiq ! (-)
- xScale = 1._dp ! (m)
- end where
-
- ! define the function and variable scaling factors for water storage in the aquifer
- where(ixStateType_subset==iname_watAquifer)
- fScale = 1._dp
- xScale = 1._dp
- endwhere
-
- ! -----
- ! * 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 = volHeatCapVeg ! volumetric heat capacity of the vegetation (J m-3 K-1)
- where(ixStateType_subset==iname_watCanopy) sMul = 1._dp ! nothing else on the left hand side
- where(ixStateType_subset==iname_liqCanopy) sMul = 1._dp ! nothing else on the left hand side
-
- ! compute terms in the Jacobian for vegetation (excluding fluxes)
- ! NOTE: This is computed outside the iteration loop because it does not depend on state variables
- ! NOTE: Energy for vegetation is computed *within* the iteration loop as it includes phase change
- ! NOTE: Use the "where" statement to generalize to multiple canopy layers (currently one canopy layer)
- where(ixStateType_subset==iname_nrgCanair) dMat = Cp_air*iden_air ! volumetric heat capacity of air (J m-3 K-1)
- where(ixStateType_subset==iname_nrgCanopy) dMat = realMissing ! populated within the iteration loop
- where(ixStateType_subset==iname_watCanopy) dMat = 1._dp ! nothing else on the left hand side
- where(ixStateType_subset==iname_liqCanopy) dMat = 1._dp ! nothing else on the left hand side
-
- ! define the energy multiplier and diagonal elements 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) = mLayerVolHeatCap(iLayer) ! transfer volumetric heat capacity to the state multiplier
- dMat(ixStateSubset) = realMissing ! diagonal element populated within the iteration loop
- 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._dp ! state multiplier = 1 (nothing else on the left-hand-side)
- dMat(ixStateSubset) = 1._dp ! diagonal element = 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._dp
- dMat = 1._dp
- endwhere
-
- ! ------------------------------------------------------------------------------------------
- ! ------------------------------------------------------------------------------------------
-
- end associate fixedLength ! end association to variables in the data structure where vector length does not change
- end subroutine getScaling
-
-
-
- ! **********************************************************************************************************
- ! public subroutine varExtract: extract variables from the state vector and compute diagnostic variables
- ! **********************************************************************************************************
- subroutine varExtract(&
- ! input
- stateVec, & ! intent(in): model state vector (mixed units)
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output: variables for the vegetation canopy
- scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
- scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
- scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
- scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
- 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,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- implicit none
- ! input
- real(dp),intent(in) :: stateVec(:) ! model state vector (mixed units)
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
- ! output: variables for the vegetation canopy
- real(dp),intent(out) :: scalarCanairTempTrial ! trial value of canopy air temperature (K)
- real(dp),intent(out) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
- real(dp),intent(out) :: scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
- real(dp),intent(out) :: scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
- real(dp),intent(out) :: scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
- ! output: variables for the snow-soil domain
- real(dp),intent(out) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
- real(dp),intent(out) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
- real(dp),intent(out) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
- real(dp),intent(out) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
- real(dp),intent(out) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
- real(dp),intent(out) :: mLayerMatricHeadLiqTrial(:) ! trial vector of liquid water matric potential (m)
- ! output: variables for the aquifer
- real(dp),intent(out) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- integer(i4b) :: iLayer ! index of layer within the snow+soil domain
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! make association with variables in the data structures
- associate(&
- ! number of model layers, and layer type
- nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
- nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
- nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
- ! indices defining model states and layers
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
- ! indices defining type of model state variables
- ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- ! 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 state variables for the aquifer
- scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(in): [dp] storage of water in the aquifer (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 (-)
- ) ! association with variables in the data structures
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
-
- ! initialize error control
- err=0; message='varExtract/'
-
- ! *** extract state variables for the vegetation canopy
-
- ! initialize to state variable from the last update
- scalarCanairTempTrial = scalarCanairTemp
- scalarCanopyTempTrial = scalarCanopyTemp
- scalarCanopyWatTrial = scalarCanopyWat
- scalarCanopyLiqTrial = scalarCanopyLiq
- scalarCanopyIceTrial = scalarCanopyIce
-
- ! check if computing the vegetation flux
- if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing .or. ixVegHyd/=integerMissing)then
-
- ! extract temperature of the canopy air space
- if(ixCasNrg/=integerMissing) scalarCanairTempTrial = stateVec(ixCasNrg)
-
- ! extract canopy temperature
- if(ixVegNrg/=integerMissing) scalarCanopyTempTrial = stateVec(ixVegNrg)
-
- ! extract intercepted water
- if(ixVegHyd/=integerMissing)then
- select case( ixStateType_subset(ixVegHyd) )
- case(iname_liqCanopy); scalarCanopyLiqTrial = stateVec(ixVegHyd)
- case(iname_watCanopy); scalarCanopyWatTrial = stateVec(ixVegHyd)
- case default; err=20; message=trim(message)//'case not found: expect iname_liqCanopy or iname_watCanopy'; return
- end select
- endif
-
- endif ! not computing the vegetation flux
-
- ! *** extract state variables from the snow+soil sub-domain
-
- ! initialize to the state variable from the last update
- mLayerTempTrial = mLayerTemp
- mLayerVolFracWatTrial = mLayerVolFracWat
- mLayerVolFracLiqTrial = mLayerVolFracLiq
- mLayerVolFracIceTrial = mLayerVolFracIce
- mLayerMatricHeadTrial = mLayerMatricHead ! total water matric potential
- mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq ! liquid water matric potential
- scalarAquiferStorageTrial = scalarAquiferStorage
-
- ! overwrite with the energy values from the state vector
- if(nSnowSoilNrg>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
- mLayerTempTrial(iLayer) = stateVec( ixSnowSoilNrg(iLayer) )
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! overwrite with the hydrology values from the state vector
- if(nSnowSoilHyd>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
- select case( ixHydType(iLayer) )
- case(iname_watLayer); mLayerVolFracWatTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
- case(iname_liqLayer); mLayerVolFracLiqTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
- case(iname_matLayer); mLayerMatricHeadTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
- case(iname_lmpLayer); mLayerMatricHeadLiqTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
- case default ! do nothing
- end select
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! extract temperature of the canopy air space
- if(ixAqWat/=integerMissing) scalarAquiferStorageTrial = stateVec(ixAqWat)
-
- end associate
-
- end subroutine varExtract
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: data structures
+ integer(i4b),intent(in) :: nState ! number of desired state variables
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ ! output
+ real(rkind),intent(out) :: stateVec(:) ! model state vector (mixed units)
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state subsets
+ integer(i4b) :: iState ! index of state within the snow+soil domain
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: ixStateSubset ! index within the state subset
+ logical(lgt),dimension(nState) :: stateFlag ! flag to denote that the state is populated
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ fixedLength: associate(&
+ ! 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)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(in) : [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ ! model state variable vectors for the snow-soil layers
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in) : [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of total water (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in) : [dp(:)] volumetric fraction of liquid water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in) : [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in) : [dp(:)] matric potential of liquid water (m)
+ ! model state variables for the aquifer
+ scalarAquiferStorage=> prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(in) : [dp] storage of water in the aquifer (m)
+ ! indices defining specific model states
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat ,& ! intent(in) : [i4b(:)] [length=1] index of aquifer storage state variable
+ ! vector of energy and hydrology indices for the snow and soil domains
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in) : [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in) : [i4b] number of hydrology state variables in the snow+soil domain
+ ! type of model state variabless
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in) : [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in) : [i4b(:)] index of the type of hydrology states in snow+soil domain
+ ! number of layers
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in) : [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in) : [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in) : [i4b] total number of layers
+ ) ! end association with variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='popStateVec/'
+
+ ! -----
+ ! * initialize state vectors...
+ ! -----------------------------
+
+ ! initialize flags
+ stateFlag(:) = .false.
+
+ ! build the state vector for the temperature of the canopy air space
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixCasNrg),ixCasNrg(iState)/=integerMissing)
+ stateVec( ixCasNrg(iState) ) = scalarCanairTemp ! transfer canopy air temperature to the state vector
+ stateFlag( ixCasNrg(iState) ) = .true. ! flag to denote that the state is populated
+ end do
+
+ ! build the state vector for the temperature of the vegetation canopy
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixVegNrg),ixVegNrg(iState)/=integerMissing)
+ stateVec( ixVegNrg(iState) ) = scalarCanopyTemp ! transfer vegetation temperature to the state vector
+ stateFlag( ixVegNrg(iState) ) = .true. ! flag to denote that the state is populated
+ end do
+
+ ! build the state vector for the water in the vegetation canopy
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer canopy
+ do concurrent (iState=1:size(ixVegHyd),ixVegHyd(iState)/=integerMissing)
+ stateFlag( ixVegHyd(iState) ) = .true. ! flag to denote that the state is populated
+ select case(ixStateType_subset( ixVegHyd(iState) ))
+ case(iname_watCanopy); stateVec( ixVegHyd(iState) ) = scalarCanopyWat ! transfer total canopy water to the state vector
+ case(iname_liqCanopy); stateVec( ixVegHyd(iState) ) = scalarCanopyLiq ! transfer liquid canopy water to the state vector
+ case default; stateFlag( ixVegHyd(iState) ) = .false. ! flag to denote that the state is populated
+ end select
+ end do
+
+ ! build the energy state vector for the snow and soil domain
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilNrg(iLayer) ! index within the state vector
+ stateVec(ixStateSubset) = mLayerTemp(iLayer) ! transfer temperature from a layer to the state vector
+ stateFlag(ixStateSubset) = .true. ! flag to denote that the state is populated
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! build the hydrology state vector for the snow+soil domains
+ ! NOTE: ixVolFracWat and ixVolFracLiq can also include states in the soil domain, hence enable primary variable switching
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ ixStateSubset = ixSnowSoilHyd(iLayer) ! index within the state vector
+ stateFlag(ixStateSubset) = .true. ! flag to denote that the state is populated
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); stateVec(ixStateSubset) = mLayerVolFracWat(iLayer) ! total water state variable for snow+soil layers
+ case(iname_liqLayer); stateVec(ixStateSubset) = mLayerVolFracLiq(iLayer) ! liquid water state variable for snow+soil layers
+ case(iname_matLayer); stateVec(ixStateSubset) = mLayerMatricHead(iLayer-nSnow) ! total water matric potential variable for soil layers
+ case(iname_lmpLayer); stateVec(ixStateSubset) = mLayerMatricHeadLiq(iLayer-nSnow) ! liquid matric potential state variable for soil layers
+ case default; stateFlag(ixStateSubset) = .false. ! flag to denote that the state is populated
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! build the state vector for the aquifer storage
+ ! NOTE: currently vector length=1, and use "do concurrent" to generalize to a multi-layer aquifer
+ do concurrent (iState=1:size(ixAqWat),ixAqWat(iState)/=integerMissing)
+ stateVec( ixAqWat(iState) ) = scalarAquiferStorage ! transfer aquifer storage to the state vector
+ stateFlag( ixAqWat(iState) ) = .true. ! flag to denote that the state is populated
+ end do
+
+ ! check that we populated all state variables
+ if(count(stateFlag)/=nState)then
+ print*, 'stateFlag = ', stateFlag
+ message=trim(message)//'some state variables unpopulated'
+ err=20; return
+ endif
+
+ end associate fixedLength ! end association to variables in the data structure where vector length does not change
+end subroutine popStateVec
+
+
+! **********************************************************************************************************
+! public subroutine getScaling: get scale factors
+! **********************************************************************************************************
+subroutine getScaling(&
+ ! 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
+ fScale, & ! intent(out): function scaling vector (mixed units)
+ xScale, & ! intent(out): variable scaling vector (mixed units)
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ dMat, & ! intent(out): diagonal of the Jacobian matrix (excludes fluxes)
+ err,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
+ 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(rkind),intent(out) :: fScale(:) ! function scaling vector (mixed units)
+ real(rkind),intent(out) :: xScale(:) ! variable scaling vector (mixed units)
+ real(rkind),intent(out) :: sMul(:) ! NOTE: qp ! multiplier for state vector (used in the residual calculations)
+ real(rkind),intent(out) :: dMat(:) ! diagonal of the Jacobian matrix (excludes fluxes)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! scaling parameters
+ real(rkind),parameter :: fScaleLiq=0.01_rkind ! func eval: characteristic scale for volumetric liquid water content (-)
+ real(rkind),parameter :: fScaleMat=10._rkind ! func eval: characteristic scale for matric head (m)
+ real(rkind),parameter :: fScaleNrg=1000000._rkind ! func eval: characteristic scale for energy (J m-3)
+ real(rkind),parameter :: xScaleLiq=0.1_rkind ! state var: characteristic scale for volumetric liquid water content (-)
+ real(rkind),parameter :: xScaleMat=10._rkind ! state var: characteristic scale for matric head (m)
+ real(rkind),parameter :: xScaleTemp=1._rkind ! state var: characteristic scale for temperature (K)
+ ! 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
+ fixedLength: 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)
+ mLayerVolHeatCap => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat ,& ! intent(in) : [dp(:)] bulk volumetric heat capacity in each snow and soil layer (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='getScaling/'
+
+ ! -----
+ ! * define scaling vectors...
+ ! ---------------------------
+
+ ! define the function and variable scaling factors for energy
+ where(ixStateType_subset==iname_nrgCanair .or. ixStateType_subset==iname_nrgCanopy .or. ixStateType_subset==iname_nrgLayer)
+ fScale = 1._rkind / fScaleNrg ! 1/(J m-3)
+ xScale = 1._rkind ! K
+ endwhere
+
+ ! define the function and variable scaling factors for water on the vegetation canopy
+ where(ixStateType_subset==iname_watCanopy .or. ixStateType_subset==iname_liqCanopy)
+ fScale = 1._rkind / (fScaleLiq*canopyDepth*iden_water) ! 1/(kg m-2)
+ xScale = 1._rkind ! (kg m-2)
+ endwhere
+
+ ! define the function and variable scaling factors for water in the snow+soil domain
+ where(ixStateType_subset==iname_watLayer .or. ixStateType_subset==iname_liqLayer)
+ fScale = 1._rkind / fScaleLiq ! (-)
+ xScale = 1._rkind ! (-)
+ end where
+
+ ! define the function and variable scaling factors for water in the snow+soil domain
+ where(ixStateType_subset==iname_matLayer .or. ixStateType_subset==iname_lmpLayer)
+ fScale = 1._rkind / fScaleLiq ! (-)
+ xScale = 1._rkind ! (m)
+ end where
+
+ ! define the function and variable scaling factors for water storage in the aquifer
+ where(ixStateType_subset==iname_watAquifer)
+ fScale = 1._rkind
+ xScale = 1._rkind
+ endwhere
+
+ ! -----
+ ! * 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 = volHeatCapVeg ! 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
+
+ ! compute terms in the Jacobian for vegetation (excluding fluxes)
+ ! NOTE: This is computed outside the iteration loop because it does not depend on state variables
+ ! NOTE: Energy for vegetation is computed *within* the iteration loop as it includes phase change
+ ! NOTE: Use the "where" statement to generalize to multiple canopy layers (currently one canopy layer)
+ where(ixStateType_subset==iname_nrgCanair) dMat = Cp_air*iden_air ! volumetric heat capacity of air (J m-3 K-1)
+ where(ixStateType_subset==iname_nrgCanopy) dMat = realMissing ! populated within the iteration loop
+ where(ixStateType_subset==iname_watCanopy) dMat = 1._rkind ! nothing else on the left hand side
+ where(ixStateType_subset==iname_liqCanopy) dMat = 1._rkind ! nothing else on the left hand side
+
+ ! define the energy multiplier and diagonal elements 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) = mLayerVolHeatCap(iLayer) ! transfer volumetric heat capacity to the state multiplier
+ dMat(ixStateSubset) = realMissing ! diagonal element populated within the iteration loop
+ 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)
+ dMat(ixStateSubset) = 1._rkind ! diagonal element = 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
+ dMat = 1._rkind
+ endwhere
+
+ end associate fixedLength ! end association to variables in the data structure where vector length does not change
+end subroutine getScaling
+
+
+! **********************************************************************************************************
+! public subroutine varExtract: extract variables from the state vector and compute diagnostic variables
+! This routine does not initialize any of the variables
+! **********************************************************************************************************
+subroutine varExtract(&
+ ! input
+ stateVec, & ! intent(in): model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial, & ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input
+ real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ real(rkind),intent(out) :: scalarCanairTempTrial ! trial value of canopy air temperature (K)
+ real(rkind),intent(out) :: scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ real(rkind),intent(out) :: scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ real(rkind),intent(out) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(out) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(out) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
+ real(rkind),intent(out) :: mLayerMatricHeadLiqTrial(:) ! trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ real(rkind),intent(out) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ )! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='varExtract/'
+
+ ! *** extract state variables for the vegetation canopy
+
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing .or. ixVegHyd/=integerMissing)then
+
+ ! extract temperature of the canopy air space
+ if(ixCasNrg/=integerMissing) scalarCanairTempTrial = stateVec(ixCasNrg)
+
+ ! extract canopy temperature
+ if(ixVegNrg/=integerMissing) scalarCanopyTempTrial = stateVec(ixVegNrg)
+
+ ! extract intercepted water
+ if(ixVegHyd/=integerMissing)then
+ select case( ixStateType_subset(ixVegHyd) )
+ case(iname_liqCanopy); scalarCanopyLiqTrial = stateVec(ixVegHyd)
+ case(iname_watCanopy); scalarCanopyWatTrial = stateVec(ixVegHyd)
+ case default; err=20; message=trim(message)//'case not found: expect iname_liqCanopy or iname_watCanopy'; return
+ end select
+ endif
+
+ endif ! not computing the vegetation flux
+
+ ! *** extract state variables from the snow+soil sub-domain
+
+
+ ! overwrite with the energy values from the state vector
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ mLayerTempTrial(iLayer) = stateVec( ixSnowSoilNrg(iLayer) )
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! overwrite with the hydrology values from the state vector
+ if(nSnowSoilHyd>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); mLayerVolFracWatTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
+ case(iname_liqLayer); mLayerVolFracLiqTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
+ case(iname_matLayer); mLayerMatricHeadTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
+ case(iname_lmpLayer); mLayerMatricHeadLiqTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
+ case default ! do nothing
+ end select
+ end do ! looping through non-missing energy state variables in the snow+soil domain
+ endif
+
+ ! extract temperature of the canopy air space
+ if(ixAqWat/=integerMissing) scalarAquiferStorageTrial = stateVec(ixAqWat)
+
+ end associate
+
+end subroutine varExtract
end module getVectorz_module
diff --git a/build/source/engine/opSplittin.f90 b/build/source/engine/opSplittin.f90
index 90393b6..ba0cbca 100755
--- a/build/source/engine/opSplittin.f90
+++ b/build/source/engine/opSplittin.f90
@@ -1,5 +1,5 @@
! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
+! Copyright (C) 2014-2015 NCAR/RAL
!
! This file is part of SUMMA
!
@@ -20,1258 +20,1094 @@
module opSplittin_module
-! data types
-USE nrtype
-
-! access the global print flag
-USE globalData,only:globalPrintFlag
-
-! access missing values
-USE globalData,only:integerMissing ! missing integer
-USE globalData,only:realMissing ! missing double precision number
-USE globalData,only:quadMissing ! missing quadruple precision number
-
-! access matrix information
-USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
-USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
-USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
-USE globalData,only: iJac1 ! first layer of the Jacobian to print
-USE globalData,only: iJac2 ! last layer of the Jacobian to print
-
-! domain types
-USE globalData,only:iname_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
-
-! 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
-
-! global metadata
-USE globalData,only:flux_meta ! metadata on the model fluxes
-USE globalData,only:diag_meta ! metadata on the model diagnostic variables
-USE globalData,only:prog_meta ! metadata on the model prognostic variables
-USE globalData,only:deriv_meta ! metadata on the model derivatives
-USE globalData,only:flux2state_orig ! metadata on flux-to-state mapping (original state variables)
-USE globalData,only:flux2state_liq ! metadata on flux-to-state mapping (liquid water state variables)
-
-! constants
-USE multiconst,only:&
- gravity, & ! acceleration of gravity (m s-2)
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
-! provide access to indices that define elements of the data structures
-USE var_lookup,only:iLookATTR ! named variables for structure elements
-USE var_lookup,only:iLookTYPE ! 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:iLookFLUX ! named variables for structure elements
-USE var_lookup,only:iLookFORCE ! named variables for structure elements
-USE var_lookup,only:iLookPARAM ! named variables for structure elements
-USE var_lookup,only:iLookINDEX ! named variables for structure elements
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-
-! look up structure for variable types
-USE var_lookup,only:iLookVarType
-
-! provide access to the number of flux variables
-USE var_lookup,only:nFlux=>maxvarFlux ! number of model flux variables
-
-! provide access to the derived types to define the data structures
-USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (dp)
- var_flagVec, & ! data vector with variable length dimension (i4b)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (dp)
- zLookup, &
- model_options ! defines the model decisions
-
-! look-up values for the choice of groundwater representation (local-column, or single-basin)
-USE mDecisions_module,only: &
- localColumn, & ! separate groundwater representation in each local soil column
- singleBasin ! single groundwater store over the entire basin
-
-! look-up values for the choice of groundwater parameterization
-USE mDecisions_module,only: &
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit, & ! no explicit groundwater parameterization
- sundialIDA, & ! IDA solver from Sundials package
- backwEuler ! backward Euler method
-
-! safety: set private unless specified otherwise
-implicit none
-private
-public::opSplittin
-
-! named variables for the coupling method
-integer(i4b),parameter :: fullyCoupled=1 ! 1st try: fully coupled solution
-integer(i4b),parameter :: stateTypeSplit=2 ! 2nd try: separate solutions for each state type
-
-! named variables for the state variable split
-integer(i4b),parameter :: nrgSplit=1 ! order in sequence for the energy operation
-integer(i4b),parameter :: massSplit=2 ! order in sequence for the mass operation
-
-! named variables for the domain type split
-integer(i4b),parameter :: vegSplit=1 ! order in sequence for the vegetation split
-integer(i4b),parameter :: snowSplit=2 ! order in sequence for the snow split
-integer(i4b),parameter :: soilSplit=3 ! order in sequence for the soil split
-integer(i4b),parameter :: aquiferSplit=4 ! order in sequence for the aquifer split
-
-! named variables for the solution method
-integer(i4b),parameter :: vector=1 ! vector solution method
-integer(i4b),parameter :: scalar=2 ! scalar solution method
-integer(i4b),parameter :: nSolutions=2 ! number of solution methods
-
-! named variables for the switch between states and domains
-integer(i4b),parameter :: fullDomain=1 ! full domain (veg+snow+soil)
-integer(i4b),parameter :: subDomain=2 ! sub domain (veg, snow, and soil separately)
-
-! maximum number of possible splits
-integer(i4b),parameter :: nStateTypes=2 ! number of state types (energy, water)
-integer(i4b),parameter :: nDomains=4 ! number of domains (vegetation, snow, soil, and aquifer)
-
-! control parameters
-real(dp),parameter :: valueMissing=-9999._dp ! missing value
-real(dp),parameter :: verySmall=1.e-12_dp ! a very small number (used to check consistency)
-real(dp),parameter :: veryBig=1.e+20_dp ! a very big number
-real(dp),parameter :: dx = 1.e-8_dp ! finite difference increment
-
-contains
-
-
-! **********************************************************************************************************
-! public subroutine opSplittin: run the coupled energy-mass model for one timestep
-!
-! The logic of the solver is as follows:
-! (1) Attempt different solutions in the following order: (a) fully coupled; (b) split by state type and by
-! domain type for a given energy and mass split (vegetation, snow, and soil); and (c) scalar solution
-! for a given state type and domain subset.
-! (2) For a given split, compute a variable number of substeps (in varSubstep).
-! **********************************************************************************************************
-subroutine opSplittin(&
- ! input: model control
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- nState, & ! intent(in): total number of state variables
- dt, & ! intent(inout): time step (s)
- firstSubStep, & ! intent(in): flag to denote first sub-step
- computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
- ! input/output: data structures
- 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
- bvar_data, & ! intent(in): model variables for the local basin
- lookup_data, & ! intent(in): lookup tables
- model_decisions,& ! intent(in): model decisions
- ! output: model control
- dtMultiplier, & ! intent(out): substep multiplier (-)
- tooMuchMelt, & ! intent(out): flag to denote that ice is insufficient to support melt
- stepFailure, & ! intent(out): flag to denote step failure
- ixCoupling, & ! intent(out): coupling method used in this iteration
- err,message) ! intent(out): error code and error message
- ! ---------------------------------------------------------------------------------------
- ! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
- ! simulation of fluxes and residuals given a trial state vector
- USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
- USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
- ! population/extraction of state vectors
- USE indexState_module,only:indexSplit ! get state indices
- USE varSubstep_module,only:varSubstep ! complete substeps for a given split
- ! identify name of variable type (for error message)
- USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
- ! sundials var_substep
- USE varSubstepSundials_module,only:varSubstepSundials ! complete substeps for a given split
+ ! data types
+ USE nrtype
+
+ ! access the global print flag
+ USE globalData,only:globalPrintFlag
+
+ ! access missing values
+ USE globalData,only:integerMissing ! missing integer
+ USE globalData,only:realMissing ! missing double precision number
+ USE globalData,only:quadMissing ! missing quadruple precision number
+
+ ! access matrix information
+ USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+ USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+ USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+ USE globalData,only: iJac1 ! first layer of the Jacobian to print
+ USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+ ! domain types
+ USE globalData,only:iname_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
+
+ ! 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
+
+ ! global metadata
+ USE globalData,only:flux_meta ! metadata on the model fluxes
+ USE globalData,only:diag_meta ! metadata on the model diagnostic variables
+ USE globalData,only:prog_meta ! metadata on the model prognostic variables
+ USE globalData,only:deriv_meta ! metadata on the model derivatives
+ USE globalData,only:flux2state_orig ! metadata on flux-to-state mapping (original state variables)
+ USE globalData,only:flux2state_liq ! metadata on flux-to-state mapping (liquid water state variables)
+
+ ! constants
+ USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+ ! provide access to indices that define elements of the data structures
+ USE var_lookup,only:iLookATTR ! named variables for structure elements
+ USE var_lookup,only:iLookTYPE ! 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:iLookFLUX ! named variables for structure elements
+ USE var_lookup,only:iLookFORCE ! named variables for structure elements
+ USE var_lookup,only:iLookPARAM ! named variables for structure elements
+ USE var_lookup,only:iLookINDEX ! named variables for structure elements
+ USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+
+ ! look up structure for variable types
+ USE var_lookup,only:iLookVarType
+
+ ! provide access to the number of flux variables
+ USE var_lookup,only:nFlux=>maxvarFlux ! number of model flux variables
+
+ ! 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_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
+
+ ! look-up values for the choice of groundwater representation (local-column, or single-basin)
+ USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+ ! look-up values for the choice of groundwater parameterization
+ USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit, & ! no explicit groundwater parameterization
+ sundials, & ! SUNDIALS/IDA solution
+ bEuler ! home-grown backward Euler solution with long time step
+
+ ! safety: set private unless specified otherwise
implicit none
- ! ---------------------------------------------------------------------------------------
- ! * dummy variables
- ! ---------------------------------------------------------------------------------------
- ! input: model control
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer(i4b),intent(in) :: nState ! total number of state variables
- real(dp),intent(inout) :: dt ! time step (seconds)
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! input/output: data structures
- type(var_i),intent(in) :: type_data ! type of vegetation and soil
- type(var_d),intent(in) :: attr_data ! spatial attributes
- type(var_d),intent(in) :: forc_data ! model forcing data
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
- type(var_dlength),intent(inout) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- ! output: model control
- real(dp),intent(out) :: dtMultiplier ! substep multiplier (-)
- logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that ice is insufficient to support melt
- logical(lgt),intent(out) :: stepFailure ! flag to denote step failure
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- ! ---------------------------------------------------------------------------------------
- ! * general local variables
- ! ---------------------------------------------------------------------------------------
- character(LEN=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: minLayer ! the minimum layer used in assigning flags for flux aggregations
- integer(i4b) :: iOffset ! offset to account for different indices in the soil domain
- integer(i4b) :: iMin(1),iMax(1) ! bounds of a given vector
- integer(i4b) :: iLayer,jLayer ! index of model layer
- integer(i4b) :: iSoil ! index of soil layer
- integer(i4b) :: iVar ! index of variables in data structures
- logical(lgt) :: firstSuccess ! flag to define the first success
- logical(lgt) :: firstFluxCall ! flag to define the first flux call
- logical(lgt) :: reduceCoupledStep ! flag to define the need to reduce the length of the coupled step
- type(var_dlength) :: prog_temp ! temporary model prognostic variables
- type(var_dlength) :: diag_temp ! temporary model diagnostic variables
- type(var_dlength) :: flux_temp ! temporary model fluxes
- type(var_dlength) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- real(dp),dimension(nLayers) :: mLayerVolFracIceInit ! initial vector for volumetric fraction of ice (-)
- ! ------------------------------------------------------------------------------------------------------
- ! * operator splitting
- ! ------------------------------------------------------------------------------------------------------
- ! minimum timestep
- real(dp),parameter :: dtmin_coupled=1800._dp ! minimum time step for the fully coupled solution (seconds)
- real(dp),parameter :: dtmin_split=60._dp ! minimum time step for the fully split solution (seconds)
- real(dp),parameter :: dtmin_scalar=10._dp ! minimum time step for the scalar solution (seconds)
- real(dp) :: dt_min ! minimum time step (seconds)
- real(dp) :: dtInit ! initial time step (seconds)
- ! explicit error tolerance (depends on state type split, so defined here)
- real(dp),parameter :: errorTolLiqFlux=0.01_dp ! error tolerance in the explicit solution (liquid flux)
- real(dp),parameter :: errorTolNrgFlux=10._dp ! error tolerance in the explicit solution (energy flux)
- ! number of substeps taken for a given split
- integer(i4b) :: nSubsteps ! number of substeps taken for a given split
- ! named variables defining the coupling and solution method
- integer(i4b) :: ixCoupling ! index of coupling method (1,2)
- integer(i4b) :: ixSolution ! index of solution method (1,2)
- integer(i4b) :: ixStateThenDomain ! switch between the state and domain (1,2)
- integer(i4b) :: tryDomainSplit ! (0,1) - flag to try the domain split
- ! actual number of splits
- integer(i4b) :: nStateTypeSplit ! number of splits for the state type
- integer(i4b) :: nDomainSplit ! number of splits for the domain
- integer(i4b) :: nStateSplit ! number of splits for the states within a given domain
- ! indices for the state type and the domain split
- integer(i4b) :: iStateTypeSplit ! index of the state type split
- integer(i4b) :: iDomainSplit ! index of the domain split
- integer(i4b) :: iStateSplit ! index of the state split
- ! flux masks
- logical(lgt) :: neededFlux(nFlux) ! .true. if flux is needed at all
- logical(lgt) :: desiredFlux ! .true. if flux is desired for a given split
- type(var_ilength) :: fluxCount ! number of times each flux is updated (should equal nSubsteps)
- type(var_flagVec) :: fluxMask ! mask defining model fluxes
- ! state masks
- integer(i4b),dimension(nState) :: stateCheck ! number of times each state variable is updated (should equal 1)
- logical(lgt),dimension(nState) :: stateMask ! mask defining desired state variables
- integer(i4b) :: nSubset ! number of selected state variables for a given split
- ! flags
- logical(lgt) :: failure ! flag to denote failure of substepping
- logical(lgt) :: doAdjustTemp ! flag to adjust temperature after the mass split
- logical(lgt) :: failedMinimumStep ! flag to denote failure of substepping for a given split
- integer(i4b) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
- integer(i4b) :: nCoupling ! number of possible solutions
- real(qp) :: dt_out !
-
+ private
+ public::opSplittin
+
+ ! named variables for the coupling method
+ integer(i4b),parameter :: fullyCoupled=1 ! 1st try: fully coupled solution
+ integer(i4b),parameter :: stateTypeSplit=2 ! 2nd try: separate solutions for each state type
+
+ ! named variables for the state variable split
+ integer(i4b),parameter :: nrgSplit=1 ! order in sequence for the energy operation
+ integer(i4b),parameter :: massSplit=2 ! order in sequence for the mass operation
+
+ ! named variables for the domain type split
+ integer(i4b),parameter :: vegSplit=1 ! order in sequence for the vegetation split
+ integer(i4b),parameter :: snowSplit=2 ! order in sequence for the snow split
+ integer(i4b),parameter :: soilSplit=3 ! order in sequence for the soil split
+ integer(i4b),parameter :: aquiferSplit=4 ! order in sequence for the aquifer split
+
+ ! named variables for the solution method
+ integer(i4b),parameter :: vector=1 ! vector solution method
+ integer(i4b),parameter :: scalar=2 ! scalar solution method
+ integer(i4b),parameter :: nSolutions=2 ! number of solution methods
+
+ ! named variables for the switch between states and domains
+ integer(i4b),parameter :: fullDomain=1 ! full domain (veg+snow+soil)
+ integer(i4b),parameter :: subDomain=2 ! sub domain (veg, snow, and soil separately)
+
+ ! maximum number of possible splits
+ integer(i4b),parameter :: nStateTypes=2 ! number of state types (energy, water)
+ integer(i4b),parameter :: nDomains=4 ! number of domains (vegetation, snow, soil, and aquifer)
+
+ ! control parameters
+ real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
+ real(rkind),parameter :: verySmall=1.e-12_rkind ! a very small number (used to check consistency)
+ real(rkind),parameter :: veryBig=1.e+20_rkind ! a very big number
+ real(rkind),parameter :: dx = 1.e-8_rkind ! finite difference increment
+
+ contains
+
+
+ ! **********************************************************************************************************
+ ! public subroutine opSplittin: run the coupled energy-mass model for one timestep
+ !
+ ! The logic of the solver is as follows:
+ ! (1) Attempt different solutions in the following order: (a) fully coupled; (b) split by state type and by
+ ! domain type for a given energy and mass split (vegetation, snow, and soil); and (c) scalar solution
+ ! for a given state type and domain subset.
+ ! (2) For a given split, compute a variable number of substeps (in varSubstepSundials).
+ ! **********************************************************************************************************
+ subroutine opSplittin(&
+ ! input: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nState, & ! intent(in): total number of state variables
+ dt, & ! intent(inout): time step (s)
+ firstSubStep, & ! intent(in): flag to denote first sub-step
+ computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
+ ! input/output: data structures
+ 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
+ bvar_data, & ! intent(in): model variables for the local basin
+ lookup_data, & ! intent(in): lookup tables
+ model_decisions,& ! intent(in): model decisions
+ ! output: model control
+ dtMultiplier, & ! intent(out): substep multiplier (-)
+ tooMuchMelt, & ! intent(out): flag to denote that ice is insufficient to support melt
+ stepFailure, & ! intent(out): flag to denote step failure
+ ixCoupling, & ! intent(out): coupling method used in this iteration
+ err,message) ! intent(out): error code and error message
+ ! ---------------------------------------------------------------------------------------
+ ! structure allocations
+ USE allocspace_module,only:allocLocal ! allocate local data structures
+ ! simulation of fluxes and residuals given a trial state vector
+ USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+ USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
+ ! population/extraction of state vectors
+ USE indexState_module,only:indexSplit ! get state indices
+ USE varSubstep_module,only:varSubstep ! complete substeps for a given split
+ USE varSubstepSundials_module,only:varSubstepSundials ! complete substeps for a given split
+ ! identify name of variable type (for error message)
+ USE get_ixName_module,only:get_varTypeName ! to access type strings for error messages
+ implicit none
+ ! ---------------------------------------------------------------------------------------
+ ! * dummy variables
+ ! ---------------------------------------------------------------------------------------
+ ! input: model control
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ real(rkind),intent(inout) :: dt ! time step (seconds)
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
+ ! input/output: data structures
+ type(var_i),intent(in) :: type_data ! type of vegetation and soil
+ type(var_d),intent(in) :: attr_data ! spatial attributes
+ type(var_d),intent(in) :: forc_data ! model forcing data
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ ! output: model control
+ real(rkind),intent(out) :: dtMultiplier ! substep multiplier (-)
+ logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that ice is insufficient to support melt
+ logical(lgt),intent(out) :: stepFailure ! flag to denote step failure
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! ---------------------------------------------------------------------------------------
+ ! * general local variables
+ ! ---------------------------------------------------------------------------------------
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: minLayer ! the minimum layer used in assigning flags for flux aggregations
+ integer(i4b) :: iOffset ! offset to account for different indices in the soil domain
+ integer(i4b) :: iMin(1),iMax(1) ! bounds of a given vector
+ integer(i4b) :: iLayer,jLayer ! index of model layer
+ integer(i4b) :: iSoil ! index of soil layer
+ integer(i4b) :: iVar ! index of variables in data structures
+ logical(lgt) :: firstSuccess ! flag to define the first success
+ logical(lgt) :: firstFluxCall ! flag to define the first flux call
+ logical(lgt) :: reduceCoupledStep ! flag to define the need to reduce the length of the coupled step
+ type(var_dlength) :: prog_temp ! temporary model prognostic variables
+ type(var_dlength) :: diag_temp ! temporary model diagnostic variables
+ type(var_dlength) :: flux_temp ! temporary model fluxes
+ type(var_dlength) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceInit ! initial vector for volumetric fraction of ice (-)
+ ! ------------------------------------------------------------------------------------------------------
+ ! * operator splitting
+ ! ------------------------------------------------------------------------------------------------------
+ ! minimum timestep
+ real(rkind),parameter :: dtmin_coupled=1800._rkind ! minimum time step for the fully coupled solution (seconds)
+ real(rkind),parameter :: dtmin_split=60._rkind ! minimum time step for the fully split solution (seconds)
+ real(rkind),parameter :: dtmin_scalar=10._rkind ! minimum time step for the scalar solution (seconds)
+ real(rkind) :: dt_min ! minimum time step (seconds)
+ real(rkind) :: dtInit ! initial time step (seconds)
+ ! explicit error tolerance (depends on state type split, so defined here)
+ real(rkind),parameter :: errorTolLiqFlux=0.01_rkind ! error tolerance in the explicit solution (liquid flux)
+ real(rkind),parameter :: errorTolNrgFlux=10._rkind ! error tolerance in the explicit solution (energy flux)
+ ! number of substeps taken for a given split
+ integer(i4b) :: nSubsteps ! number of substeps taken for a given split
+ ! named variables defining the coupling and solution method
+ integer(i4b) :: ixCoupling ! index of coupling method (1,2)
+ integer(i4b) :: ixSolution ! index of solution method (1,2)
+ integer(i4b) :: ixStateThenDomain ! switch between the state and domain (1,2)
+ integer(i4b) :: tryDomainSplit ! (0,1) - flag to try the domain split
+ ! actual number of splits
+ integer(i4b) :: nStateTypeSplit ! number of splits for the state type
+ integer(i4b) :: nDomainSplit ! number of splits for the domain
+ integer(i4b) :: nStateSplit ! number of splits for the states within a given domain
+ ! indices for the state type and the domain split
+ integer(i4b) :: iStateTypeSplit ! index of the state type split
+ integer(i4b) :: iDomainSplit ! index of the domain split
+ integer(i4b) :: iStateSplit ! index of the state split
+ ! flux masks
+ logical(lgt) :: neededFlux(nFlux) ! .true. if flux is needed at all
+ logical(lgt) :: desiredFlux ! .true. if flux is desired for a given split
+ type(var_ilength) :: fluxCount ! number of times each flux is updated (should equal nSubsteps)
+ type(var_flagVec) :: fluxMask ! mask defining model fluxes
+ ! state masks
+ integer(i4b),dimension(nState) :: stateCheck ! number of times each state variable is updated (should equal 1)
+ logical(lgt),dimension(nState) :: stateMask ! mask defining desired state variables
+ integer(i4b) :: nSubset ! number of selected state variables for a given split
+ ! flags
+ logical(lgt) :: failure ! flag to denote failure of substepping
+ logical(lgt) :: doAdjustTemp ! flag to adjust temperature after the mass split
+ logical(lgt) :: failedMinimumStep ! flag to denote failure of substepping for a given split
+ integer(i4b) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ integer(i4b) :: nCoupling
+ real(qp) :: dt_out !
+ ! ---------------------------------------------------------------------------------------
+ ! point to variables in the data structures
+ ! ---------------------------------------------------------------------------------------
+
+ globalVars: associate(&
+ ! model decisions
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
+ ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
+ ixNumericalMethod => model_decisions(iLookDECISIONS%num_method)%iDecision ,& ! intent(in): [i4b] choice of numerical method, backward Euler or SUNDIALS/IDA
+ ! domain boundary conditions
+ airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
+ ! vector of energy and hydrology indices for the snow and soil domains
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology state variables in the snow+soil domain
+ ! indices of model state variables
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset (missing for values not in the subset)
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
+ ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
+ ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ! numerix tracking
+ numberStateSplit => indx_data%var(iLookINDEX%numberStateSplit )%dat(1) ,& ! intent(inout): [i4b] number of state splitting solutions (-)
+ numberDomainSplitNrg => indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for energy (-)
+ numberDomainSplitMass => indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for mass (-)
+ numberScalarSolutions => indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) ,& ! intent(inout): [i4b] number of scalar solutions (-)
+ ! domain configuration
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! depth-varying soil parameters
+ vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat ,& ! intent(in): [dp(:)] van Genutchen "m" parameter (-)
+ vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat ,& ! intent(in): [dp(:)] van Genutchen "n" parameter (-)
+ vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat ,& ! intent(in): [dp(:)] van Genutchen "alpha" parameter (m-1)
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
+ ! soil parameters
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! model diagnostic variables (fraction of liquid water)
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
+ mLayerMeltFreeze => diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat ,& ! intent(out): [dp(:)] melt-freeze in each snow and soil layer (kg m-3)
+ ! model state variables (vegetation canopy)
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(out): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(out): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(out): [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(out): [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(out): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(out): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(out): [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(out): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(out): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(out): [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(out): [dp(:)] matric potential of liquid water (m)
+ )
+ ! ---------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="opSplittin/"
+
+ ! we just solve the fully coupled problem by with Sundials for now
+ select case(ixNumericalMethod)
+ case(sundials); nCoupling = 1
+ case(bEuler); nCoupling = 2
+ case default; err=20; message=trim(message)//'expect num_method to be sundials or bEuler (or itertive, which is bEuler)'; return
+ end select
- ! ---------------------------------------------------------------------------------------
- ! point to variables in the data structures
- ! ---------------------------------------------------------------------------------------
- globalVars: associate(&
- ! model decisions
- ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
- ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
- ! domain boundary conditions
- airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
- ! vector of energy and hydrology indices for the snow and soil domains
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology state variables in the snow+soil domain
- ! indices of model state variables
- ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset (missing for values not in the subset)
- ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
- ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
- ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
- ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
- ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
- ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ! numerix tracking
- numberStateSplit => indx_data%var(iLookINDEX%numberStateSplit )%dat(1) ,& ! intent(inout): [i4b] number of state splitting solutions (-)
- numberDomainSplitNrg => indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for energy (-)
- numberDomainSplitMass => indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) ,& ! intent(inout): [i4b] number of domain splitting solutions for mass (-)
- numberScalarSolutions => indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) ,& ! intent(inout): [i4b] number of scalar solutions (-)
- ! domain configuration
- canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp] canopy depth (m)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- ! snow parameters
- snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
- ! depth-varying soil parameters
- vGn_m => diag_data%var(iLookDIAG%scalarVGn_m)%dat ,& ! intent(in): [dp(:)] van Genutchen "m" parameter (-)
- vGn_n => mpar_data%var(iLookPARAM%vGn_n)%dat ,& ! intent(in): [dp(:)] van Genutchen "n" parameter (-)
- vGn_alpha => mpar_data%var(iLookPARAM%vGn_alpha)%dat ,& ! intent(in): [dp(:)] van Genutchen "alpha" parameter (m-1)
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] soil residual volumetric water content (-)
- ! soil parameters
- specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
- ! model diagnostic variables (fraction of liquid water)
- scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg)%dat(1) ,& ! intent(out): [dp] fraction of liquid water on vegetation (-)
- mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow)%dat ,& ! intent(out): [dp(:)] fraction of liquid water in each snow layer (-)
- mLayerMeltFreeze => diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat ,& ! intent(out): [dp(:)] melt-freeze in each snow and soil layer (kg m-3)
- ! model state variables (vegetation canopy)
- scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(out): [dp] temperature of the canopy air space (K)
- scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(out): [dp] temperature of the vegetation canopy (K)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(out): [dp] mass of ice on the vegetation canopy (kg m-2)
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(out): [dp] mass of liquid water on the vegetation canopy (kg m-2)
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(out): [dp] mass of total water on the vegetation canopy (kg m-2)
- ! model state variables (snow and soil domains)
- mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(out): [dp(:)] temperature of each snow/soil layer (K)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(out): [dp(:)] volumetric fraction of ice (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(out): [dp(:)] volumetric fraction of liquid water (-)
- mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(out): [dp(:)] volumetric fraction of total water (-)
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(out): [dp(:)] matric head (m)
- mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(out): [dp(:)] matric potential of liquid water (m)
- )
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="opSplittin/"
- ! print*, "BEFORE******"
- ! print*, "scalarCanairTemp = ", scalarCanairTemp
- ! print*, "scalarCanopyTemp = ", scalarCanopyTemp
- ! print*, "scalarCanopyIce = ", scalarCanopyIce
- ! print*, "scalarCanopyLiq = ", scalarCanopyLiq
- ! print*, "scalarCanopyWat = ", scalarCanopyWat
- ! print*, "mLayerTemp = ", mLayerTemp(1)
- ! print*, "mLayerVolFracIce = ", mLayerVolFracIce(1)
- ! print*, "mLayerVolFracLiq = ", mLayerVolFracLiq(1)
- ! print*, "mLayerVolFracWat = ", mLayerVolFracWat(1)
- ! print*, "mLayerMatricHead = ", mLayerMatricHead(1)
- ! print*, "mLayerMatricHeadLiq = ", mLayerMatricHeadLiq(1)
-
- ! we just solve the fully coupled problem by ida
- select case(model_decisions(iLookDECISIONS%diffEqSolv)%iDecision)
- case(sundialIDA); nCoupling = 1
- case(backwEuler); nCoupling = 2
- case default
- err=20
- message=trim(message)//'expect case to be sundialIDA or backwEuler'
- print*, message
- return
- end select
- ! *****
- ! (0) PRELIMINARIES...
- ! ********************
-
- ! -----
- ! * initialize...
- ! ---------------
-
- ! set the global print flag
- globalPrintFlag=.false.
-
- if(globalPrintFlag)&
- print*, trim(message), dt
-
- ! initialize the first success call
- firstSuccess=.false.
-
- ! initialize the flags
- tooMuchMelt=.false. ! too much melt (merge snow layers)
- stepFailure=.false. ! step failure
-
- ! initialize flag for the success of the substepping
- failure=.false.
-
- ! initialize the flux check
- neededFlux(:) = .false.
-
- ! initialize the state check
- stateCheck(:) = 0
-
- ! compute the total water content in the vegetation canopy
- scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce ! kg m-2
-
- ! save volumetric ice content at the start of the step
- ! NOTE: used for volumetric loss due to melt-freeze
- mLayerVolFracIceInit(:) = mLayerVolFracIce(:)
-
- ! compute the total water content in snow and soil
- ! NOTE: no ice expansion allowed for soil
- if(nSnow>0)&
- mLayerVolFracWat( 1:nSnow ) = mLayerVolFracLiq( 1:nSnow ) + mLayerVolFracIce( 1:nSnow )*(iden_ice/iden_water)
- mLayerVolFracWat(nSnow+1:nLayers) = mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers)
-
- ! compute the liquid water matric potential (m)
- ! NOTE: include ice content as part of the solid porosity - major effect of ice is to reduce the pore size; ensure that effSat=1 at saturation
- ! (from Zhao et al., J. Hydrol., 1997: Numerical analysis of simultaneous heat and mass transfer...)
- do iSoil=1,nSoil
- call liquidHead(mLayerMatricHead(iSoil),mLayerVolFracLiq(nSnow+iSoil),mLayerVolFracIce(nSnow+iSoil), & ! input: state variables
- vGn_alpha(iSoil),vGn_n(iSoil),theta_sat(iSoil),theta_res(iSoil),vGn_m(iSoil), & ! input: parameters
- matricHeadLiq=mLayerMatricHeadLiq(iSoil), & ! output: liquid water matric potential (m)
- err=err,message=cmessage) ! output: error control
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
- end do ! looping through soil layers (computing liquid water matric potential)
-
- ! allocate space for the flux mask (used to define when fluxes are updated)
- call allocLocal(flux_meta(:),fluxMask,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- return
- endif
-
- ! allocate space for the flux count (used to check that fluxes are only updated once)
- call allocLocal(flux_meta(:),fluxCount,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! allocate space for the temporary prognostic variable structure
- call allocLocal(prog_meta(:),prog_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! allocate space for the temporary diagnostic variable structure
- call allocLocal(diag_meta(:),diag_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! allocate space for the temporary flux variable structure
- call allocLocal(flux_meta(:),flux_temp,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! allocate space for the derivative structure
- call allocLocal(deriv_meta(:),deriv_data,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! intialize the flux conter
- do iVar=1,size(flux_meta) ! loop through fluxes
- fluxCount%var(iVar)%dat(:) = 0
- end do
-
- ! initialize the model fluxes
- do iVar=1,size(flux_meta) ! loop through fluxes
- if(flux2state_orig(iVar)%state1==integerMissing .and. flux2state_orig(iVar)%state2==integerMissing) cycle ! flux does not depend on state (e.g., input)
- if(flux2state_orig(iVar)%state1==iname_watCanopy .and. .not.computeVegFlux) cycle ! use input fluxes in cases where there is no canopy
- flux_data%var(iVar)%dat(:) = 0._dp
- end do
-
- ! initialize derivatives
- do iVar=1,size(deriv_meta)
- deriv_data%var(iVar)%dat(:) = 0._dp
- end do
-
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
-
- ! loop through different coupling strategies
- coupling: do ixCoupling=1,nCoupling
-
- ! initialize the time step
- dtInit = min( merge(dt, dtmin_coupled, ixCoupling==fullyCoupled), dt) ! initial time step
- dt_min = min( merge(dtmin_coupled, dtmin_split, ixCoupling==fullyCoupled), dt) ! minimum time step
-
- ! keep track of the number of state splits
- if(ixCoupling/=fullyCoupled) numberStateSplit = numberStateSplit + 1
-
- ! define the number of operator splits for the state type
- select case(ixCoupling)
- case(fullyCoupled); nStateTypeSplit=1
- case(stateTypeSplit); nStateTypeSplit=nStateTypes
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select ! operator splitting option
-
- ! define if we wish to try the domain split
- select case(ixCoupling)
- case(fullyCoupled); tryDomainSplit=0
- case(stateTypeSplit); tryDomainSplit=1
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select ! operator splitting option
-
- ! state splitting loop
- stateTypeSplitLoop: do iStateTypeSplit=1,nStateTypeSplit
-
- !print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
-
! -----
- ! * identify state-specific variables for a given state split...
- ! --------------------------------------------------------------
-
- ! flag to adjust the temperature
- doAdjustTemp = (ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)
-
- ! modify the state type names associated with the state vector
- if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
- if(computeVegFlux)then
- where(ixStateType(ixHydCanopy)==iname_watCanopy) ixStateType(ixHydCanopy)=iname_liqCanopy
- endif
- where(ixStateType(ixHydLayer) ==iname_watLayer) ixStateType(ixHydLayer) =iname_liqLayer
- where(ixStateType(ixHydLayer) ==iname_matLayer) ixStateType(ixHydLayer) =iname_lmpLayer
- endif ! if modifying state variables for the mass split
-
- ! first try the state type split, then try the domain split within a given state type
- stateThenDomain: do ixStateThenDomain=1,1+tryDomainSplit ! 1=state type split; 2=domain split within a given state type
-
- !print*, 'start of stateThenDomain loop'
-
- ! keep track of the number of domain splits
- if(iStateTypeSplit==nrgSplit .and. ixStateThenDomain==subDomain) numberDomainSplitNrg = numberDomainSplitNrg + 1
- if(iStateTypeSplit==massSplit .and. ixStateThenDomain==subDomain) numberDomainSplitMass = numberDomainSplitMass + 1
-
- ! define the number of domain splits for the state type
- select case(ixStateThenDomain)
- case(fullDomain); nDomainSplit=1
- case(subDomain); nDomainSplit=nDomains
- case default; err=20; message=trim(message)//'coupling case not found'; return
- end select
-
- ! check that we haven't split the domain when we are fully coupled
- if(ixCoupling==fullyCoupled .and. nDomainSplit==nDomains)then
- message=trim(message)//'cannot split domains when fully coupled'
- print*, message
- err=20; return
- endif
-
- ! domain splitting loop
- domainSplit: do iDomainSplit=1,nDomainSplit
-
- ! trial with the vector then scalar solution
- solution: do ixSolution=1,nSolutions
-
- ! initialize error control
- err=0; message="opSplittin/"
-
- ! refine the time step
- if(ixSolution==scalar)then
- dtInit = min(dtmin_split, dt) ! initial time step
- dt_min = min(dtmin_scalar, dt) ! minimum time step
+ ! * initialize...
+ ! ---------------
+
+ ! set the global print flag
+ globalPrintFlag=.false.
+
+ if(globalPrintFlag)&
+ print*, trim(message), dt
+
+ ! initialize the first success call
+ firstSuccess=.false.
+
+ ! initialize the flags
+ tooMuchMelt=.false. ! too much melt (merge snow layers)
+ stepFailure=.false. ! step failure
+
+ ! initialize flag for the success of the substepping
+ failure=.false.
+
+ ! initialize the flux check
+ neededFlux(:) = .false.
+
+ ! initialize the state check
+ stateCheck(:) = 0
+
+ ! compute the total water content in the vegetation canopy
+ scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce ! kg m-2
+
+ ! save volumetric ice content at the start of the step
+ ! NOTE: used for volumetric loss due to melt-freeze
+ mLayerVolFracIceInit(:) = mLayerVolFracIce(:)
+
+ ! compute the total water content in snow and soil
+ ! NOTE: no ice expansion allowed for soil
+ if(nSnow>0)&
+ mLayerVolFracWat( 1:nSnow ) = mLayerVolFracLiq( 1:nSnow ) + mLayerVolFracIce( 1:nSnow )*(iden_ice/iden_water)
+ mLayerVolFracWat(nSnow+1:nLayers) = mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers)
+
+ ! compute the liquid water matric potential (m)
+ ! NOTE: include ice content as part of the solid porosity - major effect of ice is to reduce the pore size; ensure that effSat=1 at saturation
+ ! (from Zhao et al., J. Hydrol., 1997: Numerical analysis of simultaneous heat and mass transfer...)
+ do iSoil=1,nSoil
+ call liquidHead(mLayerMatricHead(iSoil),mLayerVolFracLiq(nSnow+iSoil),mLayerVolFracIce(nSnow+iSoil), & ! input: state variables
+ vGn_alpha(iSoil),vGn_n(iSoil),theta_sat(iSoil),theta_res(iSoil),vGn_m(iSoil), & ! input: parameters
+ matricHeadLiq=mLayerMatricHeadLiq(iSoil), & ! output: liquid water matric potential (m)
+ err=err,message=cmessage) ! output: error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ end do ! looping through soil layers (computing liquid water matric potential)
+
+ ! allocate space for the flux mask (used to define when fluxes are updated)
+ call allocLocal(flux_meta(:),fluxMask,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the flux count (used to check that fluxes are only updated once)
+ call allocLocal(flux_meta(:),fluxCount,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the temporary prognostic variable structure
+ call allocLocal(prog_meta(:),prog_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the temporary diagnostic variable structure
+ call allocLocal(diag_meta(:),diag_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the temporary flux variable structure
+ call allocLocal(flux_meta(:),flux_temp,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the derivative structure
+ call allocLocal(deriv_meta(:),deriv_data,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
+
+ ! intialize the flux conter
+ do iVar=1,size(flux_meta) ! loop through fluxes
+ fluxCount%var(iVar)%dat(:) = 0
+ end do
+
+ ! initialize the model fluxes
+ do iVar=1,size(flux_meta) ! loop through fluxes
+ if(flux2state_orig(iVar)%state1==integerMissing .and. flux2state_orig(iVar)%state2==integerMissing) cycle ! flux does not depend on state (e.g., input)
+ if(flux2state_orig(iVar)%state1==iname_watCanopy .and. .not.computeVegFlux) cycle ! use input fluxes in cases where there is no canopy
+ flux_data%var(iVar)%dat(:) = 0._rkind
+ end do
+
+ ! initialize derivatives
+ do iVar=1,size(deriv_meta)
+ deriv_data%var(iVar)%dat(:) = 0._rkind
+ end do
+
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
+ ! ==========================================================================================================================================
+
+ ! loop through different coupling strategies
+ coupling: do ixCoupling=1,nCoupling
+
+ ! initialize the time step
+ dtInit = min( merge(dt, dtmin_coupled, ixCoupling==fullyCoupled), dt) ! initial time step
+ dt_min = min( merge(dtmin_coupled, dtmin_split, ixCoupling==fullyCoupled), dt) ! minimum time step
+
+ ! keep track of the number of state splits
+ if(ixCoupling/=fullyCoupled) numberStateSplit = numberStateSplit + 1
+
+ ! define the number of operator splits for the state type
+ select case(ixCoupling)
+ case(fullyCoupled); nStateTypeSplit=1
+ case(stateTypeSplit); nStateTypeSplit=nStateTypes
+ case default; err=20; message=trim(message)//'coupling case not found'; return
+ end select ! operator splitting option
+
+ ! define if we wish to try the domain split
+ select case(ixCoupling)
+ case(fullyCoupled); tryDomainSplit=0
+ case(stateTypeSplit); tryDomainSplit=1
+ case default; err=20; message=trim(message)//'coupling case not found'; return
+ end select ! operator splitting option
+
+ ! state splitting loop
+ stateTypeSplit: do iStateTypeSplit=1,nStateTypeSplit
+
+ ! -----
+ ! * identify state-specific variables for a given state split...
+ ! --------------------------------------------------------------
+
+ ! flag to adjust the temperature
+ doAdjustTemp = (ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)
+
+ ! modify the state type names associated with the state vector
+ if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
+ if(computeVegFlux)then
+ where(ixStateType(ixHydCanopy)==iname_watCanopy) ixStateType(ixHydCanopy)=iname_liqCanopy
endif
-
- ! initialize the first flux call
- firstFluxCall=.true.
-
- ! get the number of split layers
- select case(ixSolution)
- case(vector); nStateSplit=1
- case(scalar); nStateSplit=count(stateMask)
- case default; err=20
- message=trim(message)//'unknown solution method'
- print*, message
- return
+ where(ixStateType(ixHydLayer) ==iname_watLayer) ixStateType(ixHydLayer) =iname_liqLayer
+ where(ixStateType(ixHydLayer) ==iname_matLayer) ixStateType(ixHydLayer) =iname_lmpLayer
+ endif ! if modifying state variables for the mass split
+
+ ! first try the state type split, then try the domain split within a given state type
+ stateThenDomain: do ixStateThenDomain=1,1+tryDomainSplit ! 1=state type split; 2=domain split within a given state type
+
+ ! keep track of the number of domain splits
+ if(iStateTypeSplit==nrgSplit .and. ixStateThenDomain==subDomain) numberDomainSplitNrg = numberDomainSplitNrg + 1
+ if(iStateTypeSplit==massSplit .and. ixStateThenDomain==subDomain) numberDomainSplitMass = numberDomainSplitMass + 1
+
+ ! define the number of domain splits for the state type
+ select case(ixStateThenDomain)
+ case(fullDomain); nDomainSplit=1
+ case(subDomain); nDomainSplit=nDomains
+ case default; err=20; message=trim(message)//'coupling case not found'; return
end select
-
- !print*, '*****'
- !print*, 'computeVegFlux = ', computeVegFlux
- !print*, '(ixSolution==scalar) = ', (ixSolution==scalar)
- !print*, 'ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit: ', ixCoupling, iStateTypeSplit, ixStateThenDomain, iDomainSplit, nDomainSplit
- !print*, 'ixSoilOnlyHyd = ', indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat
-
- ! loop through layers (NOTE: nStateSplit=1 for the vector solution, hence no looping)
- stateSplit: do iStateSplit=1,nStateSplit
-
- ! -----
- ! * define state subsets for a given split...
- ! -------------------------------------------
-
- ! get the mask for the state subset
- call stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
- indx_data,stateMask,nSubset,err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif ! (check for errors)
-
- ! check that state variables exist
- if(nSubset==0) cycle domainSplit
-
- ! avoid redundant case where vector solution is of length 1
- if(ixSolution==vector .and. count(stateMask)==1) cycle solution
-
- ! check
- !print*, 'after stateFilter: stateMask = ', stateMask
- !print*, 'count(stateMask) = ', count(stateMask)
-
- !if(ixSolution==scalar)then
- ! print*, 'iStateSplit, nStateSplit = ', iStateSplit, nStateSplit
- ! print*, 'start of scalar solution'
- ! !print*, 'PAUSE'; read(*,*)
- !endif
-
- ! -----
- ! * assemble vectors for a given split...
- ! ---------------------------------------
-
- ! get indices for a given split
- call indexSplit(stateMask, & ! intent(in) : logical vector (.true. if state is in the subset)
- nSnow,nSoil,nLayers,nSubset, & ! intent(in) : number of snow and soil layers, and total number of layers
- indx_data, & ! intent(inout) : index data structure
- err,cmessage) ! intent(out) : error control
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! -----
- ! * define the mask of the fluxes used...
- ! ---------------------------------------
-
- ! identify the type of state for the states in the subset
- stateSubset: associate(ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] indices of state types
- ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
- ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
- ixLayerActive => indx_data%var(iLookINDEX%ixLayerActive)%dat ,& ! intent(in): [i4b(:)] list of indices for all active layers (inactive=integerM
- ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ) ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
-
- ! loop through flux variables
- do iVar=1,size(flux_meta)
-
- ! * identify flux mask for the fully coupled solution
- if(ixCoupling==fullyCoupled)then
- desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
- fluxMask%var(iVar)%dat = desiredFlux
-
- ! * identify flux mask for the split solution
- else
-
- ! identify the flux mask for a given state split
- select case(iStateTypeSplit)
- case(nrgSplit); desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
- case(massSplit); desiredFlux = any(ixStateType_subset==flux2state_liq(iVar)%state1) .or. any(ixStateType_subset==flux2state_liq(iVar)%state2)
- case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
- end select
-
- ! no domain splitting
- if(nDomains==1)then
- fluxMask%var(iVar)%dat = desiredFlux
-
- ! domain splitting
- else
-
- ! initialize to .false.
- fluxMask%var(iVar)%dat = .false.
-
- ! only need to proceed if the flux is desired
- if(desiredFlux)then
-
- ! different domain splitting operations
- select case(iDomainSplit)
-
- ! canopy fluxes -- (:1) gets the upper boundary(0) if it exists
- case(vegSplit)
-
- ! vector solution (should only be present for energy)
- if(ixSolution==vector)then
- fluxMask%var(iVar)%dat(:1) = desiredFlux
- if(ixStateThenDomain>1 .and. iStateTypeSplit/=nrgSplit)then
- message=trim(message)//'only expect a vector solution for the vegetation domain for energy'
- print*, message
- err=20; return
- endif
-
- ! scalar solution
- else
- fluxMask%var(iVar)%dat(:1) = desiredFlux
- endif
-
- ! fluxes through snow and soil
- case(snowSplit,soilSplit)
-
- ! loop through layers
- do iLayer=1,nLayers
- if(ixlayerActive(iLayer)/=integerMissing)then
-
- ! get the offset (ixLayerActive=1,2,3,...nLayers, and soil vectors nSnow+1, nSnow+2, ..., nLayers)
- iOffset = merge(nSnow, 0, flux_meta(iVar)%vartype==iLookVarType%midSoil .or. flux_meta(iVar)%vartype==iLookVarType%ifcSoil)
- jLayer = iLayer-iOffset
-
- ! identify the minimum layer
- select case(flux_meta(iVar)%vartype)
- case(iLookVarType%ifcToto, iLookVarType%ifcSnow, iLookVarType%ifcSoil); minLayer=merge(jLayer-1, jLayer, jLayer==1)
- case(iLookVarType%midToto, iLookVarType%midSnow, iLookVarType%midSoil); minLayer=jLayer
- case default; minLayer=integerMissing
- end select
-
- ! set desired layers
- select case(flux_meta(iVar)%vartype)
- case(iLookVarType%midToto,iLookVarType%ifcToto); fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- case(iLookVarType%midSnow,iLookVarType%ifcSnow); if(iLayer<=nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- case(iLookVarType%midSoil,iLookVarType%ifcSoil); if(iLayer> nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
- end select
-
- ! add hydrology states for scalar variables
- if(iStateTypeSplit==massSplit .and. flux_meta(iVar)%vartype==iLookVarType%scalarv)then
- select case(iDomainSplit)
- case(snowSplit); if(iLayer==nSnow) fluxMask%var(iVar)%dat = desiredFlux
- case(soilSplit); if(iLayer==nSnow+1) fluxMask%var(iVar)%dat = desiredFlux
- end select
- endif ! if hydrology split and scalar
-
- endif ! if the layer is active
- end do ! looping through layers
-
- ! check
- case default
- err=20
- message=trim(message)//'unable to identify split based on domain type'
- print*, message
- return
- end select ! domain split
-
- endif ! if flux is desired
-
- endif ! domain splitting
- endif ! not fully coupled
-
- ! define if the flux is desired
- if(desiredFlux) neededFlux(iVar)=.true.
- !if(desiredFlux) print*, flux_meta(iVar)%varname, fluxMask%var(iVar)%dat
-
- ! * check
- if( globalPrintFlag .and. count(fluxMask%var(iVar)%dat)>0 )&
- print*, trim(flux_meta(iVar)%varname)
-
- end do ! (loop through fluxes)
-
- end associate stateSubset
-
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! ***** trial with a given solution method...
-
- ! check that we do not attempt the scalar solution for the fully coupled case
- if(ixCoupling==fullyCoupled .and. ixSolution==scalar)then
- message=trim(message)//'only apply the scalar solution to the fully split coupling strategy'
- print*, message
- err=20; return
- endif
-
- ! reset the flag for the first flux call
- if(.not.firstSuccess) firstFluxCall=.true.
-
- ! save/recover copies of prognostic variables
- do iVar=1,size(prog_data%var)
- select case(failure)
- case(.false.); prog_temp%var(iVar)%dat(:) = prog_data%var(iVar)%dat(:)
- case(.true.); prog_data%var(iVar)%dat(:) = prog_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- ! save/recover copies of diagnostic variables
- do iVar=1,size(diag_data%var)
- select case(failure)
- case(.false.); diag_temp%var(iVar)%dat(:) = diag_data%var(iVar)%dat(:)
- case(.true.); diag_data%var(iVar)%dat(:) = diag_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- ! save/recover copies of model fluxes
- do iVar=1,size(flux_data%var)
- select case(failure)
- case(.false.); flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
- case(.true.); flux_data%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- ! -----
- ! * solve variable subset for one time step...
- ! --------------------------------------------
-
- !print*, trim(message)//'before varSubstep: nSubset = ', nSubset
-
- ! keep track of the number of scalar solutions
- if(ixSolution==scalar) numberScalarSolutions = numberScalarSolutions + 1
-
- select case(model_decisions(iLookDECISIONS%diffEqSolv)%iDecision)
- case(sundialIDA)
- call varSubstepSundials(&
- ! input: model control
- dt, & ! intent(inout) : time step (s)
- dtInit, & ! intent(in) : initial time step (seconds)
- dt_min, & ! intent(in) : minimum time step (seconds)
- nSubset, & ! intent(in) : total number of variables in the state subset
- doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
- firstSubStep, & ! intent(in) : flag to denote first sub-step
- firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
- computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
- (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
- iStateSplit, & ! intent(in) : index of the layer in the splitting operation
- fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
- fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
- ! input/output: data structures
- model_decisions, & ! intent(in) : model decisions
- lookup_data, & ! intent(in) : lookup tables
- type_data, & ! intent(in) : type of vegetation and soil
- attr_data, & ! intent(in) : spatial attributes
- forc_data, & ! intent(in) : model forcing data
- mpar_data, & ! intent(in) : model parameters
- indx_data, & ! intent(inout) : index data
- prog_data, & ! intent(inout) : model prognostic variables for a local HRU
- diag_data, & ! intent(inout) : model diagnostic variables for a local HRU
- flux_data, & ! intent(inout) : model fluxes for a local HRU
- deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
- bvar_data, & ! intent(in) : model variables for the local basin
- ! output: control
- ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dtMultiplier, & ! intent(out) : substep multiplier (-)
- nSubsteps, & ! intent(out) : number of substeps taken for a given split
- failedMinimumStep, & ! intent(out) : flag for failed substeps
- reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
- tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
- dt_out, & ! intent(out)
- err,cmessage) ! intent(out) : error code and error message
- ! solve variable subset for one full time step
- case(backwEuler)
- call varSubstep(&
- ! input: model control
- dt, & ! intent(inout) : time step (s)
- dtInit, & ! intent(in) : initial time step (seconds)
- dt_min, & ! intent(in) : minimum time step (seconds)
- nSubset, & ! intent(in) : total number of variables in the state subset
- doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
- firstSubStep, & ! intent(in) : flag to denote first sub-step
- firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
- computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
- (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
- iStateSplit, & ! intent(in) : index of the layer in the splitting operation
- fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
- fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
- ! input/output: data structures
- model_decisions, & ! intent(in) : model decisions
- lookup_data, & ! intent(in) : lookup tables
- type_data, & ! intent(in) : type of vegetation and soil
- attr_data, & ! intent(in) : spatial attributes
- forc_data, & ! intent(in) : model forcing data
- mpar_data, & ! intent(in) : model parameters
- indx_data, & ! intent(inout) : index data
- prog_data, & ! intent(inout) : model prognostic variables for a local HRU
- diag_data, & ! intent(inout) : model diagnostic variables for a local HRU
- flux_data, & ! intent(inout) : model fluxes for a local HRU
- deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
- bvar_data, & ! intent(in) : model variables for the local basin
- ! output: control
- ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dtMultiplier, & ! intent(out) : substep multiplier (-)
- nSubsteps, & ! intent(out) : number of substeps taken for a given split
- failedMinimumStep, & ! intent(out) : flag for failed substeps
- reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
- tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
- err,cmessage) ! intent(out) : error code and error message
- case default
- err=20
- message=trim(message)//'expect case to backwEuler or sundialIDA'
- print*, message
- return
- end select
-
- dt = dt_out
-
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- if(err>0) return
- endif ! (check for errors)
-
- ! print*, trim(message)//'after varSubstep: scalarSnowDrainage = ', flux_data%var(iLookFLUX%scalarSnowDrainage)%dat
- ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%iLayerLiqFluxSnow)%dat
- ! print*, trim(message)//'after varSubstep: iLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat
-
- ! check
- !if(ixSolution==scalar)then
- ! print*, 'PAUSE: check scalar'; read(*,*)
- !endif
-
- ! reduce coupled step if failed the minimum step for the scalar solution
- if(failedMinimumStep .and. ixSolution==scalar) reduceCoupledStep=.true.
-
- ! check
- !if(ixCoupling/=fullyCoupled)then
- ! print*, 'dt = ', dt
- ! print*, 'after varSubstep: err = ', err
- ! print*, 'after varSubstep: cmessage = ', trim(cmessage)
- ! print*, 'after varSubstep: computeVegFlux = ', computeVegFlux
- ! print*, 'after varSubstep: stateMask = ', stateMask
- ! print*, 'after varSubstep: coupling = ', (ixCoupling==fullyCoupled)
- ! print*, 'after varSubstep: scalar solve = ', (ixSolution==scalar)
- ! print*, 'iStateTypeSplit, nStateTypeSplit = ', iStateTypeSplit, nStateTypeSplit
- ! print*, 'iDomainSplit, nDomainSplit = ', iDomainSplit, nDomainSplit
- ! print*, 'nSubset = ', nSubset
- ! print*, 'tooMuchMelt = ', tooMuchMelt
- ! print*, 'reduceCoupledStep = ', reduceCoupledStep
- ! print*, 'failedMinimumStep = ', failedMinimumStep, merge('coupled','opSplit',ixCoupling==fullyCoupled)
- ! if(ixSolution==scalar)then; print*, 'PAUSE'; read(*,*); endif
- !endif
-
- !if(ixSolution==scalar)then
- ! !print*, trim(message)//'stop: checking scalar solution'; stop
- ! print*, trim(message)//'pause: checking scalar solution'; read(*,*)
- !endif
-
- !print*, 'tooMuchMelt, reduceCoupledStep = ', tooMuchMelt, reduceCoupledStep
-
- ! if too much melt (or some other need to reduce the coupled step) then return
- ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
- if(tooMuchMelt .or. reduceCoupledStep)then
- stepFailure=.true.
- err=0 ! recovering
- return
- endif
-
- ! define failure
- failure = (failedMinimumStep .or. err<0)
- if(.not.failure) firstSuccess=.true.
-
- ! if failed, need to reset the flux counter
- if(failure)then
- !print*, 'failure!'
- do iVar=1,size(flux_meta)
- iMin=lbound(flux_data%var(iVar)%dat)
- iMax=ubound(flux_data%var(iVar)%dat)
- do iLayer=iMin(1),iMax(1)
- if(fluxMask%var(iVar)%dat(iLayer)) fluxCount%var(iVar)%dat(iLayer) = fluxCount%var(iVar)%dat(iLayer) - nSubsteps
- end do
- !if(iVar==iLookFLUX%mLayerTranspire) print*, flux_meta(iVar)%varname, fluxCount%var(iVar)%dat
- end do
- endif
-
- ! try the fully split solution if failed to converge with a minimum time step in the coupled solution
- if(ixCoupling==fullyCoupled .and. failure) cycle coupling
-
- ! try the scalar solution if failed to converge with a minimum time step in the split solution
- if(ixCoupling/=fullyCoupled)then
- select case(ixStateThenDomain)
- case(fullDomain); if(failure) cycle stateThenDomain
- case(subDomain); if(failure) cycle solution
- case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
- end select
- endif
-
- ! check that state variables updated
- where(stateMask) stateCheck = stateCheck+1
- if(any(stateCheck>1))then
- message=trim(message)//'state variable updated more than once!'
- err=20; return
- endif
-
- ! success = exit solution
- if(.not.failure)then
- select case(ixStateThenDomain)
- case(fullDomain); if(iStateSplit==nStateSplit) exit stateThenDomain
- case(subDomain); if(iStateSplit==nStateSplit) exit solution
- case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
- end select
- else
-
- ! check that we did not fail for the scalar solution (last resort)
+
+ ! check that we haven't split the domain when we are fully coupled
+ if(ixCoupling==fullyCoupled .and. nDomainSplit==nDomains)then
+ message=trim(message)//'cannot split domains when fully coupled'
+ err=20; return
+ endif
+
+ ! domain splitting loop
+ domainSplit: do iDomainSplit=1,nDomainSplit
+
+ ! trial with the vector then scalar solution
+ solution: do ixSolution=1,nSolutions
+
+ ! initialize error control
+ err=0; message="opSplittin/"
+
+ ! refine the time step
if(ixSolution==scalar)then
- message=trim(message)//'failed the minimum step for the scalar solution'
- print*, message
- err=20; return
-
- ! check for an unexpected failure
- else
- message=trim(message)//'unexpected failure'
- print*, message
- err=20; return
+ dtInit = min(dtmin_split, dt) ! initial time step
+ dt_min = min(dtmin_scalar, dt) ! minimum time step
endif
-
- endif ! success check
-
- end do stateSplit ! solution with split layers
- !print*, 'after stateSplit'
-
- end do solution ! trial with the full layer solution then the split layer solution
-
- !print*, 'after solution loop'
-
- ! ***** trial with a given solution method...
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
- ! *******************************************************************************************************************************
-
- end do domainSplit ! domain type splitting loop
-
- !print*, 'ixStateThenDomain = ', ixStateThenDomain
- !print*, 'after domain split loop'
-
- end do stateThenDomain ! switch between the state and the domain
-
- !print*, 'after stateThenDomain switch'
-
- ! -----
- ! * reset state variables for the mass split...
- ! ---------------------------------------------
-
- ! modify the state type names associated with the state vector
- if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
- if(computeVegFlux)then
- where(ixStateType(ixHydCanopy)==iname_liqCanopy) ixStateType(ixHydCanopy)=iname_watCanopy
+
+ ! initialize the first flux call
+ firstFluxCall=.true.
+
+ ! get the number of split layers
+ select case(ixSolution)
+ case(vector); nStateSplit=1
+ case(scalar); nStateSplit=count(stateMask)
+ case default; err=20; message=trim(message)//'unknown solution method'; return
+ end select
+
+
+ ! loop through layers (NOTE: nStateSplit=1 for the vector solution, hence no looping)
+ stateSplit: do iStateSplit=1,nStateSplit
+
+ ! -----
+ ! * define state subsets for a given split...
+ ! -------------------------------------------
+
+ ! get the mask for the state subset
+ call stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
+ indx_data,stateMask,nSubset,err,cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! check that state variables exist
+ if(nSubset==0) cycle domainSplit
+
+ ! avoid redundant case where vector solution is of length 1
+ if(ixSolution==vector .and. count(stateMask)==1) cycle solution
+
+
+
+ ! -----
+ ! * assemble vectors for a given split...
+ ! ---------------------------------------
+ ! get indices for a given split
+ call indexSplit(stateMask, & ! intent(in) : logical vector (.true. if state is in the subset)
+ nSnow,nSoil,nLayers,nSubset, & ! intent(in) : number of snow and soil layers, and total number of layers
+ indx_data, & ! intent(inout) : index data structure
+ err,cmessage) ! intent(out) : error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! -----
+ ! * define the mask of the fluxes used...
+ ! ---------------------------------------
+
+ ! identify the type of state for the states in the subset
+ stateSubset: associate(ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] indices of state types
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ixLayerActive => indx_data%var(iLookINDEX%ixLayerActive)%dat ,& ! intent(in): [i4b(:)] list of indices for all active layers (inactive=integerM
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ) ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
+
+ ! loop through flux variables
+ do iVar=1,size(flux_meta)
+
+ ! * identify flux mask for the fully coupled solution
+ if(ixCoupling==fullyCoupled)then
+ desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
+ fluxMask%var(iVar)%dat = desiredFlux
+
+ ! * identify flux mask for the split solution
+ else
+
+ ! identify the flux mask for a given state split
+ select case(iStateTypeSplit)
+ case(nrgSplit); desiredFlux = any(ixStateType_subset==flux2state_orig(iVar)%state1) .or. any(ixStateType_subset==flux2state_orig(iVar)%state2)
+ case(massSplit); desiredFlux = any(ixStateType_subset==flux2state_liq(iVar)%state1) .or. any(ixStateType_subset==flux2state_liq(iVar)%state2)
+ case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
+ end select
+
+ ! no domain splitting
+ if(nDomains==1)then
+ fluxMask%var(iVar)%dat = desiredFlux
+
+ ! domain splitting
+ else
+ print*,"split domain"
+
+ ! initialize to .false.
+ fluxMask%var(iVar)%dat = .false.
+
+ ! only need to proceed if the flux is desired
+ if(desiredFlux)then
+
+ ! different domain splitting operations
+ select case(iDomainSplit)
+
+ ! canopy fluxes -- (:1) gets the upper boundary(0) if it exists
+ case(vegSplit)
+
+ ! vector solution (should only be present for energy)
+ if(ixSolution==vector)then
+ fluxMask%var(iVar)%dat(:1) = desiredFlux
+ if(ixStateThenDomain>1 .and. iStateTypeSplit/=nrgSplit)then
+ message=trim(message)//'only expect a vector solution for the vegetation domain for energy'
+ err=20; return
+ endif
+
+ ! scalar solution
+ else
+ fluxMask%var(iVar)%dat(:1) = desiredFlux
+ endif
+
+ ! fluxes through snow and soil
+ case(snowSplit,soilSplit)
+
+ ! loop through layers
+ do iLayer=1,nLayers
+ if(ixlayerActive(iLayer)/=integerMissing)then
+
+ ! get the offset (ixLayerActive=1,2,3,...nLayers, and soil vectors nSnow+1, nSnow+2, ..., nLayers)
+ iOffset = merge(nSnow, 0, flux_meta(iVar)%vartype==iLookVarType%midSoil .or. flux_meta(iVar)%vartype==iLookVarType%ifcSoil)
+ jLayer = iLayer-iOffset
+
+ ! identify the minimum layer
+ select case(flux_meta(iVar)%vartype)
+ case(iLookVarType%ifcToto, iLookVarType%ifcSnow, iLookVarType%ifcSoil); minLayer=merge(jLayer-1, jLayer, jLayer==1)
+ case(iLookVarType%midToto, iLookVarType%midSnow, iLookVarType%midSoil); minLayer=jLayer
+ case default; minLayer=integerMissing
+ end select
+
+ ! set desired layers
+ select case(flux_meta(iVar)%vartype)
+ case(iLookVarType%midToto,iLookVarType%ifcToto); fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ case(iLookVarType%midSnow,iLookVarType%ifcSnow); if(iLayer<=nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ case(iLookVarType%midSoil,iLookVarType%ifcSoil); if(iLayer> nSnow) fluxMask%var(iVar)%dat(minLayer:jLayer) = desiredFlux
+ end select
+
+ ! add hydrology states for scalar variables
+ if(iStateTypeSplit==massSplit .and. flux_meta(iVar)%vartype==iLookVarType%scalarv)then
+ select case(iDomainSplit)
+ case(snowSplit); if(iLayer==nSnow) fluxMask%var(iVar)%dat = desiredFlux
+ case(soilSplit); if(iLayer==nSnow+1) fluxMask%var(iVar)%dat = desiredFlux
+ end select
+ endif ! if hydrology split and scalar
+
+ endif ! if the layer is active
+ end do ! looping through layers
+
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify split based on domain type'; return
+ end select ! domain split
+
+ endif ! if flux is desired
+
+ endif ! domain splitting
+ endif ! not fully coupled
+
+ ! define if the flux is desired
+ if(desiredFlux) neededFlux(iVar)=.true.
+ !if(desiredFlux) print*, flux_meta(iVar)%varname, fluxMask%var(iVar)%dat
+
+ ! * check
+ if( globalPrintFlag .and. count(fluxMask%var(iVar)%dat)>0 )&
+ print*, trim(flux_meta(iVar)%varname)
+
+ end do ! (loop through fluxes)
+
+ end associate stateSubset
+
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! ***** trial with a given solution method...
+
+ ! check that we do not attempt the scalar solution for the fully coupled case
+ if(ixCoupling==fullyCoupled .and. ixSolution==scalar)then
+ message=trim(message)//'only apply the scalar solution to the fully split coupling strategy'
+ err=20; return
+ endif
+
+ ! reset the flag for the first flux call
+ if(.not.firstSuccess) firstFluxCall=.true.
+
+ ! save/recover copies of prognostic variables
+ do iVar=1,size(prog_data%var)
+ select case(failure)
+ case(.false.); prog_temp%var(iVar)%dat(:) = prog_data%var(iVar)%dat(:)
+ case(.true.); prog_data%var(iVar)%dat(:) = prog_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
+
+ ! save/recover copies of diagnostic variables
+ do iVar=1,size(diag_data%var)
+ select case(failure)
+ case(.false.); diag_temp%var(iVar)%dat(:) = diag_data%var(iVar)%dat(:)
+ case(.true.); diag_data%var(iVar)%dat(:) = diag_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
+
+ ! save/recover copies of model fluxes
+ do iVar=1,size(flux_data%var)
+ select case(failure)
+ case(.false.); flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
+ case(.true.); flux_data%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
+ end select
+ end do ! looping through variables
+
+ ! -----
+ ! * solve variable subset for one time step...
+ ! --------------------------------------------
+
+ ! keep track of the number of scalar solutions
+ if(ixSolution==scalar) numberScalarSolutions = numberScalarSolutions + 1
+
+ ! solve variable subset for one full time step
+ select case(ixNumericalMethod)
+ case(sundials)
+ call 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)
+ nSubset, & ! intent(in) : total number of variables in the state subset
+ doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
+ firstSubStep, & ! intent(in) : flag to denote first sub-step
+ firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
+ computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
+ (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
+ iStateSplit, & ! intent(in) : index of the layer in the splitting operation
+ fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
+ fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
+ ! input/output: data structures
+ model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
+ type_data, & ! intent(in) : type of vegetation and soil
+ attr_data, & ! intent(in) : spatial attributes
+ forc_data, & ! intent(in) : model forcing data
+ mpar_data, & ! intent(in) : model parameters
+ indx_data, & ! intent(inout) : index data
+ prog_data, & ! intent(inout) : model prognostic variables for a local HRU
+ diag_data, & ! intent(inout) : model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout) : model fluxes for a local HRU
+ deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
+ bvar_data, & ! intent(in) : model variables for the local basin
+ ! output: control
+ ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dtMultiplier, & ! intent(out) : substep multiplier (-)
+ nSubsteps, & ! intent(out) : number of substeps taken for a given split
+ failedMinimumStep, & ! intent(out) : flag for failed substeps
+ reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
+ dt_out, & ! intent(out)
+ err,cmessage) ! intent(out) : error code and error message
+
+ dt = dt_out
+
+ case(bEuler)
+ call varSubstep(&
+ ! input: model control
+ dt, & ! intent(in) : time step (s)
+ dtInit, & ! intent(in) : initial time step (seconds)
+ dt_min, & ! intent(in) : minimum time step (seconds)
+ nSubset, & ! intent(in) : total number of variables in the state subset
+ doAdjustTemp, & ! intent(in) : flag to indicate if we adjust the temperature
+ firstSubStep, & ! intent(in) : flag to denote first sub-step
+ firstFluxCall, & ! intent(inout) : flag to indicate if we are processing the first flux call
+ computeVegFlux, & ! intent(in) : flag to denote if computing energy flux over vegetation
+ (ixSolution==scalar), & ! intent(in) : flag to denote computing the scalar solution
+ iStateSplit, & ! intent(in) : index of the layer in the splitting operation
+ fluxMask, & ! intent(in) : mask for the fluxes used in this given state subset
+ fluxCount, & ! intent(inout) : number of times fluxes are updated (should equal nsubstep)
+ ! input/output: data structures
+ model_decisions, & ! intent(in) : model decisions
+ lookup_data, & ! intent(in) : lookup tables
+ type_data, & ! intent(in) : type of vegetation and soil
+ attr_data, & ! intent(in) : spatial attributes
+ forc_data, & ! intent(in) : model forcing data
+ mpar_data, & ! intent(in) : model parameters
+ indx_data, & ! intent(inout) : index data
+ prog_data, & ! intent(inout) : model prognostic variables for a local HRU
+ diag_data, & ! intent(inout) : model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout) : model fluxes for a local HRU
+ deriv_data, & ! intent(inout) : derivatives in model fluxes w.r.t. relevant state variables
+ bvar_data, & ! intent(in) : model variables for the local basin
+ ! output: control
+ ixSaturation, & ! intent(inout) : index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dtMultiplier, & ! intent(out) : substep multiplier (-)
+ nSubsteps, & ! intent(out) : number of substeps taken for a given split
+ failedMinimumStep, & ! intent(out) : flag for failed substeps
+ reduceCoupledStep, & ! intent(out) : flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out) : flag to denote that ice is insufficient to support melt
+ err,cmessage) ! intent(out) : error code and error message
+ ! check
+ case default; err=20; message=trim(message)//'expect num_method to be sundials or bEuler (or itertive, which is bEuler)'; return
+ end select
+
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ if(err>0) return
+ endif ! (check for errors)
+
+ ! reduce coupled step if failed the minimum step for the scalar solution
+ if(failedMinimumStep .and. ixSolution==scalar) reduceCoupledStep=.true.
+
+ ! if too much melt (or some other need to reduce the coupled step) then return
+ ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
+ if(tooMuchMelt .or. reduceCoupledStep)then
+ stepFailure=.true.
+ err=0 ! recovering
+ return
+ endif
+
+ ! define failure
+ failure = (failedMinimumStep .or. err<0)
+ if(.not.failure) firstSuccess=.true.
+
+ ! if failed, need to reset the flux counter
+ if(failure)then
+ do iVar=1,size(flux_meta)
+ iMin=lbound(flux_data%var(iVar)%dat)
+ iMax=ubound(flux_data%var(iVar)%dat)
+ do iLayer=iMin(1),iMax(1)
+ if(fluxMask%var(iVar)%dat(iLayer)) fluxCount%var(iVar)%dat(iLayer) = fluxCount%var(iVar)%dat(iLayer) - nSubsteps
+ end do
+ end do
+ endif
+
+ ! try the fully split solution if failed to converge with a minimum time step in the coupled solution
+ if(ixCoupling==fullyCoupled .and. failure) cycle coupling
+
+ ! try the scalar solution if failed to converge with a minimum time step in the split solution
+ if(ixCoupling/=fullyCoupled)then
+ select case(ixStateThenDomain)
+ case(fullDomain); if(failure) cycle stateThenDomain
+ case(subDomain); if(failure) cycle solution
+ case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
+ end select
+ endif
+
+ ! check that state variables updated
+ where(stateMask) stateCheck = stateCheck+1
+ if(any(stateCheck>1))then
+ message=trim(message)//'state variable updated more than once!'
+ err=20; return
+ endif
+
+ ! success = exit solution
+ if(.not.failure)then
+ select case(ixStateThenDomain)
+ case(fullDomain); if(iStateSplit==nStateSplit) exit stateThenDomain
+ case(subDomain); if(iStateSplit==nStateSplit) exit solution
+ case default; err=20; message=trim(message)//'unknown ixStateThenDomain case'
+ end select
+ else
+
+ ! check that we did not fail for the scalar solution (last resort)
+ if(ixSolution==scalar)then
+ message=trim(message)//'failed the minimum step for the scalar solution'
+ err=20; return
+
+ ! check for an unexpected failure
+ else
+ message=trim(message)//'unexpected failure'
+ err=20; return
+ endif
+
+ endif ! success check
+
+ end do stateSplit ! solution with split layers
+
+ end do solution ! trial with the full layer solution then the split layer solution
+
+ ! ***** trial with a given solution method...
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+ ! *******************************************************************************************************************************
+
+ end do domainSplit ! domain type splitting loop
+
+
+ end do stateThenDomain ! switch between the state and the domain
+
+
+ ! -----
+ ! * reset state variables for the mass split...
+ ! ---------------------------------------------
+ ! modify the state type names associated with the state vector
+ if(ixCoupling/=fullyCoupled .and. iStateTypeSplit==massSplit)then
+ if(computeVegFlux)then
+ where(ixStateType(ixHydCanopy)==iname_liqCanopy) ixStateType(ixHydCanopy)=iname_watCanopy
+ endif
+ where(ixStateType(ixHydLayer) ==iname_liqLayer) ixStateType(ixHydLayer) =iname_watLayer
+ where(ixStateType(ixHydLayer) ==iname_lmpLayer) ixStateType(ixHydLayer) =iname_matLayer
+ endif ! if modifying state variables for the mass split
+
+ end do stateTypeSplit ! state type splitting loop
+
+ ! success = exit the coupling loop
+ if(ixCoupling==fullyCoupled .and. .not.failure) exit coupling
+
+ end do coupling ! coupling method
+
+ ! check that all state variables were updated
+ if(any(stateCheck==0))then
+ message=trim(message)//'some state variables were not updated!'
+ err=20; return
+ endif
+
+ ! check that the desired fluxes were computed
+ do iVar=1,size(flux_meta)
+ if(neededFlux(iVar) .and. any(fluxCount%var(iVar)%dat==0))then
+ print*, 'fluxCount%var(iVar)%dat = ', fluxCount%var(iVar)%dat
+ message=trim(message)//'flux '//trim(flux_meta(iVar)%varname)//' was not computed'
+ err=20; return
endif
- where(ixStateType(ixHydLayer) ==iname_liqLayer) ixStateType(ixHydLayer) =iname_watLayer
- where(ixStateType(ixHydLayer) ==iname_lmpLayer) ixStateType(ixHydLayer) =iname_matLayer
- endif ! if modifying state variables for the mass split
-
- end do stateTypeSplitLoop ! state type splitting loop
-
- ! check
- !if(ixCoupling/=fullyCoupled)then
- ! print*, 'PAUSE: end of splitting loop'; read(*,*)
- !endif
-
- ! ==========================================================================================================================================
- ! ==========================================================================================================================================
-
- ! success = exit the coupling loop
-
- if(ixCoupling==fullyCoupled .and. .not. failure) exit coupling
-
- end do coupling ! coupling method
-
- ! check that all state variables were updated
- if(any(stateCheck==0))then
- message=trim(message)//'some state variables were not updated!'
- print*,message
- err=20; return
- endif
-
- ! check that the desired fluxes were computed
- do iVar=1,size(flux_meta)
- if(neededFlux(iVar) .and. any(fluxCount%var(iVar)%dat==0))then
- print*, 'fluxCount%var(iVar)%dat = ', fluxCount%var(iVar)%dat
- message=trim(message)//'flux '//trim(flux_meta(iVar)%varname)//' was not computed'
- err=20; return
- endif
- end do
-
- ! use step halving if unable to complete the fully coupled solution in one substep
- if(ixCoupling/=fullyCoupled .or. nSubsteps>1) dtMultiplier=0.5_dp
-
- ! compute the melt in each snow and soil layer
- if(nSnow>0) then
- diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat(1:nSnow) = -( mLayerVolFracIce(1:nSnow) - mLayerVolFracIceInit(1:nSnow) ) * iden_ice
- diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat(nSnow+1:nLayers) = -(mLayerVolFracIce(nSnow+1:nLayers) - mLayerVolFracIceInit(nSnow+1:nLayers))*iden_water
- endif
-
-
- ! print*, "After******"
- ! print*, "scalarCanairTemp = ", scalarCanairTemp
- ! print*, "scalarCanopyTemp = ", scalarCanopyTemp
- ! print*, "scalarCanopyIce = ", scalarCanopyIce
- ! print*, "scalarCanopyLiq = ", scalarCanopyLiq
- ! print*, "scalarCanopyWat = ", scalarCanopyWat
- ! print*, "mLayerTemp = ", mLayerTemp(1)
- ! print*, "mLayerVolFracIce = ", mLayerVolFracIce(1)
- ! print*, "mLayerVolFracLiq = ", mLayerVolFracLiq(1)
- ! print*, "mLayerVolFracWat = ", mLayerVolFracWat(1)
- ! print*, "mLayerMatricHead = ", mLayerMatricHead(1)
- ! print*, "mLayerMatricHeadLiq = ", mLayerMatricHeadLiq(1)
- ! end associate statements
- end associate globalVars
-
- end subroutine opSplittin
-
-
- ! **********************************************************************************************************
- ! private subroutine stateFilter: get a mask for the desired state variables
- ! **********************************************************************************************************
- subroutine stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
+ end do
+
+ ! use step halving if unable to complete the fully coupled solution in one substep
+ if(ixCoupling/=fullyCoupled .or. nSubsteps>1) dtMultiplier=0.5_rkind
+
+ ! compute the melt in each snow and soil layer
+ if(nSnow>0)then
+ diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat(1:nSnow) = -( mLayerVolFracIce(1:nSnow) - mLayerVolFracIceInit(1:nSnow) ) * iden_ice
+ diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat(nSnow+1:nLayers) = -(mLayerVolFracIce(nSnow+1:nLayers) - mLayerVolFracIceInit(nSnow+1:nLayers))*iden_water
+ endif
+
+ ! end associate statements
+ end associate globalVars
+
+ end subroutine opSplittin
+
+
+ ! **********************************************************************************************************
+ ! private subroutine stateFilter: get a mask for the desired state variables
+ ! **********************************************************************************************************
+ subroutine stateFilter(ixCoupling,ixSolution,ixStateThenDomain,iStateTypeSplit,iDomainSplit,iStateSplit,&
indx_data,stateMask,nSubset,err,message)
-
- USE indexState_module,only:indxSubset ! get state indices
- implicit none
- ! input
- integer(i4b),intent(in) :: ixCoupling ! index of coupling method (1,2)
- integer(i4b),intent(in) :: ixSolution ! index of solution method (1,2)
- integer(i4b),intent(in) :: ixStateThenDomain ! switch between full domain and sub domains
- integer(i4b),intent(in) :: iStateTypeSplit ! index of the state type split
- integer(i4b),intent(in) :: iDomainSplit ! index of the domain split
- integer(i4b),intent(in) :: iStateSplit ! index of the layer split
- type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
- ! output
- logical(lgt),intent(out) :: stateMask(:) ! mask defining desired state variables
- integer(i4b),intent(out) :: nSubset ! number of selected state variables for a given split
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local
- integer(i4b),allocatable :: ixSubset(:) ! list of indices in the state subset
- character(len=256) :: cmessage ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------------------------------------------------
- ! data structures
- associate(&
- ! indices of model state variables
- ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
- ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
- ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
- ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
- ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
- ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
- ixWatAquifer => indx_data%var(iLookINDEX%ixWatAquifer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for water storage in the aquifer
- ixAllState => indx_data%var(iLookINDEX%ixAllState)%dat ,& ! intent(in): [i4b(:)] list of indices for all model state variables (1,2,3,...nState)
- ! 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
- ) ! data structures
- ! --------------------------------------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message='stateFilter/'
-
- ! identify splitting option
- select case(ixCoupling)
-
- ! -----
- ! - fully coupled...
- ! ------------------
-
- ! use all state variables
- case(fullyCoupled); stateMask(:) = .true.
-
- ! -----
- ! - splitting by state type...
- ! ----------------------------
-
- ! initial split by state type
- case(stateTypeSplit)
-
- ! switch between full domain and sub domains
- select case(ixStateThenDomain)
-
- ! split into energy and mass
- case(fullDomain)
- select case(iStateTypeSplit)
- case(nrgSplit); stateMask = (ixStateType==iname_nrgCanair .or. ixStateType==iname_nrgCanopy .or. ixStateType==iname_nrgLayer)
- case(massSplit); stateMask = (ixStateType==iname_liqCanopy .or. ixStateType==iname_liqLayer .or. ixStateType==iname_lmpLayer .or. ixStateType==iname_watAquifer)
- case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
- end select
-
- ! split into vegetation, snow, and soil
- case(subDomain)
-
- ! define state mask
- stateMask=.false. ! (initialize state mask)
- select case(iStateTypeSplit)
-
- ! define mask for energy
- case(nrgSplit)
- select case(iDomainSplit)
- case(vegSplit)
- if(ixNrgCanair(1)/=integerMissing) stateMask(ixNrgCanair) = .true. ! energy of the canopy air space
- if(ixNrgCanopy(1)/=integerMissing) stateMask(ixNrgCanopy) = .true. ! energy of the vegetation canopy
- stateMask(ixNrgLayer(1)) = .true. ! energy of the upper-most layer in the snow+soil domain
- case(snowSplit); if(nSnow>1) stateMask(ixNrgLayer(2:nSnow)) = .true. ! NOTE: (2:) because the top layer in the snow+soil domain included in vegSplit
- case(soilSplit); stateMask(ixNrgLayer(max(2,nSnow+1):nLayers)) = .true. ! NOTE: max(2,nSnow+1) gives second layer unless more than 2 snow layers
- case(aquiferSplit) ! do nothing: no energy state variable for the aquifer domain
- case default; err=20; message=trim(message)//'unable to identify model sub-domain'; return
- end select
-
- ! define mask for water
- case(massSplit)
- select case(iDomainSplit)
- case(vegSplit); if(ixHydCanopy(1)/=integerMissing) stateMask(ixHydCanopy) = .true. ! hydrology of the vegetation canopy
- case(snowSplit); stateMask(ixHydLayer(1:nSnow)) = .true. ! snow hydrology
- case(soilSplit); stateMask(ixHydLayer(nSnow+1:nLayers)) = .true. ! soil hydrology
- case(aquiferSplit); if(ixWatAquifer(1)/=integerMissing) stateMask(ixWatAquifer) = .true. ! aquifer storage
- case default; err=20; message=trim(message)//'unable to identify model sub-domain'; return
- end select
-
- ! check
- case default; err=20; message=trim(message)//'unable to identify the state type'; return
- end select ! (split based on state type)
-
- ! check
- case default; err=20; message=trim(message)//'unable to identify the switch between full domains and sub domains'; return
- end select ! (switch between full domains and sub domains)
-
- ! check
- case default; err=20; message=trim(message)//'unable to identify coupling method'; return
- end select ! (selecting solution method)
-
- !print*, 'stateMask = ', stateMask
-
- ! identify scalar solutions
- if(ixSolution==scalar)then
-
- ! get the subset of indices
- call indxSubset(ixSubset, ixAllState, stateMask, err, cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! get the mask
- stateMask(:) = .false.
- stateMask( ixSubset(iStateSplit) ) = .true.
-
- ! check
- if(count(stateMask)/=1)then
- message=trim(message)//'expect size=1 (scalar)'
- err=20; return
- endif
-
- endif
-
- ! get the number of selected state variables
- nSubset = count(stateMask)
-
- ! end associations
- end associate
-
- end subroutine stateFilter
-
-end module opSplittin_module
+
+ USE indexState_module,only:indxSubset ! get state indices
+ implicit none
+ ! input
+ integer(i4b),intent(in) :: ixCoupling ! index of coupling method (1,2)
+ integer(i4b),intent(in) :: ixSolution ! index of solution method (1,2)
+ integer(i4b),intent(in) :: ixStateThenDomain ! switch between full domain and sub domains
+ integer(i4b),intent(in) :: iStateTypeSplit ! index of the state type split
+ integer(i4b),intent(in) :: iDomainSplit ! index of the domain split
+ integer(i4b),intent(in) :: iStateSplit ! index of the layer split
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ ! output
+ logical(lgt),intent(out) :: stateMask(:) ! mask defining desired state variables
+ integer(i4b),intent(out) :: nSubset ! number of selected state variables for a given split
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local
+ integer(i4b),allocatable :: ixSubset(:) ! list of indices in the state subset
+ character(len=256) :: cmessage ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! data structures
+ associate(&
+ ! indices of model state variables
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (ixNrgState...)
+ ixNrgCanair => indx_data%var(iLookINDEX%ixNrgCanair)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in canopy air space domain
+ ixNrgCanopy => indx_data%var(iLookINDEX%ixNrgCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the canopy domain
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the canopy domain
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ixWatAquifer => indx_data%var(iLookINDEX%ixWatAquifer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for water storage in the aquifer
+ ixAllState => indx_data%var(iLookINDEX%ixAllState)%dat ,& ! intent(in): [i4b(:)] list of indices for all model state variables (1,2,3,...nState)
+ ! 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
+ ) ! data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='stateFilter/'
+
+ ! identify splitting option
+ select case(ixCoupling)
+
+ ! -----
+ ! - fully coupled...
+ ! ------------------
+
+ ! use all state variables
+ case(fullyCoupled); stateMask(:) = .true.
+
+ ! -----
+ ! - splitting by state type...
+ ! ----------------------------
+
+ ! initial split by state type
+ case(stateTypeSplit)
+
+ ! switch between full domain and sub domains
+ select case(ixStateThenDomain)
+
+ ! split into energy and mass
+ case(fullDomain)
+ select case(iStateTypeSplit)
+ case(nrgSplit); stateMask = (ixStateType==iname_nrgCanair .or. ixStateType==iname_nrgCanopy .or. ixStateType==iname_nrgLayer)
+ case(massSplit); stateMask = (ixStateType==iname_liqCanopy .or. ixStateType==iname_liqLayer .or. ixStateType==iname_lmpLayer .or. ixStateType==iname_watAquifer)
+ case default; err=20; message=trim(message)//'unable to identify split based on state type'; return
+ end select
+
+ ! split into vegetation, snow, and soil
+ case(subDomain)
+
+ ! define state mask
+ stateMask=.false. ! (initialize state mask)
+ select case(iStateTypeSplit)
+
+ ! define mask for energy
+ case(nrgSplit)
+ select case(iDomainSplit)
+ case(vegSplit)
+ if(ixNrgCanair(1)/=integerMissing) stateMask(ixNrgCanair) = .true. ! energy of the canopy air space
+ if(ixNrgCanopy(1)/=integerMissing) stateMask(ixNrgCanopy) = .true. ! energy of the vegetation canopy
+ stateMask(ixNrgLayer(1)) = .true. ! energy of the upper-most layer in the snow+soil domain
+ case(snowSplit); if(nSnow>1) stateMask(ixNrgLayer(2:nSnow)) = .true. ! NOTE: (2:) because the top layer in the snow+soil domain included in vegSplit
+ case(soilSplit); stateMask(ixNrgLayer(max(2,nSnow+1):nLayers)) = .true. ! NOTE: max(2,nSnow+1) gives second layer unless more than 2 snow layers
+ case(aquiferSplit) ! do nothing: no energy state variable for the aquifer domain
+ case default; err=20; message=trim(message)//'unable to identify model sub-domain'; return
+ end select
+
+ ! define mask for water
+ case(massSplit)
+ select case(iDomainSplit)
+ case(vegSplit); if(ixHydCanopy(1)/=integerMissing) stateMask(ixHydCanopy) = .true. ! hydrology of the vegetation canopy
+ case(snowSplit); stateMask(ixHydLayer(1:nSnow)) = .true. ! snow hydrology
+ case(soilSplit); stateMask(ixHydLayer(nSnow+1:nLayers)) = .true. ! soil hydrology
+ case(aquiferSplit); if(ixWatAquifer(1)/=integerMissing) stateMask(ixWatAquifer) = .true. ! aquifer storage
+ case default; err=20; message=trim(message)//'unable to identify model sub-domain'; return
+ end select
+
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify the state type'; return
+ end select ! (split based on state type)
+
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify the switch between full domains and sub domains'; return
+ end select ! (switch between full domains and sub domains)
+
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify coupling method'; return
+ end select ! (selecting solution method)
+
+ ! identify scalar solutions
+ if(ixSolution==scalar)then
+
+ ! get the subset of indices
+ call indxSubset(ixSubset, ixAllState, stateMask, err, cmessage)
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! get the mask
+ stateMask(:) = .false.
+ stateMask( ixSubset(iStateSplit) ) = .true.
+
+ ! check
+ if(count(stateMask)/=1)then
+ message=trim(message)//'expect size=1 (scalar)'
+ err=20; return
+ endif
+
+ endif
+
+ ! get the number of selected state variables
+ nSubset = count(stateMask)
+
+ ! end associations
+ end associate
+
+ end subroutine stateFilter
+
+ end module opSplittin_module
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/computJacobSundials.f90 b/build/source/engine/sundials/computJacobSundials.f90
index e0f6df8..9f6bf29 100644
--- a/build/source/engine/sundials/computJacobSundials.f90
+++ b/build/source/engine/sundials/computJacobSundials.f90
@@ -20,1101 +20,990 @@
module computJacobSundials_module
- ! data types
- USE nrtype
- USE type4IDA
-
- ! derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (rkind)
- model_options ! defines the model decisions
-
- ! named variables for structure elements
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookFLUX ! named variables for structure elements
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! access missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing real number
- USE globalData,only:quadMissing ! missing quadruple precision number
-
- ! domain types
- USE globalData,only:iname_veg ! named variables for vegetation
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! named variables to describe the state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
- USE globalData,only:model_decisions ! model decision structure
-
- ! access named variables to describe the form and structure of the matrices used in the numerical solver
- USE globalData,only: ku ! number of super-diagonal bands
- USE globalData,only: kl ! number of sub-diagonal bands
- USE globalData,only: ixDiag ! index for the diagonal band
- USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
- USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
- USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
- USE globalData,only: iJac1 ! first layer of the Jacobian to print
- USE globalData,only: iJac2 ! last layer of the Jacobian to print
-
- ! constants
- USE multiconst,only:&
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! look-up values for the choice of groundwater representation (local-column, or single-basin)
- USE mDecisions_module,only: &
- localColumn, & ! separate groundwater representation in each local soil column
- singleBasin ! single groundwater store over the entire basin
-
- ! look-up values for the choice of groundwater parameterization
- USE mDecisions_module,only: &
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit ! no explicit groundwater parameterization
-
- ! look-up values for the form of Richards' equation
- USE mDecisions_module,only: &
- moisture, & ! moisture-based form of Richards' equation
- mixdform ! mixed form of Richards' equation
-
- use, intrinsic :: iso_c_binding
-
+! data types
+USE nrtype
+
+! derived types to define the data structures
+USE data_types,only:&
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables to describe the state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! access named variables to describe the form and structure of the matrices used in the numerical solver
+USE globalData,only: ku ! number of super-diagonal bands
+USE globalData,only: kl ! number of sub-diagonal bands
+USE globalData,only: ixDiag ! index for the diagonal band
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+implicit none
+! define constants
+real(rkind),parameter :: verySmall=tiny(1.0_rkind) ! a very small number
+integer(i4b),parameter :: ixBandOffset=kl+ku+1 ! offset in the band Jacobian matrix
+
+private
+public::computJacobSundials
+contains
+
+! **********************************************************************************************************
+! public subroutine computJacobSundials: compute the Jacobian matrix
+! **********************************************************************************************************
+subroutine computJacobSundials(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ computeBaseflow, & ! intent(in): flag to indicate if we need to compute baseflow
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ mLayerTemp, & ! intent(in): vector of layer temperature (K)
+ mLayerTempPrime, & ! intent(in): vector of derivative value for layer temperature (K)
+ mLayerMatricHeadPrime, & ! intent(in)
+ mLayerMatricHeadLiqPrime, & ! intent(in)
+ mLayerVolFracWatPrime, & ! intent(in)
+ scalarCanopyTemp, & ! intent(in): temperature of the vegetation canopy (K)
+ scalarCanopyTempPrime, & ! intent(in): derivative value for temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & ! intent(in)
+ ! input-output: Jacobian and its diagonal
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix
+ aJac, & ! intent(out): Jacobian matrix
+ ! output: error control
+ err,message) ! intent(out): error code and error message
+ ! -----------------------------------------------------------------------------------------------------------------
implicit none
- ! define constants
- real(rkind),parameter :: verySmall=tiny(1.0_rkind) ! a very small number
- integer(i4b),parameter :: ixBandOffset=kl+ku+1 ! offset in the band Jacobian matrix
-
- private
- public::computJacobSundials
- public::computJacobSetup
- public::computJacob4IDA
- contains
-
- ! **********************************************************************************************************
- ! public subroutine computJacobSundials: compute the Jacobian matrix
- ! **********************************************************************************************************
- subroutine computJacobSundials(&
- ! input: model control
- cj, & ! intent(in): this scalar changes whenever the step size or method order changes
- dt, & ! intent(in): length of the time step (seconds)
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- computeBaseflow, & ! intent(in): flag to indicate if we need to compute baseflow
- ixMatrix, & ! intent(in): form of the Jacobian matrix
- specificStorage, & ! intent(in): specific storage coefficient (m-1)
- theta_sat, & ! intent(in): soil porosity (-)
- ixRichards, & ! intent(in): choice of option for Richards' equation
- ! input: data structures
- indx_data, & ! intent(in): index data
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
- dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
- ! input: state variables
- mLayerTempPrime, & ! intent(in): vector of derivative value for layer temperature (K)
- mLayerMatricHeadPrime, & ! intent(in)
- mLayerMatricHeadLiqPrime, & ! intent(in)
- mLayerVolFracWatPrime, & ! intent(in)
- scalarCanopyTempPrime, & ! intent(in): derivative value for temperature of the vegetation canopy (K)
- scalarCanopyWatPrime, & ! intent(in)
- ! input-output: Jacobian and its diagonal
- dMat, & ! intent(inout): diagonal of the Jacobian matrix
- aJac, & ! intent(out): Jacobian matrix
- ! output: error control
- err,message) ! intent(out): error code and error message
- ! -----------------------------------------------------------------------------------------------------------------
- implicit none
- ! input: model control
- real(rkind),intent(in) :: cj
- real(rkind),intent(in) :: dt ! length of the time step (seconds)
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers in the snow+soil domain
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
- logical(lgt),intent(in) :: computeBaseflow ! flag to indicate if computing baseflow
- integer(i4b),intent(in) :: ixMatrix ! form of the Jacobian matrix
- real(rkind),intent(in) :: specificStorage ! specific storage coefficient (m-1)
- real(rkind),intent(in) :: theta_sat(:) ! soil porosity (-)
- integer(i4b),intent(in) :: ixRichards ! choice of option for Richards' equation
- ! input: data structures
- type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(in) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
- ! input: state variables
- real(rkind),intent(in) :: mLayerTempPrime(:)
- real(rkind),intent(in) :: mLayerMatricHeadPrime(:)
- real(rkind),intent(in) :: mLayerMatricHeadLiqPrime(:)
- real(rkind),intent(in) :: mLayerVolFracWatPrime(:)
- real(rkind),intent(in) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
- real(rkind),intent(in) :: scalarCanopyWatPrime
- ! input-output: Jacobian and its diagonal
- real(rkind),intent(inout) :: dMat(:) ! diagonal of the Jacobian matrix
- real(rkind),intent(out) :: aJac(:,:) ! Jacobian matrix
- ! output variables
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------
- ! * local variables
- ! --------------------------------------------------------------
- ! indices of model state variables
- integer(i4b) :: jState ! index of state within the state subset
- integer(i4b) :: qState ! index of cross-derivative state variable for baseflow
- integer(i4b) :: nrgState ! energy state variable
- integer(i4b) :: watState ! hydrology state variable
- integer(i4b) :: nState ! number of state variables
- ! indices of model layers
- integer(i4b) :: iLayer ! index of model layer
- integer(i4b) :: jLayer ! index of model layer within the full state vector (hydrology)
- integer(i4b) :: pLayer ! indices of soil layers (used for the baseflow derivatives)
- ! conversion factors
- real(rkind) :: convLiq2tot ! factor to convert liquid water derivative to total water derivative
- ! --------------------------------------------------------------
- ! associate variables from data structures
- associate(&
- ! indices of model state variables
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ixTopNrg => indx_data%var(iLookINDEX%ixTopNrg)%dat(1) ,& ! intent(in): [i4b] index of upper-most energy state in the snow+soil subdomain
- ixTopHyd => indx_data%var(iLookINDEX%ixTopHyd)%dat(1) ,& ! intent(in): [i4b] index of upper-most hydrology state in the snow+soil subdomain
- ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of water storage in the aquifer
- ! vectors of indices for specfic state types within specific sub-domains IN THE FULL STATE VECTOR
- ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
- ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
- ! vector of energy indices for the snow and soil domains
- ! NOTE: states not in the subset are equal to integerMissing
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
- ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow domain
- ixSoilOnlyNrg => indx_data%var(iLookINDEX%ixSoilOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the soil domain
- ! vector of hydrology indices for the snow and soil domains
- ! NOTE: states not in the subset are equal to integerMissing
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
- ixSnowOnlyHyd => indx_data%var(iLookINDEX%ixSnowOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow domain
- ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the soil domain
- ! number of state variables of a specific type
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
- nSnowOnlyNrg => indx_data%var(iLookINDEX%nSnowOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow domain
- nSoilOnlyNrg => indx_data%var(iLookINDEX%nSoilOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
- nSnowOnlyHyd => indx_data%var(iLookINDEX%nSnowOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow domain
- nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
- ! type and index of model control volume
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
- ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of the control volume for specific model domains
- ! mapping between states and model layers
- ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the full state vector that are in the state subset
- ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset in each element of the full state vector
- ! derivatives in net vegetation energy fluxes w.r.t. relevant state variables
- dCanairNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy air temperature
- dCanairNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy temperature
- dCanairNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. ground temperature
- dCanopyNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy air temperature
- dCanopyNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy temperature
- dCanopyNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. ground temperature
- dCanopyNetFlux_dCanWat => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net canopy fluxes w.r.t. canopy total water content
- dGroundNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy air temperature
- dGroundNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy temperature
- dGroundNetFlux_dCanWat => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net ground fluxes w.r.t. canopy total water content
- ! derivatives in evaporative fluxes w.r.t. relevant state variables
- dCanopyEvaporation_dTCanair => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy air temperature
- dCanopyEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy temperature
- dCanopyEvaporation_dTGround => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. ground temperature
- dCanopyEvaporation_dCanWat => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy total water content
- dGroundEvaporation_dTCanair => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy air temperature
- dGroundEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy temperature
- dGroundEvaporation_dTGround => deriv_data%var(iLookDERIV%dGroundEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. ground temperature
- dGroundEvaporation_dCanWat => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy total water content
- ! derivatives in canopy water w.r.t canopy temperature
- dCanLiq_dTcanopy => deriv_data%var(iLookDERIV%dCanLiq_dTcanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy liquid storage w.r.t. temperature
- dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in volumetric liquid water content w.r.t. temperature
- d2Theta_dTkCanopy2 => deriv_data%var(iLookDERIV%d2Theta_dTkCanopy2 )%dat(1) ,& ! intent(in): [dp] second derivative of volumetric liquid water content w.r.t. temperature
- dFracLiqVeg_dTkCanopy => deriv_data%var(iLookDERIV%dFracLiqVeg_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in fraction of (throughfall + drainage) w.r.t. temperature
- ! derivatives in canopy liquid fluxes w.r.t. canopy water
- scalarCanopyLiqDeriv => deriv_data%var(iLookDERIV%scalarCanopyLiqDeriv )%dat(1) ,& ! intent(in): [dp] derivative in (throughfall + drainage) w.r.t. canopy liquid water
- ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
- dNrgFlux_dTempAbove => deriv_data%var(iLookDERIV%dNrgFlux_dTempAbove )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. temperature in the layer above
- dNrgFlux_dTempBelow => deriv_data%var(iLookDERIV%dNrgFlux_dTempBelow )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. temperature in the layer below
- ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
- dNrgFlux_dWatAbove => deriv_data%var(iLookDERIV%dNrgFlux_dWatAbove )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer above
- dNrgFlux_dWatBelow => deriv_data%var(iLookDERIV%dNrgFlux_dWatBelow )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer below
- ! derivatives in soil transpiration w.r.t. canopy state variables
- mLayerdTrans_dTCanair => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanair )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
- mLayerdTrans_dTCanopy => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanopy )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
- mLayerdTrans_dTGround => deriv_data%var(iLookDERIV%mLayerdTrans_dTGround )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. ground temperature
- mLayerdTrans_dCanWat => deriv_data%var(iLookDERIV%mLayerdTrans_dCanWat )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy total water
- ! derivatives in aquifer transpiration w.r.t. canopy state variables
- dAquiferTrans_dTCanair => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanair )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy air temperature
- dAquiferTrans_dTCanopy => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanopy )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy temperature
- dAquiferTrans_dTGround => deriv_data%var(iLookDERIV%dAquiferTrans_dTGround )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. ground temperature
- dAquiferTrans_dCanWat => deriv_data%var(iLookDERIV%dAquiferTrans_dCanWat )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy total water
- ! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
- iLayerLiqFluxSnowDeriv => deriv_data%var(iLookDERIV%iLayerLiqFluxSnowDeriv )%dat ,& ! intent(in): [dp(:)] derivative in vertical liquid water flux at layer interfaces
- ! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
- dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
- d2VolTot_d2Psi0 => deriv_data%var(iLookDERIV%d2VolTot_d2Psi0 )%dat ,& ! intent(in): [dp(:)] second derivative in total water content w.r.t. total water matric potential
- dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi )%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t matric head
- dq_dHydStateAbove => deriv_data%var(iLookDERIV%dq_dHydStateAbove )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
- dq_dHydStateBelow => deriv_data%var(iLookDERIV%dq_dHydStateBelow )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
- dq_dHydStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dHydStateLayerSurfVec )%dat ,& ! intent(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
- ! derivative in baseflow flux w.r.t. aquifer storage
- dBaseflow_dAquifer => deriv_data%var(iLookDERIV%dBaseflow_dAquifer )%dat(1) ,& ! intent(in): [dp(:)] derivative in baseflow flux w.r.t. aquifer storage (s-1)
- ! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
- dq_dNrgStateAbove => deriv_data%var(iLookDERIV%dq_dNrgStateAbove )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
- dq_dNrgStateBelow => deriv_data%var(iLookDERIV%dq_dNrgStateBelow )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
- dq_dNrgStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dNrgStateLayerSurfVec )%dat ,& ! intent(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
- ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
- dFracLiqSnow_dTk => deriv_data%var(iLookDERIV%dFracLiqSnow_dTk )%dat ,& ! intent(in): [dp(:)] derivative in fraction of liquid snow w.r.t. temperature
- mLayerdTheta_dTk => deriv_data%var(iLookDERIV%mLayerdTheta_dTk )%dat ,& ! intent(in): [dp(:)] derivative in volumetric liquid water content w.r.t. temperature
- mLayerd2Theta_dTk2 => deriv_data%var(iLookDERIV%mLayerd2Theta_dTk2 )%dat ,& ! intent(in): [dp(:)] second derivative of volumetric liquid water content w.r.t. temperature
- ! derivate in bulk heat capacity w.r.t. relevant state variables
- dVolHtCapBulk_dPsi0 => deriv_data%var(iLookDERIV%dVolHtCapBulk_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. matric potential
- dVolHtCapBulk_dTheta => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTheta )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. volumetric water content
- dVolHtCapBulk_dCanWat => deriv_data%var(iLookDERIV%dVolHtCapBulk_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. volumetric water content
- dVolHtCapBulk_dTk => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTk )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. temperature
- dVolHtCapBulk_dTkCanopy => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. temperature
- ! diagnostic variables
- scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg )%dat(1) ,& ! intent(in): [dp] fraction of liquid water on vegetation (-)
- scalarBulkVolHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg )%dat(1) ,& ! intent(in): [dp] bulk volumetric heat capacity of vegetation (J m-3 K-1)
- mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow )%dat ,& ! intent(in): [dp(:)] fraction of liquid water in each snow layer (-)
- mLayerVolHtCapBulk => diag_data%var(iLookDIAG%mLayerVolHtCapBulk )%dat ,& ! intent(in): [dp(:)] bulk volumetric heat capacity in each snow and soil layer (J m-3 K-1)
- scalarSoilControl => diag_data%var(iLookDIAG%scalarSoilControl )%dat(1) ,& ! intent(in): [dp] soil control on infiltration, zero or one
- ! canopy and layer depth
- canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth )%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth )%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- layerType => indx_data%var(iLookINDEX%layerType )%dat & ! intent(in): [i4b(:)] named variables defining the type of layer in snow+soil domain
- ) ! making association with data in structures
- ! --------------------------------------------------------------
- ! initialize error control
- err=0; message='computJacobSundials/'
-
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- ! * PART 0: PRELIMINARIES (INITIALIZE JACOBIAN AND COMPUTE TIME-VARIABLE DIAGONAL TERMS)
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
-
- ! get the number of state variables
- nState = size(dMat)
-
- ! initialize the Jacobian
- ! NOTE: this needs to be done every time, since Jacobian matrix is modified in the solver
- aJac(:,:) = 0._rkind ! analytical Jacobian matrix
-
- ! compute terms in the Jacobian for vegetation (excluding fluxes)
- ! NOTE: energy for vegetation is computed *within* the iteration loop as it includes phase change
- if(ixVegNrg/=integerMissing)then
- dMat(ixVegNrg) = ( scalarBulkVolHeatCapVeg + LH_fus*iden_water*dTheta_dTkCanopy ) * cj &
- + dVolHtCapBulk_dTkCanopy * scalarCanopyTempPrime &
- + LH_fus*iden_water * scalarCanopyTempPrime * d2Theta_dTkCanopy2 &
- + LH_fus * dFracLiqVeg_dTkCanopy * scalarCanopyWatPrime / canopyDepth
- endif
-
- ! compute additional terms for the Jacobian for the snow-soil domain (excluding fluxes)
- ! NOTE: energy for snow+soil is computed *within* the iteration loop as it includes phase change
- do iLayer=1,nLayers
- if(ixSnowSoilNrg(iLayer)/=integerMissing)then
- dMat(ixSnowSoilNrg(iLayer)) = ( mLayerVolHtCapBulk(iLayer) + LH_fus*iden_water*mLayerdTheta_dTk(iLayer) ) * cj &
- + dVolHtCapBulk_dTk(iLayer) * mLayerTempPrime(iLayer) &
- + LH_fus*iden_water * mLayerTempPrime(iLayer) * mLayerd2Theta_dTk2(iLayer) &
- + LH_fus*iden_water * dFracLiqSnow_dTk(iLayer) * mLayerVolFracWatPrime(iLayer)
- endif
- end do
-
- ! compute additional terms for the Jacobian for the soil domain (excluding fluxes)
- do iLayer=1,nSoil
- if(ixSoilOnlyHyd(iLayer)/=integerMissing)then
- dMat(ixSoilOnlyHyd(iLayer)) = ( dVolTot_dPsi0(iLayer) + dCompress_dPsi(iLayer) ) * cj + d2VolTot_d2Psi0(iLayer) * mLayerMatricHeadPrime(iLayer)
-
- if(ixRichards==mixdform)then
- dMat(ixSoilOnlyHyd(iLayer)) = dMat(ixSoilOnlyHyd(iLayer)) + specificStorage * dVolTot_dPsi0(iLayer) * mLayerMatricHeadPrime(iLayer) / theta_sat(iLayer)
- endif
-
- endif
- end do
-
- ! define the form of the matrix
- select case(ixMatrix)
-
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- ! * PART 1: BAND MATRIX
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- case(ixBandMatrix) ! ixBandMatrix ixFullMatrix
- print *, 'banded jacobian matrix needs to be implemented'
- stop 1
-
+ ! input: model control
+ real(rkind),intent(in) :: cj
+ real(rkind),intent(in) :: dt ! length of the time step (seconds)
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers in the snow+soil domain
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: computeBaseflow ! flag to indicate if computing baseflow
+ integer(i4b),intent(in) :: ixMatrix ! form of the Jacobian matrix
+ real(rkind),intent(in) :: specificStorage ! specific storage coefficient (m-1)
+ real(rkind),intent(in) :: theta_sat(:) ! soil porosity (-)
+ integer(i4b),intent(in) :: ixRichards ! choice of option for Richards' equation
+ ! input: data structures
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(in) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ real(rkind),intent(in) :: mLayerTemp(:)
+ real(rkind),intent(in) :: mLayerTempPrime(:)
+ real(rkind),intent(in) :: mLayerMatricHeadPrime(:)
+ real(rkind),intent(in) :: mLayerMatricHeadLiqPrime(:)
+ real(rkind),intent(in) :: mLayerVolFracWatPrime(:)
+ real(rkind),intent(in) :: scalarCanopyTemp
+ real(rkind),intent(in) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyWatPrime
+ ! input-output: Jacobian and its diagonal
+ real(rkind),intent(inout) :: dMat(:) ! diagonal of the Jacobian matrix
+ real(rkind),intent(out) :: aJac(:,:) ! Jacobian matrix
+ ! output variables
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------
+ ! * local variables
+ ! --------------------------------------------------------------
+ ! indices of model state variables
+ integer(i4b) :: jState ! index of state within the state subset
+ integer(i4b) :: qState ! index of cross-derivative state variable for baseflow
+ integer(i4b) :: nrgState ! energy state variable
+ integer(i4b) :: watState ! hydrology state variable
+ integer(i4b) :: nState ! number of state variables
+ ! indices of model layers
+ integer(i4b) :: iLayer ! index of model layer
+ integer(i4b) :: jLayer ! index of model layer within the full state vector (hydrology)
+ integer(i4b) :: pLayer ! indices of soil layers (used for the baseflow derivatives)
+ ! conversion factors
+ real(rkind) :: convLiq2tot ! factor to convert liquid water derivative to total water derivative
+ ! --------------------------------------------------------------
+ ! associate variables from data structures
+ associate(&
+ ! indices of model state variables
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixTopNrg => indx_data%var(iLookINDEX%ixTopNrg)%dat(1) ,& ! intent(in): [i4b] index of upper-most energy state in the snow+soil subdomain
+ ixTopHyd => indx_data%var(iLookINDEX%ixTopHyd)%dat(1) ,& ! intent(in): [i4b] index of upper-most hydrology state in the snow+soil subdomain
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of water storage in the aquifer
+ ! vectors of indices for specfic state types within specific sub-domains IN THE FULL STATE VECTOR
+ ixNrgLayer => indx_data%var(iLookINDEX%ixNrgLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for energy states in the snow+soil domain
+ ixHydLayer => indx_data%var(iLookINDEX%ixHydLayer)%dat ,& ! intent(in): [i4b(:)] indices IN THE FULL VECTOR for hydrology states in the snow+soil domain
+ ! vector of energy indices for the snow and soil domains
+ ! NOTE: states not in the subset are equal to integerMissing
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow+soil domain
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the snow domain
+ ixSoilOnlyNrg => indx_data%var(iLookINDEX%ixSoilOnlyNrg)%dat ,& ! intent(in): [i4b(:)] index in the state subset for energy state variables in the soil domain
+ ! vector of hydrology indices for the snow and soil domains
+ ! NOTE: states not in the subset are equal to integerMissing
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow+soil domain
+ ixSnowOnlyHyd => indx_data%var(iLookINDEX%ixSnowOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the snow domain
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in): [i4b(:)] index in the state subset for hydrology state variables in the soil domain
+ ! number of state variables of a specific type
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowOnlyNrg => indx_data%var(iLookINDEX%nSnowOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow domain
+ nSoilOnlyNrg => indx_data%var(iLookINDEX%nSoilOnlyNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ nSnowOnlyHyd => indx_data%var(iLookINDEX%nSnowOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow domain
+ nSoilOnlyHyd => indx_data%var(iLookINDEX%nSoilOnlyHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the soil domain
+ ! type and index of model control volume
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the domain (iname_veg, iname_snow, iname_soil)
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of the control volume for specific model domains
+ ! mapping between states and model layers
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in): [i4b(:)] list of indices in the full state vector that are in the state subset
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] list of indices in the state subset in each element of the full state vector
+ ! derivatives in net vegetation energy fluxes w.r.t. relevant state variables
+ dCanairNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy air temperature
+ dCanairNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. canopy temperature
+ dCanairNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanairNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy air space flux w.r.t. ground temperature
+ dCanopyNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy air temperature
+ dCanopyNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. canopy temperature
+ dCanopyNetFlux_dGroundTemp => deriv_data%var(iLookDERIV%dCanopyNetFlux_dGroundTemp )%dat(1) ,& ! intent(in): [dp] derivative in net canopy flux w.r.t. ground temperature
+ dCanopyNetFlux_dCanWat => deriv_data%var(iLookDERIV%dCanopyNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net canopy fluxes w.r.t. canopy total water content
+ dGroundNetFlux_dCanairTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanairTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy air temperature
+ dGroundNetFlux_dCanopyTemp => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanopyTemp )%dat(1) ,& ! intent(in): [dp] derivative in net ground flux w.r.t. canopy temperature
+ dGroundNetFlux_dCanWat => deriv_data%var(iLookDERIV%dGroundNetFlux_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in net ground fluxes w.r.t. canopy total water content
+ ! derivatives in evaporative fluxes w.r.t. relevant state variables
+ dCanopyEvaporation_dTCanair => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy air temperature
+ dCanopyEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy temperature
+ dCanopyEvaporation_dTGround => deriv_data%var(iLookDERIV%dCanopyEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. ground temperature
+ dCanopyEvaporation_dCanWat => deriv_data%var(iLookDERIV%dCanopyEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in canopy evaporation w.r.t. canopy total water content
+ dGroundEvaporation_dTCanair => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanair )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy air temperature
+ dGroundEvaporation_dTCanopy => deriv_data%var(iLookDERIV%dGroundEvaporation_dTCanopy )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy temperature
+ dGroundEvaporation_dTGround => deriv_data%var(iLookDERIV%dGroundEvaporation_dTGround )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. ground temperature
+ dGroundEvaporation_dCanWat => deriv_data%var(iLookDERIV%dGroundEvaporation_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in ground evaporation w.r.t. canopy total water content
+ ! derivatives in canopy water w.r.t canopy temperature
+ dCanLiq_dTcanopy => deriv_data%var(iLookDERIV%dCanLiq_dTcanopy )%dat(1) ,& ! intent(in): [dp] derivative in canopy liquid storage w.r.t. temperature
+ dTheta_dTkCanopy => deriv_data%var(iLookDERIV%dTheta_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in volumetric liquid water content w.r.t. temperature
+ d2Theta_dTkCanopy2 => deriv_data%var(iLookDERIV%d2Theta_dTkCanopy2 )%dat(1) ,& ! intent(in): [dp] second derivative of volumetric liquid water content w.r.t. temperature
+ dFracLiqVeg_dTkCanopy => deriv_data%var(iLookDERIV%dFracLiqVeg_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in fraction of (throughfall + drainage) w.r.t. temperature
+ ! derivatives in canopy liquid fluxes w.r.t. canopy water
+ scalarCanopyLiqDeriv => deriv_data%var(iLookDERIV%scalarCanopyLiqDeriv )%dat(1) ,& ! intent(in): [dp] derivative in (throughfall + drainage) w.r.t. canopy liquid water
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
+ dNrgFlux_dTempAbove => deriv_data%var(iLookDERIV%dNrgFlux_dTempAbove )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. temperature in the layer above
+ dNrgFlux_dTempBelow => deriv_data%var(iLookDERIV%dNrgFlux_dTempBelow )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. temperature in the layer below
+ ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
+ dNrgFlux_dWatAbove => deriv_data%var(iLookDERIV%dNrgFlux_dWatAbove )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer above
+ dNrgFlux_dWatBelow => deriv_data%var(iLookDERIV%dNrgFlux_dWatBelow )%dat ,& ! intent(in): [dp(:)] derivatives in the flux w.r.t. water state in the layer below
+ ! derivatives in soil transpiration w.r.t. canopy state variables
+ mLayerdTrans_dTCanair => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanair )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
+ mLayerdTrans_dTCanopy => deriv_data%var(iLookDERIV%mLayerdTrans_dTCanopy )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy temperature
+ mLayerdTrans_dTGround => deriv_data%var(iLookDERIV%mLayerdTrans_dTGround )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. ground temperature
+ mLayerdTrans_dCanWat => deriv_data%var(iLookDERIV%mLayerdTrans_dCanWat )%dat ,& ! intent(in): derivatives in the soil layer transpiration flux w.r.t. canopy total water
+ ! derivatives in aquifer transpiration w.r.t. canopy state variables
+ dAquiferTrans_dTCanair => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanair )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy air temperature
+ dAquiferTrans_dTCanopy => deriv_data%var(iLookDERIV%dAquiferTrans_dTCanopy )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy temperature
+ dAquiferTrans_dTGround => deriv_data%var(iLookDERIV%dAquiferTrans_dTGround )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. ground temperature
+ dAquiferTrans_dCanWat => deriv_data%var(iLookDERIV%dAquiferTrans_dCanWat )%dat(1) ,& ! intent(in): derivatives in the aquifer transpiration flux w.r.t. canopy total water
+ ! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
+ iLayerLiqFluxSnowDeriv => deriv_data%var(iLookDERIV%iLayerLiqFluxSnowDeriv )%dat ,& ! intent(in): [dp(:)] derivative in vertical liquid water flux at layer interfaces
+ ! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ d2VolTot_d2Psi0 => deriv_data%var(iLookDERIV%d2VolTot_d2Psi0 )%dat ,& ! intent(in): [dp(:)] second derivative in total water content w.r.t. total water matric potential
+ dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi )%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t matric head
+ dq_dHydStateAbove => deriv_data%var(iLookDERIV%dq_dHydStateAbove )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
+ dq_dHydStateBelow => deriv_data%var(iLookDERIV%dq_dHydStateBelow )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
+ dq_dHydStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dHydStateLayerSurfVec )%dat ,& ! intent(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
+ ! derivative in baseflow flux w.r.t. aquifer storage
+ dBaseflow_dAquifer => deriv_data%var(iLookDERIV%dBaseflow_dAquifer )%dat(1) ,& ! intent(in): [dp(:)] derivative in baseflow flux w.r.t. aquifer storage (s-1)
+ ! derivative in liquid water fluxes for the soil domain w.r.t energy state variables
+ dq_dNrgStateAbove => deriv_data%var(iLookDERIV%dq_dNrgStateAbove )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer above
+ dq_dNrgStateBelow => deriv_data%var(iLookDERIV%dq_dNrgStateBelow )%dat ,& ! intent(in): [dp(:)] change in flux at layer interfaces w.r.t. states in the layer below
+ dq_dNrgStateLayerSurfVec => deriv_data%var(iLookDERIV%dq_dNrgStateLayerSurfVec )%dat ,& ! intent(in): [dp(:)] change in the flux in soil surface interface w.r.t. state variables in layers
+ ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
+ dFracLiqSnow_dTk => deriv_data%var(iLookDERIV%dFracLiqSnow_dTk )%dat ,& ! intent(in): [dp(:)] derivative in fraction of liquid snow w.r.t. temperature
+ mLayerdTheta_dTk => deriv_data%var(iLookDERIV%mLayerdTheta_dTk )%dat ,& ! intent(in): [dp(:)] derivative in volumetric liquid water content w.r.t. temperature
+ mLayerd2Theta_dTk2 => deriv_data%var(iLookDERIV%mLayerd2Theta_dTk2 )%dat ,& ! intent(in): [dp(:)] second derivative of volumetric liquid water content w.r.t. temperature
+ ! derivate in bulk heat capacity w.r.t. relevant state variables
+ dVolHtCapBulk_dPsi0 => deriv_data%var(iLookDERIV%dVolHtCapBulk_dPsi0 )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. matric potential
+ dVolHtCapBulk_dTheta => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTheta )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dCanWat => deriv_data%var(iLookDERIV%dVolHtCapBulk_dCanWat )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. volumetric water content
+ dVolHtCapBulk_dTk => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTk )%dat ,& ! intent(in): [dp(:)] derivative in bulk heat capacity w.r.t. temperature
+ dVolHtCapBulk_dTkCanopy => deriv_data%var(iLookDERIV%dVolHtCapBulk_dTkCanopy )%dat(1) ,& ! intent(in): [dp] derivative in bulk heat capacity w.r.t. temperature
+ ! diagnostic variables
+ scalarFracLiqVeg => diag_data%var(iLookDIAG%scalarFracLiqVeg )%dat(1) ,& ! intent(in): [dp] fraction of liquid water on vegetation (-)
+ scalarBulkVolHeatCapVeg => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg )%dat(1) ,& ! intent(in): [dp] bulk volumetric heat capacity of vegetation (J m-3 K-1)
+ mLayerFracLiqSnow => diag_data%var(iLookDIAG%mLayerFracLiqSnow )%dat ,& ! intent(in): [dp(:)] fraction of liquid water in each snow layer (-)
+ mLayerVolHtCapBulk => diag_data%var(iLookDIAG%mLayerVolHtCapBulk )%dat ,& ! intent(in): [dp(:)] bulk volumetric heat capacity in each snow and soil layer (J m-3 K-1)
+ scalarSoilControl => diag_data%var(iLookDIAG%scalarSoilControl )%dat(1) ,& ! intent(in): [dp] soil control on infiltration, zero or one
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth )%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth )%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ layerType => indx_data%var(iLookINDEX%layerType )%dat & ! intent(in): [i4b(:)] named variables defining the type of layer in snow+soil domain
+ ) ! making association with data in structures
+ ! --------------------------------------------------------------
+ ! initialize error control
+ err=0; message='computJacobSundials/'
+
! *********************************************************************************************************************************************************
! *********************************************************************************************************************************************************
- ! * PART 2: FULL MATRIX
+ ! * PART 0: PRELIMINARIES (INITIALIZE JACOBIAN AND COMPUTE TIME-VARIABLE DIAGONAL TERMS)
! *********************************************************************************************************************************************************
! *********************************************************************************************************************************************************
- case(ixFullMatrix) ! ixFullMatrix ixBandMatrix
-
- ! check
- if(size(aJac,1)/=size(dMat) .or. size(aJac,2)/=size(dMat))then
- message=trim(message)//'unexpected shape of the Jacobian matrix: expect aJac(nState,nState)'
- err=20; return
- endif
-
- ! -----
- ! * energy and liquid fluxes over vegetation...
- ! ---------------------------------------------
- if(computeVegFlux)then ! (derivatives only defined when vegetation protrudes over the surface)
-
- ! * energy fluxes with the canopy water
- if(ixVegHyd/=integerMissing)then
-
- ! * cross-derivative terms w.r.t. system temperatures (kg m-2 K-1)
- if(ixCasNrg/=integerMissing) aJac(ixVegHyd,ixCasNrg) = -dCanopyEvaporation_dTCanair*dt
- ! dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy is the derivative in throughfall and canopy drainage with canopy temperature
- if(ixVegNrg/=integerMissing) aJac(ixVegHyd,ixVegNrg) = -dCanopyEvaporation_dTCanopy*dt + dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy
- ! * liquid water fluxes for vegetation canopy (-), dt*scalarFracLiqVeg*scalarCanopyLiqDeriv is the derivative in throughfall and canopy drainage with canopy water
- aJac(ixVegHyd,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._rkind * cj
- if(ixTopNrg/=integerMissing) aJac(ixVegHyd,ixTopNrg) = -dCanopyEvaporation_dTGround*dt
-
- ! * cross-derivative terms w.r.t. canopy water (kg-1 m2)
- if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
-
- ! * cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
- ! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
- if(ixVegNrg/=integerMissing) aJac(ixVegNrg,ixVegHyd) = (-1._rkind + scalarFracLiqVeg)*LH_fus/canopyDepth * cj &
- + dVolHtCapBulk_dCanWat * scalarCanopyTempPrime - (dt/canopyDepth) * dCanopyNetFlux_dCanWat &
- + LH_fus * scalarCanopyTempPrime * dFracLiqVeg_dTkCanopy / canopyDepth ! dF/dLiq
- if(ixTopNrg/=integerMissing) aJac(ixTopNrg,ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
- endif
-
- ! * -derivative terms w.r.t. canopy temperature (K-1)
- if(ixVegNrg/=integerMissing)then
- if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarCanopyLiqDeriv*dCanLiq_dTcanopy)/iden_water
- endif
-
- ! * energy fluxes with the canopy air space (J m-3 K-1)
- if(ixCasNrg/=integerMissing)then
- aJac(ixCasNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanairTemp) + dMat(ixCasNrg) * cj
- if(ixVegNrg/=integerMissing) aJac(ixCasNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanopyTemp)
- if(ixTopNrg/=integerMissing) aJac(ixCasNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dGroundTemp)
- endif
-
- ! * energy fluxes with the vegetation canopy (J m-3 K-1)
- if(ixVegNrg/=integerMissing)then
- if(ixCasNrg/=integerMissing) aJac(ixVegNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanairTemp)
- aJac(ixVegNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanopyTemp) + dMat(ixVegNrg)
- if(ixTopNrg/=integerMissing) aJac(ixVegNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dGroundTemp)
- endif
-
- ! * energy fluxes with the surface (J m-3 K-1)
- if(ixTopNrg/=integerMissing)then
- if(ixCasNrg/=integerMissing) aJac(ixTopNrg,ixCasNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanairTemp)
- if(ixVegNrg/=integerMissing) aJac(ixTopNrg,ixVegNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanopyTemp)
+
+ ! get the number of state variables
+ nState = size(dMat)
+
+ ! initialize the Jacobian
+ ! NOTE: this needs to be done every time, since Jacobian matrix is modified in the solver
+ aJac(:,:) = 0._rkind ! analytical Jacobian matrix
+
+ ! compute terms in the Jacobian for vegetation (excluding fluxes)
+ ! NOTE: energy for vegetation is computed *within* the iteration loop as it includes phase change
+ if(ixVegNrg/=integerMissing)then
+ dMat(ixVegNrg) = ( scalarBulkVolHeatCapVeg + LH_fus*iden_water*dTheta_dTkCanopy ) * cj &
+ + dVolHtCapBulk_dTkCanopy * scalarCanopyTempPrime &
+ + LH_fus*iden_water * scalarCanopyTempPrime * d2Theta_dTkCanopy2 &
+ + LH_fus * dFracLiqVeg_dTkCanopy * scalarCanopyWatPrime / canopyDepth
+ endif
+
+ ! compute additional terms for the Jacobian for the snow-soil domain (excluding fluxes)
+ ! NOTE: energy for snow+soil is computed *within* the iteration loop as it includes phase change
+ do iLayer=1,nLayers
+ if(ixSnowSoilNrg(iLayer)/=integerMissing)then
+ dMat(ixSnowSoilNrg(iLayer)) = ( mLayerVolHtCapBulk(iLayer) + LH_fus*iden_water*mLayerdTheta_dTk(iLayer) ) * cj &
+ + dVolHtCapBulk_dTk(iLayer) * mLayerTempPrime(iLayer) &
+ + LH_fus*iden_water * mLayerTempPrime(iLayer) * mLayerd2Theta_dTk2(iLayer) &
+ + LH_fus*iden_water * dFracLiqSnow_dTk(iLayer) * mLayerVolFracWatPrime(iLayer)
endif
-
- endif ! if there is a need to compute energy fluxes within vegetation
-
- ! -----
- ! * energy fluxes for the snow+soil domain...
- ! -------------------------------------------
- if(nSnowSoilNrg>0)then
- do iLayer=1,nLayers ! loop through all layers in the snow+soil domain
-
- ! check if the state is in the subset
- if(ixSnowSoilNrg(iLayer)==integerMissing) cycle
-
- ! - define index within the state subset and the full state vector
- jState = ixSnowSoilNrg(iLayer) ! index within the state subset
-
- ! - diagonal elements
- aJac(jState,jState) = (dt/mLayerDepth(iLayer))*(-dNrgFlux_dTempBelow(iLayer-1) + dNrgFlux_dTempAbove(iLayer)) + dMat(jState)
-
- ! - lower-diagonal elements
- if(iLayer>1)then
- if(ixSnowSoilNrg(iLayer-1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer-1),jState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dTempBelow(iLayer-1) )
- endif
-
- ! - upper diagonal elements
- if(iLayer<nLayers)then
- if(ixSnowSoilNrg(iLayer+1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer+1),jState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dTempAbove(iLayer ) )
- endif
-
- end do ! (looping through energy states in the snow+soil domain)
- endif ! (if the subset includes energy state variables in the snow+soil domain)
-
- ! -----
- ! * liquid water fluxes for the snow domain...
- ! --------------------------------------------
- if(nSnowOnlyHyd>0)then
- do iLayer=1,nSnow ! loop through layers in the snow domain
-
- ! - check that the snow layer is desired
- if(ixSnowOnlyHyd(iLayer)==integerMissing) cycle
-
- ! - define state indices for the current layer
- watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
-
- ! compute factor to convert liquid water derivative to total water derivative
- select case( ixHydType(iLayer) )
- case(iname_watLayer); convLiq2tot = mLayerFracLiqSnow(iLayer)
- case default; convLiq2tot = 1._rkind
- end select
-
- ! - diagonal elements
- aJac(watState,watState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot + dMat(watState) * cj
-
- ! - lower-diagonal elements
- if(iLayer>1)then
- if(ixSnowOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer-1),watState) = 0._rkind ! sub-diagonal: no dependence on other layers
- endif
-
- ! - upper diagonal elements
- if(iLayer<nSnow)then
- if(ixSnowOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer+1),watState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot ! dVol(below)/dLiq(above) -- (-)
- endif
-
- end do ! (looping through liquid water states in the snow domain)
- endif ! (if the subset includes hydrology state variables in the snow domain)
-
- ! -----
- ! * cross derivatives in the snow domain...
- ! ----------------------------------------
- if(nSnowOnlyHyd>0 .and. nSnowOnlyNrg>0)then
- do iLayer=1,nSnow ! loop through layers in the snow domain
-
- ! - check that the snow layer is desired
- if(ixSnowOnlyNrg(iLayer)==integerMissing) cycle
-
- ! (define the energy state)
- nrgState = ixSnowOnlyNrg(iLayer) ! index within the full state vector
-
- ! - define state indices for the current layer
- watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
-
- if(watstate/=integerMissing)then ! (energy state for the current layer is within the state subset)
-
- ! - include derivatives of energy fluxes w.r.t water fluxes for current layer
- aJac(nrgState,watState) = (-1._rkind + mLayerFracLiqSnow(iLayer))*LH_fus*iden_water * cj &
- + dVolHtCapBulk_dTheta(iLayer) * mLayerTempPrime(iLayer) &
- + (dt/mLayerDepth(iLayer))*(-dNrgFlux_dWatBelow(iLayer-1) + dNrgFlux_dWatAbove(iLayer)) &
- + LH_fus*iden_water * mLayerTempPrime(iLayer) * dFracLiqSnow_dTk(iLayer) ! (dF/dLiq)
-
- ! - include derivatives of water fluxes w.r.t energy fluxes for current layer
- aJac(watState,nrgState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! (dVol/dT)
-
- ! (cross-derivative terms for the layer below)
- if(iLayer<nSnow)then
- aJac(ixSnowOnlyHyd(iLayer+1),nrgState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! dVol(below)/dT(above) -- K-1
- endif ! (if there is a water state in the layer below the current layer in the given state subset)
-
- ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
- if(iLayer>1)then
- if(ixSnowOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dWatBelow(iLayer-1) )
- endif
-
- ! (cross-derivative terms for the layer below)
- if(iLayer<nSnow)then
- if(ixSnowOnlyNrg(iLayer+1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dWatAbove(iLayer ) )
- elseif(iLayer==nSnow .and. nSoilOnlyNrg>0)then !bottom snow layer and there is soil below
- if(ixSoilOnlyNrg(1)/=integerMissing) aJac(ixSoilOnlyNrg(1),watState) = (dt/mLayerDepth(nSnow+1))*(-dNrgFlux_dWatAbove(nSnow) )
- endif
-
- endif ! (if the energy state for the current layer is within the state subset)
-
- end do ! (looping through snow layers)
- endif ! (if there are state variables for both water and energy in the snow domain)
-
- ! -----
- ! * liquid water fluxes for the soil domain...
- ! --------------------------------------------
- if(nSoilOnlyHyd>0)then
- do iLayer=1,nSoil
-
- ! - check that the soil layer is desired
- if(ixSoilOnlyHyd(iLayer)==integerMissing) cycle
-
- ! - define state indices
- watState = ixSoilOnlyHyd(iLayer) ! hydrology state index within the state subset
-
- ! - define indices of the soil layers
- jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
-
- ! - compute the diagonal elements
- ! all terms *excluding* baseflow
- aJac(watState,watState) = (dt/mLayerDepth(jLayer))*(-dq_dHydStateBelow(iLayer-1) + dq_dHydStateAbove(iLayer)) + dMat(watState)
-
- ! - compute the lower-diagonal elements
- if(iLayer>1)then
- if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dq_dHydStateBelow(iLayer-1))
- endif
-
- ! - compute the upper-diagonal elements
- if(iLayer<nSoil)then
- if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dq_dHydStateAbove(iLayer))
- endif
-
- ! - include terms for baseflow
- if(computeBaseflow .and. nSoilOnlyHyd==nSoil)then
- do pLayer=1,nSoil
- qState = ixSoilOnlyHyd(pLayer) ! hydrology state index within the state subset
- aJac(watState,qState) = (dt/mLayerDepth(jLayer))*dBaseflow_dMatric(iLayer,pLayer) + aJac(watState,qState)
- end do
- endif
-
- ! - include terms for surface infiltration below surface
- if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),watState) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),watState)
-
- end do ! (looping through hydrology states in the soil domain)
-
- ! - include terms for surface infiltration above surface
- if(nSnowOnlyHyd>0 .and. ixSnowOnlyHyd(nSnow)/=integerMissing)then
- if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyHyd(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0)
- elseif(computeVegFlux .and. ixVegHyd/=integerMissing)then !ixTopHyd = ixSoilOnlyHyd(1)
- if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegHyd)
+ end do
+
+ ! compute additional terms for the Jacobian for the soil domain (excluding fluxes)
+ do iLayer=1,nSoil
+ if(ixSoilOnlyHyd(iLayer)/=integerMissing)then
+ dMat(ixSoilOnlyHyd(iLayer)) = ( dVolTot_dPsi0(iLayer) + dCompress_dPsi(iLayer) ) * cj + d2VolTot_d2Psi0(iLayer) * mLayerMatricHeadPrime(iLayer)
+
+ if(ixRichards==mixdform)then
+ dMat(ixSoilOnlyHyd(iLayer)) = dMat(ixSoilOnlyHyd(iLayer)) + specificStorage * dVolTot_dPsi0(iLayer) * mLayerMatricHeadPrime(iLayer) / theta_sat(iLayer)
endif
-
- endif ! (if the subset includes hydrology state variables in the soil domain)
-
- ! -----
- ! * liquid water fluxes for the aquifer...
- ! ----------------------------------------
- if(ixAqWat/=integerMissing) then
- aJac(ixAqWat,ixAqWat) = -dBaseflow_dAquifer*dt + dMat(ixAqWat) * cj
- aJac(ixAqWat,ixSoilOnlyNrg(nSoil)) = -dq_dNrgStateAbove(nSoil)*dt ! dAquiferRecharge_dTk = d_iLayerLiqFluxSoil(nSoil)_dTk
- aJac(ixAqWat,ixSoilOnlyHyd(nSoil)) = -dq_dHydStateAbove(nSoil)*dt ! dAquiferRecharge_dWat = d_iLayerLiqFluxSoil(nSoil)_dWat
- ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
- if(computeVegFlux)then
- aJac(ixAqWat,ixCasNrg) = -dAquiferTrans_dTCanair*dt ! dVol/dT (K-1)
- aJac(ixAqWat,ixVegNrg) = -dAquiferTrans_dTCanopy*dt ! dVol/dT (K-1)
- aJac(ixAqWat,ixVegHyd) = -dAquiferTrans_dCanWat*dt ! dVol/dLiq (kg m-2)-1
- aJac(ixAqWat,ixTopNrg) = -dAquiferTrans_dTGround*dt ! dVol/dT (K-1)
+
endif
- endif
-
- ! -----
- ! * cross derivatives in the soil domain...
- ! ----------------------------------------
- if(nSoilOnlyHyd>0 .and. nSoilOnlyNrg>0)then
- do iLayer=1,nSoilOnlyNrg
-
- ! - check that the soil layer is desired
- if(ixSoilOnlyNrg(iLayer)==integerMissing) cycle
-
- ! - define indices of the soil layers
- jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
-
- ! - define the energy state variable
- nrgState = ixNrgLayer(jLayer) ! index within the full state vector
-
- ! - define index of hydrology state variable within the state subset
- watState = ixSoilOnlyHyd(iLayer)
-
- ! only compute derivatives if the water state for the current layer is within the state subset
- if(watstate/=integerMissing)then
-
- ! - include derivatives in liquid water fluxes w.r.t. temperature for current layer
- aJac(watState,nrgState) = (dt/mLayerDepth(jLayer))*(-dq_dNrgStateBelow(iLayer-1) + dq_dNrgStateAbove(iLayer)) ! dVol/dT (K-1) -- flux depends on ice impedance
-
- ! - compute lower diagonal elements
- if(iLayer>1)then
- if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),nrgState) = (dt/mLayerDepth(jLayer-1))*( dq_dNrgStateBelow(iLayer-1)) ! K-1
- endif
-
- ! compute upper-diagonal elements
- if(iLayer<nSoil)then
- if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),nrgState) = (dt/mLayerDepth(jLayer+1))*(-dq_dNrgStateAbove(iLayer)) ! K-1
+ end do
+
+ ! define the form of the matrix
+ select case(ixMatrix)
+
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! * PART 1: BAND MATRIX
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ case(ixBandMatrix)
+ ! check
+ if(size(aJac,1)/=nBands .or. size(aJac,2)/=size(dMat))then
+ message=trim(message)//'unexpected shape of the Jacobian matrix: expect aJac(nBands,nState)'
+ err=20; return
endif
-
- ! - include derivatives of energy w.r.t. ground evaporation
- if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
- if(computeVegFlux)then
- aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
- aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
- aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
- endif
- aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTGround/iden_water) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+
+ ! -----
+ ! * energy and liquid fluxes over vegetation...
+ ! ---------------------------------------------
+ if(computeVegFlux)then ! (derivatives only defined when vegetation protrudes over the surface)
+
+ ! * energy fluxes with the canopy water
+ if(ixVegHyd/=integerMissing)then
+
+ ! * cross-derivative terms w.r.t. system temperatures (kg m-2 K-1)
+ if(ixCasNrg/=integerMissing) aJac(ixOffDiag(ixVegHyd,ixCasNrg),ixCasNrg) = -dCanopyEvaporation_dTCanair*dt
+ ! dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy is the derivative in throughfall and canopy drainage with canopy temperature
+ if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixVegHyd,ixVegNrg),ixVegNrg) = -dCanopyEvaporation_dTCanopy*dt + dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy
+ ! * liquid water fluxes for vegetation canopy (-), dt*scalarFracLiqVeg*scalarCanopyLiqDeriv is the derivative in throughfall and canopy drainage with canopy water
+ aJac(ixDiag, ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._rkind * cj
+ if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixVegHyd,ixTopNrg),ixTopNrg) = -dCanopyEvaporation_dTGround*dt
+
+ ! * cross-derivative terms w.r.t. canopy water (kg-1 m2)
+ if(ixTopHyd/=integerMissing) aJac(ixOffDiag(ixTopHyd,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
+
+ ! * cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
+ ! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
+ if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixVegNrg,ixVegHyd),ixVegHyd) = (-1._rkind + scalarFracLiqVeg)*LH_fus/canopyDepth * cj &
+ + dVolHtCapBulk_dCanWat * scalarCanopyTempPrime - (dt/canopyDepth) * dCanopyNetFlux_dCanWat &
+ + LH_fus * scalarCanopyTempPrime * dFracLiqVeg_dTkCanopy / canopyDepth ! dF/dLiq
+ if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixTopNrg,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
+ endif
+
+ ! * -derivative terms w.r.t. canopy temperature (K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixTopHyd/=integerMissing) aJac(ixOffDiag(ixTopHyd,ixVegNrg),ixVegNrg) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarCanopyLiqDeriv*dCanLiq_dTcanopy)/iden_water
+ endif
+
+ ! * energy fluxes with the canopy air space (J m-3 K-1)
+ if(ixCasNrg/=integerMissing)then
+ aJac(ixDiag, ixCasNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanairTemp) + dMat(ixCasNrg) * cj
+ if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixCasNrg,ixVegNrg),ixVegNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanopyTemp)
+ if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixCasNrg,ixTopNrg),ixTopNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dGroundTemp)
+ endif
+
+ ! * energy fluxes with the vegetation canopy (J m-3 K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixOffDiag(ixVegNrg,ixCasNrg),ixCasNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanairTemp)
+ aJac(ixDiag, ixVegNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanopyTemp) + dMat(ixVegNrg)
+ if(ixTopNrg/=integerMissing) aJac(ixOffDiag(ixVegNrg,ixTopNrg),ixTopNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dGroundTemp)
+ endif
+
+ ! * energy fluxes with the surface (J m-3 K-1)
+ if(ixTopNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixOffDiag(ixTopNrg,ixCasNrg),ixCasNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanairTemp)
+ if(ixVegNrg/=integerMissing) aJac(ixOffDiag(ixTopNrg,ixVegNrg),ixVegNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanopyTemp)
+ endif
+
+ endif ! if there is a need to compute energy fluxes within vegetation
+
+ ! -----
+ ! * energy fluxes for the snow+soil domain...
+ ! -------------------------------------------
+ if(nSnowSoilNrg>0)then
+ do iLayer=1,nLayers ! loop through all layers in the snow+soil domain
+
+ ! check if the state is in the subset
+ if(ixSnowSoilNrg(iLayer)==integerMissing) cycle
+
+ ! - define index within the state subset and the full state vector
+ jState = ixSnowSoilNrg(iLayer) ! index within the state subset
+
+ ! - diagonal elements
+ aJac(ixDiag,jState) = (dt/mLayerDepth(iLayer))*(-dNrgFlux_dTempBelow(iLayer-1) + dNrgFlux_dTempAbove(iLayer)) + dMat(jState)
+
+ ! - lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSnowSoilNrg(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSnowSoilNrg(iLayer-1),jState),jState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dTempBelow(iLayer-1) )
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer<nLayers)then
+ if(ixSnowSoilNrg(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSnowSoilNrg(iLayer+1),jState),jState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dTempAbove(iLayer ) )
+ endif
+
+ end do ! (looping through energy states in the snow+soil domain)
+ endif ! (if the subset includes energy state variables in the snow+soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the snow domain...
+ ! --------------------------------------------
+ if(nSnowOnlyHyd>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! compute factor to convert liquid water derivative to total water derivative
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); convLiq2tot = mLayerFracLiqSnow(iLayer)
+ case default; convLiq2tot = 1._rkind
+ end select
+
+ ! - diagonal elements
+ aJac(ixDiag,watState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot + dMat(watState) * cj
+
+ ! - lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSnowOnlyHyd(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSnowOnlyHyd(iLayer-1),watState),watState) = 0._rkind ! sub-diagonal: no dependence on other layers
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer<nSnow)then
+ if(ixSnowOnlyHyd(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSnowOnlyHyd(iLayer+1),watState),watState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot ! dVol(below)/dLiq(above) -- (-)
+ endif
+
+ end do ! (looping through liquid water states in the snow domain)
+ endif ! (if the subset includes hydrology state variables in the snow domain)
+
+ ! -----
+ ! * cross derivatives in the snow domain...
+ ! ----------------------------------------
+ if(nSnowOnlyHyd>0 .and. nSnowOnlyNrg>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! (define the energy state)
+ nrgState = ixSnowOnlyNrg(iLayer) ! index within the full state vector
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ if(watstate/=integerMissing)then ! (energy state for the current layer is within the state subset)
+
+ ! - include derivatives of energy fluxes w.r.t water fluxes for current layer
+ aJac(ixOffDiag(nrgState,watState),watState) = (-1._rkind + mLayerFracLiqSnow(iLayer))*LH_fus*iden_water * cj &
+ + dVolHtCapBulk_dTheta(iLayer) * mLayerTempPrime(iLayer) &
+ + (dt/mLayerDepth(iLayer))*(-dNrgFlux_dWatBelow(iLayer-1) + dNrgFlux_dWatAbove(iLayer)) &
+ + LH_fus*iden_water * mLayerTempPrime(iLayer) * dFracLiqSnow_dTk(iLayer) ! (dF/dLiq)
+
+ ! - include derivatives of water fluxes w.r.t energy fluxes for current layer
+ aJac(ixOffDiag(watState,nrgState),nrgState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! (dVol/dT)
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ aJac(ixOffDiag(ixSnowOnlyHyd(iLayer+1),nrgState),nrgState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! dVol(below)/dT(above) -- K-1
+ endif ! (if there is a water state in the layer below the current layer in the given state subset)
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSnowOnlyNrg(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSnowOnlyNrg(iLayer-1),watState),watState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dWatBelow(iLayer-1) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ if(ixSnowOnlyNrg(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSnowOnlyNrg(iLayer+1),watState),watState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dWatAbove(iLayer ) )
+ elseif(iLayer==nSnow .and. nSoilOnlyNrg>0)then !bottom snow layer and there is soil below
+ if(ixSoilOnlyNrg(1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyNrg(1),watState),watState) = (dt/mLayerDepth(nSnow+1))*(-dNrgFlux_dWatAbove(nSnow) )
+ endif
+
+ endif ! (if the energy state for the current layer is within the state subset)
+
+ end do ! (looping through snow layers)
+ endif ! (if there are state variables for both water and energy in the snow domain)
+
+ ! -----
+ ! * liquid water fluxes for the soil domain...
+ ! --------------------------------------------
+ if(nSoilOnlyHyd>0)then
+ do iLayer=1,nSoil
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices
+ watState = ixSoilOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - compute the diagonal elements
+ ! all terms *excluding* baseflow
+ aJac(ixDiag,watState) = (dt/mLayerDepth(jLayer))*(-dq_dHydStateBelow(iLayer-1) + dq_dHydStateAbove(iLayer)) + dMat(watState)
+
+ ! - compute the lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyHyd(iLayer-1),watState),watState) = (dt/mLayerDepth(jLayer-1))*( dq_dHydStateBelow(iLayer-1))
+ endif
+
+ ! - compute the upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyHyd(iLayer+1),watState),watState) = (dt/mLayerDepth(jLayer+1))*(-dq_dHydStateAbove(iLayer))
+ endif
+
+ end do ! (looping through hydrology states in the soil domain)
+
+ endif ! (if the subset includes hydrology state variables in the soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the aquifer...
+ ! ----------------------------------------
+ if(ixAqWat/=integerMissing) then
+ aJac(ixDiag,ixAqWat) = -dBaseflow_dAquifer*dt + dMat(ixAqWat) * cj
+ aJac(ixOffDiag(ixAqWat,ixSoilOnlyNrg(nSoil)),ixSoilOnlyNrg(nSoil)) = -dq_dNrgStateAbove(nSoil)*dt
+ aJac(ixOffDiag(ixAqWat,ixSoilOnlyHyd(nSoil)),ixSoilOnlyHyd(nSoil)) = -dq_dHydStateAbove(nSoil)*dt
endif
-
- ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
- if(computeVegFlux)then
- aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanair(iLayer)) + aJac(watState,ixCasNrg) ! dVol/dT (K-1)
- aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanopy(iLayer)) + aJac(watState,ixVegNrg) ! dVol/dT (K-1)
- aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dCanWat(iLayer)) + aJac(watState,ixVegHyd) ! dVol/dLiq (kg m-2)-1
- aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTGround(iLayer)) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+
+ ! -----
+ ! * cross derivatives in the soil domain...
+ ! ----------------------------------------
+ if(nSoilOnlyHyd>0 .and. nSoilOnlyNrg>0)then
+ do iLayer=1,nSoilOnlyNrg
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - define the energy state variable
+ nrgState = ixNrgLayer(jLayer) ! index within the full state vector
+
+ ! - define index of hydrology state variable within the state subset
+ watState = ixSoilOnlyHyd(iLayer)
+
+ ! only compute derivatives if the water state for the current layer is within the state subset
+ if(watstate/=integerMissing)then
+
+ ! - include derivatives in liquid water fluxes w.r.t. temperature for current layer
+ aJac(ixOffDiag(watState,nrgState),nrgState) = (dt/mLayerDepth(jLayer))*(-dq_dNrgStateBelow(iLayer-1) + dq_dNrgStateAbove(iLayer)) ! dVol/dT (K-1) -- flux depends on ice impedance
+
+ ! - compute lower diagonal elements
+ if(iLayer>1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyHyd(iLayer-1),nrgState),nrgState) = (dt/mLayerDepth(jLayer-1))*( dq_dNrgStateBelow(iLayer-1)) ! K-1
+ endif
+
+ ! compute upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyHyd(iLayer+1),nrgState),nrgState) = (dt/mLayerDepth(jLayer+1))*(-dq_dNrgStateAbove(iLayer)) ! K-1
+ endif
+
+ ! - include derivatives of energy w.r.t. ground evaporation
+ if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
+ if(computeVegFlux)then
+ aJac(ixOffDiag(watState,ixCasNrg),ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
+ aJac(ixOffDiag(watState,ixVegNrg),ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
+ aJac(ixOffDiag(watState,ixVegHyd),ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
+ endif
+ aJac(ixOffDiag(watState,ixTopNrg),ixTopNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTGround/iden_water) + aJac(ixOffDiag(watState,ixTopNrg),ixTopNrg) ! dVol/dT (K-1)
+ endif
+
+ ! - include derivatives in energy fluxes w.r.t. with respect to water for current layer
+ aJac(ixOffDiag(nrgState,watState),watState) = dVolHtCapBulk_dPsi0(iLayer) * mLayerTempPrime(jLayer) &
+ + (dt/mLayerDepth(jLayer))*(-dNrgFlux_dWatBelow(jLayer-1) + dNrgFlux_dWatAbove(jLayer))
+ if(mLayerdTheta_dTk(jLayer) > verySmall)then ! ice is present
+ aJac(ixOffDiag(nrgState,watState),watState) = -LH_fus*iden_water * dVolTot_dPsi0(iLayer) * cj &
+ - LH_fus*iden_water * mLayerMatricHeadPrime(iLayer) * d2VolTot_d2Psi0(iLayer) + aJac(ixOffDiag(nrgState,watState),watState) ! dNrg/dMat (J m-3 m-1) -- dMat changes volumetric water, and hence ice content
+ endif
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSoilOnlyNrg(iLayer-1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyNrg(iLayer-1),watState),watState) = (dt/mLayerDepth(jLayer-1))*( dNrgFlux_dWatBelow(jLayer-1) )
+ elseif(iLayer==1 .and. nSnowOnlyNrg>0)then !top soil layer and there is snow above
+ if(ixSnowOnlyNrg(nSnow)/=integerMissing) aJac(ixOffDiag(ixSnowOnlyNrg(nSnow),watState),watState) = (dt/mLayerDepth(nSnow))*( dNrgFlux_dWatBelow(nSnow) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixOffDiag(ixSoilOnlyNrg(iLayer+1),watState),watState) = (dt/mLayerDepth(jLayer+1))*(-dNrgFlux_dWatAbove(jLayer ) )
+ endif
+
+ endif ! (if the water state for the current layer is within the state subset)
+
+ end do ! (looping through soil layers)
+
+ endif ! (if there are state variables for both water and energy in the soil domain)
+
+ if(globalPrintFlag)then
+ print*, '** banded analytical Jacobian:'
+ write(*,'(a4,1x,100(i17,1x))') 'xCol', (iLayer, iLayer=min(iJac1,nState),min(iJac2,nState))
+ do iLayer=kl+1,nBands
+ write(*,'(i4,1x,100(e17.10,1x))') iLayer, (aJac(iLayer,jLayer),jLayer=min(iJac1,nState),min(iJac2,nState))
+ end do
endif
-
- ! - include derivatives in energy fluxes w.r.t. with respect to water for current layer
- aJac(nrgState,watState) = dVolHtCapBulk_dPsi0(iLayer) * mLayerTempPrime(jLayer) &
- + (dt/mLayerDepth(jLayer))*(-dNrgFlux_dWatBelow(jLayer-1) + dNrgFlux_dWatAbove(jLayer))
- if(mLayerdTheta_dTk(jLayer) > verySmall)then ! ice is present
- aJac(nrgState,watState) = -LH_fus*iden_water * dVolTot_dPsi0(iLayer) * cj &
- - LH_fus*iden_water * mLayerMatricHeadPrime(iLayer) * d2VolTot_d2Psi0(iLayer) + aJac(nrgState,watState) ! dNrg/dMat (J m-3 m-1) -- dMat changes volumetric water, and hence ice content
+
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ ! * PART 2: FULL MATRIX
+ ! *********************************************************************************************************************************************************
+ ! *********************************************************************************************************************************************************
+ case(ixFullMatrix)
+
+ ! check
+ if(size(aJac,1)/=size(dMat) .or. size(aJac,2)/=size(dMat))then
+ message=trim(message)//'unexpected shape of the Jacobian matrix: expect aJac(nState,nState)'
+ err=20; return
endif
-
- ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
- if(iLayer>1)then
- if(ixSoilOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dNrgFlux_dWatBelow(jLayer-1) )
- elseif(iLayer==1 .and. nSnowOnlyNrg>0)then !top soil layer and there is snow above
- if(ixSnowOnlyNrg(nSnow)/=integerMissing) aJac(ixSnowOnlyNrg(nSnow),watState) = (dt/mLayerDepth(nSnow))*( dNrgFlux_dWatBelow(nSnow) )
+
+ ! -----
+ ! * energy and liquid fluxes over vegetation...
+ ! ---------------------------------------------
+ if(computeVegFlux)then ! (derivatives only defined when vegetation protrudes over the surface)
+
+ ! * energy fluxes with the canopy water
+ if(ixVegHyd/=integerMissing)then
+
+ ! * cross-derivative terms w.r.t. system temperatures (kg m-2 K-1)
+ if(ixCasNrg/=integerMissing) aJac(ixVegHyd,ixCasNrg) = -dCanopyEvaporation_dTCanair*dt
+ ! dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy is the derivative in throughfall and canopy drainage with canopy temperature
+ if(ixVegNrg/=integerMissing) aJac(ixVegHyd,ixVegNrg) = -dCanopyEvaporation_dTCanopy*dt + dt*scalarCanopyLiqDeriv*dCanLiq_dTcanopy
+ ! * liquid water fluxes for vegetation canopy (-), dt*scalarFracLiqVeg*scalarCanopyLiqDeriv is the derivative in throughfall and canopy drainage with canopy water
+ aJac(ixVegHyd,ixVegHyd) = -scalarFracLiqVeg*(dCanopyEvaporation_dCanWat - scalarCanopyLiqDeriv)*dt + 1._rkind * cj
+ if(ixTopNrg/=integerMissing) aJac(ixVegHyd,ixTopNrg) = -dCanopyEvaporation_dTGround*dt
+
+ ! * cross-derivative terms w.r.t. canopy water (kg-1 m2)
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarFracLiqVeg*scalarCanopyLiqDeriv)/iden_water
+
+ ! * cross-derivative terms w.r.t. canopy liquid water (J m-1 kg-1)
+ ! NOTE: dIce/dLiq = (1 - scalarFracLiqVeg); dIce*LH_fus/canopyDepth = J m-3; dLiq = kg m-2
+ if(ixVegNrg/=integerMissing) aJac(ixVegNrg,ixVegHyd) = (-1._rkind + scalarFracLiqVeg)*LH_fus/canopyDepth * cj &
+ + dVolHtCapBulk_dCanWat * scalarCanopyTempPrime - (dt/canopyDepth) * dCanopyNetFlux_dCanWat &
+ + LH_fus * scalarCanopyTempPrime * dFracLiqVeg_dTkCanopy / canopyDepth ! dF/dLiq
+ if(ixTopNrg/=integerMissing) aJac(ixTopNrg,ixVegHyd) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanWat)
+ endif
+
+ ! * -derivative terms w.r.t. canopy temperature (K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = (dt/mLayerDepth(1))*(-scalarSoilControl*scalarCanopyLiqDeriv*dCanLiq_dTcanopy)/iden_water
+ endif
+
+ ! * energy fluxes with the canopy air space (J m-3 K-1)
+ if(ixCasNrg/=integerMissing)then
+ aJac(ixCasNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanairTemp) + dMat(ixCasNrg) * cj
+ if(ixVegNrg/=integerMissing) aJac(ixCasNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dCanopyTemp)
+ if(ixTopNrg/=integerMissing) aJac(ixCasNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanairNetFlux_dGroundTemp)
+ endif
+
+ ! * energy fluxes with the vegetation canopy (J m-3 K-1)
+ if(ixVegNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixVegNrg,ixCasNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanairTemp)
+ aJac(ixVegNrg,ixVegNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dCanopyTemp) + dMat(ixVegNrg)
+ if(ixTopNrg/=integerMissing) aJac(ixVegNrg,ixTopNrg) = (dt/canopyDepth)*(-dCanopyNetFlux_dGroundTemp)
+ endif
+
+ ! * energy fluxes with the surface (J m-3 K-1)
+ if(ixTopNrg/=integerMissing)then
+ if(ixCasNrg/=integerMissing) aJac(ixTopNrg,ixCasNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanairTemp)
+ if(ixVegNrg/=integerMissing) aJac(ixTopNrg,ixVegNrg) = (dt/mLayerDepth(1))*(-dGroundNetFlux_dCanopyTemp)
+ endif
+
+ endif ! if there is a need to compute energy fluxes within vegetation
+
+ ! -----
+ ! * energy fluxes for the snow+soil domain...
+ ! -------------------------------------------
+ if(nSnowSoilNrg>0)then
+ do iLayer=1,nLayers ! loop through all layers in the snow+soil domain
+
+ ! check if the state is in the subset
+ if(ixSnowSoilNrg(iLayer)==integerMissing) cycle
+
+ ! - define index within the state subset and the full state vector
+ jState = ixSnowSoilNrg(iLayer) ! index within the state subset
+
+ ! - diagonal elements
+ aJac(jState,jState) = (dt/mLayerDepth(iLayer))*(-dNrgFlux_dTempBelow(iLayer-1) + dNrgFlux_dTempAbove(iLayer)) + dMat(jState)
+
+ ! - lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSnowSoilNrg(iLayer-1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer-1),jState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dTempBelow(iLayer-1) )
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer<nLayers)then
+ if(ixSnowSoilNrg(iLayer+1)/=integerMissing) aJac(ixSnowSoilNrg(iLayer+1),jState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dTempAbove(iLayer ) )
+ endif
+
+ end do ! (looping through energy states in the snow+soil domain)
+ endif ! (if the subset includes energy state variables in the snow+soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the snow domain...
+ ! --------------------------------------------
+ if(nSnowOnlyHyd>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! compute factor to convert liquid water derivative to total water derivative
+ select case( ixHydType(iLayer) )
+ case(iname_watLayer); convLiq2tot = mLayerFracLiqSnow(iLayer)
+ case default; convLiq2tot = 1._rkind
+ end select
+
+ ! - diagonal elements
+ aJac(watState,watState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot + dMat(watState) * cj
+
+ ! - lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSnowOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer-1),watState) = 0._rkind ! sub-diagonal: no dependence on other layers
+ endif
+
+ ! - upper diagonal elements
+ if(iLayer<nSnow)then
+ if(ixSnowOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSnowOnlyHyd(iLayer+1),watState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*convLiq2tot ! dVol(below)/dLiq(above) -- (-)
+ endif
+
+ end do ! (looping through liquid water states in the snow domain)
+ endif ! (if the subset includes hydrology state variables in the snow domain)
+
+ ! -----
+ ! * cross derivatives in the snow domain...
+ ! ----------------------------------------
+ if(nSnowOnlyHyd>0 .and. nSnowOnlyNrg>0)then
+ do iLayer=1,nSnow ! loop through layers in the snow domain
+
+ ! - check that the snow layer is desired
+ if(ixSnowOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! (define the energy state)
+ nrgState = ixSnowOnlyNrg(iLayer) ! index within the full state vector
+
+ ! - define state indices for the current layer
+ watState = ixSnowOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ if(watstate/=integerMissing)then ! (energy state for the current layer is within the state subset)
+
+ ! - include derivatives of energy fluxes w.r.t water fluxes for current layer
+ aJac(nrgState,watState) = (-1._rkind + mLayerFracLiqSnow(iLayer))*LH_fus*iden_water * cj &
+ + dVolHtCapBulk_dTheta(iLayer) * mLayerTempPrime(iLayer) &
+ + (dt/mLayerDepth(iLayer))*(-dNrgFlux_dWatBelow(iLayer-1) + dNrgFlux_dWatAbove(iLayer)) &
+ + LH_fus*iden_water * mLayerTempPrime(iLayer) * dFracLiqSnow_dTk(iLayer) ! (dF/dLiq)
+
+ ! - include derivatives of water fluxes w.r.t energy fluxes for current layer
+ aJac(watState,nrgState) = (dt/mLayerDepth(iLayer))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! (dVol/dT)
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ aJac(ixSnowOnlyHyd(iLayer+1),nrgState) = -(dt/mLayerDepth(iLayer+1))*iLayerLiqFluxSnowDeriv(iLayer)*mLayerdTheta_dTk(iLayer) ! dVol(below)/dT(above) -- K-1
+ endif ! (if there is a water state in the layer below the current layer in the given state subset)
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSnowOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(iLayer-1))*( dNrgFlux_dWatBelow(iLayer-1) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSnow)then
+ if(ixSnowOnlyNrg(iLayer+1)/=integerMissing) aJac(ixSnowOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(iLayer+1))*(-dNrgFlux_dWatAbove(iLayer ) )
+ elseif(iLayer==nSnow .and. nSoilOnlyNrg>0)then !bottom snow layer and there is soil below
+ if(ixSoilOnlyNrg(1)/=integerMissing) aJac(ixSoilOnlyNrg(1),watState) = (dt/mLayerDepth(nSnow+1))*(-dNrgFlux_dWatAbove(nSnow) )
+ endif
+
+ endif ! (if the energy state for the current layer is within the state subset)
+
+ end do ! (looping through snow layers)
+ endif ! (if there are state variables for both water and energy in the snow domain)
+
+ ! -----
+ ! * liquid water fluxes for the soil domain...
+ ! --------------------------------------------
+ if(nSoilOnlyHyd>0)then
+ do iLayer=1,nSoil
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyHyd(iLayer)==integerMissing) cycle
+
+ ! - define state indices
+ watState = ixSoilOnlyHyd(iLayer) ! hydrology state index within the state subset
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - compute the diagonal elements
+ ! all terms *excluding* baseflow
+ aJac(watState,watState) = (dt/mLayerDepth(jLayer))*(-dq_dHydStateBelow(iLayer-1) + dq_dHydStateAbove(iLayer)) + dMat(watState)
+
+ ! - compute the lower-diagonal elements
+ if(iLayer>1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dq_dHydStateBelow(iLayer-1))
+ endif
+
+ ! - compute the upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dq_dHydStateAbove(iLayer))
+ endif
+
+ ! - include terms for baseflow
+ if(computeBaseflow .and. nSoilOnlyHyd==nSoil)then
+ do pLayer=1,nSoil
+ qState = ixSoilOnlyHyd(pLayer) ! hydrology state index within the state subset
+ aJac(watState,qState) = (dt/mLayerDepth(jLayer))*dBaseflow_dMatric(iLayer,pLayer) + aJac(watState,qState)
+ end do
+ endif
+
+ ! - include terms for surface infiltration below surface
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),watState) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),watState)
+
+ end do ! (looping through hydrology states in the soil domain)
+
+ ! - include terms for surface infiltration above surface
+ if(nSnowOnlyNrg>0)then !have snow above first soil layer
+ if(ixSnowOnlyHyd(nSnow)/=integerMissing .and. ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyHyd(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0)
+ elseif(computeVegFlux)then !have vegetation above first soil layer, ixTopHyd = ixSoilOnlyHyd(1)
+ if(ixVegHyd/=integerMissing .and. ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegHyd) = -(dt/mLayerDepth(1+nSnow))*dq_dHydStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegHyd)
+ endif
+
+ endif ! (if the subset includes hydrology state variables in the soil domain)
+
+ ! -----
+ ! * liquid water fluxes for the aquifer...
+ ! ----------------------------------------
+ if(ixAqWat/=integerMissing) then
+ aJac(ixAqWat,ixAqWat) = -dBaseflow_dAquifer*dt + dMat(ixAqWat) * cj
+ aJac(ixAqWat,ixSoilOnlyNrg(nSoil)) = -dq_dNrgStateAbove(nSoil)*dt ! dAquiferRecharge_dTk = d_iLayerLiqFluxSoil(nSoil)_dTk
+ aJac(ixAqWat,ixSoilOnlyHyd(nSoil)) = -dq_dHydStateAbove(nSoil)*dt ! dAquiferRecharge_dWat = d_iLayerLiqFluxSoil(nSoil)_dWat
+ ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
+ if(computeVegFlux)then
+ aJac(ixAqWat,ixCasNrg) = -dAquiferTrans_dTCanair*dt ! dVol/dT (K-1)
+ aJac(ixAqWat,ixVegNrg) = -dAquiferTrans_dTCanopy*dt ! dVol/dT (K-1)
+ aJac(ixAqWat,ixVegHyd) = -dAquiferTrans_dCanWat*dt ! dVol/dLiq (kg m-2)-1
+ aJac(ixAqWat,ixTopNrg) = -dAquiferTrans_dTGround*dt ! dVol/dT (K-1)
+ endif
endif
-
- ! (cross-derivative terms for the layer below)
- if(iLayer<nSoil)then
- if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dNrgFlux_dWatAbove(jLayer ) )
+
+ ! -----
+ ! * cross derivatives in the soil domain...
+ ! ----------------------------------------
+ if(nSoilOnlyHyd>0 .and. nSoilOnlyNrg>0)then
+ do iLayer=1,nSoilOnlyNrg
+
+ ! - check that the soil layer is desired
+ if(ixSoilOnlyNrg(iLayer)==integerMissing) cycle
+
+ ! - define indices of the soil layers
+ jLayer = iLayer+nSnow ! index of layer in the snow+soil vector
+
+ ! - define the energy state variable
+ nrgState = ixNrgLayer(jLayer) ! index within the full state vector
+
+ ! - define index of hydrology state variable within the state subset
+ watState = ixSoilOnlyHyd(iLayer)
+
+ ! only compute derivatives if the water state for the current layer is within the state subset
+ if(watstate/=integerMissing)then
+
+ ! - include derivatives in liquid water fluxes w.r.t. temperature for current layer
+ aJac(watState,nrgState) = (dt/mLayerDepth(jLayer))*(-dq_dNrgStateBelow(iLayer-1) + dq_dNrgStateAbove(iLayer)) ! dVol/dT (K-1) -- flux depends on ice impedance
+
+ ! - compute lower diagonal elements
+ if(iLayer>1)then
+ if(ixSoilOnlyHyd(iLayer-1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer-1),nrgState) = (dt/mLayerDepth(jLayer-1))*( dq_dNrgStateBelow(iLayer-1)) ! K-1
+ endif
+
+ ! compute upper-diagonal elements
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyHyd(iLayer+1),nrgState) = (dt/mLayerDepth(jLayer+1))*(-dq_dNrgStateAbove(iLayer)) ! K-1
+ endif
+
+ ! - include derivatives of energy w.r.t. ground evaporation
+ if(nSnow==0 .and. iLayer==1)then ! upper-most soil layer
+ if(computeVegFlux)then
+ aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanair/iden_water) ! dVol/dT (K-1)
+ aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTCanopy/iden_water) ! dVol/dT (K-1)
+ aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dCanWat/iden_water) ! dVol/dLiq (kg m-2)-1
+ endif
+ aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-dGroundEvaporation_dTGround/iden_water) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+ endif
+
+ ! - include derivatives of energy and water w.r.t soil transpiration (dependent on canopy transpiration)
+ if(computeVegFlux)then
+ aJac(watState,ixCasNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanair(iLayer)) + aJac(watState,ixCasNrg) ! dVol/dT (K-1)
+ aJac(watState,ixVegNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTCanopy(iLayer)) + aJac(watState,ixVegNrg) ! dVol/dT (K-1)
+ aJac(watState,ixVegHyd) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dCanWat(iLayer)) + aJac(watState,ixVegHyd) ! dVol/dLiq (kg m-2)-1
+ aJac(watState,ixTopNrg) = (dt/mLayerDepth(jLayer))*(-mLayerdTrans_dTGround(iLayer)) + aJac(watState,ixTopNrg) ! dVol/dT (K-1)
+ endif
+
+ ! - include derivatives in energy fluxes w.r.t. with respect to water for current layer
+ aJac(nrgState,watState) = dVolHtCapBulk_dPsi0(iLayer) * mLayerTempPrime(jLayer) &
+ + (dt/mLayerDepth(jLayer))*(-dNrgFlux_dWatBelow(jLayer-1) + dNrgFlux_dWatAbove(jLayer))
+ if(mLayerdTheta_dTk(jLayer) > verySmall)then ! ice is present
+ aJac(nrgState,watState) = -LH_fus*iden_water * dVolTot_dPsi0(iLayer) * cj &
+ - LH_fus*iden_water * mLayerMatricHeadPrime(iLayer) * d2VolTot_d2Psi0(iLayer) + aJac(nrgState,watState) ! dNrg/dMat (J m-3 m-1) -- dMat changes volumetric water, and hence ice content
+ endif
+
+ ! - include derivatives of heat capacity w.r.t water fluxes for surrounding layers starting with layer above
+ if(iLayer>1)then
+ if(ixSoilOnlyNrg(iLayer-1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer-1),watState) = (dt/mLayerDepth(jLayer-1))*( dNrgFlux_dWatBelow(jLayer-1) )
+ elseif(iLayer==1 .and. nSnowOnlyNrg>0)then !top soil layer and there is snow above
+ if(ixSnowOnlyNrg(nSnow)/=integerMissing) aJac(ixSnowOnlyNrg(nSnow),watState) = (dt/mLayerDepth(nSnow))*( dNrgFlux_dWatBelow(nSnow) )
+ endif
+
+ ! (cross-derivative terms for the layer below)
+ if(iLayer<nSoil)then
+ if(ixSoilOnlyHyd(iLayer+1)/=integerMissing) aJac(ixSoilOnlyNrg(iLayer+1),watState) = (dt/mLayerDepth(jLayer+1))*(-dNrgFlux_dWatAbove(jLayer ) )
+ endif
+
+ endif ! (if the water state for the current layer is within the state subset)
+
+ ! - include terms for surface infiltration below surface
+ if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),nrgState) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),nrgState)
+
+ end do ! (looping through soil layers)
+
+ ! - include terms for surface infiltration above surface
+ if(nSnowOnlyNrg>0)then !have snow above first soil layer
+ if(ixSnowOnlyNrg(nSnow)/=integerMissing .and. ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyNrg(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0)
+ elseif(computeVegFlux)then !have vegetation above first soil layer, ixTopHyd = ixSoilOnlyHyd(1)
+ if(ixVegNrg/=integerMissing .and. ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegNrg)
+ endif
+
+ endif ! (if there are state variables for both water and energy in the soil domain)
+
+ ! print the Jacobian
+ if(globalPrintFlag)then
+ print*, '** analytical Jacobian (full):'
+ write(*,'(a4,1x,100(i12,1x))') 'xCol', (iLayer, iLayer=min(iJac1,nState),min(iJac2,nState))
+ do iLayer=min(iJac1,nState),min(iJac2,nState)
+ write(*,'(i4,1x,100(e12.5,1x))') iLayer, aJac(min(iJac1,nState):min(iJac2,nState),iLayer)
+ end do
endif
-
- endif ! (if the water state for the current layer is within the state subset)
-
- ! - include terms for surface infiltration below surface
- if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),nrgState) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(iLayer) + aJac(ixSoilOnlyHyd(1),nrgState)
-
- end do ! (looping through soil layers)
-
- ! - include terms for surface infiltration above surface
- if(nSnowOnlyHyd>0 .and. ixSnowOnlyNrg(nSnow)/=integerMissing)then
- if(ixSoilOnlyHyd(1)/=integerMissing) aJac(ixSoilOnlyHyd(1),ixSnowOnlyNrg(nSnow)) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0)
- elseif(computeVegFlux .and. ixVegNrg/=integerMissing)then !ixTopHyd = ixSoilOnlyHyd(1)
- if(ixTopHyd/=integerMissing) aJac(ixTopHyd,ixVegNrg) = -(dt/mLayerDepth(1+nSnow))*dq_dNrgStateLayerSurfVec(0) + aJac(ixTopHyd,ixVegNrg)
- endif
-
- endif ! (if there are state variables for both water and energy in the soil domain)
-
- ! print the Jacobian
- if(globalPrintFlag)then
- print*, '** analytical Jacobian (full):'
- write(*,'(a4,1x,100(i12,1x))') 'xCol', (iLayer, iLayer=min(iJac1,nState),min(iJac2,nState))
- do iLayer=min(iJac1,nState),min(iJac2,nState)
- write(*,'(i4,1x,100(e12.5,1x))') iLayer, aJac(min(iJac1,nState):min(iJac2,nState),iLayer)
- end do
- endif
-
- !print*, '** analytical Jacobian (full):'
- !write(*,'(a4,1x,100(i12,1x))') 'xCol', (iLayer, iLayer=1,size(aJac,2))
- !do iLayer=1,size(aJac,1)
- ! write(*,'(i4,1x,100(e12.5,1x))') iLayer, aJac(iLayer,1:size(aJac,2))
- !end do
- !print *, '--------------------------------------------------------------'
-
- ! ***
- ! check
- case default; err=20; message=trim(message)//'unable to identify option for the type of matrix'; return
-
- end select ! type of matrix
-
- if(any(isNan(aJac)))then
- print *, '******************************* WE FOUND NAN IN JACOBIAN ************************************'
- stop 1
- message=trim(message)//'we found NaN'
- err=20; return
- endif
-
- ! end association to variables in the data structures
- end associate
-
- end subroutine computJacobSundials
-
-
- ! **********************************************************************************************************
- ! public subroutine computJacobSetup: this sets up the inputs for the Jacobian computation for the IDA function
- ! **********************************************************************************************************
- subroutine computJacobSetup(&
- ! input: model control
- cj, & ! intent(in): this scalar changes whenever the step size or method order changes
- dt, & ! intent(in): time step
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- ixMatrix, & ! intent(in): form of the Jacobian matrix
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVec, & ! intent(in): model state vector
- stateVecPrime, & ! intent(in): derivative of model state vector
- sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- indx_data, & ! intent(inout): index data
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input: baseflow
- dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- dMat, & ! intent(inout): diagonal of Jacobian Matrix
- Jac, & ! intent(out): jacobian matrix
- err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! provide access to subroutines
- USE getVectorzAddSundials_module, only:varExtractSundials
- USE updateVarsSundials_module, only:updateVarsSundials ! update prognostic variables
- implicit none
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- real(rkind),intent(in) :: cj ! this scalar changes whenever the step size or method order changes
- real(rkind),intent(in) :: dt ! time step
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input: state vectors
- real(rkind),intent(in) :: stateVec(:) ! model state vector
- real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
- real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
- ! input: data structures
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- type(var_dlength), intent(in) :: mpar_data ! model parameters
- type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
- ! output: data structures
- type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: baseflow
- real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
- ! output: Jacobian
- real(rkind), intent(inout) :: dMat(:)
- real(rkind), intent(out) :: Jac(:,:) ! jacobian matrix
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! state variables
- real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
- real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
- real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
- real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
- real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
- ! diagnostic variables
- real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
- real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
- real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
- ! derivative of state variables
- real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
- real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
- real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
- real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
- real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
- ! derivative of diagnostic variables
- real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
- real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
- real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
- ! other local variables
- character(LEN=256) :: cmessage ! error message of downwind routine
- real(rkind) :: dt1
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- associate(&
- ! model decisions
- ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
- ! soil parameters
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
- ! decisions
- ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision &
- ) ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="computJacobSetup/"
-
- ! 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
- scalarCanairTempTrial = realMissing ! scalarCanairTemp prognostic not up to date
- scalarCanopyTempTrial = realMissing ! scalarCanopyTempTrial prognostic not up to date
- scalarCanopyWatTrial = realMissing ! scalarCanopyWat prognostic not up to date
- scalarCanopyLiqTrial = realMissing ! scalarCanopyLiq prognostic not up to date
- scalarCanopyIceTrial = realMissing ! scalarCanopyLIce prognostic not up to date
- mLayerTempTrial = realMissing ! mLayerTemp prognostic not up to date
- mLayerVolFracWatTrial = realMissing ! mLayerVolFracWat prognostic not up to date
- mLayerVolFracLiqTrial = realMissing ! mLayerVolFracLiq prognostic not up to date
- mLayerVolFracIceTrial = realMissing ! mLayerVolFracIce prognostic not up to date
- mLayerMatricHeadTrial = realMissing ! mLayerMatricHead prognostic not up to date
- mLayerMatricHeadLiqTrial = realMissing ! mLayerMatricHeadLiq prognostic not up to date
- scalarAquiferStorageTrial= realMissing ! scalarAquiferStorage prognostic not up to date
-
- ! extract variables from the model state vector
- call varExtractSundials(&
- ! input
- stateVec, & ! 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)
-
- call updateVarsSundials(&
- ! input
- dt, & ! intent(in): time step
- .true., & ! intent(in): logical flag if computing Jacobian for Sundials solver
- .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
- mpar_data, & ! intent(in): model parameters for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- 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)
-
- ! -----
- ! * compute the Jacobian matrix...
- ! --------------------------------
-
- ! compute the analytical Jacobian matrix
- ! NOTE: The derivatives were computed in the previous call to computFlux
- ! This occurred either at the call to eval8summaSundials at the start of systemSolvSundials
- ! or in the call to eval8summaSundials in the previous iteration
- dt1 = 1._qp
- call computJacobSundials(&
- ! input: model control
- cj, & ! intent(in): this scalar changes whenever the step size or method order changes
- dt1, & ! intent(in): length of the time step (seconds)
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- (ixGroundwater==qbaseTopmodel), & ! intent(in): flag to indicate if we need to compute baseflow
- ixMatrix, & ! intent(in): form of the Jacobian matrix
- specificStorage, & ! intent(in): specific storage coefficient (m-1)
- theta_sat, & ! intent(in): soil porosity (-)
- ixRichards, & ! intent(in): choice of option for Richards' equation
- ! input: data structures
- indx_data, & ! intent(in): index data
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
- dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
- ! input: state variables
- mLayerTempPrime, & ! intent(in)
- mLayerMatricHeadPrime, & ! intent(in)
- mLayerMatricHeadLiqPrime, & ! intent(in)
- mLayerVolFracWatPrime, & ! intent(in)
- scalarCanopyTempPrime, & ! intent(in) derivative value for temperature of the vegetation canopy (K)
- scalarCanopyWatPrime, & ! intent(in)
- ! input-output: Jacobian and its diagonal
- dMat, & ! intent(inout): diagonal of the Jacobian matrix
- Jac, & ! intent(out): Jacobian matrix
- ! output: error control
- err,cmessage) ! intent(out): error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! end association with the information in the data structures
- end associate
-
- end subroutine computJacobSetup
-
-
- ! **********************************************************************************************************
- ! public function computJacob4IDA: the interface to compute the Jacobian matrix dF/dy + c dF/dy' for IDA solver
- ! **********************************************************************************************************
- ! Return values:
- ! 0 = success,
- ! 1 = recoverable error,
- ! -1 = non-recoverable error
- ! ----------------------------------------------------------------
- integer(c_int) function computJacob4IDA(t, cj, sunvec_y, sunvec_yp, sunvec_r, &
- sunmat_J, user_data, sunvec_temp1, sunvec_temp2, sunvec_temp3) &
- result(ierr) bind(C,name='computJacob4IDA')
-
- !======= Inclusions ===========
- use, intrinsic :: iso_c_binding
- use fsundials_nvector_mod
- use fsundials_matrix_mod
- use fnvector_serial_mod
- use fsunmatrix_dense_mod
- use nrtype
- use type4IDA
- !======= Declarations =========
- implicit none
-
- ! calling variables
- real(rkind), value :: t ! current time
- real(rkind), value :: cj ! step size scaling factor
- type(N_Vector) :: sunvec_y ! solution N_Vector
- type(N_Vector) :: sunvec_yp ! derivative N_Vector
- type(N_Vector) :: sunvec_r ! residual N_Vector
- type(SUNMatrix) :: sunmat_J ! Jacobian SUNMatrix
- type(c_ptr), value :: user_data ! user-defined data
- type(N_Vector) :: sunvec_temp1 ! temporary N_Vector
- type(N_Vector) :: sunvec_temp2 ! temporary N_Vector
- type(N_Vector) :: sunvec_temp3 ! temporary N_Vector
-
- ! pointers to data in SUNDIALS vectors
- real(rkind), pointer :: stateVec(:) ! state vector
- real(rkind), pointer :: stateVecPrime(:)! derivative of the state vector
- real(rkind), pointer :: rVec(:) ! residual vector
- real(rkind), pointer :: Jac(:,:) ! Jacobian matrix
- type(eqnsData), pointer :: eqns_data ! equations data
-
-
-
- !======= Internals ============
-
- ! get equations data from user-defined data
- call c_f_pointer(user_data, eqns_data)
-
-
- ! get data arrays from SUNDIALS vectors
- stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
- stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
- rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
- Jac(1:eqns_data%nState, 1:eqns_data%nState) => FSUNDenseMatrix_Data(sunmat_J)
-
- ! compute Jacobian matrix
- call computJacobSetup(&
- ! input: model control
- cj, & ! intent(in): this scalar changes whenever the step size or method order changes
- eqns_data%dt, & ! intent(in): data step
- eqns_data%nSnow, & ! intent(in): number of snow layers
- eqns_data%nSoil, & ! intent(in): number of soil layers
- eqns_data%nLayers, & ! intent(in): number of layers
- eqns_data%ixMatrix, & ! intent(in): type of matrix (dense or banded)
- eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVec, & ! intent(in): model state vector
- stateVecPrime, & ! intent(in): model state vector
- eqns_data%sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- eqns_data%mpar_data, & ! intent(in): model parameters
- eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- eqns_data%indx_data, & ! intent(inou): index data
- eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input: baseflow
- eqns_data%dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
- ! output
- eqns_data%dMat, & ! intetn(inout): diagonal of the Jacobian matrix
- Jac, & ! intent(out): Jacobian matrix
- eqns_data%err,eqns_data%message) ! intent(out): error control
-
- if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
- if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
-
- ! return success
- ierr = 0
- return
-
-
-
- end function computJacob4IDA
-
-
- ! **********************************************************************************************************
- ! private function: get the off-diagonal index in the band-diagonal matrix
- ! **********************************************************************************************************
- function ixOffDiag(jState,iState)
- implicit none
- integer(i4b),intent(in) :: jState ! off-diagonal state
- integer(i4b),intent(in) :: iState ! diagonal state
- integer(i4b) :: ixOffDiag ! off-diagonal index in gthe band-diagonal matrix
- ixOffDiag = ixBandOffset + jState - iState
- end function ixOffDiag
-
- end module computJacobSundials_module
+
+ ! check
+ case default; err=20; message=trim(message)//'unable to identify option for the type of matrix'; return
+
+ end select ! type of matrix
+
+ if(any(isNan(aJac)))then
+ print *, '******************************* WE FOUND NAN IN JACOBIAN ************************************'
+ stop 1
+ message=trim(message)//'we found NaN'
+ err=20; return
+ endif
+
+ ! end association to variables in the data structures
+ end associate
+
+end subroutine computJacobSundials
+
+
+! **********************************************************************************************************
+! private function: get the off-diagonal index in the band-diagonal matrix
+! **********************************************************************************************************
+function ixOffDiag(jState,iState)
+ implicit none
+ integer(i4b),intent(in) :: jState ! off-diagonal state
+ integer(i4b),intent(in) :: iState ! diagonal state
+ integer(i4b) :: ixOffDiag ! off-diagonal index in gthe band-diagonal matrix
+ ixOffDiag = ixBandOffset + jState - iState
+end function ixOffDiag
+
+end module computJacobSundials_module
\ No newline at end of file
diff --git a/build/source/engine/sundials/eval8JacDAE.f90 b/build/source/engine/sundials/eval8JacDAE.f90
new file mode 100644
index 0000000..e2cdcdd
--- /dev/null
+++ b/build/source/engine/sundials/eval8JacDAE.f90
@@ -0,0 +1,343 @@
+
+module eval8JacDAE_module
+
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables to describe the state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only:model_decisions ! model decision structure
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8JacDAE
+
+contains
+
+! **********************************************************************************************************
+! public subroutine eval8JacDAE: compute the Jacobian matrix
+! **********************************************************************************************************
+subroutine eval8JacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt, & ! intent(in): time step
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): derivative of model state vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ mpar_data, & ! intent(in): model parameters
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input: baseflow
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ dMat, & ! intent(inout): diagonal of Jacobian Matrix
+ Jac, & ! intent(out): jacobian matrix
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE getVectorz_module, only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module, only:updateVarsSundials ! update prognostic variables
+ USE computJacobSundials_module,only:computJacobSundials
+ implicit none
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: cj ! this scalar changes whenever the step size or method order changes
+ real(rkind),intent(in) :: dt ! time step
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVec(:) ! model state vector
+ real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
+ real(qp),intent(in) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ real(rkind),intent(in) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: Jacobian
+ real(rkind), intent(inout) :: dMat(:)
+ real(rkind), intent(out) :: Jac(:,:) ! jacobian matrix
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial value for volumetric fraction of ice (-)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
+ ! derivative of diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
+ ! other local variables
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ real(rkind) :: dt1
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ ! model state variables
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision &
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8JacDAE/"
+
+ ! extract variables from the model state vector
+ call varExtract(&
+ ! input
+ stateVec, & ! intent(in): model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! extract derivative of variables from derivative of the model state vector
+ call varExtract(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ call updateVarsSundials(&
+ ! input
+ dt, & ! intent(in): time step
+ .true., & ! intent(in): logical flag if computing Jacobian for sundials solver
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ 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)
+
+ ! -----
+ ! * compute the Jacobian matrix...
+ ! --------------------------------
+
+ ! compute the analytical Jacobian matrix
+ ! NOTE: The derivatives were computed in the previous call to computFlux
+ ! This occurred either at the call to eval8summaSundials at the start of sysSolveSundials
+ ! or in the call to eval8summaSundials in the previous iteration
+ dt1 = 1._qp
+ call computJacobSundials(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ dt1, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ (ixGroundwater==qbaseTopmodel), & ! intent(in): flag to indicate if we need to compute baseflow
+ ixMatrix, & ! intent(in): form of the Jacobian matrix
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ! input: data structures
+ indx_data, & ! intent(in): index data
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ deriv_data, & ! intent(in): derivatives in model fluxes w.r.t. relevant state variables
+ dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! input: state variables
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerTempPrime, & ! intent(in)
+ mLayerMatricHeadPrime, & ! intent(in)
+ mLayerMatricHeadLiqPrime, & ! intent(in)
+ mLayerVolFracWatPrime, & ! intent(in)
+ scalarCanopyTempTrial, & ! intent(in)
+ scalarCanopyTempPrime, & ! intent(in) derivative value for temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, & ! intetn(in)
+ ! input-output: Jacobian and its diagonal
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix
+ Jac, & ! intent(out): Jacobian matrix
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! end association with the information in the data structures
+ end associate
+
+end subroutine eval8JacDAE
+end module eval8JacDAE_module
diff --git a/build/source/engine/sundials/eval8summaSundials.f90 b/build/source/engine/sundials/eval8summaSundials.f90
index b5f5d42..0674236 100644
--- a/build/source/engine/sundials/eval8summaSundials.f90
+++ b/build/source/engine/sundials/eval8summaSundials.f90
@@ -1,506 +1,510 @@
module eval8summaSundials_module
- ! data types
- USE nrtype
- USE type4IDA
-
- ! access missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing double precision number
- USE globalData,only:quadMissing ! missing quadruple precision number
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! define access to state variables to print
- USE globalData,only: iJac1 ! first layer of the Jacobian to print
- USE globalData,only: iJac2 ! last layer of the Jacobian to print
-
- ! domain types
- USE globalData,only:iname_veg ! named variables for vegetation
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! named variables to describe the state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
- USE globalData,only:model_decisions ! model decision structure
- USE globalData,only:flux_meta ! metadata on the model fluxes
-
- ! constants
- USE multiconst,only:&
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_vap, & ! latent heat of vaporization (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! provide access to the derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (rkind)
- zlookup, &
- model_options ! defines the model decisions
-
- ! indices that define elements of the data structures
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookFLUX ! named variables for structure elements
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
-
- ! look-up values for the choice of groundwater representation (local-column, or single-basin)
- USE mDecisions_module,only: &
- localColumn, & ! separate groundwater representation in each local soil column
- singleBasin, & ! single groundwater store over the entire basin
- enthalpyFD ! heat capacity using enthalpy
-
- ! look-up values for the choice of groundwater parameterization
- USE mDecisions_module,only: &
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit ! no explicit groundwater parameterization
-
- ! look-up values for the form of Richards' equation
- USE mDecisions_module,only: &
- moisture, & ! moisture-based form of Richards' equation
- mixdform ! mixed form of Richards' equation
-
- use, intrinsic :: iso_c_binding
-
+! data types
+USE nrtype
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! define access to state variables to print
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables to describe the state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:model_decisions ! model decision structure
+
+
+! constants
+USE multiconst,only:&
+ Tfreeze, & ! temperature at freezing (K)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ LH_vap, & ! latent heat of vaporization (J kg-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zlookup, &
+ model_options ! defines the model decisions
+
+! indices that define elements of the data structures
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin, & ! single groundwater store over the entire basin
+ enthalpyFD ! heat capacity using enthalpy
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+! look-up values for the form of Richards' equation
+USE mDecisions_module,only: &
+ moisture, & ! moisture-based form of Richards' equation
+ mixdform ! mixed form of Richards' equation
+
+implicit none
+private
+public::eval8summaSundials
+
+contains
+
+! **********************************************************************************************************
+! public subroutine eval8summaSundials: compute the residual vector
+! **********************************************************************************************************
+subroutine eval8summaSundials(&
+ ! input: model control
+ dt_cur, & ! intent(in): current stepsize
+ dt, & ! intent(in): entire time step
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nState, & ! intent(in): total number of state variables
+ insideIDA, & ! intent(in): flag to indicate if we are inside Sundials solver
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout) flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(inout) flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): derivative of model state vector
+ sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup data
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(inout): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output:
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyTempPrev, & ! intent(in): value of canopy temperature (K)
+ scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ scalarCanopyEnthalpyPrev,& ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ mLayerMatricHeadLiqTrial,& ! intent(out): trial value for liquid water matric potential (m)
+ mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ scalarAquiferStoragePrev,& ! intent(in): value of storage of water in the aquifer (m)
+ mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ fluxVec, & ! intent(out): flux vector
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! provide access to subroutines
+ USE getVectorz_module, only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module, only:updateVarsSundials ! update variables
+ USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
+ USE computFlux_module, only:soilCmpresSundials ! compute soil compression
+ USE computFlux_module, only:computFlux ! compute fluxes given a state vector
+ USE computHeatCap_module,only:computHeatCap ! compute heat capacity
+ USE computHeatCap_module,only:computHeatCapAnalytic ! compute heat capacity
+ USE computHeatCap_module,only:computCm
+ USE computHeatCap_module, only:computStatMult
+ USE computResidSundials_module,only:computResidSundials ! compute residuals given a state vector
+ USE computThermConduct_module,only:computThermConduct
+ USE computEnthalpy_module,only:computEnthalpy
+ USE computEnthalpy_module,only:computEnthalpyPrime
implicit none
- private
- public::eval8summaSundials
- public::eval8summa4IDA
-
- contains
-
- ! **********************************************************************************************************
- ! public subroutine eval8summaSundials: compute the residual vector
- ! **********************************************************************************************************
- subroutine eval8summaSundials(&
- ! input: model control
- dt_cur, & ! intent(in): current stepsize
- dt, & ! intent(in): entire time step
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- nState, & ! intent(in): total number of state variables
- insideIDA, & ! intent(in): flag to indicate if we are inside Sundials solver
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- firstFluxCall, & ! intent(inout) flag to indicate if we are processing the first flux call
- firstSplitOper, & ! intent(inout) flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVec, & ! intent(in): model state vector
- stateVecPrime, & ! intent(in): derivative of model state vector
- sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- lookup_data, & ! intent(in): lookup data
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- indx_data, & ! intent(inout): index data
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: here we need to pass some extra variables that do not get updated in in the Sundials loops
- scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
- scalarCanopyIceTrial, & ! intent(inout): trial value for mass of ice on the vegetation canopy (kg m-2)
- scalarCanopyEnthalpyTrial,& ! intent(inout): trial value for enthalpy of the vegetation canopy (J m-3)
- mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
- mLayerMatricHeadTrial, & ! intent(inout): trial value for total water matric potential (m)
- mLayerMatricHeadLiqTrial,& ! intent(inout): trial value for liquid water matric potential (m)
- mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
- mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
- mLayerEnthalpyTrial, & ! intent(inout): trial vector of enthalpy for snow+soil layers (J m-3)
- ! input-output: baseflow
- ixSaturation, & ! intent(inout): index of the lowest saturated layer
- dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- feasible, & ! intent(out): flag to denote the feasibility of the solution
- fluxVec, & ! intent(out): flux vector
- resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- resVec, & ! intent(out): residual vector
- err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! provide access to subroutines
- USE getVectorzAddSundials_module, only:varExtractSundials ! extract variables from the state vector
- USE updateVarsSundials_module, only:updateVarsSundials ! update variables
- USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
- USE computFlux_module, only:soilCmpresSundials ! compute soil compression
- USE computFlux_module, only:computFlux ! compute fluxes given a state vector
- USE computHeatCap_module,only:computHeatCap ! compute heat capacity
- USE computHeatCap_module,only:computHeatCapAnalytic ! compute heat capacity
- USE computHeatCap_module,only:computCm
- USE computHeatCap_module, only:computStatMult
- USE computResidSundials_module,only:computResidSundials ! compute residuals given a state vector
- USE computThermConduct_module,only:computThermConduct
- USE computEnthalpy_module,only:computEnthalpy
- USE computEnthalpy_module,only:computEnthalpyPrime
- implicit none
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- real(rkind),intent(in) :: dt_cur
- real(rkind),intent(in) :: dt ! time step
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer,intent(in) :: nState ! total number of state variables
- logical(lgt),intent(in) :: insideIDA ! flag to indicate if we are inside Sundials solver
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(inout) :: firstFluxCall
- logical(lgt),intent(inout) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input: state vectors
- real(rkind),intent(in) :: stateVec(:) ! model state vector
- real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
- real(qp),intent(inout) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
- ! input: data structures
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- type(var_i), intent(in) :: type_data ! type of vegetation and soil
- type(var_d), intent(in) :: attr_data ! spatial attributes
- type(var_dlength), intent(in) :: mpar_data ! model parameters
- type(var_d), intent(in) :: forc_data ! model forcing data
- type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
- type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
- ! output: data structures
- type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: here we need to pass some extra variables that do not get updated in in the Sundials loops
- real(rkind),intent(inout) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
- real(rkind),intent(inout) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
- real(rkind),intent(inout) :: scalarCanopyEnthalpyTrial ! trial value for enthalpy of the vegetation canopy (J m-3)
- real(rkind),intent(inout) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
- real(rkind),intent(inout) :: mLayerMatricHeadTrial(:) ! trial vector of total water matric potential (m)
- real(rkind),intent(inout) :: mLayerMatricHeadLiqTrial(:)! trial value for liquid water matric potential (m)
- real(rkind),intent(inout) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
- real(rkind),intent(inout) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
- real(rkind),intent(inout) :: mLayerEnthalpyTrial(:) ! trial vector of enthalpy for snow+soil layers (J m-3)
- ! input-output: baseflow
- integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
- real(rkind),intent(out) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- logical(lgt),intent(out) :: feasible ! flag to denote the feasibility of the solution
- real(rkind),intent(out) :: fluxVec(:) ! flux vector
- real(rkind),intent(out) :: resSink(:) ! sink terms on the RHS of the flux equation
- real(qp),intent(out) :: resVec(:) ! NOTE: qp ! residual vector
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! previous state variables
- real(rkind) :: scalarCanopyTempPrev ! previous value for temperature of the vegetation canopy (K)
- real(rkind) :: scalarCanopyIcePrev ! previous value for mass of ice on the vegetation canopy (kg m-2)
- real(rkind),dimension(nLayers) :: mLayerTempPrev ! previous vector of layer temperature (K)
- real(rkind),dimension(nSoil) :: mLayerMatricHeadPrev ! previous vector of total water matric potential (m)
- real(rkind),dimension(nLayers) :: mLayerVolFracWatPrev ! previous vector of volumetric total water content (-)
- real(rkind),dimension(nLayers) :: mLayerVolFracIcePrev ! previous vector of volumetric ice water content (-)
- ! trial state variables
- real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
- real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
- 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),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial vector for volumetric fraction of liquid water (-)
- ! 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 (-)
- ! enthalpy
- real(rkind) :: scalarCanopyEnthalpyPrev ! previous value for enthalpy of the vegetation canopy (J m-3)
- real(rkind) :: scalarCanairEnthalpy ! enthalpy of the canopy air space (J m-3)
- real(rkind),dimension(nLayers) :: mLayerEnthalpyPrime ! enthalpy of each snow+soil layer (J m-3)
- real(rkind),dimension(nLayers) :: mLayerEnthalpyPrev ! previous vector of enthalpy for snow+soil layers (J m-3)
- ! other local variables
- integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
- integer(i4b) :: jState(1) ! index of model state for the scalar solution within the soil domain
- integer(i4b) :: ixBeg,ixEnd ! index of indices for the soil compression routine
- integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
- real(rkind) :: xMin,xMax ! minimum and maximum values for water content
- real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
- character(LEN=256) :: cmessage ! error message of downwind routine
- real(rkind) :: scalarCanopyCmTrial ! trial value of Cm for the canopy
- real(rkind),dimension(nLayers) :: mLayerCmTrial ! trial vector of Cm for snow+soil
- logical(lgt),parameter :: updateCp=.true. ! flag to indicate if we update Cp at each step
- logical(lgt),parameter :: needCm=.false. ! flag to indicate if the energy equation contains Cm = dH_T/dTheta_m
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- associate(&
- ! model decisions
- ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
- ! snow parameters
- snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
- ! soil parameters
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
- ! canopy and layer depth
- canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- ! model state variables
- scalarSfcMeltPond => prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) ,& ! intent(in): [dp] ponded water caused by melt of the "snow without a layer" (kg m-2)
- ! soil compression
- scalarSoilCompress => diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ,& ! intent(in): [dp] total change in storage associated with compression of the soil matrix (kg m-2)
- mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
- ! derivatives
- dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0)%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
- dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi)%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t. matric head (m-1)
- ! mapping
- ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
- ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
- ! indices
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable (nrg)
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable (nrg)
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
- ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
- ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
- heatCapVegTrial => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1),& ! intent(out): volumetric heat capacity of vegetation canopy
- mLayerHeatCapTrial => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat & ! intent(out): heat capacity for snow and soil
- ) ! association to variables in the data structures
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="eval8summaSundials/"
- feasible=.true.
-
- ! check the feasibility of the solution only if not inside Sundials solver
- if (.not.insideIDA) then
- ! check that the canopy air space temperature is reasonable
- if(ixCasNrg/=integerMissing)then
- if(stateVec(ixCasNrg) > canopyTempMax) feasible=.false.
- if(stateVec(ixCasNrg) > canopyTempMax) message=trim(message)//'canopy air space temp high,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixCasNrg )', feasible, canopyTempMax, stateVec(ixCasNrg)
- endif
-
- ! check that the canopy temperature is reasonable
- if(ixVegNrg/=integerMissing)then
- if(stateVec(ixVegNrg) > canopyTempMax) feasible=.false.
- if(stateVec(ixVegNrg) > canopyTempMax) message=trim(message)//'canopy temp high,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixVegNrg )', feasible, canopyTempMax, stateVec(ixVegNrg)
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt_cur
+ real(rkind),intent(in) :: dt ! time step
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer,intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: insideIDA ! flag to indicate if we are inside Sundials solver
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall
+ logical(lgt),intent(inout) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVec(:) ! model state vector
+ real(rkind),intent(in) :: stateVecPrime(:) ! model state vector
+ real(qp),intent(inout) :: sMul(:) ! NOTE: qp ! state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i), intent(in) :: type_data ! type of vegetation and soil
+ type(var_d), intent(in) :: attr_data ! spatial attributes
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_d), intent(in) :: forc_data ! model forcing data
+ type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ ! output: data structures
+ type(var_ilength),intent(inout) :: indx_data ! indices defining model states and layers
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ real(rkind),intent(out) :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1)
+ ! output: flux and residual vectors
+ real(rkind),intent(out) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind),intent(in) :: scalarCanopyTempPrev ! previous value for temperature of the vegetation canopy (K)
+ real(rkind),intent(out) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyIcePrev ! previous value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyLiqTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(in) :: scalarCanopyLiqPrev ! previous value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),intent(out) :: scalarCanopyEnthalpyTrial ! trial value for enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(in) :: scalarCanopyEnthalpyPrev ! previous value of enthalpy of the vegetation canopy (J m-3)
+ real(rkind),intent(out) :: mLayerTempTrial(:) ! trial vector of layer temperature (K)
+ real(rkind),intent(in) :: mLayerTempPrev(:)
+ real(rkind),intent(out) :: mLayerMatricHeadLiqTrial(:) ! trial value for liquid water matric potential (m)
+ real(rkind),intent(out) :: mLayerMatricHeadTrial(:) ! trial value for total water matric potential (m)
+ real(rkind),intent(in) :: mLayerMatricHeadPrev(:) ! value for total water matric potential (m)
+ real(rkind),intent(out) :: mLayerVolFracWatTrial(:) ! trial vector of volumetric total water content (-)
+ real(rkind),intent(in) :: mLayerVolFracWatPrev(:) ! vector of volumetric total water content (-)
+ real(rkind),intent(out) :: mLayerVolFracIceTrial(:) ! trial vector of volumetric ice water content (-)
+ real(rkind),intent(in) :: mLayerVolFracIcePrev(:) ! vector of volumetric ice water content (-)
+ real(rkind),intent(out) :: mLayerVolFracLiqTrial(:) ! trial vector of volumetric liquid water content (-)
+ real(rkind),intent(in) :: mLayerVolFracLiqPrev(:) ! vector of volumetric liquid water content (-)
+ real(rkind),intent(out) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
+ real(rkind),intent(in) :: scalarAquiferStoragePrev ! value of storage of water in the aquifer (m)
+ real(rkind),intent(in) :: mLayerEnthalpyPrev(:) ! vector of enthalpy for snow+soil layers (J m-3)
+ real(rkind),intent(out) :: mLayerEnthalpyTrial(:) ! trial vector of enthalpy for snow+soil layers (J m-3)
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
+ logical(lgt),intent(out) :: feasible ! flag to denote the feasibility of the solution
+ real(rkind),intent(out) :: fluxVec(:) ! flux vector
+ real(rkind),intent(out) :: resSink(:) ! sink terms on the RHS of the flux equation
+ real(qp),intent(out) :: resVec(:) ! NOTE: qp ! residual vector
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! derivative value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! derivative value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! derivative value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! derivative value for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! derivative value for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! derivative value for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! derivative value for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! derivative value of storage of water in the aquifer (m)
+ ! derivative of diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! derivative value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! derivative value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! derivative value for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! derivative value for volumetric fraction of ice (-)
+ ! enthalpy
+ real(rkind) :: scalarCanairEnthalpy ! enthalpy of the canopy air space (J m-3)
+ real(rkind),dimension(nLayers) :: mLayerEnthalpyPrime ! enthalpy of each snow+soil layer (J m-3)
+ ! other local variables
+ integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
+ integer(i4b) :: jState(1) ! index of model state for the scalar solution within the soil domain
+ integer(i4b) :: ixBeg,ixEnd ! index of indices for the soil compression routine
+ integer(i4b),parameter :: ixVegVolume=1 ! index of the desired vegetation control volumne (currently only one veg layer)
+ real(rkind) :: xMin,xMax ! minimum and maximum values for water content
+ real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ real(rkind) :: scalarCanopyCmTrial ! trial value of Cm for the canopy
+ real(rkind),dimension(nLayers) :: mLayerCmTrial ! trial vector of Cm for snow+soil
+ logical(lgt),parameter :: updateCp=.true. ! flag to indicate if we update Cp at each step
+ logical(lgt),parameter :: needCm=.false. ! flag to indicate if the energy equation contains Cm = dH_T/dTheta_m
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ associate(&
+ ! model decisions
+ ixRichards => model_decisions(iLookDECISIONS%f_Richards)%iDecision ,& ! intent(in): [i4b] index of the form of Richards' equation
+ ! snow parameters
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ specificStorage => mpar_data%var(iLookPARAM%specificStorage)%dat(1) ,& ! intent(in): [dp] specific storage coefficient (m-1)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
+ ! canopy and layer depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in): [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model state variables
+ scalarSfcMeltPond => prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) ,& ! intent(in): [dp] ponded water caused by melt of the "snow without a layer" (kg m-2)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ ! soil compression
+ scalarSoilCompress => diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ,& ! intent(in): [dp] total change in storage associated with compression of the soil matrix (kg m-2)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in): [dp(:)] change in storage associated with compression of the soil matrix (-)
+ ! derivatives
+ dVolTot_dPsi0 => deriv_data%var(iLookDERIV%dVolTot_dPsi0)%dat ,& ! intent(in): [dp(:)] derivative in total water content w.r.t. total water matric potential
+ dCompress_dPsi => deriv_data%var(iLookDERIV%dCompress_dPsi)%dat ,& ! intent(in): [dp(:)] derivative in compressibility w.r.t. matric head (m-1)
+ ! mapping
+ ixMapFull2Subset => indx_data%var(iLookINDEX%ixMapFull2Subset)%dat ,& ! intent(in): [i4b(:)] mapping of full state vector to the state subset
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in): [i4b(:)] index of control volume for different domains (veg, snow, soil)
+ ! indices
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable (nrg)
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable (nrg)
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixStateType => indx_data%var(iLookINDEX%ixStateType)%dat ,& ! intent(in): [i4b(:)] indices defining the type of the state (iname_nrgLayer...)
+ ixHydCanopy => indx_data%var(iLookINDEX%ixHydCanopy)%dat ,& ! intent(in): [i4b(:)] index of the hydrology states in the canopy domain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
+ heatCapVegTrial => diag_data%var(iLookDIAG%scalarBulkVolHeatCapVeg)%dat(1) ,& ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial => diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat & ! intent(out): heat capacity for snow and soil
+ ) ! association to variables in the data structures
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="eval8summaSundials/"
+ feasible=.true.
+
+ ! check the feasibility of the solution
+ if (.not.insideIDA) then
+ ! check that the canopy air space temperature is reasonable
+ if(ixCasNrg/=integerMissing)then
+ if(stateVec(ixCasNrg) > canopyTempMax) feasible=.false.
+ if(stateVec(ixCasNrg) > canopyTempMax) message=trim(message)//'canopy air space temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixCasNrg )', feasible, canopyTempMax, stateVec(ixCasNrg)
+ endif
+
+ ! check that the canopy temperature is reasonable
+ if(ixVegNrg/=integerMissing)then
+ if(stateVec(ixVegNrg) > canopyTempMax) feasible=.false.
+ if(stateVec(ixVegNrg) > canopyTempMax) message=trim(message)//'canopy temp high,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, max, stateVec( ixVegNrg )', feasible, canopyTempMax, stateVec(ixVegNrg)
+ endif
+
+ ! check canopy liquid water is not negative
+ if(ixVegHyd/=integerMissing)then
+ if(stateVec(ixVegHyd) < 0._rkind) feasible=.false.
+ if(stateVec(ixVegHyd) < 0._rkind) message=trim(message)//'canopy water negative,'
+ if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, min, stateVec( ixVegHyd )', feasible, 0._rkind, stateVec(ixVegHyd)
+ end if
+
+ ! check snow temperature is below freezing
+ if(count(ixSnowOnlyNrg/=integerMissing)>0)then
+ if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) feasible=.false.
+ if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) message=trim(message)//'snow temp above freezing,'
+ do iLayer=1,nSnow
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, max, stateVec( ixSnowOnlyNrg(iLayer) )', iLayer, feasible, Tfreeze, stateVec( ixSnowOnlyNrg(iLayer) )
+ enddo
+ endif
+
+ ! loop through non-missing hydrology state variables in the snow+soil domain
+ do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
+
+ ! check the minimum and maximum water constraints
+ if(ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_liqLayer)then
+
+ ! --> minimum
+ if (layerType(iLayer) == iname_soil) then
+ xMin = theta_res(iLayer-nSnow)
+ else
+ xMin = 0._rkind
+ endif
+
+ ! --> maximum
+ select case( layerType(iLayer) )
+ case(iname_snow); xMax = merge(iden_ice, 1._rkind - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ case(iname_soil); xMax = merge(theta_sat(iLayer-nSnow), theta_sat(iLayer-nSnow) - mLayerVolFracIce(iLayer), ixHydType(iLayer)==iname_watLayer)
+ end select
+
+ ! --> check
+ if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) feasible=.false.
+ if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) message=trim(message)//'layer water outside bounds,'
+ if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax = ', iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax
+
+ endif ! if water states
+
+ end do ! loop through non-missing hydrology state variables in the snow+soil domain
+
+ ! early return for non-feasible solutions
+ if(.not.feasible)then
+ fluxVec(:) = realMissing
+ resVec(:) = quadMissing
+ message=trim(message)//'non-feasible'
+ err=20; return
+ end if
+
+ end if ! ( feasibility check )
+
+ ! get the start and end indices for the soil compression calculations
+ if(scalarSolution)then
+ jState = pack(ixControlVolume, ixMapFull2Subset/=integerMissing)
+ ixBeg = jState(1)
+ ixEnd = jState(1)
+ else
+ ixBeg = 1
+ ixEnd = nSoil
endif
-
- ! check canopy liquid water is not negative
- if(ixVegHyd/=integerMissing)then
- if(stateVec(ixVegHyd) < 0._rkind) feasible=.false.
- if(stateVec(ixVegHyd) < 0._rkind) message=trim(message)//'canopy water negative,'
- if(.not.feasible) write(*,'(a,1x,L1,1x,10(f20.10,1x))') 'feasible, min, stateVec( ixVegHyd )', feasible, 0._rkind, stateVec(ixVegHyd)
- end if
-
- ! check snow temperature is below freezing
- if(count(ixSnowOnlyNrg/=integerMissing)>0)then
- if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) feasible=.false.
- if(any(stateVec( pack(ixSnowOnlyNrg,ixSnowOnlyNrg/=integerMissing) ) > Tfreeze)) message=trim(message)//'snow temp above freezing,'
- do iLayer=1,nSnow
- if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, max, stateVec( ixSnowOnlyNrg(iLayer) )', iLayer, feasible, Tfreeze, stateVec( ixSnowOnlyNrg(iLayer) )
- enddo
+
+ ! initialize to state variable from the last update
+ scalarCanopyTempTrial = scalarCanopyTempPrev
+ scalarCanopyLiqTrial = scalarCanopyLiqPrev
+ scalarCanopyIceTrial = scalarCanopyIcePrev
+ mLayerTempTrial = mLayerTempPrev
+ mLayerVolFracWatTrial = mLayerVolFracWatPrev
+ mLayerVolFracLiqTrial = mLayerVolFracLiqPrev
+ mLayerVolFracIceTrial = mLayerVolFracIcePrev
+ mLayerMatricHeadTrial = mLayerMatricHeadPrev
+ scalarAquiferStorageTrial = scalarAquiferStoragePrev
+
+ ! extract variables from the model state vector
+ call varExtract(&
+ ! input
+ stateVec, & ! intent(in): model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
+ scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
+ scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! Extract the variables for stateVecPrime
+ call varExtract(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ call updateVarsSundials(&
+ ! input
+ dt_cur, &
+ .false., & ! intent(in): logical flag if computing Jacobian for Sundials solver
+ .false., & ! intent(in): logical flag to adjust temperature to account for the energy
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ mLayerVolFracWatPrev, & ! intent(in): 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 canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(inout): trial value of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(inout): trial value of canopy liquid water (kg m-2)
+ scalarCanopyIcePrime, & ! intent(inout): trial value of canopy ice content (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(inout): trial vector of volumetric liquid water content (-)
+ mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
+ mLayerMatricHeadTrial, & ! intent(inout): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(inout): trial vector of liquid water matric potential (m)
+ mLayerTempPrime, & !
+ mLayerVolFracWatPrime, & ! intent(inout): Prime vector of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(inout): Prime vector of volumetric liquid water content (-)
+ mLayerVolFracIcePrime, & !
+ mLayerMatricHeadPrime, & ! intent(inout): Prime vector of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(inout): Prime vector of liquid water matric potential (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ ! print the water content
+ if(globalPrintFlag)then
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(iJac2,nSnow))
+ if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(iJac2,nSnow))
endif
-
- ! loop through non-missing hydrology state variables in the snow+soil domain
- do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing)
-
- ! check the minimum and maximum water constraints
- if(ixHydType(iLayer)==iname_watLayer .or. ixHydType(iLayer)==iname_liqLayer)then
-
- ! --> minimum
- if (layerType(iLayer) == iname_soil) then
- xMin = theta_res(iLayer-nSnow)
- else
- xMin = 0._rkind
- endif
-
- ! --> maximum
- select case( layerType(iLayer) )
- case(iname_snow); xMax = merge(iden_ice, 1._rkind - mLayerVolFracIceTrial(iLayer), ixHydType(iLayer)==iname_watLayer)
- case(iname_soil); xMax = merge(theta_sat(iLayer-nSnow), theta_sat(iLayer-nSnow) - mLayerVolFracIceTrial(iLayer), ixHydType(iLayer)==iname_watLayer)
- end select
-
- ! --> check
- if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) feasible=.false.
- if(stateVec( ixSnowSoilHyd(iLayer) ) < xMin .or. stateVec( ixSnowSoilHyd(iLayer) ) > xMax) message=trim(message)//'layer water outside bounds,'
- if(.not.feasible) write(*,'(a,1x,i4,1x,L1,1x,10(f20.10,1x))') 'iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax = ', iLayer, feasible, stateVec( ixSnowSoilHyd(iLayer) ), xMin, xMax
-
- endif ! if water states
-
- end do ! loop through non-missing hydrology state variables in the snow+soil domain
-
- ! early return for non-feasible solutions
- if(.not.feasible)then
- fluxVec(:) = realMissing
- resVec(:) = quadMissing
- message=trim(message)//'non-feasible'
- err=20; return
- end if
-
- end if ! ( feasibility check )
-
- ! get the start and end indices for the soil compression calculations
- if(scalarSolution)then
- jState = pack(ixControlVolume, ixMapFull2Subset/=integerMissing)
- ixBeg = jState(1)
- ixEnd = jState(1)
- else
- ixBeg = 1
- ixEnd = nSoil
- endif
-
- ! save previous step
- scalarCanopyTempPrev = scalarCanopyTempTrial
- scalarCanopyIcePrev = scalarCanopyIceTrial
- scalarCanopyEnthalpyPrev = scalarCanopyEnthalpyTrial
- mLayerTempPrev = mLayerTempTrial
- mLayerMatricHeadPrev = mLayerMatricHeadTrial
- mLayerVolFracWatPrev = mLayerVolFracWatTrial
- mLayerVolFracIcePrev = mLayerVolFracIceTrial
- mLayerEnthalpyPrev = mLayerEnthalpyTrial
-
- ! 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
- scalarCanairTempTrial = realMissing ! scalarCanairTemp prognostic not up to date
- scalarCanopyWatTrial = realMissing ! scalarCanopyWat prognostic not up to date
- scalarCanopyLiqTrial = realMissing ! scalarCanopyLiq prognostic not up to date
- mLayerVolFracLiqTrial = realMissing ! mLayerVolFracLiq prognostic not up to date
- scalarAquiferStorageTrial= realMissing ! scalarAquiferStorage prognostic not up to date
-
- ! extract variables from the model state vector
- call varExtractSundials(&
- ! input
- stateVec, & ! 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)
-
- call updateVarsSundials(&
- ! input
- dt_cur, &
- .false., & ! intent(in): logical flag if computing Jacobian for Sundials solver
- .false., & ! intent(in): logical flag to adjust temperature to account for the energy
- mpar_data, & ! intent(in): model parameters for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- mLayerVolFracWatPrev, & ! intent(in): 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, & !
- 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,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! print the water content
- if(globalPrintFlag)then
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracWatTrial = ', mLayerVolFracWatTrial(iJac1:min(iJac2,nSnow))
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial(iJac1:min(iJac2,nSnow))
- if(iJac1<nSnow) write(*,'(a,10(f16.10,1x))') 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial(iJac1:min(iJac2,nSnow))
- endif
-
- if(updateCp)then
- ! *** compute volumetric heat capacity C_p
- if(model_decisions(iLookDECISIONS%howHeatCap)%iDecision == enthalpyFD)then
- ! compute H_T
- call t2enthalpy_T(&
+
+ if(updateCp)then
+ ! *** compute volumetric heat capacity C_p
+ if(model_decisions(iLookDECISIONS%howHeatCap)%iDecision == enthalpyFD)then
+ ! compute H_T
+ call t2enthalpy_T(&
! input: data structures
diag_data, & ! intent(in): model diagnostic variables for a local HRU
mpar_data, & ! intent(in): parameter data structure
@@ -522,350 +526,228 @@ module eval8summaSundials_module
mLayerEnthalpyTrial, & ! intent(out): enthalpy of each snow+soil layer (J m-3)
! output: error control
err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! *** compute volumetric heat capacity C_p = dH_T/dT
- call computHeatCap(&
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! *** compute volumetric heat capacity C_p = dH_T/dT
+ call computHeatCap(&
+ ! input: control variables
+ nLayers, & ! intent(in): number of layers (soil+snow)
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ ! input: state variables
+ scalarCanopyIceTrial, & ! intent(in): trial value for canopy ice content (kg m-2)
+ scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ scalarCanopyEnthalpyTrial, & ! intent(in): trial enthalpy of the vegetation canopy (J m-3)
+ scalarCanopyEnthalpyPrev, & ! intent(in): previous enthalpy of the vegetation canopy (J m-3)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerTempTrial, & ! intent(in): trial temperature
+ mLayerTempPrev, & ! intent(in): previous temperature
+ mLayerEnthalpyTrial, & ! intent(in): trial enthalpy for snow and soil
+ mLayerEnthalpyPrev, & ! intent(in): previous enthalpy for snow and soil
+ ! output
+ heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(out): heat capacity for snow and soil
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+ ! to conserve energy compute finite difference approximation of (theta_ice)'
+ if(dt_cur > 1e-14_rkind) then
+ scalarCanopyIcePrime = ( scalarCanopyIceTrial - scalarCanopyIcePrev ) / dt_cur
+ do concurrent (iLayer=1:nLayers)
+ mLayerVolFracIcePrime(iLayer) = ( mLayerVolFracIceTrial(iLayer) - mLayerVolFracIcePrev(iLayer) ) / dt_cur
+ end do
+ endif ! if dt_cur is not too samll
+ else ! if using closed formula of heat capacity
+ call computHeatCapAnalytic(&
! input: control variables
- 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
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
! input: state variables
- scalarCanopyIceTrial, & ! intent(in): trial value for canopy ice content (kg m-2)
- scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
- scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
- scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
- scalarCanopyEnthalpyTrial, & ! intent(in): trial enthalpy of the vegetation canopy (J m-3)
- scalarCanopyEnthalpyPrev, & ! intent(in): previous enthalpy of the vegetation canopy (J m-3)
- mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
- mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
- mLayerTempTrial, & ! intent(in): trial temperature
- mLayerTempPrev, & ! intent(in): previous temperature
- mLayerEnthalpyTrial, & ! intent(in): trial enthalpy for snow and soil
- mLayerEnthalpyPrev, & ! intent(in): previous enthalpy for snow and soil
+ scalarCanopyIceTrial, & ! intent(in)
+ scalarCanopyLiqTrial, & ! intent(in)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): fraction of liquid water at the start of the sub-step (-)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
! output
- heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
- mLayerHeatCapTrial, & ! intent(out): heat capacity for snow and soil
+ heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(out): volumetric heat capacity of soil and snow
! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- ! to conserve energy compute finite difference approximation of (theta_ice)'
- if(dt_cur > 1e-14_rkind) then
- scalarCanopyIcePrime = ( scalarCanopyIceTrial - scalarCanopyIcePrev ) / dt_cur
- do concurrent (iLayer=1:nLayers)
- mLayerVolFracIcePrime(iLayer) = ( mLayerVolFracIceTrial(iLayer) - mLayerVolFracIcePrev(iLayer) ) / dt_cur
- end do
- endif ! if dt_cur is not too samll
- else ! if using closed formula of heat capacity
- call computHeatCapAnalytic(&
- ! input: control variables
- computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- canopyDepth, & ! intent(in): canopy depth (m)
- ! input: state variables
- scalarCanopyIceTrial, & ! intent(in)
- scalarCanopyLiqTrial, & ! intent(in)
- mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
- mLayerVolFracLiqTrial, & ! intent(in): fraction of liquid water at the start of the sub-step (-)
- ! input data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model layer indices
- ! output
- heatCapVegTrial, & ! intent(out): volumetric heat capacity of vegetation canopy
- mLayerHeatCapTrial, & ! intent(out): volumetric heat capacity of soil and snow
- ! output: error control
- err,cmessage) ! intent(out): error control
- endif
-
- ! compute multiplier of state vector
- call computStatMult(&
- ! input
- heatCapVegTrial, & ! intent(in): volumetric heat capacity of vegetation canopy
- mLayerHeatCapTrial, & ! intent(in): volumetric heat capacity of soil and snow
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output
- sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- ! update thermal conductivity
- call computThermConduct(&
- ! input: control variables
- computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- canopyDepth, & ! intent(in): canopy depth (m)
- ! input: state variables
- scalarCanopyIceTrial, & ! intent(in)
- scalarCanopyLiqTrial, & ! intent(in)
- mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
- mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
- ! input/output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model layer indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=55; message=trim(message)//trim(cmessage); return; end if
-
- end if ! updateCp
-
-
- if(needCm)then
- ! compute C_m
- call computCm(&
- ! input: control variables
- computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- ! input: state variables
- scalarCanopyTempTrial, & ! intent(in)
- mLayerTempTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
- mLayerMatricHeadTrial, & ! intent(in)
- ! input data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model layer indices
+ err,cmessage) ! intent(out): error control
+ endif
+
+ ! compute multiplier of state vector
+ call computStatMult(&
+ ! input
+ heatCapVegTrial, & ! intent(in): volumetric heat capacity of vegetation canopy
+ mLayerHeatCapTrial, & ! intent(in): volumetric heat capacity of soil and snow
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
! output
- scalarCanopyCmTrial, & ! intent(out): Cm for vegetation
- mLayerCmTrial, & ! intent(out): Cm for soil and snow
- err,cmessage) ! intent(out): error control
- else
- scalarCanopyCmTrial = 0._qp
- mLayerCmTrial = 0._qp
- end if ! needCm
-
-
- ! save the number of flux calls per time step
- indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) = indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) + 1
- ! compute the fluxes for a given state vector
- call computFlux(&
- ! input-output: model control
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- firstFluxCall, & ! intent(inout): flag to denote the first flux call
- firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- insideIDA, & ! intent(in): logical flag if inside Sundials solver
- scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
- ! input: state variables
- scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
- scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
- mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
- mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
- mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
- scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
- ! input: diagnostic variables defining the liquid water and ice content
- scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
- scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
- mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each snow and soil layer (-)
- mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): index data
- ! input-output: data structures
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- deriv_data, & ! intent(out): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: flux vector and baseflow derivatives
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later in computeJacobSundials
- fluxVec, & ! intent(out): flux vector (mixed units)
- ! output: error control
- err,cmessage) ! intent(out): error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- firstSplitOper = .true.
-
-
- ! compute soil compressibility (-) and its derivative w.r.t. matric head (m)
- ! NOTE: we already extracted trial matrix head and volumetric liquid water as part of the flux calculations
- call soilCmpresSundials(&
- ! input:
- ixRichards, & ! intent(in): choice of option for Richards' equation
- ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
- mLayerMatricHeadPrime(1:nSoil), & ! intent(in): matric head at the start of the time step (m)
- mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
- mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
- specificStorage, & ! intent(in): specific storage coefficient (m-1)
- theta_sat, & ! intent(in): soil porosity (-)
- ! output:
- mLayerCompress, & ! intent(inout): compressibility of the soil matrix (-)
- dCompress_dPsi, & ! intent(inout): derivative in compressibility w.r.t. matric head (m-1)
- err,cmessage) ! intent(out): error code and error message
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- ! print *, 'dt = ', dt
- ! print *, 'dt_cur = ', dt_cur
-
- ! compute the residual vector
- call computResidSundials(&
- ! input: model control
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! update thermal conductivity
+ call computThermConduct(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ canopyDepth, & ! intent(in): canopy depth (m)
+ ! input: state variables
+ scalarCanopyIceTrial, & ! intent(in)
+ scalarCanopyLiqTrial, & ! intent(in)
+ mLayerVolFracIceTrial, & ! intent(in): volumetric fraction of ice at the start of the sub-step (-)
+ mLayerVolFracLiqTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ ! input/output: data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; err=55; message=trim(message)//trim(cmessage); return; end if
+
+ end if ! updateCp
+
+
+ if(needCm)then
+ ! compute C_m
+ call computCm(&
+ ! input: control variables
+ computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
+ ! input: state variables
+ scalarCanopyTempTrial, & ! intent(in)
+ mLayerTempTrial, & ! intent(in): volumetric fraction of liquid water at the start of the sub-step (-)
+ mLayerMatricHeadTrial, & ! intent(in)
+ ! input data structures
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(in): model layer indices
+ ! output
+ scalarCanopyCmTrial, & ! intent(out): Cm for vegetation
+ mLayerCmTrial, & ! intent(out): Cm for soil and snow
+ err,cmessage) ! intent(out): error control
+ else
+ scalarCanopyCmTrial = 0._qp
+ mLayerCmTrial = 0._qp
+ end if ! needCm
+
+
+ ! save the number of flux calls per time step
+ indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) = indx_data%var(iLookINDEX%numberFluxCalc)%dat(1) + 1
+ ! compute the fluxes for a given state vector
+ call computFlux(&
+ ! input-output: model control
nSnow, & ! intent(in): number of snow layers
nSoil, & ! intent(in): number of soil layers
nLayers, & ! intent(in): total number of layers
- ! input: flux vectors
- sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
- fluxVec, & ! intent(in): flux vector
- ! input: state variables (already disaggregated into scalars and vectors)
- scalarCanopyTempTrial, & ! intent(in):
- mLayerTempTrial, & ! intent(in)
- scalarCanairTempPrime, & ! intent(in): Prime value for the temperature of the canopy air space (K)
- scalarCanopyTempPrime, & ! intent(in): Prime value for the temperature of the vegetation canopy (K)
- scalarCanopyWatPrime, &
- mLayerTempPrime, & ! intent(in): Prime value for the temperature of each snow and soil layer (K)
- scalarAquiferStoragePrime, & ! intent(in): Prime value of storage of water in the aquifer (m)
- ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
- scalarCanopyIcePrime, & ! intent(in): Prime value for the ice on the vegetation canopy (kg m-2)
- scalarCanopyLiqPrime, & ! intent(in):
- mLayerVolFracIcePrime, & ! intent(in): Prime value for the volumetric ice in each snow and soil layer (-)
- mLayerVolFracWatPrime, &
- mLayerVolFracLiqPrime, &
- scalarCanopyCmTrial, & ! intent(in) Cm of vegetation canopy
- mLayerCmTrial, & ! intent(in) Cm of soil and snow
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to denote the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ insideIDA, & ! intent(in): logical flag if inside Sundials solver
+ scalarSfcMeltPond/dt, & ! intent(in): drainage from the surface melt pond (kg m-2 s-1)
+ ! input: state variables
+ scalarCanairTempTrial, & ! intent(in): trial value for the temperature of the canopy air space (K)
+ scalarCanopyTempTrial, & ! intent(in): trial value for the temperature of the vegetation canopy (K)
+ mLayerTempTrial, & ! intent(in): trial value for the temperature of each snow and soil layer (K)
+ mLayerMatricHeadLiqTrial, & ! intent(in): trial value for the liquid water matric potential in each soil layer (m)
+ mLayerMatricHeadTrial, & ! intent(in): trial vector of total water matric potential (m)
+ scalarAquiferStorageTrial, & ! intent(in): trial value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content
+ scalarCanopyLiqTrial, & ! intent(in): trial value for the liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyIceTrial, & ! intent(in): trial value for the ice on the vegetation canopy (kg m-2)
+ mLayerVolFracLiqTrial, & ! intent(in): trial value for the volumetric liquid water content in each snow and soil layer (-)
+ mLayerVolFracIceTrial, & ! intent(in): trial value for the volumetric ice in each snow and soil layer (-)
! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- flux_data, & ! intent(in): model fluxes for a local HRU
indx_data, & ! intent(in): index data
- ! output
- resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- resVec, & ! intent(out): residual vector
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- !print *, '====================================================================================='
-
- ! end association with the information in the data structures
- end associate
-
- end subroutine eval8summaSundials
-
-
- ! **********************************************************************************************************
- ! public function eval8summa4IDA: compute the residual vector F(t,y,y') required for IDA solver
- ! **********************************************************************************************************
- ! Return values:
- ! 0 = success,
- ! 1 = recoverable error,
- ! -1 = non-recoverable error
- ! ----------------------------------------------------------------
- integer(c_int) function eval8summa4IDA(tres, sunvec_y, sunvec_yp, sunvec_r, user_data) &
- result(ierr) bind(C,name='eval8summa4IDA')
-
- !======= Inclusions ===========
- use, intrinsic :: iso_c_binding
- use fida_mod
- use fsundials_nvector_mod
- use fnvector_serial_mod
- use nrtype
- use type4IDA
-
- !======= Declarations =========
- implicit none
-
- ! calling variables
- real(rkind), value :: tres ! current time t
- type(N_Vector) :: sunvec_y ! solution N_Vector y
- type(N_Vector) :: sunvec_yp ! derivative N_Vector y'
- type(N_Vector) :: sunvec_r ! residual N_Vector F(t,y,y')
- type(c_ptr), value :: user_data ! user-defined data
-
-
- ! pointers to data in SUNDIALS vectors
- type(eqnsData), pointer :: eqns_data ! equations data
- real(rkind), pointer :: stateVec(:)
- real(rkind), pointer :: stateVecPrime(:)
- real(rkind), pointer :: rVec(:)
- logical(lgt) :: feasible
- integer(i4b) :: retval
- real(c_double) :: stepsize_next(1)
- !======= Internals ============
-
- ! get equations data from user-defined data
- call c_f_pointer(user_data, eqns_data)
-
- ! get data arrays from SUNDIALS vectors
- stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
- stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
- rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
-
- retval = FIDAGetCurrentStep(eqns_data%ida_mem, stepsize_next)
- if (retval /= 0) then
- print *, 'Error in FIDAGetCurrentStep, retval = ', retval, '; halting'
- stop 1
- end if
-
- ! compute the flux and the residual vector for a given state vector
- call eval8summaSundials(&
- ! input: model control
- stepsize_next(1), & ! intent(in): current stepsize
- eqns_data%dt, & ! intent(in): data step
- eqns_data%nSnow, & ! intent(in): number of snow layers
- eqns_data%nSoil, & ! intent(in): number of soil layers
- eqns_data%nLayers, & ! intent(in): number of layers
- eqns_data%nState, & ! intent(in): number of state variables in the current subset
- .true., & ! intent(in): inside Sundials solver
- eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
- eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVec, & ! intent(in): model state vector
- stateVecPrime, & ! intent(in): model state vector
- eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- eqns_data%lookup_data, & ! intent(in): lookup data
- eqns_data%type_data, & ! intent(in): type of vegetation and soil
- eqns_data%attr_data, & ! intent(in): spatial attributes
- eqns_data%mpar_data, & ! intent(in): model parameters
- eqns_data%forc_data, & ! intent(in): model forcing data
- eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
- eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- eqns_data%indx_data, & ! intent(inou): index data
- eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
- eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: here we need to pass some extra variables that do not get updated in in the Sundials loops
- eqns_data%scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
- eqns_data%scalarCanopyIceTrial, & ! intent(inout): trial value for mass of ice on the vegetation canopy (kg m-2)
- eqns_data%scalarCanopyEnthalpyTrial,& ! intent(inout): trial value for enthalpy of the vegetation canopy (J m-3)
- eqns_data%mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
- eqns_data%mLayerMatricHeadTrial, & ! intent(inout): trial value for total water matric potential (m)
- eqns_data%mLayerMatricHeadLiqTrial, & ! intent(inout): trial value for liquid water matric potential (m)
- eqns_data%mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
- eqns_data%mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
- eqns_data%mLayerEnthalpyTrial, & ! intent(inout): trial vector of enthalpy for snow+soil layers (J m-3)
- ! input-output: baseflow
- eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
- eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- feasible, & ! intent(out): flag to denote the feasibility of the solution
- eqns_data%fluxVec, & ! intent(out): flux vector
- eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- rVec, & ! intent(out): residual vector
- eqns_data%err,eqns_data%message) ! intent(out): error control
-
- if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
- if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
- if(.not.feasible)then; eqns_data%message=trim(eqns_data%message)//'state vector not feasible'; ierr = 1; return; endif
-
- ! return success
- ierr = 0
- return
-
- end function eval8summa4IDA
-
- end module eval8summaSundials_module
-
\ No newline at end of file
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ deriv_data, & ! intent(out): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: flux vector and baseflow derivatives
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later in computeJacobSundials
+ fluxVec, & ! intent(out): flux vector (mixed units)
+ ! output: error control
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ firstSplitOper = .true.
+
+
+ ! compute soil compressibility (-) and its derivative w.r.t. matric head (m)
+ ! NOTE: we already extracted trial matrix head and volumetric liquid water as part of the flux calculations
+ call soilCmpresSundials(&
+ ! input:
+ ixRichards, & ! intent(in): choice of option for Richards' equation
+ ixBeg,ixEnd, & ! intent(in): start and end indices defining desired layers
+ mLayerMatricHeadPrime(1:nSoil), & ! intent(in): matric head at the start of the time step (m)
+ mLayerVolFracLiqTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric liquid water content in each soil layer (-)
+ mLayerVolFracIceTrial(nSnow+1:nLayers), & ! intent(in): trial value for the volumetric ice content in each soil layer (-)
+ specificStorage, & ! intent(in): specific storage coefficient (m-1)
+ theta_sat, & ! intent(in): soil porosity (-)
+ ! output:
+ mLayerCompress, & ! intent(inout): compressibility of the soil matrix (-)
+ dCompress_dPsi, & ! intent(inout): derivative in compressibility w.r.t. matric head (m-1)
+ err,cmessage) ! intent(out): error code and error message
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ ! compute the residual vector
+ call computResidSundials(&
+ ! input: model control
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ ! input: flux vectors
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ fluxVec, & ! intent(in): flux vector
+ ! input: state variables (already disaggregated into scalars and vectors)
+ scalarCanopyTempTrial, & ! intent(in):
+ mLayerTempTrial, & ! intent(in)
+ scalarCanairTempPrime, & ! intent(in): Prime value for the temperature of the canopy air space (K)
+ scalarCanopyTempPrime, & ! intent(in): Prime value for the temperature of the vegetation canopy (K)
+ scalarCanopyWatPrime, &
+ mLayerTempPrime, & ! intent(in): Prime value for the temperature of each snow and soil layer (K)
+ scalarAquiferStoragePrime, & ! intent(in): Prime value of storage of water in the aquifer (m)
+ ! input: diagnostic variables defining the liquid water and ice content (function of state variables)
+ scalarCanopyIcePrime, & ! intent(in): Prime value for the ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(in):
+ mLayerVolFracIcePrime, & ! intent(in): Prime value for the volumetric ice in each snow and soil layer (-)
+ mLayerVolFracWatPrime, &
+ mLayerVolFracLiqPrime, &
+ scalarCanopyCmTrial, & ! intent(in) Cm of vegetation canopy
+ mLayerCmTrial, & ! intent(in) Cm of soil and snow
+ ! input: data structures
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ flux_data, & ! intent(in): model fluxes for a local HRU
+ indx_data, & ! intent(in): index data
+ ! output
+ resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ resVec, & ! intent(out): residual vector
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+
+ ! end association with the information in the data structures
+ end associate
+
+end subroutine eval8summaSundials
+end module eval8summaSundials_module
diff --git a/build/source/engine/sundials/evalDAE4IDA.f90 b/build/source/engine/sundials/evalDAE4IDA.f90
new file mode 100644
index 0000000..0199be1
--- /dev/null
+++ b/build/source/engine/sundials/evalDAE4IDA.f90
@@ -0,0 +1,165 @@
+module evalDAE4IDA_module
+
+
+!======= Inclusions ===========
+use, intrinsic :: iso_c_binding
+use nrtype
+use type4IDA
+USE globalData,only:model_decisions ! model decision structure
+USE globalData,only:flux_meta ! metadata on the model fluxes
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+USE multiconst,only:iden_water ! intrinsic density of liquid water (kg m-3)
+USE var_lookup,only:iLookDIAG
+USE var_lookup,only:iLookPROG
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+
+! privacy
+implicit none
+private
+public::evalDAE4IDA
+
+
+contains
+
+! **********************************************************************************************************
+! public function evalDAE4IDA: compute the residual vector F(t,y,y') required for IDA solver
+! **********************************************************************************************************
+! Return values:
+! 0 = success,
+! 1 = recoverable error,
+! -1 = non-recoverable error
+! ----------------------------------------------------------------
+integer(c_int) function evalDAE4IDA(tres, sunvec_y, sunvec_yp, sunvec_r, user_data) &
+ result(ierr) bind(C,name='evalDAE4IDA')
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use fida_mod
+ use fsundials_nvector_mod
+ use fnvector_serial_mod
+ use nrtype
+ use type4IDA
+ use eval8summaSundials_module,only:eval8summaSundials
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind), value :: tres ! current time t
+ type(N_Vector) :: sunvec_y ! solution N_Vector y
+ type(N_Vector) :: sunvec_yp ! derivative N_Vector y'
+ type(N_Vector) :: sunvec_r ! residual N_Vector F(t,y,y')
+ type(c_ptr), value :: user_data ! user-defined data
+
+
+ ! pointers to data in SUNDIALS vectors
+ type(eqnsData), pointer :: eqns_data ! equations data
+ real(rkind), pointer :: stateVec(:)
+ real(rkind), pointer :: stateVecPrime(:)
+ real(rkind), pointer :: rVec(:)
+ logical(lgt) :: feasible
+ integer(i4b) :: retval
+ real(c_double) :: stepsize_next(1)
+ !======= Internals ============
+
+ ! get equations data from user-defined data
+ call c_f_pointer(user_data, eqns_data)
+
+ ! get data arrays from SUNDIALS vectors
+ stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
+ stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
+ rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
+
+ retval = FIDAGetCurrentStep(eqns_data%ida_mem, stepsize_next)
+ if (retval /= 0) then
+ print *, 'Error in FIDAGetCurrentStep, retval = ', retval, '; halting'
+ stop 1
+ end if
+
+ ! compute the flux and the residual vector for a given state vector
+ call eval8summaSundials(&
+ ! input: model control
+ stepsize_next(1), & ! intent(in): current stepsize
+ eqns_data%dt, & ! intent(in): data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%nState, & ! intent(in): number of state variables in the current subset
+ .true., & ! intent(in): inside Sundials solver
+ eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%lookup_data, & ! intent(in): lookup data
+ eqns_data%type_data, & ! intent(in): type of vegetation and soil
+ eqns_data%attr_data, & ! intent(in): spatial attributes
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%forc_data, & ! intent(in): model forcing data
+ eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inou): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later for Jacobian
+ eqns_data%scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ eqns_data%scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ eqns_data%scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%scalarCanopyEnthalpyPrev, & ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ eqns_data%mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ eqns_data%mLayerMatricHeadLiqTrial,& ! intent(out): trial value for liquid water matric potential (m)
+ eqns_data%mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ eqns_data%mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ eqns_data%mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ eqns_data%mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ eqns_data%scalarAquiferStorageTrial, & ! intent(out): trial value of storage of water in the aquifer (m)
+ eqns_data%scalarAquiferStoragePrev, & ! intent(in): value of storage of water in the aquifer (m)
+ eqns_data%mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ eqns_data%fluxVec, & ! intent(out): flux vector
+ eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
+ if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
+ if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
+ if(.not.feasible)then; eqns_data%message=trim(eqns_data%message)//'state vector not feasible'; ierr = 1; return; endif
+
+ ! return success
+ ierr = 0
+ return
+
+end function evalDAE4IDA
+
+
+end module evalDAE4IDA_module
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/evalJac4IDA.f90 b/build/source/engine/sundials/evalJac4IDA.f90
new file mode 100644
index 0000000..97a877d
--- /dev/null
+++ b/build/source/engine/sundials/evalJac4IDA.f90
@@ -0,0 +1,132 @@
+module evalJac4IDA_module
+
+
+!======= Inclusions ===========
+use, intrinsic :: iso_c_binding
+use nrtype
+use type4IDA
+USE globalData,only:model_decisions ! model decision structure
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+
+
+! privacy
+implicit none
+private
+public::evalJac4IDA
+
+
+contains
+
+! **********************************************************************************************************
+! public function evalJac4IDA: the interface to compute the Jacobian matrix dF/dy + c dF/dy' for IDA solver
+! **********************************************************************************************************
+! Return values:
+! 0 = success,
+! 1 = recoverable error,
+! -1 = non-recoverable error
+! ----------------------------------------------------------------
+integer(c_int) function evalJac4IDA(t, cj, sunvec_y, sunvec_yp, sunvec_r, &
+ sunmat_J, user_data, sunvec_temp1, sunvec_temp2, sunvec_temp3) &
+ result(ierr) bind(C,name='evalJac4IDA')
+
+ !======= Inclusions ===========
+ use, intrinsic :: iso_c_binding
+ use fsundials_nvector_mod
+ use fsundials_matrix_mod
+ use fnvector_serial_mod
+ use fsunmatrix_band_mod
+ use fsunmatrix_dense_mod
+ use nrtype
+ use type4IDA
+ use eval8JacDAE_module,only:eval8JacDAE ! compute Jacobian matrix
+ USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+ USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+ USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind), value :: t ! current time
+ real(rkind), value :: cj ! step size scaling factor
+ type(N_Vector) :: sunvec_y ! solution N_Vector
+ type(N_Vector) :: sunvec_yp ! derivative N_Vector
+ type(N_Vector) :: sunvec_r ! residual N_Vector
+ type(SUNMatrix) :: sunmat_J ! Jacobian SUNMatrix
+ type(c_ptr), value :: user_data ! user-defined data
+ type(N_Vector) :: sunvec_temp1 ! temporary N_Vector
+ type(N_Vector) :: sunvec_temp2 ! temporary N_Vector
+ type(N_Vector) :: sunvec_temp3 ! temporary N_Vector
+
+ ! pointers to data in SUNDIALS vectors
+ real(rkind), pointer :: stateVec(:) ! state vector
+ real(rkind), pointer :: stateVecPrime(:)! derivative of the state vector
+ real(rkind), pointer :: rVec(:) ! residual vector
+ real(rkind), pointer :: Jac(:,:) ! Jacobian matrix
+ type(eqnsData), pointer :: eqns_data ! equations data
+
+
+
+ !======= Internals ============
+
+ ! get equations data from user-defined data
+ call c_f_pointer(user_data, eqns_data)
+
+
+ ! get data arrays from SUNDIALS vectors
+ stateVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_y)
+ stateVecPrime(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_yp)
+ rVec(1:eqns_data%nState) => FN_VGetArrayPointer(sunvec_r)
+ if (eqns_data%ixMatrix==ixBandMatrix) Jac(1:nBands, 1:eqns_data%nState) => FSUNBandMatrix_Data(sunmat_J)
+ if (eqns_data%ixMatrix==ixFullMatrix) Jac(1:eqns_data%nState, 1:eqns_data%nState) => FSUNDenseMatrix_Data(sunmat_J)
+
+ ! compute Jacobian matrix
+ call eval8JacDAE(&
+ ! input: model control
+ cj, & ! intent(in): this scalar changes whenever the step size or method order changes
+ eqns_data%dt, & ! intent(in): data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inou): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input: baseflow
+ eqns_data%dBaseflow_dMatric, & ! intent(in): derivative in baseflow w.r.t. matric head (s-1)
+ ! output
+ eqns_data%dMat, & ! intetn(inout): diagonal of the Jacobian matrix
+ Jac, & ! intent(out): Jacobian matrix
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
+ if(eqns_data%err > 0)then; eqns_data%message=trim(eqns_data%message); ierr=-1; return; endif
+ if(eqns_data%err < 0)then; eqns_data%message=trim(eqns_data%message); ierr=1; return; endif
+
+ ! return success
+ ierr = 0
+ return
+
+
+
+end function evalJac4IDA
+
+
+end module evalJac4IDA_module
+
\ No newline at end of file
diff --git a/build/source/engine/sundials/getVectorzAddSundials.f90 b/build/source/engine/sundials/getVectorzAddSundials.f90
index e205e87..16cdb0a 100644
--- a/build/source/engine/sundials/getVectorzAddSundials.f90
+++ b/build/source/engine/sundials/getVectorzAddSundials.f90
@@ -1,256 +1,246 @@
+module getVectorzAddSundials_module
+! data types
+USE nrtype
-module getVectorzAddSundials_module
+! missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing real number
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! domain types
+USE globalData,only:iname_cas ! named variables for canopy air space
+USE globalData,only:iname_veg ! named variables for vegetation canopy
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! named variables to describe the state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:iname_watAquifer ! named variable defining the water storage in the aquifer
+
+! metadata for information in the data structures
+USE globalData,only:indx_meta ! metadata for the variables in the index structure
+
+! constants
+USE multiconst,only:&
+ gravity, & ! acceleration of gravity (m s-2)
+ Tfreeze, & ! temperature at freezing (K)
+ Cp_air, & ! specific heat of air (J kg-1 K-1)
+ LH_fus, & ! latent heat of fusion (J kg-1)
+ iden_air, & ! intrinsic density of air (kg m-3)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength ! data vector with variable length dimension (rkind)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+! provide access to routines to update states
+USE updatState_module,only:updateSnow ! update snow states
+USE updatState_module,only:updateSoil ! update soil states
- ! data types
- USE nrtype
-
- ! missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing real number
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! domain types
- USE globalData,only:iname_cas ! named variables for canopy air space
- USE globalData,only:iname_veg ! named variables for vegetation canopy
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! named variables to describe the state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
- USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
- USE globalData,only:iname_watAquifer ! named variable defining the water storage in the aquifer
-
- ! metadata for information in the data structures
- USE globalData,only:indx_meta ! metadata for the variables in the index structure
-
- ! constants
- USE multiconst,only:&
- gravity, & ! acceleration of gravity (m s-2)
- Tfreeze, & ! temperature at freezing (K)
- Cp_air, & ! specific heat of air (J kg-1 K-1)
- LH_fus, & ! latent heat of fusion (J kg-1)
- iden_air, & ! intrinsic density of air (kg m-3)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! provide access to the derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength ! data vector with variable length dimension (rkind)
-
- ! provide access to indices that define elements of the data structures
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
-
- ! provide access to routines to update states
- USE updatState_module,only:updateSnow ! update snow states
- USE updatState_module,only:updateSoil ! update soil states
-
- ! provide access to functions for the constitutive functions and derivatives
- USE snow_utils_module,only:fracliquid ! compute the fraction of liquid water (snow)
- USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
- USE soil_utils_module,only:dTheta_dTk ! differentiate the freezing curve w.r.t. temperature (soil)
- USE soil_utils_module,only:dTheta_dPsi ! derivative in the soil water characteristic (soil)
- USE soil_utils_module,only:dPsi_dTheta ! derivative in the soil water characteristic (soil)
- USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
- USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
- USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
- USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
-
+! provide access to functions for the constitutive functions and derivatives
+USE snow_utils_module,only:fracliquid ! compute the fraction of liquid water (snow)
+USE snow_utils_module,only:dFracLiq_dTk ! differentiate the freezing curve w.r.t. temperature (snow)
+USE soil_utils_module,only:dTheta_dTk ! differentiate the freezing curve w.r.t. temperature (soil)
+USE soil_utils_module,only:dTheta_dPsi ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:dPsi_dTheta ! derivative in the soil water characteristic (soil)
+USE soil_utils_module,only:matricHead ! compute the matric head based on volumetric water content
+USE soil_utils_module,only:volFracLiq ! compute volumetric fraction of liquid water
+USE soil_utils_module,only:crit_soilT ! compute critical temperature below which ice exists
+USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
+
+implicit none
+private
+public::residDiscontinuity
+public::countDiscontinuity
+contains
+
+
+
+! **********************************************************************************************************
+! public subroutine residDiscontinuity:
+! **********************************************************************************************************
+subroutine residDiscontinuity(&
+ ! input
+ stateVec, & ! intent(in): model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ resid, & ! intent(out)
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
implicit none
- private
- public::varExtractSundials
-
-
- contains
-
- ! **********************************************************************************************************
- ! public subroutine varExtractSundials: extract state prime state variables from the state vector and compute diagnostic variables
- ! This routine does not initialize any of the variables, needs to be done inside calling routine
- ! **********************************************************************************************************
- subroutine varExtractSundials(&
- ! input
- stateVec, & ! 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): trial value of canopy air temperature (K)
- 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)
- ! 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): trial vector of layer temperature (K)
- mLayerVolFracWatPrime, & ! intent(inout): trial vector of volumetric total water content (-)
- mLayerVolFracLiqPrime, & ! intent(inout): trial vector of volumetric liquid water content (-)
- mLayerMatricHeadPrime, & ! intent(inout): trial vector of total water matric potential (m)
- mLayerMatricHeadLiqPrime, & ! intent(inout): trial vector 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): trial value of storage of water in the aquifer (m)
- ! output: error control
- err,message) ! intent(out): error control
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
- implicit none
- ! input
- real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
- real(rkind),intent(in) :: stateVecPrime(:) ! model state vector (mixed units)
- type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
- ! output: variables for the vegetation canopy
- real(rkind),intent(inout) :: scalarCanairTempTrial ! trial value of canopy air temperature (K)
- 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) :: scalarCanairTempPrime ! trial value of canopy air temperature (K)
- real(rkind),intent(inout) :: scalarCanopyTempPrime ! trial value of canopy temperature (K)
- real(rkind),intent(inout) :: scalarCanopyWatPrime ! trial value of canopy total water (kg m-2)
- real(rkind),intent(inout) :: scalarCanopyLiqPrime ! trial value of canopy liquid water (kg m-2)
- ! 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) :: 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 layer temperature (K)
- real(rkind),intent(inout) :: mLayerVolFracWatPrime(:) ! trial vector of volumetric total water content (-)
- real(rkind),intent(inout) :: mLayerVolFracLiqPrime(:) ! trial vector of volumetric liquid water content (-)
- real(rkind),intent(inout) :: mLayerMatricHeadPrime(:) ! trial vector of total water matric potential (m)
- real(rkind),intent(inout) :: mLayerMatricHeadLiqPrime(:)! trial vector of liquid water matric potential (m)
- ! output: variables for the aquifer
- real(rkind),intent(inout) :: scalarAquiferStorageTrial ! trial value of storage of water in the aquifer (m)
- real(rkind),intent(inout) :: scalarAquiferStoragePrime ! trial value of storage of water in the aquifer (m)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- integer(i4b) :: iLayer ! index of layer within the snow+soil domain
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! make association with variables in the data structures
- associate(&
- ! number of model layers, and layer type
- nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
- nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
- nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
- ! indices defining model states and layers
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
- nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
- nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
- ! indices defining type of model state variables
- ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- ) ! association with variables in the data structures
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! --------------------------------------------------------------------------------------------------------------------------------
-
- ! initialize error control
- err=0; message='varExtractSundials/'
-
-
- ! check if computing the vegetation flux
- if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing .or. ixVegHyd/=integerMissing)then
-
- ! extract temperature of the canopy air space
- if(ixCasNrg/=integerMissing)then
- scalarCanairTempTrial = stateVec(ixCasNrg)
- scalarCanairTempPrime = stateVecPrime(ixCasNrg)
- endif
-
- ! extract canopy temperature
- if(ixVegNrg/=integerMissing) then
- scalarCanopyTempTrial = stateVec(ixVegNrg)
- scalarCanopyTempPrime = stateVecPrime(ixVegNrg)
+ ! input
+ real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ real(qp),intent(out) :: resid(:)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ integer(i4b) :: iCount
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ )! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='residDiscontinuity/'
+
+ iCount = 1
+
+
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing)then
+
+ ! temperature of the canopy air space
+ if(ixCasNrg/=integerMissing)then
+ resid(iCount) = stateVec(ixCasNrg) - Tfreeze ! scalarCanairTempTrial - Tfreeze
+ iCount = iCount + 1
+ endif
+
+ ! canopy temperature
+ if(ixVegNrg/=integerMissing)then
+ resid(iCount) = stateVec(ixVegNrg) - Tfreeze ! scalarCanopyTempTrial - Tfreeze
+ iCount = iCount + 1
+ endif
+
+ endif ! not computing the vegetation flux
+
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ resid( iCount ) = stateVec( ixSnowSoilNrg(iLayer) ) - Tfreeze ! mLayerTempTrial(iLayer) - Tfreeze
+ iCount = iCount + 1
+ end do ! looping through non-missing energy state variables in the snow+soil domain
endif
-
- ! extract intercepted water
- if(ixVegHyd/=integerMissing)then
- select case( ixStateType_subset(ixVegHyd) )
- case(iname_liqCanopy)
- scalarCanopyLiqTrial = stateVec(ixVegHyd)
- scalarCanopyLiqPrime = stateVecPrime(ixVegHyd)
- case(iname_watCanopy)
- scalarCanopyWatTrial = stateVec(ixVegHyd)
- scalarCanopyWatPrime = stateVecPrime(ixVegHyd)
- case default; err=20; message=trim(message)//'case not found: expect iname_liqCanopy or iname_watCanopy'; return
- end select
+
+ end associate
+end subroutine residDiscontinuity
+
+! **********************************************************************************************************
+! public subroutine countDiscontinuity:
+! **********************************************************************************************************
+subroutine countDiscontinuity(&
+ ! input
+ stateVec, & ! intent(in): model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ countD, & ! intent(out)
+ err,message) ! intent(out): error control
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ implicit none
+ ! input
+ real(rkind),intent(in) :: stateVec(:) ! model state vector (mixed units)
+ type(var_dlength),intent(in) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_ilength),intent(in) :: indx_data ! indices defining model states and layers
+ integer(i4b),intent(out) :: countD
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ integer(i4b) :: iLayer ! index of layer within the snow+soil domain
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! make association with variables in the data structures
+ associate(&
+ ! number of model layers, and layer type
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] total number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] total number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) ,& ! intent(in): [i4b] total number of snow and soil layers
+ ! indices defining model states and layers
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ ixAqWat => indx_data%var(iLookINDEX%ixAqWat)%dat(1) ,& ! intent(in): [i4b] index of the squifer storage state variable
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for energy states in the snow+soil subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices IN THE STATE SUBSET for hydrology states in the snow+soil subdomain
+ nSnowSoilNrg => indx_data%var(iLookINDEX%nSnowSoilNrg )%dat(1) ,& ! intent(in): [i4b] number of energy state variables in the snow+soil domain
+ nSnowSoilHyd => indx_data%var(iLookINDEX%nSnowSoilHyd )%dat(1) ,& ! intent(in): [i4b] number of hydrology variables in the snow+soil domain
+ ! indices defining type of model state variables
+ ixStateType_subset => indx_data%var(iLookINDEX%ixStateType_subset)%dat ,& ! intent(in): [i4b(:)] [state subset] type of desired model state variables
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat & ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ )! association with variables in the data structures
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! --------------------------------------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message='countDiscontinuity/'
+
+ ! *** extract state variables for the vegetation canopy
+
+ countD = 0
+ ! check if computing the vegetation flux
+ if(ixCasNrg/=integerMissing .or. ixVegNrg/=integerMissing)then
+
+ ! temperature of the canopy air space
+ if(ixCasNrg/=integerMissing) countD = countD + 1
+
+ ! canopy temperature
+ if(ixVegNrg/=integerMissing) countD = countD + 1
+
+
+ endif ! not computing the vegetation flux
+
+ if(nSnowSoilNrg>0)then
+ do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
+ countD = countD + 1
+ end do ! looping through non-missing energy state variables in the snow+soil domain
endif
-
- endif ! not computing the vegetation flux
-
-
- ! overwrite with the energy values from the state vector
- if(nSnowSoilNrg>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilNrg(iLayer)/=integerMissing) ! (loop through non-missing energy state variables in the snow+soil domain)
- mLayerTempTrial(iLayer) = stateVec( ixSnowSoilNrg(iLayer) )
- mLayerTempPrime(iLayer) = stateVecPrime( ixSnowSoilNrg(iLayer) )
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! overwrite with the hydrology values from the state vector
- if(nSnowSoilHyd>0)then
- do concurrent (iLayer=1:nLayers,ixSnowSoilHyd(iLayer)/=integerMissing) ! (loop through non-missing hydrology state variables in the snow+soil domain)
- select case( ixHydType(iLayer) )
- case(iname_watLayer)
- mLayerVolFracWatTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
- mLayerVolFracWatPrime(iLayer) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! total water state variable for snow+soil layers
- case(iname_liqLayer)
- mLayerVolFracLiqTrial(iLayer) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
- mLayerVolFracLiqPrime(iLayer) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! liquid water state variable for snow+soil layers
- case(iname_matLayer)
- mLayerMatricHeadTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
- mLayerMatricHeadPrime(iLayer-nSnow) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! total water matric potential variable for soil layers
- case(iname_lmpLayer)
- mLayerMatricHeadLiqTrial(iLayer-nSnow) = stateVec( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
- mLayerMatricHeadLiqPrime(iLayer-nSnow) = stateVecPrime( ixSnowSoilHyd(iLayer) ) ! liquid matric potential state variable for soil layers
- case default ! do nothing
- end select
- end do ! looping through non-missing energy state variables in the snow+soil domain
- endif
-
- ! extract temperature of the canopy air space
- if(ixAqWat/=integerMissing)then
- scalarAquiferStorageTrial = stateVec(ixAqWat)
- scalarAquiferStoragePrime = stateVecPrime(ixAqWat)
- endif
-
- end associate
-
- end subroutine varExtractSundials
-
-
- end module getVectorzAddSundials_module
+
+ end associate
+
+end subroutine countDiscontinuity
+
+end module getVectorzAddSundials_module
\ No newline at end of file
diff --git a/build/source/engine/sundials/summaSolveSundialsIDA.f90 b/build/source/engine/sundials/summaSolveSundialsIDA.f90
index 48cfe32..79b9dba 100644
--- a/build/source/engine/sundials/summaSolveSundialsIDA.f90
+++ b/build/source/engine/sundials/summaSolveSundialsIDA.f90
@@ -4,699 +4,729 @@
module summaSolveSundialsIDA_module
+!======= Inclusions ===========
+USE, intrinsic :: iso_c_binding
+USE nrtype
+USE type4IDA
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access matrix information
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+USE globalData,only: ku ! number of super-diagonal bands
+USE globalData,only: kl ! number of sub-diagonal bands
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+USE globalData,only:model_decisions ! model decision structure
+
+! global metadata
+USE globalData,only:flux_meta ! metadata on the model fluxes
+USE globalData,only:diag_meta ! metadata on the model diagnostic variables
+USE globalData,only:prog_meta ! metadata on the model prognostic variables
+USE globalData,only:deriv_meta ! metadata on the model derivatives
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J K-1)
+ LH_sub, & ! latent heat of sublimation (J kg-1)
+ Tfreeze, & ! temperature at freezing (K)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup ! data vector
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: qbaseTopmodel ! TOPMODEL-ish baseflow parameterization
+
+! privacy
+ implicit none
+ private::setInitialCondition
+ private::setSolverParams
+ public::summaSolveSundialsIDA
+
+contains
+
+!-------------------
+! * public subroutine summaSolveSundialsIDA: solve F(y,y') = 0 by IDA (y is the state vector)
+! ------------------
+subroutine summaSolveSundialsIDA( &
+ dt, & ! intent(in): data time step
+ atol, & ! intent(in): absolute telerance
+ rtol, & ! intent(in): relative tolerance
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): total number of layers
+ nStat, & ! intent(in): total number of state variables
+ ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVecInit, & ! intent(in): initial state vector
+ sMul, & ! intent(inout): state vector multiplier (USEd in the residual calculations)
+ dMat, & ! intent(inout): diagonal of the Jacobian matrix (excludes fluxes)
+ ! input: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ indx_data, & ! intent(in): index data
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ flux_data, & ! intent(inout): model fluxes for a local HRU
+ flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output
+ ixSaturation, & ! intent(inout) index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
+ tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
+ mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
+ dt_out, & ! intent(out): time step
+ stateVec, & ! intent(out): model state vector
+ stateVecPrime, & ! intent(out): derivative of model state vector
+ err,message & ! intent(out): error control
+ )
+
!======= Inclusions ===========
- USE, intrinsic :: iso_c_binding
- USE nrtype
- USE type4IDA
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! access missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing double precision number
- USE globalData,only:quadMissing ! missing quadruple precision number
-
- ! access matrix information
- USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
- USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
- USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
- USE globalData,only: iJac1 ! first layer of the Jacobian to print
- USE globalData,only: iJac2 ! last layer of the Jacobian to print
- USE globalData,only: ku ! number of super-diagonal bands
- USE globalData,only: kl ! number of sub-diagonal bands
-
- ! domain types
- USE globalData,only:iname_veg ! named variables for vegetation
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
- USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
- USE globalData,only:model_decisions ! model decision structure
-
- ! global metadata
- USE globalData,only:flux_meta ! metadata on the model fluxes
- USE globalData,only:diag_meta ! metadata on the model diagnostic variables
- USE globalData,only:prog_meta ! metadata on the model prognostic variables
- USE globalData,only:deriv_meta ! metadata on the model derivatives
-
- ! constants
- USE multiconst,only:&
- LH_fus, & ! latent heat of fusion (J K-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- Tfreeze, & ! temperature at freezing (K)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! provide access to indices that define elements of the data structures
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
- USE var_lookup,only:iLookFLUX ! named variables for structure elements
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
-
- ! provide access to the derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (rkind)
- zLookup ! data vector
-
- ! look-up values for the choice of groundwater parameterization
- USE mDecisions_module,only: qbaseTopmodel ! TOPMODEL-ish baseflow parameterization
-
- ! privacy
- implicit none
- private::setInitialCondition
- private::setSolverParams
- public::summaSolveSundialsIDA
-
- contains
-
- !-------------------
- ! * public subroutine summaSolveSundialsIDA: solve F(y,y') = 0 by IDA (y is the state vector)
- ! ------------------
- subroutine summaSolveSundialsIDA( &
- dt, & ! intent(in): data time step
- atol, & ! intent(in): absolute telerance
- rtol, & ! intent(in): relative tolerance
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- nStat, & ! intent(in): total number of state variables
- ixMatrix, & ! intent(in): type of matrix (dense or banded)
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVecInit, & ! intent(in): initial state vector
- sMul, & ! intent(inout): state vector multiplier (USEd in the residual calculations)
- dMat, & ! intent(inout): diagonal of the Jacobian matrix (excludes fluxes)
- ! input: data structures
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- indx_data, & ! intent(in): index data
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_temp, & ! intent(inout): model fluxes for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! output
- ixSaturation, & ! intent(inout) index of the lowest saturated layer (NOTE: only computed on the first iteration)
- idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
- tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
- mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
- dt_out, & ! intent(out): time step
- stateVec, & ! intent(out): model state vector
- stateVecPrime, & ! intent(out): derivative of model state vector
- err,message & ! intent(out): error control
- )
-
- !======= Inclusions ===========
- USE fida_mod ! Fortran interface to IDA
- USE fnvector_serial_mod ! Fortran interface to serial N_Vector
- USE fsunmatrix_dense_mod ! Fortran interface to dense SUNMatrix
- USE fsunlinsol_dense_mod ! Fortran interface to dense SUNLinearSolver
- USE fsunmatrix_band_mod ! Fortran interface to banded SUNMatrix
- USE fsunlinsol_band_mod ! Fortran interface to banded SUNLinearSolver
- USE fsunnonlinsol_newton_mod ! Fortran interface to Newton SUNNonlinearSolver
- USE fsundials_matrix_mod ! Fortran interface to generic SUNMatrix
- USE fsundials_nvector_mod ! Fortran interface to generic N_Vector
- USE fsundials_linearsolver_mod ! Fortran interface to generic SUNLinearSolver
- USE fsundials_nonlinearsolver_mod ! Fortran interface to generic SUNNonlinearSolver
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
- USE eval8summaSundials_module,only:eval8summa4IDA ! DAE/ODE functions
- USE computJacobSundials_module,only:computJacob4IDA ! system Jacobian
- USE tol4IDA_module,only:computWeight4IDA ! weight required for tolerances
- USE eval8summaSundials_module,only:eval8summaSundials ! residual of DAE
- USE var_derive_module,only:calcHeight ! height at layer interfaces and layer mid-point
-
- !======= Declarations =========
- implicit none
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! calling variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! input: model control
- real(qp),intent(in) :: dt ! data time step
- real(qp),intent(inout) :: atol(:) ! vector of absolute tolerances
- real(qp),intent(inout) :: rtol(:) ! vector of relative tolerances
- integer(i4b),intent(in) :: nSnow ! number of snow layers
- integer(i4b),intent(in) :: nSoil ! number of soil layers
- integer(i4b),intent(in) :: nLayers ! total number of layers
- integer(i4b),intent(in) :: nStat ! total number of state variables
- integer(i4b),intent(in) :: ixMatrix ! form of matrix (dense or banded)
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input: state vectors
- real(rkind),intent(in) :: stateVecInit(:) ! model state vector
- real(qp),intent(in) :: sMul(:) ! state vector multiplier (used in the residual calculations)
- real(rkind), intent(inout) :: dMat(:)
- ! input: data structures
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- type(var_i), intent(in) :: type_data ! type of vegetation and soil
- type(var_d), intent(in) :: attr_data ! spatial attributes
- type(var_dlength), intent(in) :: mpar_data ! model parameters
- type(var_d), intent(in) :: forc_data ! model forcing data
- type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
- type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_ilength), intent(in) :: indx_data ! indices defining model states and layers
- ! input-output: data structures
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_temp ! model fluxes for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- type(var_dlength),intent(inout) :: flux_sum ! sum of fluxes
- type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- real(rkind),intent(inout) :: mLayerCmpress_sum(:) ! sum of soil compress
- ! output: state vectors
- integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
- real(rkind),intent(inout) :: stateVec(:) ! model state vector (y)
- real(rkind),intent(inout) :: stateVecPrime(:) ! model state vector (y')
- logical(lgt),intent(out) :: idaSucceeds ! flag to indicate if IDA is successful
- logical(lgt),intent(inout) :: tooMuchMelt ! flag to denote that there was too much melt
- real(qp),intent(out) :: dt_out ! time step
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
-
- ! --------------------------------------------------------------------------------------------------------------------------------
- ! local variables
- ! --------------------------------------------------------------------------------------------------------------------------------
- type(N_Vector), pointer :: sunvec_y ! sundials solution vector
- type(N_Vector), pointer :: sunvec_yp ! sundials derivative vector
- type(N_Vector), pointer :: sunvec_av ! sundials tolerance vector
- type(SUNMatrix), pointer :: sunmat_A ! sundials matrix
- type(SUNLinearSolver), pointer :: sunlinsol_LS ! sundials linear solver
- type(SUNNonLinearSolver), pointer :: sunnonlin_NLS ! sundials nonlinear solver
- type(c_ptr) :: ida_mem ! IDA memory
- type(eqnsData), target :: eqns_data ! IDA type
- integer(i4b) :: retval, retvalr ! return value
- integer(i4b) :: rootsfound(3) ! crossing direction of discontinuities
- logical(lgt) :: feasible ! feasibility flag
- real(qp) :: t0 ! staring time
- real(qp) :: dt_last(1) ! last time step
- integer(kind = 8) :: mu, lu ! in banded matrix mode
- integer(i4b) :: iVar
- logical(lgt) :: startQuadrature
- real(rkind) :: mLayerMatricHeadLiqPrev(nSoil)
- real(qp) :: h_init
- integer(c_long) :: nState ! total number of state variables
- real(rkind) :: rVec(nStat)
- real(qp) :: tret(1)
- logical(lgt) :: mergedLayers
- logical(lgt),parameter :: offErrWarnMessage = .false.
- real(rkind) :: superflousSub ! superflous sublimation (kg m-2 s-1)
- real(rkind) :: superflousNrg ! superflous energy that cannot be used for sublimation (W m-2 [J m-2 s-1])
- integer(i4b) :: i
-
- ! -----------------------------------------------------------------------------------------------------
-
- ! initialize error control
- err=0; message="summaSolveSundialsIDA/"
-
- nState = nStat
- idaSucceeds = .true.
- ! fill eqns_data which will be required later to call eval8summaSundials
- eqns_data%dt = dt
- eqns_data%nSnow = nSnow
- eqns_data%nSoil = nSoil
- eqns_data%nLayers = nLayers
- eqns_data%nState = nState
- eqns_data%ixMatrix = ixMatrix
- eqns_data%firstSubStep = firstSubStep
- eqns_data%computeVegFlux = computeVegFlux
- eqns_data%scalarSolution = scalarSolution
-
- allocate( eqns_data%atol(nState) )
- eqns_data%atol = atol
-
- allocate( eqns_data%rtol(nState) )
- eqns_data%rtol = rtol
-
- allocate( eqns_data%sMul(nState) )
- eqns_data%sMul = sMul
-
- allocate( eqns_data%dMat(nState) )
- eqns_data%dMat = dMat
-
- ! allocate space for the temporary prognostic variable structure
- call allocLocal(prog_meta(:),eqns_data%prog_data,nSnow,nSoil,err,message)
- if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
- eqns_data%prog_data = prog_data
-
- ! allocate space for the temporary diagnostic variable structure
- call allocLocal(diag_meta(:),eqns_data%diag_data,nSnow,nSoil,err,message)
- if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
- eqns_data%diag_data = diag_data
-
- ! allocate space for the temporary flux variable structure
- call allocLocal(flux_meta(:),eqns_data%flux_data,nSnow,nSoil,err,message)
- if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
- eqns_data%flux_data = flux_data
-
- ! allocate space for the derivative structure
- call allocLocal(deriv_meta(:),eqns_data%deriv_data,nSnow,nSoil,err,message)
- if(err/=0)then; err=20; message=trim(message)//trim(message); return; end if
- eqns_data%deriv_data = deriv_data
-
- eqns_data%lookup_data = lookup_data
- eqns_data%type_data = type_data
- eqns_data%attr_data = attr_data
- eqns_data%mpar_data = mpar_data
- eqns_data%forc_data = forc_data
- eqns_data%bvar_data = bvar_data
- eqns_data%indx_data = indx_data
-
- ! allocate space
- if(model_decisions(iLookDECISIONS%groundwatr)%iDecision==qbaseTopmodel)then
+ USE fida_mod ! Fortran interface to IDA
+ USE fnvector_serial_mod ! Fortran interface to serial N_Vector
+ USE fsunmatrix_dense_mod ! Fortran interface to dense SUNMatrix
+ USE fsunlinsol_dense_mod ! Fortran interface to dense SUNLinearSolver
+ USE fsunmatrix_band_mod ! Fortran interface to banded SUNMatrix
+ USE fsunlinsol_band_mod ! Fortran interface to banded SUNLinearSolver
+ USE fsunnonlinsol_newton_mod ! Fortran interface to Newton SUNNonlinearSolver
+ USE fsundials_matrix_mod ! Fortran interface to generic SUNMatrix
+ USE fsundials_nvector_mod ! Fortran interface to generic N_Vector
+ USE fsundials_linearsolver_mod ! Fortran interface to generic SUNLinearSolver
+ USE fsundials_nonlinearsolver_mod ! Fortran interface to generic SUNNonlinearSolver
+ USE allocspace_module,only:allocLocal ! allocate local data structures
+ USE evalDAE4IDA_module,only:evalDAE4IDA ! DAE/ODE functions
+ USE evalJac4IDA_module,only:evalJac4IDA ! system Jacobian
+ USE tol4IDA_module,only:computWeight4IDA ! weigth required for tolerances
+ USE eval8summaSundials_module,only:eval8summaSundials ! residual of DAE
+ USE var_derive_module,only:calcHeight ! height at layer interfaces and layer mid-point
+
+ !======= Declarations =========
+ implicit none
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! calling variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! input: model control
+ real(qp),intent(in) :: dt ! data time step
+ real(qp),intent(inout) :: atol(:) ! vector of absolute tolerances
+ real(qp),intent(inout) :: rtol(:) ! vector of relative tolerances
+ integer(i4b),intent(in) :: nSnow ! number of snow layers
+ integer(i4b),intent(in) :: nSoil ! number of soil layers
+ integer(i4b),intent(in) :: nLayers ! total number of layers
+ integer(i4b),intent(in) :: nStat ! total number of state variables
+ integer(i4b),intent(in) :: ixMatrix ! form of matrix (dense or banded)
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if computing fluxes over vegetation
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input: state vectors
+ real(rkind),intent(in) :: stateVecInit(:) ! model state vector
+ real(qp),intent(in) :: sMul(:) ! state vector multiplier (used in the residual calculations)
+ real(rkind), intent(inout) :: dMat(:)
+ ! input: data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i), intent(in) :: type_data ! type of vegetation and soil
+ type(var_d), intent(in) :: attr_data ! spatial attributes
+ type(var_dlength), intent(in) :: mpar_data ! model parameters
+ type(var_d), intent(in) :: forc_data ! model forcing data
+ type(var_dlength), intent(in) :: bvar_data ! model variables for the local basin
+ type(var_dlength), intent(in) :: prog_data ! prognostic variables for a local HRU
+ type(var_ilength), intent(in) :: indx_data ! indices defining model states and layers
+ ! input-output: data structures
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_temp ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: flux_sum ! sum of fluxes
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ real(rkind),intent(inout) :: mLayerCmpress_sum(:) ! sum of soil compress
+ ! output: state vectors
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer
+ real(rkind),intent(inout) :: stateVec(:) ! model state vector (y)
+ real(rkind),intent(inout) :: stateVecPrime(:) ! model state vector (y')
+ logical(lgt),intent(out) :: idaSucceeds ! flag to indicate if IDA is successful
+ logical(lgt),intent(inout) :: tooMuchMelt ! flag to denote that there was too much melt
+ real(qp),intent(out) :: dt_out ! time step
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ ! local variables
+ ! --------------------------------------------------------------------------------------------------------------------------------
+ type(N_Vector), pointer :: sunvec_y ! sundials solution vector
+ type(N_Vector), pointer :: sunvec_yp ! sundials derivative vector
+ type(N_Vector), pointer :: sunvec_av ! sundials tolerance vector
+ type(SUNMatrix), pointer :: sunmat_A ! sundials matrix
+ type(SUNLinearSolver), pointer :: sunlinsol_LS ! sundials linear solver
+ type(SUNNonLinearSolver), pointer :: sunnonlin_NLS ! sundials nonlinear solver
+ type(c_ptr) :: ida_mem ! IDA memory
+ type(eqnsData), target :: eqns_data ! IDA type
+ integer(i4b) :: retval, retvalr ! return value
+ integer(i4b) :: rootsfound(3) ! crossing direction of discontinuities
+ logical(lgt) :: feasible ! feasibility flag
+ real(qp) :: t0 ! staring time
+ real(qp) :: dt_last(1) ! last time step
+ integer(kind = 8) :: mu, lu ! in banded matrix mode
+ integer(i4b) :: iVar
+ logical(lgt) :: startQuadrature
+ real(rkind) :: mLayerMatricHeadLiqPrev(nSoil)
+ real(qp) :: h_init
+ integer(c_long) :: nState ! total number of state variables
+ real(rkind) :: rVec(nStat)
+ real(qp) :: tret(1)
+ logical(lgt) :: mergedLayers
+ logical(lgt),parameter :: offErrWarnMessage = .false.
+ real(rkind) :: superflousSub ! superflous sublimation (kg m-2 s-1)
+ real(rkind) :: superflousNrg ! superflous energy that cannot be used for sublimation (W m-2 [J m-2 s-1])
+ integer(i4b) :: i
+
+ ! -----------------------------------------------------------------------------------------------------
+
+ ! initialize error control
+ err=0; message="summaSolveSundialsIDA/"
+
+ nState = nStat
+ idaSucceeds = .true.
+ ! fill eqns_data which will be required later to call eval8summaSundials
+ eqns_data%dt = dt
+ eqns_data%nSnow = nSnow
+ eqns_data%nSoil = nSoil
+ eqns_data%nLayers = nLayers
+ eqns_data%nState = nState
+ eqns_data%ixMatrix = ixMatrix
+ eqns_data%firstSubStep = firstSubStep
+ eqns_data%computeVegFlux = computeVegFlux
+ eqns_data%scalarSolution = scalarSolution
+
+ allocate( eqns_data%atol(nState) )
+ eqns_data%atol = atol
+
+ allocate( eqns_data%rtol(nState) )
+ eqns_data%rtol = rtol
+
+ allocate( eqns_data%sMul(nState) )
+ eqns_data%sMul = sMul
+
+ allocate( eqns_data%dMat(nState) )
+ eqns_data%dMat = dMat
+
+ ! allocate space for the temporary prognostic variable structure
+ call allocLocal(prog_meta(:),eqns_data%prog_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%prog_data = prog_data
+
+ ! allocate space for the temporary diagnostic variable structure
+ call allocLocal(diag_meta(:),eqns_data%diag_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%diag_data = diag_data
+
+ ! allocate space for the temporary flux variable structure
+ call allocLocal(flux_meta(:),eqns_data%flux_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; endif
+ eqns_data%flux_data = flux_data
+
+ ! allocate space for the derivative structure
+ call allocLocal(deriv_meta(:),eqns_data%deriv_data,nSnow,nSoil,err,message)
+ if(err/=0)then; err=20; message=trim(message)//trim(message); return; end if
+ eqns_data%deriv_data = deriv_data
+
+ eqns_data%lookup_data = lookup_data
+ eqns_data%type_data = type_data
+ eqns_data%attr_data = attr_data
+ eqns_data%mpar_data = mpar_data
+ eqns_data%forc_data = forc_data
+ eqns_data%bvar_data = bvar_data
+ eqns_data%indx_data = indx_data
+
+ ! allocate space
+ if(model_decisions(iLookDECISIONS%groundwatr)%iDecision==qbaseTopmodel)then
allocate(eqns_data%dBaseflow_dMatric(nSoil,nSoil),stat=err)
- else
+ else
allocate(eqns_data%dBaseflow_dMatric(0,0),stat=err)
- end if
- allocate( eqns_data%mLayerTempTrial(nLayers) )
- allocate( eqns_data%mLayerMatricHeadLiqTrial(nSoil) )
- allocate( eqns_data%mLayerMatricHeadTrial(nSoil) )
- allocate( eqns_data%mLayerVolFracWatTrial(nLayers) )
- allocate( eqns_data%mLayerVolFracIceTrial(nLayers) )
- allocate( eqns_data%mLayerEnthalpyTrial(nLayers) )
- allocate( eqns_data%fluxVec(nState) )
- allocate( eqns_data%resSink(nState) )
-
- startQuadrature = .true.
-
- ! create serial vectors
- sunvec_y => FN_VMake_Serial(nState, stateVec)
- if (.not. associated(sunvec_y)) then; err=20; message='summaSolveSundialsIDA: sunvec = NULL'; return; endif
-
- sunvec_yp => FN_VMake_Serial(nState, stateVecPrime)
- if (.not. associated(sunvec_yp)) then; err=20; message='summaSolveSundialsIDA: sunvec = NULL'; return; endif
-
- ! Initialize solution vectors
- call setInitialCondition(nState, stateVecInit, sunvec_y, sunvec_yp)
-
- ! Create memory
- ida_mem = FIDACreate()
- if (.not. c_associated(ida_mem)) then; err=20; message='summaSolveSundialsIDA: ida_mem = NULL'; return; endif
-
- ! Attach user data to memory
- eqns_data%ida_mem = ida_mem
- retval = FIDASetUserData(ida_mem, c_loc(eqns_data))
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetUserData'; return; endif
-
- ! Initialize memory
- t0 = 0._rkind
- retval = FIDAInit(ida_mem, c_funloc(eval8summa4IDA), t0, sunvec_y, sunvec_yp)
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDAInit'; return; endif
-
- ! set tolerances
- retval = FIDAWFtolerances(ida_mem, c_funloc(computWeight4IDA))
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDAWFtolerances'; return; endif
-
- ! define the form of the matrix
- select case(ixMatrix)
+ end if
+ allocate( eqns_data%mLayerMatricHeadLiqTrial(nSoil) )
+ allocate( eqns_data%mLayerMatricHeadTrial(nSoil) )
+ allocate( eqns_data%mLayerMatricHeadPrev(nSoil) )
+ allocate( eqns_data%mLayerVolFracWatTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracWatPrev(nLayers) )
+ allocate( eqns_data%mLayerTempTrial(nLayers) )
+ allocate( eqns_data%mLayerTempPrev(nLayers) )
+ allocate( eqns_data%mLayerVolFracIceTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracIcePrev(nLayers) )
+ allocate( eqns_data%mLayerVolFracLiqTrial(nLayers) )
+ allocate( eqns_data%mLayerVolFracLiqPrev(nLayers) )
+ allocate( eqns_data%mLayerEnthalpyTrial(nLayers) )
+ allocate( eqns_data%mLayerEnthalpyPrev(nLayers) )
+ allocate( eqns_data%fluxVec(nState) )
+ allocate( eqns_data%resSink(nState) )
+
+ startQuadrature = .true.
+
+ ! create serial vectors
+ sunvec_y => FN_VMake_Serial(nState, stateVec)
+ if (.not. associated(sunvec_y)) then; err=20; message='summaSolveSundialsIDA: sunvec = NULL'; return; endif
+
+ sunvec_yp => FN_VMake_Serial(nState, stateVecPrime)
+ if (.not. associated(sunvec_yp)) then; err=20; message='summaSolveSundialsIDA: sunvec = NULL'; return; endif
+
+ ! Initialize solution vectors
+ call setInitialCondition(nState, stateVecInit, sunvec_y, sunvec_yp)
+
+ ! Create memory
+ ida_mem = FIDACreate()
+ if (.not. c_associated(ida_mem)) then; err=20; message='summaSolveSundialsIDA: ida_mem = NULL'; return; endif
+
+ ! Attach user data to memory
+ eqns_data%ida_mem = ida_mem
+ retval = FIDASetUserData(ida_mem, c_loc(eqns_data))
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetUserData'; return; endif
+
+ ! Initialize memory
+ t0 = 0._rkind
+ retval = FIDAInit(ida_mem, c_funloc(evalDAE4IDA), t0, sunvec_y, sunvec_yp)
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDAInit'; return; endif
+
+ ! set tolerances
+ retval = FIDAWFtolerances(ida_mem, c_funloc(computWeight4IDA))
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDAWFtolerances'; return; endif
+
+ ! define the form of the matrix
+ select case(ixMatrix)
case(ixBandMatrix)
- mu = ku; lu = kl;
- ! Create banded SUNMatrix for use in linear solves
- sunmat_A => FSUNBandMatrix(nState, mu, lu)
- if (.not. associated(sunmat_A)) then; err=20; message='summaSolveSundialsIDA: sunmat = NULL'; return; endif
-
- ! Create banded SUNLinearSolver object
- sunlinsol_LS => FSUNLinSol_Band(sunvec_y, sunmat_A)
- if (.not. associated(sunlinsol_LS)) then; err=20; message='summaSolveSundialsIDA: sunlinsol = NULL'; return; endif
-
+ mu = ku; lu = kl;
+ ! Create banded SUNMatrix for use in linear solves
+ sunmat_A => FSUNBandMatrix(nState, mu, lu)
+ if (.not. associated(sunmat_A)) then; err=20; message='summaSolveSundialsIDA: sunmat = NULL'; return; endif
+
+ ! Create banded SUNLinearSolver object
+ sunlinsol_LS => FSUNLinSol_Band(sunvec_y, sunmat_A)
+ if (.not. associated(sunlinsol_LS)) then; err=20; message='summaSolveSundialsIDA: sunlinsol = NULL'; return; endif
+
case(ixFullMatrix)
- ! Create dense SUNMatrix for use in linear solves
- sunmat_A => FSUNDenseMatrix(nState, nState)
- if (.not. associated(sunmat_A)) then; err=20; message='summaSolveSundialsIDA: sunmat = NULL'; return; endif
-
- ! Create dense SUNLinearSolver object
- sunlinsol_LS => FSUNDenseLinearSolver(sunvec_y, sunmat_A)
- if (.not. associated(sunlinsol_LS)) then; err=20; message='summaSolveSundialsIDA: sunlinsol = NULL'; return; endif
-
- ! check
+ ! Create dense SUNMatrix for use in linear solves
+ sunmat_A => FSUNDenseMatrix(nState, nState)
+ if (.not. associated(sunmat_A)) then; err=20; message='summaSolveSundialsIDA: sunmat = NULL'; return; endif
+
+ ! Create dense SUNLinearSolver object
+ sunlinsol_LS => FSUNDenseLinearSolver(sunvec_y, sunmat_A)
+ if (.not. associated(sunlinsol_LS)) then; err=20; message='summaSolveSundialsIDA: sunlinsol = NULL'; return; endif
+
+ ! check
case default; err=20; message='summaSolveSundialsIDA: error in type of matrix'; return
-
- end select ! form of matrix
-
- ! Attach the matrix and linear solver
- retval = FIDASetLinearSolver(ida_mem, sunlinsol_LS, sunmat_A);
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetLinearSolver'; return; endif
-
- if(ixMatrix == ixFullMatrix)then
- ! Set the user-supplied Jacobian routine
- !comment this line out to use FD Jacobian
- retval = FIDASetJacFn(ida_mem, c_funloc(computJacob4IDA))
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetJacFn'; return; endif
- endif
-
- ! Create Newton SUNNonlinearSolver object
- sunnonlin_NLS => FSUNNonlinSol_Newton(sunvec_y)
- if (.not. associated(sunnonlin_NLS)) then; err=20; message='summaSolveSundialsIDA: sunnonlinsol = NULL'; return; endif
-
- ! Attach the nonlinear solver
- retval = FIDASetNonlinearSolver(ida_mem, sunnonlin_NLS)
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetNonlinearSolver'; return; endif
-
- ! Enforce the solver to stop at end of the time step
- retval = FIDASetStopTime(ida_mem, dt)
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetStopTime'; return; endif
-
- ! Set solver parameters such as maximum order, number of iterations, ...
- call setSolverParams(dt, ida_mem, retval)
- if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in setSolverParams'; return; endif
-
- ! Disable error messages and warnings
- if(offErrWarnMessage) then
- retval = FIDASetErrFile(ida_mem, c_null_ptr)
- retval = FIDASetNoInactiveRootWarn(ida_mem)
- endif
-
- ! need the following values for the first substep
- eqns_data%scalarCanopyTempTrial = prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1)
- eqns_data%scalarCanopyIceTrial = prog_data%var(iLookPROG%scalarCanopyIce)%dat(1)
- eqns_data%scalarCanopyEnthalpyTrial = diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1)
- eqns_data%mLayerTempTrial(:) = prog_data%var(iLookPROG%mLayerTemp)%dat(:)
- eqns_data%mLayerMatricHeadLiqTrial(:)= diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat(:)
- eqns_data%mLayerMatricHeadTrial(:) = prog_data%var(iLookPROG%mLayerMatricHead)%dat(:)
- eqns_data%mLayerVolFracWatTrial(:) = prog_data%var(iLookPROG%mLayerVolFracWat)%dat(:)
- eqns_data%mLayerVolFracIceTrial(:) = prog_data%var(iLookPROG%mLayerVolFracIce)%dat(:)
- eqns_data%mLayerEnthalpyTrial(:) = diag_data%var(iLookDIAG%mLayerEnthalpy)%dat(:)
- eqns_data%ixSaturation = ixSaturation
-
- !**********************************************************************************
- !****************************** Main Solver ***************************************
- !************************* loop on one_step mode **********************************
- !**********************************************************************************
-
- tret(1) = t0 ! intial time
- do while(tret(1) < dt)
+
+ end select ! form of matrix
+
+ ! Attach the matrix and linear solver
+ retval = FIDASetLinearSolver(ida_mem, sunlinsol_LS, sunmat_A);
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetLinearSolver'; return; endif
+
+ ! Set the user-supplied Jacobian routine
+ !comment this line out to use FD Jacobian
+ retval = FIDASetJacFn(ida_mem, c_funloc(evalJac4IDA))
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetJacFn'; return; endif
+
+ ! Create Newton SUNNonlinearSolver object
+ sunnonlin_NLS => FSUNNonlinSol_Newton(sunvec_y)
+ if (.not. associated(sunnonlin_NLS)) then; err=20; message='summaSolveSundialsIDA: sunnonlinsol = NULL'; return; endif
+
+ ! Attach the nonlinear solver
+ retval = FIDASetNonlinearSolver(ida_mem, sunnonlin_NLS)
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetNonlinearSolver'; return; endif
+
+ ! Enforce the solver to stop at end of the time step
+ retval = FIDASetStopTime(ida_mem, dt)
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in FIDASetStopTime'; return; endif
+
+ ! Set solver parameters such as maximum order, number of iterations, ...
+ call setSolverParams(dt, ida_mem, retval)
+ if (retval /= 0) then; err=20; message='summaSolveSundialsIDA: error in setSolverParams'; return; endif
+
+ ! Disable error messages and warnings
+ if(offErrWarnMessage) then
+ retval = FIDASetErrFile(ida_mem, c_null_ptr)
+ retval = FIDASetNoInactiveRootWarn(ida_mem)
+ endif
+
+ ! need the following values for the first substep
+ eqns_data%scalarCanopyTempPrev = prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1)
+ eqns_data%scalarCanopyIcePrev = prog_data%var(iLookPROG%scalarCanopyIce)%dat(1)
+ eqns_data%scalarCanopyLiqPrev = prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1)
+ eqns_data%mLayerVolFracWatPrev(:) = prog_data%var(iLookPROG%mLayerVolFracWat)%dat(:)
+ eqns_data%mLayerTempPrev(:) = prog_data%var(iLookPROG%mLayerTemp)%dat(:)
+ eqns_data%mLayerVolFracIcePrev(:) = prog_data%var(iLookPROG%mLayerVolFracIce)%dat(:)
+ eqns_data%mLayerVolFracLiqPrev(:) = prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(:)
+ eqns_data%mLayerMatricHeadPrev(:) = prog_data%var(iLookPROG%mLayerMatricHead)%dat(:)
+ eqns_data%scalarAquiferStoragePrev = prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1)
+ eqns_data%mLayerEnthalpyPrev(:) = diag_data%var(iLookDIAG%mLayerEnthalpy)%dat(:)
+ eqns_data%scalarCanopyEnthalpyPrev = diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1)
+ mLayerMatricHeadLiqPrev(:) = diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat(:)
+ eqns_data%ixSaturation = ixSaturation
+
+ !**********************************************************************************
+ !****************************** Main Solver ***************************************
+ !************************* loop on one_step mode **********************************
+ !**********************************************************************************
+
+ tret(1) = t0 ! intial time
+ do while(tret(1) < dt)
eqns_data%firstFluxCall = .false.
eqns_data%firstSplitOper = .true.
! call IDASolve, advance solver just one internal step
retvalr = FIDASolve(ida_mem, dt, tret, sunvec_y, sunvec_yp, IDA_ONE_STEP)
if( retvalr < 0 )then
- idaSucceeds = .false.
- exit
+ idaSucceeds = .false.
+ exit
endif
-
+
tooMuchMelt = .false.
feasible = .true.
! loop through non-missing energy state variables in the snow domain to see if need to merge
do concurrent (i=1:nSnow,indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat(i)/=integerMissing)
- if (stateVec(indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat(i)) > Tfreeze) tooMuchMelt = .true. !need to merge
+ if (stateVec(indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat(i)) > Tfreeze) tooMuchMelt = .true. !need to merge
enddo
if(tooMuchMelt)exit
-
+
! get the last stepsize
retval = FIDAGetLastStep(ida_mem, dt_last)
-
- ! save previous step
- mLayerMatricHeadLiqPrev(:) = eqns_data%mLayerMatricHeadLiqTrial(:)
-
+
! compute the flux and the residual vector for a given state vector
call eval8summaSundials(&
- ! input: model control
- dt_last(1), & ! intent(in): current stepsize
- eqns_data%dt, & ! intent(in): total data step
- eqns_data%nSnow, & ! intent(in): number of snow layers
- eqns_data%nSoil, & ! intent(in): number of soil layers
- eqns_data%nLayers, & ! intent(in): number of layers
- eqns_data%nState, & ! intent(in): number of state variables in the current subset
- .false., & ! intent(in): outside Sundials solverå
- eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
- eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVec, & ! intent(in): model state vector
- stateVecPrime, & ! intent(in): model state vector
- eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- eqns_data%lookup_data, & ! intent(in): lookup data
- eqns_data%type_data, & ! intent(in): type of vegetation and soil
- eqns_data%attr_data, & ! intent(in): spatial attributes
- eqns_data%mpar_data, & ! intent(in): model parameters
- eqns_data%forc_data, & ! intent(in): model forcing data
- eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
- eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- eqns_data%indx_data, & ! intent(inout): index data
- eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
- eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: here we need to pass some extra variables that do not get updated in in the Sundials loops
- eqns_data%scalarCanopyTempTrial, & ! intent(inout): trial value of canopy temperature (K)
- eqns_data%scalarCanopyIceTrial, & ! intent(inout): trial value for mass of ice on the vegetation canopy (kg m-2)
- eqns_data%scalarCanopyEnthalpyTrial,& ! intent(inout): trial value for enthalpy of the vegetation canopy (J m-3)
- eqns_data%mLayerTempTrial, & ! intent(inout): trial vector of layer temperature (K)
- eqns_data%mLayerMatricHeadTrial, & ! intent(inout): trial value for total water matric potential (m)
- eqns_data%mLayerMatricHeadLiqTrial, & ! intent(inout): trial value for liquid water matric potential (m)
- eqns_data%mLayerVolFracWatTrial, & ! intent(inout): trial vector of volumetric total water content (-)
- eqns_data%mLayerVolFracIceTrial, & ! intent(inout): trial vector of volumetric ice water content (-)
- eqns_data%mLayerEnthalpyTrial, & ! intent(inout): trial vector of enthalpy for snow+soil layers (J m-3)
- ! input-output: baseflow
- eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
- eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- feasible, & ! intent(out): flag to denote the feasibility of the solution
- eqns_data%fluxVec, & ! intent(out): flux vector
- eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
- rVec, & ! intent(out): residual vector
- eqns_data%err,eqns_data%message) ! intent(out): error control
-
+ ! input: model control
+ dt_last(1), & ! intent(in): current stepsize
+ eqns_data%dt, & ! intent(in): total data step
+ eqns_data%nSnow, & ! intent(in): number of snow layers
+ eqns_data%nSoil, & ! intent(in): number of soil layers
+ eqns_data%nLayers, & ! intent(in): number of layers
+ eqns_data%nState, & ! intent(in): number of state variables in the current subset
+ .false., & ! intent(in): check for feasibility once outside Sundials loop
+ eqns_data%firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ eqns_data%firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ eqns_data%firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
+ eqns_data%computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ eqns_data%scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVec, & ! intent(in): model state vector
+ stateVecPrime, & ! intent(in): model state vector
+ eqns_data%sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ eqns_data%lookup_data, & ! intent(in): lookup data
+ eqns_data%type_data, & ! intent(in): type of vegetation and soil
+ eqns_data%attr_data, & ! intent(in): spatial attributes
+ eqns_data%mpar_data, & ! intent(in): model parameters
+ eqns_data%forc_data, & ! intent(in): model forcing data
+ eqns_data%bvar_data, & ! intent(in): average model variables for the entire basin
+ eqns_data%prog_data, & ! intent(in): model prognostic variables for a local HRU
+ ! input-output: data structures
+ eqns_data%indx_data, & ! intent(inout): index data
+ eqns_data%diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ eqns_data%flux_data, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ eqns_data%deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output
+ eqns_data%dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1), we will use it later for Jacobian
+ eqns_data%scalarCanopyTempTrial, & ! intent(in): trial value of canopy temperature (K)
+ eqns_data%scalarCanopyTempPrev, & ! intent(in): previous value of canopy temperature (K)
+ eqns_data%scalarCanopyIceTrial, & ! intent(out): trial value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyIcePrev, & ! intent(in): value for mass of ice on the vegetation canopy (kg m-2)
+ eqns_data%scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyLiqPrev, & ! intent(in): value of canopy liquid water (kg m-2)
+ eqns_data%scalarCanopyEnthalpyTrial,& ! intent(out): trial value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%scalarCanopyEnthalpyPrev, & ! intent(in): value for enthalpy of the vegetation canopy (J m-3)
+ eqns_data%mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ eqns_data%mLayerTempPrev, & ! intent(in): vector of layer temperature (K)
+ eqns_data%mLayerMatricHeadLiqTrial, & ! intent(out): trial value for liquid water matric potential (m)
+ eqns_data%mLayerMatricHeadTrial, & ! intent(out): trial value for total water matric potential (m)
+ eqns_data%mLayerMatricHeadPrev, & ! intent(in): value for total water matric potential (m)
+ eqns_data%mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracWatPrev, & ! intent(in): vector of volumetric total water content (-)
+ eqns_data%mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracIcePrev, & ! intent(in): vector of volumetric ice water content (-)
+ eqns_data%mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ eqns_data%mLayerVolFracLiqPrev, & ! intent(in): vector of volumetric liquid water content (-)
+ eqns_data%scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ eqns_data%scalarAquiferStoragePrev, & ! intent(in): value of storage of water in the aquifer (m)
+ eqns_data%mLayerEnthalpyPrev, & ! intent(in): vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%mLayerEnthalpyTrial, & ! intent(out): trial vector of enthalpy for snow+soil layers (J m-3)
+ eqns_data%ixSaturation, & ! intent(inout): index of the lowest saturated layer
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ eqns_data%fluxVec, & ! intent(out): flux vector
+ eqns_data%resSink, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ eqns_data%err,eqns_data%message) ! intent(out): error control
+
! sum of fluxes
do iVar=1,size(flux_meta)
- flux_sum%var(iVar)%dat(:) = flux_sum%var(iVar)%dat(:) + eqns_data%flux_data%var(iVar)%dat(:) * dt_last(1)
+ flux_sum%var(iVar)%dat(:) = flux_sum%var(iVar)%dat(:) + eqns_data%flux_data%var(iVar)%dat(:) * dt_last(1)
end do
-
- ! do iVar=1,size(flux_meta)
- ! flux_data%var(iVar)%dat(:) = ( flux_sum%var(iVar)%dat(:) ) / tret(1)
- ! end do
-
+
! sum of mLayerCmpress
mLayerCmpress_sum(:) = mLayerCmpress_sum(:) + eqns_data%deriv_data%var(iLookDERIV%dCompress_dPsi)%dat(:) &
- * ( eqns_data%mLayerMatricHeadLiqTrial(:) - mLayerMatricHeadLiqPrev(:) )
-
- enddo ! while loop on one_step mode until time dt
-
- !****************************** End of Main Solver ***************************************
-
- err = eqns_data%err
- message = eqns_data%message
- if( .not. feasible) idaSucceeds = .false.
-
- if(idaSucceeds)then
+ * ( eqns_data%mLayerMatricHeadLiqTrial(:) - mLayerMatricHeadLiqPrev(:) )
+
+ ! save required quantities for next step
+ eqns_data%scalarCanopyTempPrev = eqns_data%scalarCanopyTempTrial
+ eqns_data%scalarCanopyIcePrev = eqns_data%scalarCanopyIceTrial
+ eqns_data%scalarCanopyLiqPrev = eqns_data%scalarCanopyLiqTrial
+ eqns_data%mLayerTempPrev(:) = eqns_data%mLayerTempTrial(:)
+ mLayerMatricHeadLiqPrev(:) = eqns_data%mLayerMatricHeadLiqTrial(:)
+ eqns_data%mLayerMatricHeadPrev(:) = eqns_data%mLayerMatricHeadTrial(:)
+ eqns_data%mLayerVolFracWatPrev(:) = eqns_data%mLayerVolFracWatTrial(:)
+ eqns_data%mLayerVolFracIcePrev(:) = eqns_data%mLayerVolFracIceTrial(:)
+ eqns_data%mLayerVolFracLiqPrev(:) = eqns_data%mLayerVolFracLiqTrial(:)
+ eqns_data%scalarAquiferStoragePrev = eqns_data%scalarAquiferStorageTrial
+ eqns_data%mLayerEnthalpyPrev(:) = eqns_data%mLayerEnthalpyTrial(:)
+ eqns_data%scalarCanopyEnthalpyPrev = eqns_data%scalarCanopyEnthalpyTrial
+
+ enddo ! while loop on one_step mode until time dt
+
+ !****************************** End of Main Solver ***************************************
+
+ err = eqns_data%err
+ message = eqns_data%message
+ if( .not. feasible) idaSucceeds = .false.
+
+ if(idaSucceeds)then
! copy to output data
diag_data = eqns_data%diag_data
flux_data = eqns_data%flux_data
deriv_data = eqns_data%deriv_data
ixSaturation = eqns_data%ixSaturation
dt_out = tret(1)
- endif
-
- ! free memory
- deallocate( eqns_data%sMul )
- deallocate( eqns_data%dMat )
- deallocate( eqns_data%dBaseflow_dMatric )
- deallocate( eqns_data%mLayerTempTrial )
- deallocate( eqns_data%mLayerMatricHeadLiqTrial )
- deallocate( eqns_data%mLayerMatricHeadTrial )
- deallocate( eqns_data%mLayerVolFracWatTrial )
- deallocate( eqns_data%mLayerVolFracIceTrial )
- deallocate( eqns_data%mLayerEnthalpyTrial )
- deallocate( eqns_data%fluxVec )
- deallocate( eqns_data%resSink )
-
- call FIDAFree(ida_mem)
- retval = FSUNNonlinSolFree(sunnonlin_NLS)
- retval = FSUNLinSolFree(sunlinsol_LS)
- call FSUNMatDestroy(sunmat_A)
- call FN_VDestroy(sunvec_y)
- call FN_VDestroy(sunvec_yp)
-
- end subroutine summaSolveSundialsIDA
-
- ! ----------------------------------------------------------------
- ! SetInitialCondition: routine to initialize u and up vectors.
- ! ----------------------------------------------------------------
- subroutine setInitialCondition(neq, y, sunvec_u, sunvec_up)
-
- !======= Inclusions ===========
- USE, intrinsic :: iso_c_binding
- USE fsundials_nvector_mod
- USE fnvector_serial_mod
-
- !======= Declarations =========
- implicit none
-
- ! calling variables
- type(N_Vector) :: sunvec_u ! solution N_Vector
- type(N_Vector) :: sunvec_up ! derivative N_Vector
- integer(c_long) :: neq
- real(rkind) :: y(neq)
-
- ! pointers to data in SUNDIALS vectors
- real(c_double), pointer :: uu(:)
- real(c_double), pointer :: up(:)
-
- ! get data arrays from SUNDIALS vectors
- uu(1:neq) => FN_VGetArrayPointer(sunvec_u)
- up(1:neq) => FN_VGetArrayPointer(sunvec_up)
-
- uu = y
- up = 0._rkind
-
- end subroutine setInitialCondition
-
- ! ----------------------------------------------------------------
- ! setSolverParams: private routine to set parameters in ida solver
- ! ----------------------------------------------------------------
- subroutine setSolverParams(dt,ida_mem,retval)
-
- !======= Inclusions ===========
- USE, intrinsic :: iso_c_binding
- USE fida_mod ! Fortran interface to IDA
-
- !======= Declarations =========
- implicit none
-
- ! calling variables
- real(rkind),intent(in) :: dt ! time step
- type(c_ptr),intent(inout) :: ida_mem ! IDA memory
- integer(i4b),intent(out) :: retval ! return value
-
- !======= Internals ============
- real(qp),parameter :: coef_nonlin = 0.33 ! Coeff. in the nonlinear convergence test, default = 0.33
- integer,parameter :: max_order = 1 ! maximum BDF order, default = 5
- integer,parameter :: nonlin_iter = 100 ! maximun number of nonliear iterations, default = 4
- integer,parameter :: acurtest_fail = 50 ! maximum number of error test failures, default = 10
- integer,parameter :: convtest_fail = 50 ! maximum number of convergence test failures, default = 10
- integer(kind = 8),parameter :: max_step = 999999 ! maximum number of steps, dafault = 500
- real(qp),parameter :: h_init = 0 ! initial stepsize
- real(qp) :: h_max ! maximum stepsize, dafault = infinity
-
- ! Set the maximum BDF order
- retval = FIDASetMaxOrd(ida_mem, max_order)
- if (retval /= 0) return
-
- ! Set Coeff. in the nonlinear convergence test
- retval = FIDASetNonlinConvCoef(ida_mem, coef_nonlin)
- if (retval /= 0) return
-
- ! Set maximun number of nonliear iterations
- retval = FIDASetMaxNonlinIters(ida_mem, nonlin_iter)
- if (retval /= 0) return
-
- ! Set maximum number of convergence test failures
- retval = FIDASetMaxConvFails(ida_mem, convtest_fail)
- if (retval /= 0) return
-
- ! Set maximum number of error test failures
- retval = FIDASetMaxErrTestFails(ida_mem, acurtest_fail)
- if (retval /= 0) return
-
- ! Set maximum number of steps
- retval = FIDASetMaxNumSteps(ida_mem, max_step)
- if (retval /= 0) return
-
- ! Set maximum stepsize
- h_max = dt
- retval = FIDASetMaxStep(ida_mem, h_max)
- if (retval /= 0) return
-
- ! Set initial stepsize
- retval = FIDASetInitStep(ida_mem, h_init)
- if (retval /= 0) return
-
- ! scaling on 1 and off 0
- ! retval = FIDASetLinearSolutionScaling(ida_mem, 0)
- ! if (retval /= 0) return
-
- end subroutine setSolverParams
-
- ! *********************************************************************************************************
- ! private subroutine implctMelt: compute melt of the "snow without a layer"
- ! *********************************************************************************************************
- subroutine implctMelt(&
- ! input/output: integrated snowpack properties
- scalarSWE, & ! intent(inout): snow water equivalent (kg m-2)
- scalarSnowDepth, & ! intent(inout): snow depth (m)
- scalarSfcMeltPond, & ! intent(inout): surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- soilTemp, & ! intent(inout): surface layer temperature (K)
- soilDepth, & ! intent(inout): surface layer depth (m)
- soilHeatcap, & ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- err,message ) ! intent(out): error control
- implicit none
- ! input/output: integrated snowpack properties
- real(rkind),intent(inout) :: scalarSWE ! snow water equivalent (kg m-2)
- real(rkind),intent(inout) :: scalarSnowDepth ! snow depth (m)
- real(rkind),intent(inout) :: scalarSfcMeltPond ! surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- real(rkind),intent(inout) :: soilTemp ! surface layer temperature (K)
- real(rkind),intent(inout) :: soilDepth ! surface layer depth (m)
- real(rkind),intent(inout) :: soilHeatcap ! surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- real(rkind) :: nrgRequired ! energy required to melt all the snow (J m-2)
- real(rkind) :: nrgAvailable ! energy available to melt the snow (J m-2)
- real(rkind) :: snwDensity ! snow density (kg m-3)
- ! initialize error control
- err=0; message='implctMelt/'
-
- if(scalarSWE > 0._rkind)then
+ endif
+
+ ! free memory
+ deallocate( eqns_data%sMul )
+ deallocate( eqns_data%dMat )
+ deallocate( eqns_data%dBaseflow_dMatric )
+ deallocate( eqns_data%mLayerMatricHeadLiqTrial )
+ deallocate( eqns_data%mLayerMatricHeadTrial )
+ deallocate( eqns_data%mLayerMatricHeadPrev )
+ deallocate( eqns_data%fluxVec )
+ deallocate( eqns_data%resSink )
+ deallocate( eqns_data%mLayerVolFracWatTrial )
+ deallocate( eqns_data%mLayerVolFracWatPrev )
+ deallocate( eqns_data%mLayerVolFracIceTrial )
+ deallocate( eqns_data%mLayerTempPrev )
+ deallocate( eqns_data%mLayerTempTrial )
+ deallocate( eqns_data%mLayerVolFracIcePrev )
+ deallocate( eqns_data%mLayerVolFracLiqPrev )
+ deallocate( eqns_data%mLayerEnthalpyTrial )
+ deallocate( eqns_data%mLayerEnthalpyPrev )
+
+ call FIDAFree(ida_mem)
+ retval = FSUNNonlinSolFree(sunnonlin_NLS)
+ retval = FSUNLinSolFree(sunlinsol_LS)
+ call FSUNMatDestroy(sunmat_A)
+ call FN_VDestroy(sunvec_y)
+ call FN_VDestroy(sunvec_yp)
+
+end subroutine summaSolveSundialsIDA
+
+! ----------------------------------------------------------------
+! SetInitialCondition: routine to initialize u and up vectors.
+! ----------------------------------------------------------------
+subroutine setInitialCondition(neq, y, sunvec_u, sunvec_up)
+
+ !======= Inclusions ===========
+ USE, intrinsic :: iso_c_binding
+ USE fsundials_nvector_mod
+ USE fnvector_serial_mod
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ type(N_Vector) :: sunvec_u ! solution N_Vector
+ type(N_Vector) :: sunvec_up ! derivative N_Vector
+ integer(c_long) :: neq
+ real(rkind) :: y(neq)
+
+ ! pointers to data in SUNDIALS vectors
+ real(c_double), pointer :: uu(:)
+ real(c_double), pointer :: up(:)
+
+ ! get data arrays from SUNDIALS vectors
+ uu(1:neq) => FN_VGetArrayPointer(sunvec_u)
+ up(1:neq) => FN_VGetArrayPointer(sunvec_up)
+
+ uu = y
+ up = 0._rkind
+
+end subroutine setInitialCondition
+
+! ----------------------------------------------------------------
+! setSolverParams: private routine to set parameters in ida solver
+! ----------------------------------------------------------------
+subroutine setSolverParams(dt,ida_mem,retval)
+
+ !======= Inclusions ===========
+ USE, intrinsic :: iso_c_binding
+ USE fida_mod ! Fortran interface to IDA
+
+ !======= Declarations =========
+ implicit none
+
+ ! calling variables
+ real(rkind),intent(in) :: dt ! time step
+ type(c_ptr),intent(inout) :: ida_mem ! IDA memory
+ integer(i4b),intent(out) :: retval ! return value
+
+ !======= Internals ============
+ real(qp),parameter :: coef_nonlin = 0.33 ! Coeff. in the nonlinear convergence test, default = 0.33
+ integer,parameter :: max_order = 1 ! maximum BDF order, default = 5
+ integer,parameter :: nonlin_iter = 100 ! maximun number of nonliear iterations, default = 4
+ integer,parameter :: acurtest_fail = 50 ! maximum number of error test failures, default = 10
+ integer,parameter :: convtest_fail = 50 ! maximum number of convergence test failures, default = 10
+ integer(kind = 8),parameter :: max_step = 999999 ! maximum number of steps, dafault = 500
+ real(qp),parameter :: h_init = 0 ! initial stepsize
+ real(qp) :: h_max ! maximum stepsize, dafault = infinity
+
+ ! Set the maximum BDF order
+ retval = FIDASetMaxOrd(ida_mem, max_order)
+ if (retval /= 0) return
+
+ ! Set Coeff. in the nonlinear convergence test
+ retval = FIDASetNonlinConvCoef(ida_mem, coef_nonlin)
+ if (retval /= 0) return
+
+ ! Set maximun number of nonliear iterations
+ retval = FIDASetMaxNonlinIters(ida_mem, nonlin_iter)
+ if (retval /= 0) return
+
+ ! Set maximum number of convergence test failures
+ retval = FIDASetMaxConvFails(ida_mem, convtest_fail)
+ if (retval /= 0) return
+
+ ! Set maximum number of error test failures
+ retval = FIDASetMaxErrTestFails(ida_mem, acurtest_fail)
+ if (retval /= 0) return
+
+ ! Set maximum number of steps
+ retval = FIDASetMaxNumSteps(ida_mem, max_step)
+ if (retval /= 0) return
+
+ ! Set maximum stepsize
+ h_max = dt
+ retval = FIDASetMaxStep(ida_mem, h_max)
+ if (retval /= 0) return
+
+ ! Set initial stepsize
+ retval = FIDASetInitStep(ida_mem, h_init)
+ if (retval /= 0) return
+
+end subroutine setSolverParams
+
+! *********************************************************************************************************
+! private subroutine implctMelt: compute melt of the "snow without a layer"
+! *********************************************************************************************************
+subroutine implctMelt(&
+ ! input/output: integrated snowpack properties
+ scalarSWE, & ! intent(inout): snow water equivalent (kg m-2)
+ scalarSnowDepth, & ! intent(inout): snow depth (m)
+ scalarSfcMeltPond, & ! intent(inout): surface melt pond (kg m-2)
+ ! input/output: properties of the upper-most soil layer
+ soilTemp, & ! intent(inout): surface layer temperature (K)
+ soilDepth, & ! intent(inout): surface layer depth (m)
+ soilHeatcap, & ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
+ ! output: error control
+ err,message ) ! intent(out): error control
+ implicit none
+ ! input/output: integrated snowpack properties
+ real(rkind),intent(inout) :: scalarSWE ! snow water equivalent (kg m-2)
+ real(rkind),intent(inout) :: scalarSnowDepth ! snow depth (m)
+ real(rkind),intent(inout) :: scalarSfcMeltPond ! surface melt pond (kg m-2)
+ ! input/output: properties of the upper-most soil layer
+ real(rkind),intent(inout) :: soilTemp ! surface layer temperature (K)
+ real(rkind),intent(inout) :: soilDepth ! surface layer depth (m)
+ real(rkind),intent(inout) :: soilHeatcap ! surface layer volumetric heat capacity (J m-3 K-1)
+ ! output: error control
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+ ! local variables
+ real(rkind) :: nrgRequired ! energy required to melt all the snow (J m-2)
+ real(rkind) :: nrgAvailable ! energy available to melt the snow (J m-2)
+ real(rkind) :: snwDensity ! snow density (kg m-3)
+ ! initialize error control
+ err=0; message='implctMelt/'
+
+ if(scalarSWE > 0._rkind)then
! only melt if temperature of the top soil layer is greater than Tfreeze
if(soilTemp > Tfreeze)then
- ! compute the energy required to melt all the snow (J m-2)
- nrgRequired = scalarSWE*LH_fus
- ! compute the energy available to melt the snow (J m-2)
- nrgAvailable = soilHeatcap*(soilTemp - Tfreeze)*soilDepth
- ! compute the snow density (not saved)
- snwDensity = scalarSWE/scalarSnowDepth
- ! compute the amount of melt, and update SWE (kg m-2)
- if(nrgAvailable > nrgRequired)then
- scalarSfcMeltPond = scalarSWE
- scalarSWE = 0._rkind
- else
- scalarSfcMeltPond = nrgAvailable/LH_fus
- scalarSWE = scalarSWE - scalarSfcMeltPond
- end if
- ! update depth
- scalarSnowDepth = scalarSWE/snwDensity
- ! update temperature of the top soil layer (K)
- soilTemp = soilTemp - (LH_fus*scalarSfcMeltPond/soilDepth)/soilHeatcap
+ ! compute the energy required to melt all the snow (J m-2)
+ nrgRequired = scalarSWE*LH_fus
+ ! compute the energy available to melt the snow (J m-2)
+ nrgAvailable = soilHeatcap*(soilTemp - Tfreeze)*soilDepth
+ ! compute the snow density (not saved)
+ snwDensity = scalarSWE/scalarSnowDepth
+ ! compute the amount of melt, and update SWE (kg m-2)
+ if(nrgAvailable > nrgRequired)then
+ scalarSfcMeltPond = scalarSWE
+ scalarSWE = 0._rkind
+ else
+ scalarSfcMeltPond = nrgAvailable/LH_fus
+ scalarSWE = scalarSWE - scalarSfcMeltPond
+ end if
+ ! update depth
+ scalarSnowDepth = scalarSWE/snwDensity
+ ! update temperature of the top soil layer (K)
+ soilTemp = soilTemp - (LH_fus*scalarSfcMeltPond/soilDepth)/soilHeatcap
else ! melt is zero if the temperature of the top soil layer is less than Tfreeze
- scalarSfcMeltPond = 0._rkind ! kg m-2
+ scalarSfcMeltPond = 0._rkind ! kg m-2
end if ! (if the temperature of the top soil layer is greater than Tfreeze)
- else ! melt is zero if the "snow without a layer" does not exist
+ else ! melt is zero if the "snow without a layer" does not exist
scalarSfcMeltPond = 0._rkind ! kg m-2
- end if ! (if the "snow without a layer" exists)
-
- end subroutine implctMelt
-
- end module summaSolveSundialsIDA_module
+ end if ! (if the "snow without a layer" exists)
+
+end subroutine implctMelt
+
+end module summaSolveSundialsIDA_module
\ No newline at end of file
diff --git a/build/source/engine/sundials/systemSolvSundials.f90 b/build/source/engine/sundials/systemSolvSundials.f90
index 308f741..100cc56 100644
--- a/build/source/engine/sundials/systemSolvSundials.f90
+++ b/build/source/engine/sundials/systemSolvSundials.f90
@@ -2,561 +2,537 @@
module systemSolvSundials_module
- ! data types
- USE nrtype
-
- ! access the global print flag
- USE globalData,only:globalPrintFlag
-
- ! access missing values
- USE globalData,only:integerMissing ! missing integer
- USE globalData,only:realMissing ! missing double precision number
- USE globalData,only:quadMissing ! missing quadruple precision number
-
- ! access matrix information
- USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
- USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
- USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
- USE globalData,only: iJac1 ! first layer of the Jacobian to print
- USE globalData,only: iJac2 ! last layer of the Jacobian to print
-
- ! domain types
- USE globalData,only:iname_veg ! named variables for vegetation
- USE globalData,only:iname_snow ! named variables for snow
- USE globalData,only:iname_soil ! named variables for soil
-
- ! state variable type
- USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
- USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
- USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
- USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
- USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
- USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
- USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
- USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
- USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
-
- ! global metadata
- USE globalData,only:flux_meta ! metadata on the model fluxes
-
- ! constants
- USE multiconst,only:&
- LH_fus, & ! latent heat of fusion (J K-1)
- Tfreeze, & ! temperature at freezing (K)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
- ! provide access to indices that define elements of the data structures
- USE var_lookup,only:iLookPROG ! named variables for structure elements
- USE var_lookup,only:iLookDIAG ! named variables for structure elements
- USE var_lookup,only:iLookFLUX ! named variables for structure elements
- USE var_lookup,only:iLookFORCE ! named variables for structure elements
- USE var_lookup,only:iLookPARAM ! named variables for structure elements
- USE var_lookup,only:iLookINDEX ! named variables for structure elements
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- USE var_lookup,only:iLookDERIV ! named variables for structure elements
-
- ! provide access to the derived types to define the data structures
- USE data_types,only:&
- var_i, & ! data vector (i4b)
- var_d, & ! data vector (rkind)
- var_ilength, & ! data vector with variable length dimension (i4b)
- var_dlength, & ! data vector with variable length dimension (rkind)
- zLookup, & ! data vector with variable length dimension (rkind)
- model_options ! defines the model decisions
-
- ! look-up values for the choice of groundwater representation (local-column, or single-basin)
- USE mDecisions_module,only: &
- localColumn, & ! separate groundwater representation in each local soil column
- singleBasin ! single groundwater store over the entire basin
-
- ! look-up values for the choice of groundwater parameterization
- USE mDecisions_module,only: &
- qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
- bigBucket, & ! a big bucket (lumped aquifer model)
- noExplicit ! no explicit groundwater parameterization
-
-
- ! safety: set private unless specified otherwise
+! data types
+USE nrtype
+
+! access the global print flag
+USE globalData,only:globalPrintFlag
+
+! access missing values
+USE globalData,only:integerMissing ! missing integer
+USE globalData,only:realMissing ! missing double precision number
+USE globalData,only:quadMissing ! missing quadruple precision number
+
+! access matrix information
+USE globalData,only: nBands ! length of the leading dimension of the band diagonal matrix
+USE globalData,only: ixFullMatrix ! named variable for the full Jacobian matrix
+USE globalData,only: ixBandMatrix ! named variable for the band diagonal matrix
+USE globalData,only: iJac1 ! first layer of the Jacobian to print
+USE globalData,only: iJac2 ! last layer of the Jacobian to print
+
+! domain types
+USE globalData,only:iname_veg ! named variables for vegetation
+USE globalData,only:iname_snow ! named variables for snow
+USE globalData,only:iname_soil ! named variables for soil
+
+! state variable type
+USE globalData,only:iname_nrgCanair ! named variable defining the energy of the canopy air space
+USE globalData,only:iname_nrgCanopy ! named variable defining the energy of the vegetation canopy
+USE globalData,only:iname_watCanopy ! named variable defining the mass of total water on the vegetation canopy
+USE globalData,only:iname_liqCanopy ! named variable defining the mass of liquid water on the vegetation canopy
+USE globalData,only:iname_nrgLayer ! named variable defining the energy state variable for snow+soil layers
+USE globalData,only:iname_watLayer ! named variable defining the total water state variable for snow+soil layers
+USE globalData,only:iname_liqLayer ! named variable defining the liquid water state variable for snow+soil layers
+USE globalData,only:iname_matLayer ! named variable defining the matric head state variable for soil layers
+USE globalData,only:iname_lmpLayer ! named variable defining the liquid matric potential state variable for soil layers
+
+! global metadata
+USE globalData,only:flux_meta ! metadata on the model fluxes
+
+! constants
+USE multiconst,only:&
+ LH_fus, & ! latent heat of fusion (J K-1)
+ Tfreeze, & ! temperature at freezing (K)
+ iden_ice, & ! intrinsic density of ice (kg m-3)
+ iden_water ! intrinsic density of liquid water (kg m-3)
+
+! provide access to indices that define elements of the data structures
+USE var_lookup,only:iLookPROG ! named variables for structure elements
+USE var_lookup,only:iLookDIAG ! named variables for structure elements
+USE var_lookup,only:iLookFLUX ! named variables for structure elements
+USE var_lookup,only:iLookFORCE ! named variables for structure elements
+USE var_lookup,only:iLookPARAM ! named variables for structure elements
+USE var_lookup,only:iLookINDEX ! named variables for structure elements
+USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
+USE var_lookup,only:iLookDERIV ! named variables for structure elements
+
+! provide access to the derived types to define the data structures
+USE data_types,only:&
+ var_i, & ! data vector (i4b)
+ var_d, & ! data vector (rkind)
+ var_ilength, & ! data vector with variable length dimension (i4b)
+ var_dlength, & ! data vector with variable length dimension (rkind)
+ zLookup, & ! data vector with variable length dimension (rkind)
+ model_options ! defines the model decisions
+
+! look-up values for the choice of groundwater representation (local-column, or single-basin)
+USE mDecisions_module,only: &
+ localColumn, & ! separate groundwater representation in each local soil column
+ singleBasin ! single groundwater store over the entire basin
+
+! look-up values for the choice of groundwater parameterization
+USE mDecisions_module,only: &
+ qbaseTopmodel, & ! TOPMODEL-ish baseflow parameterization
+ bigBucket, & ! a big bucket (lumped aquifer model)
+ noExplicit ! no explicit groundwater parameterization
+
+
+! safety: set private unless specified otherwise
+implicit none
+private
+public::systemSolvSundials
+
+! control parameters
+real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
+real(rkind),parameter :: verySmall=1.e-12_rkind ! a very small number (used to check consistency)
+real(rkind),parameter :: veryBig=1.e+20_rkind ! a very big number
+real(rkind),parameter :: dx = 1.e-8_rkind ! finite difference increment
+
+contains
+
+
+! **********************************************************************************************************
+! public subroutine systemSolvSundials: run the coupled energy-mass model for one timestep
+! **********************************************************************************************************
+subroutine systemSolvSundials(&
+ ! input: model control
+ dt, & ! intent(in): time step (s)
+ nState, & ! intent(in): total number of state variables
+ firstSubStep, & ! intent(in): flag to denote first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
+ scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ forc_data, & ! intent(in): model forcing data
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(inout): index data
+ prog_data, & ! intent(inout): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ bvar_data, & ! intent(in): model variables for the local basin
+ model_decisions, & ! intent(in): model decisions
+ stateVecInit, & ! intent(in): initial state vector
+ ! output
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ stateVecTrial, & ! intent(out): updated state vector
+ stateVecPrime, & ! intent(out): updated state vector
+ reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out): flag to denote that there was too much melt
+ dt_out, & ! intent(out)
+ err,message) ! intent(out): error code and error message
+ ! ---------------------------------------------------------------------------------------
+ ! structure allocations
+ USE allocspace_module,only:allocLocal ! allocate local data structures
+ ! simulation of fluxes and residuals given a trial state vector
+ USE eval8summa_module,only:eval8summa ! simulation of fluxes and residuals given a trial state vector
+ USE eval8summaSundials_module,only:eval8summaSundials
+ USE getVectorz_module,only:getScaling ! get the scaling vectors
+ USE convE2Temp_module,only:temp2ethpy ! convert temperature to enthalpy
+ USE tol4IDA_module,only:popTol4IDA ! pop tolerances
+ USE summaSolveSundialsIDA_module,only:summaSolveSundialsIDA ! solve DAE by IDA
+ USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
+ use, intrinsic :: iso_c_binding
implicit none
- private
- public::systemSolvSundials
-
- ! control parameters
- real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
- real(rkind),parameter :: verySmall=1.e-12_rkind ! a very small number (used to check consistency)
- real(rkind),parameter :: veryBig=1.e+20_rkind ! a very big number
- real(rkind),parameter :: dx = 1.e-8_rkind ! finite difference increment
-
- contains
-
-
- ! **********************************************************************************************************
- ! public subroutine systemSolvSundials: run the coupled energy-mass model for one timestep
- ! **********************************************************************************************************
- subroutine systemSolvSundials(&
- ! input: model control
- dt, & ! intent(in): time step (s)
- nState, & ! intent(in): total number of state variables
- firstSubStep, & ! intent(in): flag to denote first sub-step
- firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
- scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
- ! input/output: data structures
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(inout): index data
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_temp, & ! intent(inout): model fluxes for a local HRU
- bvar_data, & ! intent(in): model variables for the local basin
- model_decisions, & ! intent(in): model decisions
- stateVecInit, & ! intent(in): initial state vector
- ! output
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- stateVecTrial, & ! intent(out): updated state vector
- stateVecPrime, & ! intent(out): updated state vector
- reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
- tooMuchMelt, & ! intent(out): flag to denote that there was too much melt
- dt_out, & ! intent(out)
- err,message) ! intent(out): error code and error message
- ! ---------------------------------------------------------------------------------------
- ! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
- ! simulation of fluxes and residuals given a trial state vector
- USE eval8summaSundials_module,only:eval8summaSundials ! simulation of fluxes and residuals given a trial state vector
- USE getVectorz_module,only:getScaling ! get the scaling vectors
- USE convE2Temp_module,only:temp2ethpy ! convert temperature to enthalpy
- USE tol4IDA_module,only:popTol4IDA ! pop tolerances
- USE summaSolveSundialsIDA_module,only:summaSolveSundialsIDA ! solve DAE by IDA
- USE t2enthalpy_module, only:t2enthalpy_T ! compute enthalpy
- use, intrinsic :: iso_c_binding
- implicit none
- ! ---------------------------------------------------------------------------------------
- ! * dummy variables
- ! ---------------------------------------------------------------------------------------
- ! input: model control
- real(rkind),intent(in) :: dt ! time step (seconds)
- integer(i4b),intent(in) :: nState ! total number of state variables
- logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
- logical(lgt),intent(inout) :: firstFluxCall ! flag to define the first flux call
- logical(lgt),intent(inout) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
- logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
- ! input/output: data structures
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- type(var_i),intent(in) :: type_data ! type of vegetation and soil
- type(var_d),intent(in) :: attr_data ! spatial attributes
- type(var_d),intent(in) :: forc_data ! model forcing data
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
- type(var_dlength),intent(inout) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_temp ! model fluxes for a local HRU
- type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- real(rkind),intent(in) :: stateVecInit(:) ! initial state vector (mixed units)
- ! output: model control
- type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
- integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
- real(rkind),intent(out) :: stateVecTrial(:) ! trial state vector (mixed units)
- real(rkind),intent(out) :: stateVecPrime(:) ! trial state vector (mixed units)
- logical(lgt),intent(out) :: reduceCoupledStep ! flag to reduce the length of the coupled step
- logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that there was too much melt
- real(qp),intent(out) :: dt_out ! time step
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! *********************************************************************************************************************************************************
- ! *********************************************************************************************************************************************************
- ! ---------------------------------------------------------------------------------------
- ! * general local variables
- ! ---------------------------------------------------------------------------------------
- character(LEN=256) :: cmessage ! error message of downwind routine
- integer(i4b) :: iVar ! index of variable
- integer(i4b) :: local_ixGroundwater ! local index for groundwater representation
- real(rkind) :: bulkDensity ! bulk density of a given layer (kg m-3)
- real(rkind) :: volEnthalpy ! volumetric enthalpy of a given layer (J m-3)
- real(rkind),parameter :: tempAccelerate=0.00_rkind ! factor to force initial canopy temperatures to be close to air temperature
- real(rkind),parameter :: xMinCanopyWater=0.0001_rkind ! minimum value to initialize canopy water (kg m-2)
- real(rkind),parameter :: tinyStep=0.000001_rkind ! stupidly small time step (s)
- ! ------------------------------------------------------------------------------------------------------
- ! * model solver
- ! ------------------------------------------------------------------------------------------------------
- logical(lgt),parameter :: forceFullMatrix=.true. ! flag to force the use of the full Jacobian matrix
- integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
- type(var_dlength) :: flux_init ! model fluxes at the start of the time step
- real(rkind),allocatable :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1) ! NOTE: allocatable, since not always needed
- real(rkind) :: stateVecNew(nState) ! new state vector (mixed units)
- real(rkind) :: fluxVec0(nState) ! flux vector (mixed units)
- real(rkind) :: fScale(nState) ! characteristic scale of the function evaluations (mixed units)
- real(rkind) :: xScale(nState) ! characteristic scale of the state vector (mixed units)
- real(rkind) :: dMat(nState) ! diagonal matrix (excludes flux derivatives)
- real(qp) :: sMul(nState) ! NOTE: qp ! multiplier for state vector for the residual calculations
- real(qp) :: rVec(nState) ! NOTE: qp ! residual vector
- real(rkind) :: rAdd(nState) ! additional terms in the residual vector
- logical(lgt) :: feasible ! feasibility flag
- real(rkind) :: atol(nState) ! absolute telerance
- real(rkind) :: rtol(nState) ! relative tolerance
- integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
- real(rkind) :: xMin,xMax ! minimum and maximum values for water content
- real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
- type(var_dlength) :: flux_sum ! sum of fluxes model fluxes for a local HRU over a data step
- integer(i4b) :: tol_iter ! iteration index
- real(rkind), allocatable :: mLayerCmpress_sum(:) ! sum of compression of the soil matrix
- logical(lgt) :: idaSucceeds ! flag to indicate if ida successfully solved the problem in current data step
-
- ! ---------------------------------------------------------------------------------------
- ! point to variables in the data structures
- ! ---------------------------------------------------------------------------------------
- globalVars: associate(&
- ! model decisions
- ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
- ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
- ! enthalpy
- scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the canopy air space (J m-3)
- scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the vegetation canopy (J m-3)
- mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(out): [dp(:)] enthalpy of the snow+soil layers (J m-3)
- ! soil parameters
- theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
- theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
- ! model state variables
- scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in): [dp] temperature of the canopy air space (K)
- scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in): [dp] temperature of the vegetation canopy (K)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp] mass of ice on the vegetation canopy (kg m-2)
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in): [dp] mass of total water on the vegetation canopy (kg m-2)
- ! model state variables (snow and soil domains)
- mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in): [dp(:)] temperature of each snow/soil layer (K)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
- mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in): [dp(:)] volumetric fraction of total water (-)
- mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(in): [dp(:)] liquid water matric potential (m)
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout): [dp(:)] matric head (m)
- ! check the need to merge snow layers
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
- snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
- ! accelerate solution for temperature
- airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
- ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
- ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
- ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
- ! vector of energy and hydrology indices for the snow and soil domains
- ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
- ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
- ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow+soil subdomain
- ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
- layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
- ! layer geometry
- nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] number of snow layers
- nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] number of soil layers
- nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in): [i4b] total number of layers
- )
- ! ---------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="systemSolvSundials/"
-
- ! *****
- ! (0) PRELIMINARIES...
- ! ********************
-
- ! -----
- ! * initialize...
- ! ---------------
-
- ! check
- if(dt < tinyStep)then
- message=trim(message)//'dt is tiny'
- err=20; return
- endif
-
- ! initialize the flags
- tooMuchMelt = .false. ! too much melt
- reduceCoupledStep = .false. ! need to reduce the length of the coupled step
-
- ! modify the groundwater representation for this single-column implementation
- select case(ixSpatialGroundwater)
- case(singleBasin); local_ixGroundwater = noExplicit ! force no explicit representation of groundwater at the local scale
- case(localColumn); local_ixGroundwater = ixGroundwater ! go with the specified decision
- case default; err=20; message=trim(message)//'unable to identify spatial representation of groundwater'; return
- end select ! (modify the groundwater representation for this single-column implementation)
-
- ! allocate space for the model fluxes at the start of the time step
- call allocLocal(flux_meta(:),flux_init,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the baseflow derivatives
- ! NOTE: needs allocation because only used when baseflow sinks are active
- if(ixGroundwater==qbaseTopmodel)then
- allocate(dBaseflow_dMatric(nSoil,nSoil),stat=err) ! baseflow depends on total storage in the soil column, hence on matric head in every soil layer
- else
- allocate(dBaseflow_dMatric(0,0),stat=err) ! allocate zero-length dimnensions to avoid passing around an unallocated matrix
- end if
- if(err/=0)then; err=20; message=trim(message)//'unable to allocate space for the baseflow derivatives'; return; end if
-
-
- ! identify the matrix solution method
- ! (the type of matrix used to solve the linear system A.X=B)
- if(local_ixGroundwater==qbaseTopmodel .or. scalarSolution .or. forceFullMatrix)then
- ixMatrix=ixFullMatrix ! named variable to denote the full Jacobian matrix
- else
- ixMatrix=ixBandMatrix ! named variable to denote the band-diagonal matrix
- endif
-
- ! initialize the model fluxes (some model fluxes are not computed in the iterations)
- do iVar=1,size(flux_temp%var)
- flux_init%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
- end do
-
- ! -----
- ! * get scaling vectors...
- ! ------------------------
-
- ! initialize state vectors
- call getScaling(&
- ! input
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output
- fScale, & ! intent(out): function scaling vector (mixed units)
- xScale, & ! intent(out): variable scaling vector (mixed units)
- sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
- dMat, & ! intent(out): diagonal of the Jacobian matrix (excludes fluxes)
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- ! initialize the trial state vectors
- stateVecTrial = stateVecInit
-
- ! need to intialize canopy water at a positive value
- if(ixVegHyd/=integerMissing)then
- if(stateVecTrial(ixVegHyd) < xMinCanopyWater) stateVecTrial(ixVegHyd) = stateVecTrial(ixVegHyd) + xMinCanopyWater
- endif
-
- ! try to accelerate solution for energy
- if(ixCasNrg/=integerMissing) stateVecTrial(ixCasNrg) = stateVecInit(ixCasNrg) + (airtemp - stateVecInit(ixCasNrg))*tempAccelerate
- if(ixVegNrg/=integerMissing) stateVecTrial(ixVegNrg) = stateVecInit(ixVegNrg) + (airtemp - stateVecInit(ixVegNrg))*tempAccelerate
-
- ! compute H_T at the beginning of the data step
- call t2enthalpy_T(&
- ! input: data structures
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- mpar_data, & ! intent(in): parameter data structure
- indx_data, & ! intent(in): model indices
- lookup_data, & ! intent(in): lookup table data structure
- ! input: state variables for the vegetation canopy
- scalarCanairTemp, & ! intent(in): value of canopy air temperature (K)
- scalarCanopyTemp, & ! intent(in): value of canopy temperature (K)
- scalarCanopyWat, & ! intent(in): value of canopy total water (kg m-2)
- scalarCanopyIce, & ! intent(in): value for canopy ice content (kg m-2)
- ! input: variables for the snow-soil domain
- mLayerTemp, & ! intent(in): vector of layer temperature (K)
- mLayerVolFracWat, & ! intent(in): vector of volumetric total water content (-)
- mLayerMatricHead, & ! intent(in): vector of total water matric potential (m)
- mLayerVolFracIce, & ! intent(in): vector of volumetric fraction of ice (-)
- ! output: enthalpy
- scalarCanairEnthalpy, & ! intent(out): temperature component of enthalpy of the canopy air space (J m-3)
- scalarCanopyEnthalpy, & ! intent(out): temperature component of enthalpy of the vegetation canopy (J m-3)
- mLayerEnthalpy, & ! intent(out): temperature component of enthalpy of each snow+soil layer (J m-3)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
-
- ! compute the flux and the residual vector for a given state vector
- ! NOTE 1: The derivatives computed in eval8summaSundials are used to calculate the Jacobian matrix for the first iteration
- ! NOTE 2: The Jacobian matrix together with the residual vector is used to calculate the first iteration increment
- call eval8summaSundials(&
- ! input: model control
- dt, & ! intent(in): current stepsize
- dt, & ! intent(in): length of the time step (seconds)
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): number of layers
- nState, & ! intent(in): number of state variables in the current subset
- .false., & ! intent(in): outside Sundials solver loop
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- firstSplitOper, & ! intent(inout): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vectors
- stateVecTrial, & ! intent(in): model state vector
- fScale, & ! intent(in): function scaling vector
- sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
- ! input: data structures
- model_decisions, & ! intent(in): model decisions
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- ! input-output: data structures
- indx_data, & ! intent(inout): index data
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! input-output: here we need to pass some extra variables that do not get updated in in the Sundials loops
- scalarCanopyTemp, & ! intent(inout): trial value of canopy temperature (K)
- scalarCanopyIce, & ! intent(inout): trial value for mass of ice on the vegetation canopy (kg m-2)
- scalarCanopyEnthalpy, & ! intent(inout): trial value for enthalpy of the vegetation canopy (J m-3)
- mLayerTemp, & ! intent(inout): trial vector of layer temperature (K)
- mLayerMatricHead, & ! intent(inout): trial value for total water matric potential (m)
- mLayerMatricHeadLiq, & ! intent(inout): trial value for liquid water matric potential (m)
- mLayerVolFracWat, & ! intent(inout): trial vector of volumetric total water content (-)
- mLayerVolFracIce, & ! intent(inout): trial vector of volumetric ice water content (-)
- mLayerEnthalpy, & ! intent(inout): trial vector of enthalpy for snow+soil layers (J m-3)
- ! input-output: baseflow
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
- ! output: flux and residual vectors
- feasible, & ! intent(out): flag to denote the feasibility of the solution
- fluxVec0, & ! intent(out): flux vector
- rAdd, & ! intent(out): additional (sink) terms on the RHS of the state equation
- rVec, & ! intent(out): residual vector
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
- if(.not.feasible)then; message=trim(message)//'state vector not feasible'; err=20; return; endif
-
- ! copy over the initial flux structure since some model fluxes are not computed in the iterations
- do concurrent ( iVar=1:size(flux_meta) )
- flux_temp%var(iVar)%dat(:) = flux_init%var(iVar)%dat(:)
- end do
-
- ! allocate space for the temporary flux_sum structure
- call allocLocal(flux_meta(:),flux_sum,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for mLayerCmpress_sum
- allocate( mLayerCmpress_sum(nSoil) )
-
- ! check the need to merge snow layers
- if(nSnow>0)then
- ! compute the energy required to melt the top snow layer (J m-2)
- bulkDensity = mLayerVolFracIce(1)*iden_ice + mLayerVolFracLiq(1)*iden_water
- volEnthalpy = temp2ethpy(mLayerTemp(1),bulkDensity,snowfrz_scale)
- ! set flag and error codes for too much melt
- if(-volEnthalpy < flux_init%var(iLookFLUX%mLayerNrgFlux)%dat(1)*dt)then
- tooMuchMelt=.true.
- message=trim(message)//'net flux in the top snow layer can melt all the snow in the top layer'
- err=-20; return ! negative error code to denote a warning
+ ! ---------------------------------------------------------------------------------------
+ ! * dummy variables
+ ! ---------------------------------------------------------------------------------------
+ ! input: model control
+ real(rkind),intent(in) :: dt ! time step (seconds)
+ integer(i4b),intent(in) :: nState ! total number of state variables
+ logical(lgt),intent(in) :: firstSubStep ! flag to indicate if we are processing the first sub-step
+ logical(lgt),intent(inout) :: firstFluxCall ! flag to define the first flux call
+ logical(lgt),intent(in) :: firstSplitOper ! flag to indicate if we are processing the first flux call in a splitting operation
+ logical(lgt),intent(in) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
+ logical(lgt),intent(in) :: scalarSolution ! flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_i),intent(in) :: type_data ! type of vegetation and soil
+ type(var_d),intent(in) :: attr_data ! spatial attributes
+ type(var_d),intent(in) :: forc_data ! model forcing data
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(inout) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: flux_temp ! model fluxes for a local HRU
+ type(var_dlength),intent(in) :: bvar_data ! model variables for the local basin
+ type(model_options),intent(in) :: model_decisions(:) ! model decisions
+ real(rkind),intent(in) :: stateVecInit(:) ! initial state vector (mixed units)
+ ! output: model control
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ integer(i4b),intent(inout) :: ixSaturation ! index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ real(rkind),intent(out) :: stateVecTrial(:) ! trial state vector (mixed units)
+ real(rkind),intent(out) :: stateVecPrime(:) ! trial state vector (mixed units)
+ logical(lgt),intent(out) :: reduceCoupledStep ! flag to reduce the length of the coupled step
+ logical(lgt),intent(out) :: tooMuchMelt ! flag to denote that there was too much melt
+ real(qp),intent(out) :: dt_out ! time step
+ integer(i4b),intent(out) :: err ! error code
+ character(*),intent(out) :: message ! error message
+
+ ! ---------------------------------------------------------------------------------------
+ ! * general local variables
+ ! ---------------------------------------------------------------------------------------
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ integer(i4b) :: iVar ! index of variable
+ integer(i4b) :: local_ixGroundwater ! local index for groundwater representation
+ real(rkind) :: bulkDensity ! bulk density of a given layer (kg m-3)
+ real(rkind) :: volEnthalpy ! volumetric enthalpy of a given layer (J m-3)
+ real(rkind),parameter :: tempAccelerate=0.00_rkind ! factor to force initial canopy temperatures to be close to air temperature
+ real(rkind),parameter :: xMinCanopyWater=0.0001_rkind ! minimum value to initialize canopy water (kg m-2)
+ real(rkind),parameter :: tinyStep=0.000001_rkind ! stupidly small time step (s)
+
+ ! ------------------------------------------------------------------------------------------------------
+ ! * model solver
+ ! ------------------------------------------------------------------------------------------------------
+ logical(lgt),parameter :: forceFullMatrix=.true. ! flag to force the use of the full Jacobian matrix
+ integer(i4b) :: ixMatrix ! form of matrix (band diagonal or full matrix)
+ type(var_dlength) :: flux_init ! model fluxes at the start of the time step
+ real(rkind),allocatable :: dBaseflow_dMatric(:,:) ! derivative in baseflow w.r.t. matric head (s-1) ! NOTE: allocatable, since not always needed
+ real(rkind) :: stateVecNew(nState) ! new state vector (mixed units)
+ real(rkind) :: fluxVec0(nState) ! flux vector (mixed units)
+ real(rkind) :: fScale(nState) ! characteristic scale of the function evaluations (mixed units)
+ real(rkind) :: xScale(nState) ! characteristic scale of the state vector (mixed units)
+ real(rkind) :: dMat(nState) ! diagonal matrix (excludes flux derivatives)
+ real(qp) :: sMul(nState) ! NOTE: qp ! multiplier for state vector for the residual calculations
+ real(qp) :: rVec(nState) ! NOTE: qp ! residual vector
+ real(rkind) :: rAdd(nState) ! additional terms in the residual vector
+ real(rkind) :: fOld ! function values (-); NOTE: dimensionless because scaled
+ logical(lgt) :: feasible ! feasibility flag
+ real(rkind) :: atol(nState) ! absolute telerance
+ real(rkind) :: rtol(nState) ! relative tolerance
+ integer(i4b) :: iLayer ! index of model layer in the snow+soil domain
+ real(rkind) :: xMin,xMax ! minimum and maximum values for water content
+ real(rkind),parameter :: canopyTempMax=500._rkind ! expected maximum value for the canopy temperature (K)
+ type(var_dlength) :: flux_sum ! sum of fluxes model fluxes for a local HRU over a data step
+ integer(i4b) :: tol_iter ! iteration index
+ real(rkind), allocatable :: mLayerCmpress_sum(:) ! sum of compression of the soil matrix
+ logical(lgt) :: idaSucceeds ! flag to indicate if ida successfully solved the problem in current data step
+
+
+ ! ---------------------------------------------------------------------------------------
+ ! point to variables in the data structures
+ ! ---------------------------------------------------------------------------------------
+ globalVars: associate(&
+ ! model decisions
+ ixGroundwater => model_decisions(iLookDECISIONS%groundwatr)%iDecision ,& ! intent(in): [i4b] groundwater parameterization
+ ixSpatialGroundwater => model_decisions(iLookDECISIONS%spatial_gw)%iDecision ,& ! intent(in): [i4b] spatial representation of groundwater (local-column or single-basin)
+ ! enthalpy
+ scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(out): [dp] enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(out): [dp(:)] enthalpy of the snow+soil layers (J m-3)
+ ! soil parameters
+ theta_sat => mpar_data%var(iLookPARAM%theta_sat)%dat ,& ! intent(in): [dp(:)] soil porosity (-)
+ theta_res => mpar_data%var(iLookPARAM%theta_res)%dat ,& ! intent(in): [dp(:)] residual volumetric water content (-)
+ ! model state variables
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(in): [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(in): [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(in): [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(in): [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(in): [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(in): [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(in): [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout): [dp(:)] matric head (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in): [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ snowfrz_scale => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) ,& ! intent(in): [dp] scaling parameter for the snow freezing curve (K-1)
+ airtemp => forc_data%var(iLookFORCE%airtemp) ,& ! intent(in): [dp] temperature of the upper boundary of the snow and soil domains (K)
+ ixCasNrg => indx_data%var(iLookINDEX%ixCasNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy air space energy state variable
+ ixVegNrg => indx_data%var(iLookINDEX%ixVegNrg)%dat(1) ,& ! intent(in): [i4b] index of canopy energy state variable
+ ixSnowOnlyNrg => indx_data%var(iLookINDEX%ixSnowOnlyNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow subdomain
+ ixSnowSoilHyd => indx_data%var(iLookINDEX%ixSnowSoilHyd)%dat ,& ! intent(in): [i4b(:)] indices for hydrology states in the snow+soil subdomain
+ ixSnowSoilNrg => indx_data%var(iLookINDEX%ixSnowSoilNrg)%dat ,& ! intent(in): [i4b(:)] indices for energy states in the snow+soil subdomain
+ ixHydType => indx_data%var(iLookINDEX%ixHydType)%dat ,& ! intent(in): [i4b(:)] index of the type of hydrology states in snow+soil domain
+ layerType => indx_data%var(iLookINDEX%layerType)%dat ,& ! intent(in): [i4b(:)] layer type (iname_soil or iname_snow)
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in): [i4b] index of canopy hydrology state variable (mass)
+ nSnow => indx_data%var(iLookINDEX%nSnow)%dat(1) ,& ! intent(in): [i4b] number of snow layers
+ nSoil => indx_data%var(iLookINDEX%nSoil)%dat(1) ,& ! intent(in): [i4b] number of soil layers
+ nLayers => indx_data%var(iLookINDEX%nLayers)%dat(1) & ! intent(in): [i4b] total number of layers
+ )
+ ! ---------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message="systemSolvSundials/"
+
+ ! *****
+ ! (0) PRELIMINARIES...
+ ! ********************
+
+ ! -----
+ ! * initialize...
+ ! ---------------
+
+ ! check
+ if(dt < tinyStep)then
+ message=trim(message)//'dt is tiny'
+ err=20; return
+ endif
+
+ ! initialize the flags
+ tooMuchMelt = .false. ! too much melt
+ reduceCoupledStep = .false. ! need to reduce the length of the coupled step
+
+
+ ! modify the groundwater representation for this single-column implementation
+ select case(ixSpatialGroundwater)
+ case(singleBasin); local_ixGroundwater = noExplicit ! force no explicit representation of groundwater at the local scale
+ case(localColumn); local_ixGroundwater = ixGroundwater ! go with the specified decision
+ case default; err=20; message=trim(message)//'unable to identify spatial representation of groundwater'; return
+ end select ! (modify the groundwater representation for this single-column implementation)
+
+ ! allocate space for the model fluxes at the start of the time step
+ call allocLocal(flux_meta(:),flux_init,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for the baseflow derivatives
+ ! NOTE: needs allocation because only used when baseflow sinks are active
+ if(ixGroundwater==qbaseTopmodel)then
+ allocate(dBaseflow_dMatric(nSoil,nSoil),stat=err) ! baseflow depends on total storage in the soil column, hence on matric head in every soil layer
+ else
+ allocate(dBaseflow_dMatric(0,0),stat=err) ! allocate zero-length dimnensions to avoid passing around an unallocated matrix
+ end if
+ if(err/=0)then; err=20; message=trim(message)//'unable to allocate space for the baseflow derivatives'; return; end if
+
+
+ ! identify the matrix solution method
+ ! (the type of matrix used to solve the linear system A.X=B)
+ if(local_ixGroundwater==qbaseTopmodel .or. scalarSolution .or. forceFullMatrix)then
+ ixMatrix=ixFullMatrix ! named variable to denote the full Jacobian matrix
+ else
+ ixMatrix=ixBandMatrix ! named variable to denote the band-diagonal matrix
endif
- endif
-
- ! get tolerance vectors
- call popTol4IDA(&
+
+ ! initialize the model fluxes (some model fluxes are not computed in the iterations)
+ do iVar=1,size(flux_temp%var)
+ flux_init%var(iVar)%dat(:) = flux_temp%var(iVar)%dat(:)
+ end do
+
+ ! -----
+ ! * get scaling vectors...
+ ! ------------------------
+
+ ! initialize state vectors
+ call getScaling(&
! input
- nState, & ! intent(in): number of desired state variables
- prog_data, & ! intent(in): model prognostic variables for a local HRU
diag_data, & ! intent(in): model diagnostic variables for a local HRU
indx_data, & ! intent(in): indices defining model states and layers
- mpar_data, & ! intent(in): model parameters
! output
- atol, & ! intent(out): absolute tolerances vector (mixed units)
- rtol, & ! intent(out): relative tolerances vector (mixed units)
+ fScale, & ! intent(out): function scaling vector (mixed units)
+ xScale, & ! intent(out): variable scaling vector (mixed units)
+ sMul, & ! intent(out): multiplier for state vector (used in the residual calculations)
+ dMat, & ! intent(out): diagonal of the Jacobian matrix (excludes fluxes)
err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- !-------------------
- ! * solving F(y,y') = 0 by IDA. Here, y is the state vector
- ! ------------------
-
- !do tol_iter=1,3
-
- ! initialize flux_sum
- do concurrent ( iVar=1:size(flux_meta) )
- flux_sum%var(iVar)%dat(:) = 0._rkind
- end do
-
- ! initialize sum of compression of the soil matrix
- mLayerCmpress_sum(:) = 0._rkind
-
- call summaSolveSundialsIDA(&
- dt, & ! intent (in) data time step
- atol, & ! intent (in) absolute telerance
- rtol, & ! intent (in) relative tolerance
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): number of snow+soil layers
- nState, & ! intent(in): number of state variables in the current subset
- ixMatrix, & ! intent(in): type of matrix (dense or banded)
- firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
- computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
- scalarSolution, & ! intent(in): flag to indicate the scalar solution
- ! input: state vector
- stateVecTrial, & ! intent(in): model state vector at the beginning of the data time step
- sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
- dMat, & ! intent(inout) diagonal of the Jacobian matrix (excludes fluxes)
- ! input: data structures
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- forc_data, & ! intent(in): model forcing data
- bvar_data, & ! intent(in): average model variables for the entire basin
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): index data
- ! input-output: data structures
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
- flux_temp, & ! intent(inout): model fluxes for a local HRU
- flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ! output
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
- tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
- mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
- dt_out, & ! intent(out): time step
- stateVecNew, & ! intent(out): model state vector (y) at the end of the data time step
- stateVecPrime, & ! intent(out): derivative of model state vector (y') at the end of the data time step
- err,cmessage) ! intent(out): error control
-
- !if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
- ! if (idaSucceeds)then
- ! exit
- ! else
- ! atol = atol * 0.1
- ! rtol = rtol * 0.1
- ! endif
- ! if( .not.idaSucceeds .and. tol_iter==3) message=trim(message)//'IDA did not succeed after reducing tolerance by 2 magnitudes'
-
- !end do ! iteration over tolerances
-
- ! check if IDA is successful
- if( .not.idaSucceeds )then
- err = 20
- message=trim(message)//trim(cmessage)
- ! reduceCoupledStep = .true.
- return
- else
- if (tooMuchMelt) return !exit to start same step over after merge
- endif
-
- ! compute average flux
- do iVar=1,size(flux_meta)
- flux_temp%var(iVar)%dat(:) = ( flux_sum%var(iVar)%dat(:) ) / dt_out
- end do
-
- ! compute the total change in storage associated with compression of the soil matrix (kg m-2)
- diag_data%var(iLookDIAG%mLayerCompress)%dat(:) = mLayerCmpress_sum(:)
- diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) = sum(diag_data%var(iLookDIAG%mLayerCompress)%dat(1:nSoil)*mLayerDepth(nSnow+1:nLayers))*iden_water
-
- ! save the computed solution
- stateVecTrial = stateVecNew
-
- ! free memory
- deallocate(mLayerCmpress_sum)
- deallocate(dBaseflow_dMatric)
-
- ! end associate statements
- end associate globalVars
-
- end subroutine systemSolvSundials
-
- end module systemSolvSundials_module
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! initialize the trial state vectors
+ stateVecTrial = stateVecInit
+
+ ! need to intialize canopy water at a positive value
+ if(ixVegHyd/=integerMissing)then
+ if(stateVecTrial(ixVegHyd) < xMinCanopyWater) stateVecTrial(ixVegHyd) = stateVecTrial(ixVegHyd) + xMinCanopyWater
+ endif
+
+ ! try to accelerate solution for energy
+ if(ixCasNrg/=integerMissing) stateVecTrial(ixCasNrg) = stateVecInit(ixCasNrg) + (airtemp - stateVecInit(ixCasNrg))*tempAccelerate
+ if(ixVegNrg/=integerMissing) stateVecTrial(ixVegNrg) = stateVecInit(ixVegNrg) + (airtemp - stateVecInit(ixVegNrg))*tempAccelerate
+
+ ! compute H_T at the beginning of the data step
+ call t2enthalpy_T(&
+ ! input: data structures
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ mpar_data, & ! intent(in): parameter data structure
+ indx_data, & ! intent(in): model indices
+ lookup_data, & ! intent(in): lookup table data structure
+ ! input: state variables for the vegetation canopy
+ scalarCanairTemp, & ! intent(in): value of canopy air temperature (K)
+ scalarCanopyTemp, & ! intent(in): value of canopy temperature (K)
+ scalarCanopyWat, & ! intent(in): value of canopy total water (kg m-2)
+ scalarCanopyIce, & ! intent(in): value for canopy ice content (kg m-2)
+ ! input: variables for the snow-soil domain
+ mLayerTemp, & ! intent(in): vector of layer temperature (K)
+ mLayerVolFracWat, & ! intent(in): vector of volumetric total water content (-)
+ mLayerMatricHead, & ! intent(in): vector of total water matric potential (m)
+ mLayerVolFracIce, & ! intent(in): vector of volumetric fraction of ice (-)
+ ! output: enthalpy
+ scalarCanairEnthalpy, & ! intent(out): temperature component of enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy, & ! intent(out): temperature component of enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy, & ! intent(out): temperature component of enthalpy of each snow+soil layer (J m-3)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
+
+ ! compute the flux and the residual vector for a given state vector
+ ! NOTE 1: The derivatives computed in eval8summa are used to calculate the Jacobian matrix for the first iteration
+ ! NOTE 2: The Jacobian matrix together with the residual vector is used to calculate the first iteration increment
+
+ call eval8summa(&
+ ! input: model control
+ dt, & ! intent(in): length of the time step (seconds)
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): number of layers
+ nState, & ! intent(in): number of state variables in the current subset
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vectors
+ stateVecTrial, & ! intent(in): model state vector
+ fScale, & ! intent(in): function scaling vector
+ sMul, & ! intent(in): state vector multiplier (used in the residual calculations)
+ ! input: data structures
+ model_decisions, & ! intent(in): model decisions
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): index data
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! input-output: baseflow
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ dBaseflow_dMatric, & ! intent(out): derivative in baseflow w.r.t. matric head (s-1)
+ ! output
+ feasible, & ! intent(out): flag to denote the feasibility of the solution
+ fluxVec0, & ! intent(out): flux vector
+ rAdd, & ! intent(out): additional (sink) terms on the RHS of the state equation
+ rVec, & ! intent(out): residual vector
+ fOld, & ! intent(out): function evaluation
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+ if(.not.feasible)then; message=trim(message)//'state vector not feasible'; err=20; return; endif
+
+ ! copy over the initial flux structure since some model fluxes are not computed in the iterations
+ do concurrent ( iVar=1:size(flux_meta) )
+ flux_temp%var(iVar)%dat(:) = flux_init%var(iVar)%dat(:)
+ end do
+
+ ! allocate space for the temporary flux_sum structure
+ call allocLocal(flux_meta(:),flux_sum,nSnow,nSoil,err,cmessage)
+ if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
+
+ ! allocate space for mLayerCmpress_sum
+ allocate( mLayerCmpress_sum(nSoil) )
+
+ ! check the need to merge snow layers
+ if(nSnow>0)then
+ ! compute the energy required to melt the top snow layer (J m-2)
+ bulkDensity = mLayerVolFracIce(1)*iden_ice + mLayerVolFracLiq(1)*iden_water
+ volEnthalpy = temp2ethpy(mLayerTemp(1),bulkDensity,snowfrz_scale)
+ ! set flag and error codes for too much melt
+ if(-volEnthalpy < flux_init%var(iLookFLUX%mLayerNrgFlux)%dat(1)*dt)then
+ tooMuchMelt=.true.
+ message=trim(message)//'net flux in the top snow layer can melt all the snow in the top layer'
+ err=-20; return ! negative error code to denote a warning
+ endif
+ endif
+
+ ! get tolerance vectors
+ call popTol4IDA(&
+ ! input
+ nState, & ! intent(in): number of desired state variables
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ mpar_data, & ! intent(in): model parameters
+ ! output
+ atol, & ! intent(out): absolute tolerances vector (mixed units)
+ rtol, & ! intent(out): relative tolerances vector (mixed units)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ !-------------------
+ ! * solving F(y,y') = 0 by IDA. Here, y is the state vector
+ ! ------------------
+ ! initialize flux_sum
+ do concurrent ( iVar=1:size(flux_meta) )
+ flux_sum%var(iVar)%dat(:) = 0._rkind
+ end do
+
+ ! initialize sum of compression of the soil matrix
+ mLayerCmpress_sum(:) = 0._rkind
+
+ call summaSolveSundialsIDA(&
+ dt, & ! intent (in) data time step
+ atol, & ! intent (in) absolute telerance
+ rtol, & ! intent (in) relative tolerance
+ nSnow, & ! intent(in): number of snow layers
+ nSoil, & ! intent(in): number of soil layers
+ nLayers, & ! intent(in): number of snow+soil layers
+ nState, & ! intent(in): number of state variables in the current subset
+ ixMatrix, & ! intent(in): type of matrix (dense or banded)
+ firstSubStep, & ! intent(in): flag to indicate if we are processing the first sub-step
+ computeVegFlux, & ! intent(in): flag to indicate if we need to compute fluxes over vegetation
+ scalarSolution, & ! intent(in): flag to indicate the scalar solution
+ ! input: state vector
+ stateVecTrial, & ! intent(in): model state vector at the beginning of the data time step
+ sMul, & ! intent(inout): state vector multiplier (used in the residual calculations)
+ dMat, & ! intent(inout) diagonal of the Jacobian matrix (excludes fluxes)
+ ! input: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ mpar_data, & ! intent(in): model parameters
+ forc_data, & ! intent(in): model forcing data
+ bvar_data, & ! intent(in): average model variables for the entire basin
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): index data
+ ! input-output: data structures
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_init, & ! intent(inout): model fluxes for a local HRU (initial flux structure)
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ flux_sum, & ! intent(inout): sum of fluxes model fluxes for a local HRU over a data step
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ! output
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ idaSucceeds, & ! intent(out): flag to indicate if ida successfully solved the problem in current data step
+ tooMuchMelt, & ! intent(inout): flag to denote that there was too much melt
+ mLayerCmpress_sum, & ! intent(out): sum of compression of the soil matrix
+ dt_out, & ! intent(out): time step
+ stateVecNew, & ! intent(out): model state vector (y) at the end of the data time step
+ stateVecPrime, & ! intent(out): derivative of model state vector (y') at the end of the data time step
+ err,cmessage) ! intent(out): error control
+
+ ! check if IDA is successful
+ if( .not.idaSucceeds )then
+ err = 20
+ message=trim(message)//trim(cmessage)
+ ! reduceCoupledStep = .true.
+ return
+ else
+ if (tooMuchMelt) return !exit to start same step over after merge
+ endif
+
+ ! compute average flux
+ do iVar=1,size(flux_meta)
+ flux_temp%var(iVar)%dat(:) = ( flux_sum%var(iVar)%dat(:) ) / dt_out
+ end do
+
+ diag_data%var(iLookDIAG%mLayerCompress)%dat(:) = mLayerCmpress_sum(:)
+
+ ! compute the total change in storage associated with compression of the soil matrix (kg m-2)
+ diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) = sum(diag_data%var(iLookDIAG%mLayerCompress)%dat(1:nSoil)*mLayerDepth(nSnow+1:nLayers))*iden_water
+
+ ! save the computed solution
+ stateVecTrial = stateVecNew
+
+ ! free memory
+ deallocate(mLayerCmpress_sum)
+ deallocate(dBaseflow_dMatric)
+
+ ! end associate statements
+ end associate globalVars
+
+end subroutine systemSolvSundials
+
+end module systemSolvSundials_module
\ No newline at end of file
diff --git a/build/source/engine/sundials/varSubstepSundials.f90 b/build/source/engine/sundials/varSubstepSundials.f90
index 3da718e..93921b0 100644
--- a/build/source/engine/sundials/varSubstepSundials.f90
+++ b/build/source/engine/sundials/varSubstepSundials.f90
@@ -84,723 +84,712 @@ module varSubstepSundials_module
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
-
- ! initialize error control
- err=0; message='varSubstepSundials/'
-
- !write(*,'(a,1x,3(f13.2,1x))') '***** new subStep: dtSubstep, dtSum, dt = ', dtSubstep, dtSum, dt
- !print*, 'scalarCanopyIce = ', prog_data%var(iLookPROG%scalarCanopyIce)%dat(1)
- !print*, 'scalarCanopyTemp = ', prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1)
-
- ! -----
- ! * populate state vectors...
- ! ---------------------------
-
- ! initialize state vectors
- call popStateVec(&
- ! input
- nState, & ! intent(in): number of desired state variables
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output
- stateVecInit, & ! intent(out): initial model state vector (mixed units)
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
-
- ! -----
- ! * iterative solution...
- ! -----------------------
- ! solve the system of equations for a given state subset
- call systemSolvSundials(&
- ! input: model control
- dtSubstep, & ! intent(in): time step (s)
- nState, & ! intent(in): total number of state variables
- firstSubStep, & ! intent(in): flag to denote first sub-step
- firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
- firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
- computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
- scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
- ! input/output: data structures
- lookup_data, & ! intent(in): lookup tables
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(inout): index data
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_temp, & ! intent(inout): model fluxes for a local HRU
- bvar_data, & ! intent(in): model variables for the local basin
- model_decisions, & ! intent(in): model decisions
- stateVecInit, & ! intent(in): initial state vector
- ! output: model control
- deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
- ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
- stateVecTrial, & ! intent(out): updated state vector
- stateVecPrime, & ! intent(out): updated state vector
- reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
- tooMuchMelt, & ! intent(out): flag to denote that ice is insufficient to support melt
- dt_out, & ! intent(out): time step (s)
- err,cmessage) ! intent(out): error code and error message
-
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- if(err>0) return
- endif
-
- ! set untapped melt energy to zero
- untappedMelt(:) = 0._rkind
-
- ! if too much melt or need to reduce length of the coupled step then return
- ! NOTE: need to go all the way back to coupled_em and merge snow layers, as all splitting operations need to occur with the same layer geometry
- if(tooMuchMelt .or. reduceCoupledStep) return
-
- ! identify failure
- failedSubstep = (err<0)
+ ! **********************************************************************************************************
+ ! 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 getVectorz_module,only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
+ ! 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
+
+ ! initalize flag for checking if energy fluxes had been modified
+ nrgFluxModified = .false.
- ! 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
+ ! 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/'
+
+ ! -----
+ ! * populate state vectors...
+ ! ---------------------------
+
+ ! initialize state vectors
+ call popStateVec(&
+ ! input
+ nState, & ! intent(in): number of desired state variables
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output
+ stateVecInit, & ! intent(out): initial model state vector (mixed units)
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; endif ! (check for errors)
+
+ ! -----
+ ! * iterative solution...
+ ! -----------------------
+ ! solve the system of equations for a given state subset
+ call systemSolvSundials(&
+ ! input: model control
+ dtSubstep, & ! intent(in): time step (s)
+ nState, & ! intent(in): total number of state variables
+ firstSubStep, & ! intent(in): flag to denote first sub-step
+ firstFluxCall, & ! intent(inout): flag to indicate if we are processing the first flux call
+ firstSplitOper, & ! intent(in): flag to indicate if we are processing the first flux call in a splitting operation
+ computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
+ scalarSolution, & ! intent(in): flag to denote if implementing the scalar solution
+ ! input/output: data structures
+ lookup_data, & ! intent(in): lookup tables
+ type_data, & ! intent(in): type of vegetation and soil
+ attr_data, & ! intent(in): spatial attributes
+ forc_data, & ! intent(in): model forcing data
+ mpar_data, & ! intent(in): model parameters
+ indx_data, & ! intent(inout): index data
+ prog_data, & ! intent(inout): model prognostic variables for a local HRU
+ diag_data, & ! intent(inout): model diagnostic variables for a local HRU
+ flux_temp, & ! intent(inout): model fluxes for a local HRU
+ bvar_data, & ! intent(in): model variables for the local basin
+ model_decisions, & ! intent(in): model decisions
+ stateVecInit, & ! intent(in): initial state vector
+ ! output: model control
+ deriv_data, & ! intent(inout): derivatives in model fluxes w.r.t. relevant state variables
+ ixSaturation, & ! intent(inout): index of the lowest saturated layer (NOTE: only computed on the first iteration)
+ stateVecTrial, & ! intent(out): updated state vector
+ stateVecPrime, & ! intent(out): updated state vector
+ reduceCoupledStep, & ! intent(out): flag to reduce the length of the coupled step
+ tooMuchMelt, & ! intent(out): flag to denote that ice is insufficient to support melt
+ dt_out, & ! intent(out): time step (s)
+ err,cmessage) ! intent(out): error code and error message
+
+ if(err/=0)then
+ message=trim(message)//trim(cmessage)
+ if(err>0) return
+ endif
- endif ! switch between failure and success
+ ! set untapped melt energy to zero
+ untappedMelt(:) = 0._rkind
- ! check if we failed the substep
- if(failedSubstep)then
+ ! 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
- ! 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
+ ! identify failure
+ failedSubstep = (err<0)
- else ! step is still OK
- dtSubstep = dtSubstep*dtMultiplier
- cycle subSteps
- endif ! if step is less than the minimum
+ ! 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 ! if failed the substep
+ endif ! switch between failure and success
- ! -----
- ! * update model fluxes...
- ! ------------------------
+ ! check if we failed the substep
+ if(failedSubstep)then
- ! NOTE: if we get to here then we are accepting the step
+ ! 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
- ! NOTE: we get to here if iterations are successful
- if(err/=0)then
- message=trim(message)//'expect err=0 if updating fluxes'
- return
- endif
+ else ! step is still OK
+ dtSubstep = dtSubstep*dtMultiplier
+ cycle subSteps
+ endif ! if step is less than the minimum
- ! 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
+ endif ! if failed the substep
- ! if water balance error then reduce the length of the coupled step
- if(waterBalanceError)then
- message=trim(message)//'water balance error'
- reduceCoupledStep=.true.
- err=-20; return
- endif
+ ! -----
+ ! * update model fluxes...
+ ! ------------------------
- if(globalPrintFlag)&
- print*, trim(cmessage)//': dt = ', dtSubstep
-
- ! recover from errors in prognostic update
- if(err<0)then
-
- ! modify step
- err=0 ! error recovery
- dtSubstep = dtSubstep/2._rkind
-
- ! check minimum: fail minimum step if there is an error in the update
- if(dtSubstep<dt_min)then
- failedMinimumStep=.true.
- exit subSteps
- ! minimum OK -- try again
- else
- cycle substeps
- endif
-
- endif ! if errors in prognostic update
-
- ! get the total energy fluxes (modified in updateProgSundials)
- if(nrgFluxModified .or. indx_data%var(iLookINDEX%ixVegNrg)%dat(1)/=integerMissing)then
- sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_temp%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_temp%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_temp%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
- else
- sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
- endif ! if energy fluxes were modified
-
- ! get the total soil compression
- if (count(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat/=integerMissing)>0) then
- ! scalar compression
- if(.not.scalarSolution .or. iStateSplit==nSoil)&
- sumSoilCompress = sumSoilCompress + diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ! total soil compression
- ! vector compression
- do iSoil=1,nSoil
- if(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat(iSoil)/=integerMissing)&
- sumLayerCompress(iSoil) = sumLayerCompress(iSoil) + diag_data%var(iLookDIAG%mLayerCompress)%dat(iSoil) ! soil compression in layers
- end do
- endif
+ ! NOTE: if we get to here then we are accepting the step
- ! 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
+ ! NOTE: we get to here if iterations are successful
+ if(err/=0)then
+ message=trim(message)//'expect err=0 if updating fluxes'
+ return
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
+ ! 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
- ! check that we have completed the sub-step
- if(dtSum >= dt-verySmall)then
- failedMinimumStep=.false.
- exit subSteps
- endif
+ ! if water balance error then reduce the length of the coupled step
+ if(waterBalanceError)then
+ message=trim(message)//'water balance error'
+ reduceCoupledStep=.true.
+ err=-20; return
+ endif
- ! adjust length of the sub-step (make sure that we don't exceed the step)
- dtSubstep = min(dt - dtSum, max(dtSubstep*dtMultiplier, dt_min) )
+ if(globalPrintFlag)&
+ print*, trim(cmessage)//': dt = ', dtSubstep
+
+ ! recover from errors in prognostic update
+ if(err<0)then
+
+ ! modify step
+ err=0 ! error recovery
+ dtSubstep = dtSubstep/2._rkind
+
+ ! check minimum: fail minimum step if there is an error in the update
+ if(dtSubstep<dt_min)then
+ failedMinimumStep=.true.
+ exit subSteps
+ ! minimum OK -- try again
+ else
+ cycle substeps
+ endif
+
+ endif ! if errors in prognostic update
+
+ ! get the total energy fluxes (modified in updateProgSundials)
+ if(nrgFluxModified .or. indx_data%var(iLookINDEX%ixVegNrg)%dat(1)/=integerMissing)then
+ sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_temp%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_temp%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_temp%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ else
+ sumCanopyEvaporation = sumCanopyEvaporation + dt_out*flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_out*flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ sumSenHeatCanopy = sumSenHeatCanopy + dt_out*flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ endif ! if energy fluxes were modified
+
+ ! get the total soil compression
+ if (count(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat/=integerMissing)>0) then
+ ! scalar compression
+ if(.not.scalarSolution .or. iStateSplit==nSoil)&
+ sumSoilCompress = sumSoilCompress + diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ! total soil compression
+ ! vector compression
+ do iSoil=1,nSoil
+ if(indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat(iSoil)/=integerMissing)&
+ sumLayerCompress(iSoil) = sumLayerCompress(iSoil) + diag_data%var(iLookDIAG%mLayerCompress)%dat(iSoil) ! soil compression in layers
+ end do
+ endif
- end do substeps ! time steps for variable-dependent sub-stepping
+ ! 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
+
+ ! ** 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
+
+ ! check that we have completed the sub-step
+ if(dtSum >= dt-verySmall)then
+ failedMinimumStep=.false.
+ exit subSteps
+ endif
- ! 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)
+ ! adjust length of the sub-step (make sure that we don't exceed the step)
+ dtSubstep = min(dt - dtSum, max(dtSubstep*dtMultiplier, dt_min) )
- ! 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 do substeps ! time steps for variable-dependent sub-stepping
- ! end associate statements
- end associate globalVars
+ ! 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)
- ! update error codes
- if(failedMinimumStep)then
- err=-20 ! negative = recoverable error
- message=trim(message)//'failed minimum step'
- endif
+ ! 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
- end subroutine varSubstepSundials
+ ! 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
+ ! **********************************************************************************************************
+ ! 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
+ USE getVectorz_module,only:varExtract ! extract variables from the state vector
+ USE updateVarsSundials_module,only:updateVarsSundials ! update prognostic variables
+ USE computEnthalpy_module,only:computEnthalpy
+ USE t2enthalpy_module, only:t2enthalpy ! compute enthalpy
+ implicit none
+ ! model control
+ real(rkind) ,intent(in) :: dt ! time step (s)
+ integer(i4b) ,intent(in) :: nSnow ! number of snow layers
+ integer(i4b) ,intent(in) :: nSoil ! number of soil layers
+ integer(i4b) ,intent(in) :: nLayers ! total number of layers
+ logical(lgt) ,intent(in) :: doAdjustTemp ! flag to indicate if we adjust the temperature
+ logical(lgt) ,intent(in) :: computeVegFlux ! flag to compute the vegetation flux
+ real(rkind) ,intent(in) :: untappedMelt(:) ! un-tapped melt energy (J m-3 s-1)
+ real(rkind) ,intent(in) :: stateVecTrial(:) ! trial state vector (mixed units)
+ real(rkind) ,intent(in) :: stateVecPrime(:) ! trial state vector (mixed units)
+ logical(lgt) ,intent(in) :: checkMassBalance ! flag to check the mass balance
+ logical(lgt) ,intent(in) :: checkNrgBalance ! flag to check the energy balance
+ ! data structures
+ type(zLookup),intent(in) :: lookup_data ! lookup tables
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ type(var_dlength),intent(inout) :: prog_data ! prognostic variables for a local HRU
+ type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
+ type(var_dlength),intent(inout) :: deriv_data ! derivatives in model fluxes w.r.t. relevant state variables
+ ! flags and error control
+ logical(lgt) ,intent(out) :: waterBalanceError ! flag to denote that there is a water balance error
+ logical(lgt) ,intent(out) :: nrgFluxModified ! flag to denote that the energy fluxes were modified
+ integer(i4b) ,intent(out) :: err ! error code
+ character(*) ,intent(out) :: message ! error message
+ ! ==================================================================================================================
+ ! general
+ integer(i4b) :: iState ! index of model state variable
+ integer(i4b) :: ixSubset ! index within the state subset
+ integer(i4b) :: ixFullVector ! index within full state vector
+ integer(i4b) :: ixControlIndex ! index within a given domain
+ real(rkind) :: volMelt ! volumetric melt (kg m-3)
+ real(rkind),parameter :: verySmall=epsilon(1._rkind)*2._rkind ! a very small number (deal with precision issues)
+ ! mass balance
+ real(rkind) :: canopyBalance0,canopyBalance1 ! canopy storage at start/end of time step
+ real(rkind) :: soilBalance0,soilBalance1 ! soil storage at start/end of time step
+ real(rkind) :: vertFlux ! change in storage due to vertical fluxes
+ real(rkind) :: tranSink,baseSink,compSink ! change in storage due to sink terms
+ real(rkind) :: liqError ! water balance error
+ real(rkind) :: fluxNet ! net water fluxes (kg m-2 s-1)
+ real(rkind) :: superflousWat ! superflous water used for evaporation (kg m-2 s-1)
+ real(rkind) :: superflousNrg ! superflous energy that cannot be used for evaporation (W m-2 [J m-2 s-1])
+ character(LEN=256) :: cmessage ! error message of downwind routine
+ ! trial state variables
+ real(rkind) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempTrial ! trial vector for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatTrial ! trial vector for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadTrial ! trial vector for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial vector for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStorageTrial ! trial value for storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial vector for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIceTrial ! trial vector for volumetric fraction of ice (-)
+ ! derivative of state variables
+ real(rkind) :: scalarCanairTempPrime ! trial value for temperature of the canopy air space (K)
+ real(rkind) :: scalarCanopyTempPrime ! trial value for temperature of the vegetation canopy (K)
+ real(rkind) :: scalarCanopyWatPrime ! trial value for liquid water storage in the canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerTempPrime ! trial vector for temperature of layers in the snow and soil domains (K)
+ real(rkind),dimension(nLayers) :: mLayerVolFracWatPrime ! trial vector for volumetric fraction of total water (-)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadPrime ! trial vector for total water matric potential (m)
+ real(rkind),dimension(nSoil) :: mLayerMatricHeadLiqPrime ! trial vector for liquid water matric potential (m)
+ real(rkind) :: scalarAquiferStoragePrime ! trial value for storage of water in the aquifer (m)
+ ! diagnostic variables
+ real(rkind) :: scalarCanopyLiqPrime ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
+ real(rkind) :: scalarCanopyIcePrime ! trial value for mass of ice on the vegetation canopy (kg m-2)
+ real(rkind),dimension(nLayers) :: mLayerVolFracLiqPrime ! trial vector for volumetric fraction of liquid water (-)
+ real(rkind),dimension(nLayers) :: mLayerVolFracIcePrime ! trial vector for volumetric fraction of ice (-)
+ real(rkind) :: scalarCanairEnthalpyTrial ! enthalpy of the canopy air space (J m-3)
+ real(rkind) :: scalarCanopyEnthalpyTrial ! enthalpy of the vegetation canopy (J m-3)
+ real(rkind),dimension(nLayers) :: mLayerEnthalpyTrial ! enthalpy of snow + soil (J m-3)
+ ! -------------------------------------------------------------------------------------------------------------------
+
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! point to flux variables in the data structure
+ associate(&
+ ! get indices for mass balance
+ ixVegHyd => indx_data%var(iLookINDEX%ixVegHyd)%dat(1) ,& ! intent(in) : [i4b] index of canopy hydrology state variable (mass)
+ ixSoilOnlyHyd => indx_data%var(iLookINDEX%ixSoilOnlyHyd)%dat ,& ! intent(in) : [i4b(:)] index in the state subset for hydrology state variables in the soil domain
+ ! get indices for the un-tapped melt
+ ixNrgOnly => indx_data%var(iLookINDEX%ixNrgOnly)%dat ,& ! intent(in) : [i4b(:)] list of indices for all energy states
+ ixDomainType => indx_data%var(iLookINDEX%ixDomainType)%dat ,& ! intent(in) : [i4b(:)] indices defining the domain of the state (iname_veg, iname_snow, iname_soil)
+ ixControlVolume => indx_data%var(iLookINDEX%ixControlVolume)%dat ,& ! intent(in) : [i4b(:)] index of the control volume for different domains (veg, snow, soil)
+ ixMapSubset2Full => indx_data%var(iLookINDEX%ixMapSubset2Full)%dat ,& ! intent(in) : [i4b(:)] [state subset] list of indices of the full state vector in the state subset
+ ! water fluxes
+ scalarRainfall => flux_data%var(iLookFLUX%scalarRainfall)%dat(1) ,& ! intent(in) : [dp] rainfall rate (kg m-2 s-1)
+ scalarThroughfallRain => flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) ,& ! intent(in) : [dp] rain reaches ground without touching the canopy (kg m-2 s-1)
+ scalarCanopyEvaporation => flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ,& ! intent(in) : [dp] canopy evaporation/condensation (kg m-2 s-1)
+ scalarCanopyTranspiration => flux_data%var(iLookFLUX%scalarCanopyTranspiration)%dat(1) ,& ! intent(in) : [dp] canopy transpiration (kg m-2 s-1)
+ scalarCanopyLiqDrainage => flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) ,& ! intent(in) : [dp] drainage liquid water from vegetation canopy (kg m-2 s-1)
+ iLayerLiqFluxSoil => flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat ,& ! intent(in) : [dp(0:)] vertical liquid water flux at soil layer interfaces (-)
+ iLayerNrgFlux => flux_data%var(iLookFLUX%iLayerNrgFlux)%dat ,& ! intent(in) :
+ mLayerNrgFlux => flux_data%var(iLookFLUX%mLayerNrgFlux)%dat ,& ! intent(out): [dp] net energy flux for each layer within the snow+soil domain (J m-3 s-1)
+ mLayerTranspire => flux_data%var(iLookFLUX%mLayerTranspire)%dat ,& ! intent(in) : [dp(:)] transpiration loss from each soil layer (m s-1)
+ mLayerBaseflow => flux_data%var(iLookFLUX%mLayerBaseflow)%dat ,& ! intent(in) : [dp(:)] baseflow from each soil layer (m s-1)
+ mLayerCompress => diag_data%var(iLookDIAG%mLayerCompress)%dat ,& ! intent(in) : [dp(:)] change in storage associated with compression of the soil matrix (-)
+ scalarCanopySublimation => flux_data%var(iLookFLUX%scalarCanopySublimation)%dat(1) ,& ! intent(in) : [dp] sublimation of ice from the vegetation canopy (kg m-2 s-1)
+ scalarSnowSublimation => flux_data%var(iLookFLUX%scalarSnowSublimation)%dat(1) ,& ! intent(in) : [dp] sublimation of ice from the snow surface (kg m-2 s-1)
+ ! energy fluxes
+ scalarLatHeatCanopyEvap => flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) ,& ! intent(in) : [dp] latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
+ scalarSenHeatCanopy => flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ,& ! intent(in) : [dp] sensible heat flux from the canopy to the canopy air space (W m-2)
+ ! domain depth
+ canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ,& ! intent(in) : [dp ] canopy depth (m)
+ mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat ,& ! intent(in) : [dp(:)] depth of each layer in the snow-soil sub-domain (m)
+ ! model state variables (vegetation canopy)
+ scalarCanairTemp => prog_data%var(iLookPROG%scalarCanairTemp)%dat(1) ,& ! intent(inout) : [dp] temperature of the canopy air space (K)
+ scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) ,& ! intent(inout) : [dp] temperature of the vegetation canopy (K)
+ scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(inout) : [dp] mass of ice on the vegetation canopy (kg m-2)
+ scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! intent(inout) : [dp] mass of liquid water on the vegetation canopy (kg m-2)
+ scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(inout) : [dp] mass of total water on the vegetation canopy (kg m-2)
+ ! model state variables (snow and soil domains)
+ mLayerTemp => prog_data%var(iLookPROG%mLayerTemp)%dat ,& ! intent(inout) : [dp(:)] temperature of each snow/soil layer (K)
+ mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of ice (-)
+ mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of liquid water (-)
+ mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat ,& ! intent(inout) : [dp(:)] volumetric fraction of total water (-)
+ mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(inout) : [dp(:)] matric head (m)
+ mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat ,& ! intent(inout) : [dp(:)] matric potential of liquid water (m)
+ ! enthalpy
+ scalarCanairEnthalpy => diag_data%var(iLookDIAG%scalarCanairEnthalpy)%dat(1) ,& ! intent(inout): [dp] enthalpy of the canopy air space (J m-3)
+ scalarCanopyEnthalpy => diag_data%var(iLookDIAG%scalarCanopyEnthalpy)%dat(1) ,& ! intent(inout): [dp] enthalpy of the vegetation canopy (J m-3)
+ mLayerEnthalpy => diag_data%var(iLookDIAG%mLayerEnthalpy)%dat ,& ! intent(inout): [dp(:)] enthalpy of the snow+soil layers (J m-3)
+ ! model state variables (aquifer)
+ scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! intent(inout) : [dp(:)] storage of water in the aquifer (m)
+ ! error tolerance
+ absConvTol_liquid => mpar_data%var(iLookPARAM%absConvTol_liquid)%dat(1) & ! intent(in) : [dp] absolute convergence tolerance for vol frac liq water (-)
+ ) ! associating flux variables in the data structure
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! initialize error control
+ err=0; message='updateProgSundials/'
+
+ ! initialize water balancmLayerVolFracWatTriale error
+ waterBalanceError=.false.
+
+ ! get storage at the start of the step
+ canopyBalance0 = merge(scalarCanopyWat, realMissing, computeVegFlux)
+ soilBalance0 = sum( (mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
+
+ ! -----
+ ! * update states...
+ ! ------------------
+
+ ! initialize to state variable from the last update
+ scalarCanairTempTrial = scalarCanairTemp
+ scalarCanopyTempTrial = scalarCanopyTemp
+ scalarCanopyWatTrial = scalarCanopyWat
+ scalarCanopyLiqTrial = scalarCanopyLiq
+ scalarCanopyIceTrial = scalarCanopyIce
+ mLayerTempTrial = mLayerTemp
+ mLayerVolFracWatTrial = mLayerVolFracWat
+ mLayerVolFracLiqTrial = mLayerVolFracLiq
+ mLayerVolFracIceTrial = mLayerVolFracIce
+ mLayerMatricHeadTrial = mLayerMatricHead ! total water matric potential
+ mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq ! liquid water matric potential
+ scalarAquiferStorageTrial = scalarAquiferStorage
+
+ ! 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)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ call varExtract(&
+ ! input
+ stateVecPrime, & ! intent(in): derivative of model state vector (mixed units)
+ diag_data, & ! intent(in): model diagnostic variables for a local HRU
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ ! output: variables for the vegetation canopy
+ scalarCanairTempPrime, & ! intent(out): derivative of canopy air temperature (K)
+ scalarCanopyTempPrime, & ! intent(out): derivative of canopy temperature (K)
+ scalarCanopyWatPrime, & ! intent(out): derivative of canopy total water (kg m-2)
+ scalarCanopyLiqPrime, & ! intent(out): derivative of canopy liquid water (kg m-2)
+ ! output: variables for the snow-soil domain
+ mLayerTempPrime, & ! intent(out): derivative of layer temperature (K)
+ mLayerVolFracWatPrime, & ! intent(out): derivative of volumetric total water content (-)
+ mLayerVolFracLiqPrime, & ! intent(out): derivative of volumetric liquid water content (-)
+ mLayerMatricHeadPrime, & ! intent(out): derivative of total water matric potential (m)
+ mLayerMatricHeadLiqPrime, & ! intent(out): derivative of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStoragePrime,& ! intent(out): derivative of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+
+ ! update diagnostic variables
+ call updateVarsSundials(&
+ ! input
+ dt, &
+ .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(&
+ call t2enthalpy(&
! input: data structures
diag_data, & ! intent(in): model diagnostic variables for a local HRU
mpar_data, & ! intent(in): parameter data structure
@@ -824,281 +813,279 @@ module varSubstepSundials_module
err,cmessage) ! intent(out): error control
if(err/=0)then; message=trim(message)//trim(cmessage); return; endif
- endif
-
- ! -----
- ! * check mass balance...
- ! -----------------------
-
- ! NOTE: should not need to do this, since mass balance is checked in the solver
- if(checkMassBalance)then
-
- ! check mass balance for the canopy
- if(ixVegHyd/=integerMissing)then
-
- ! handle cases where fluxes empty the canopy
- fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
- if(-fluxNet*dt > canopyBalance0)then
-
- ! --> first add water
- canopyBalance1 = canopyBalance0 + (scalarRainfall - scalarThroughfallRain)*dt
-
- ! --> next, remove canopy evaporation -- put the unsatisfied evap into sensible heat
- canopyBalance1 = canopyBalance1 + scalarCanopyEvaporation*dt
- if(canopyBalance1 < 0._rkind)then
- ! * get superfluous water and energy
- superflousWat = -canopyBalance1/dt ! kg m-2 s-1
- superflousNrg = superflousWat*LH_vap ! W m-2 (J m-2 s-1)
- ! * update fluxes and states
- canopyBalance1 = 0._rkind
- scalarCanopyEvaporation = scalarCanopyEvaporation + superflousWat
- scalarLatHeatCanopyEvap = scalarLatHeatCanopyEvap + superflousNrg
- scalarSenHeatCanopy = scalarSenHeatCanopy - superflousNrg
- endif
-
- ! --> next, remove canopy drainage
- canopyBalance1 = canopyBalance1 - scalarCanopyLiqDrainage*dt
- if(canopyBalance1 < 0._rkind)then
- superflousWat = -canopyBalance1/dt ! kg m-2 s-1
- canopyBalance1 = 0._rkind
- scalarCanopyLiqDrainage = scalarCanopyLiqDrainage + superflousWat
endif
- ! update the trial state
- scalarCanopyWatTrial = canopyBalance1
-
- ! set the modification flag
- nrgFluxModified = .true.
-
- else
- canopyBalance1 = canopyBalance0 + fluxNet*dt
- nrgFluxModified = .false.
- endif ! cases where fluxes empty the canopy
-
- ! check the mass balance
- fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
- liqError = (canopyBalance0 + fluxNet*dt) - scalarCanopyWatTrial
- if(abs(liqError) > absConvTol_liquid*10._rkind*iden_water)then ! *10 because of precision issues
- !write(*,'(a,1x,f20.10)') 'dt = ', dt
- !write(*,'(a,1x,f20.10)') 'scalarCanopyWatTrial = ', scalarCanopyWatTrial
- !write(*,'(a,1x,f20.10)') 'canopyBalance0 = ', canopyBalance0
- !write(*,'(a,1x,f20.10)') 'canopyBalance1 = ', canopyBalance1
- !write(*,'(a,1x,f20.10)') 'scalarRainfall*dt = ', scalarRainfall*dt
- !write(*,'(a,1x,f20.10)') 'scalarCanopyLiqDrainage*dt = ', scalarCanopyLiqDrainage*dt
- !write(*,'(a,1x,f20.10)') 'scalarCanopyEvaporation*dt = ', scalarCanopyEvaporation*dt
- !write(*,'(a,1x,f20.10)') 'scalarThroughfallRain*dt = ', scalarThroughfallRain*dt
- !write(*,'(a,1x,f20.10)') 'liqError = ', liqError
- waterBalanceError = .true.
- return
- endif ! if there is a water balance error
- endif ! if veg canopy
-
- ! check mass balance for soil
- ! NOTE: fatal errors, though possible to recover using negative error codes
- if(count(ixSoilOnlyHyd/=integerMissing)==nSoil)then
- soilBalance1 = sum( (mLayerVolFracLiqTrial(nSnow+1:nLayers) + mLayerVolFracIceTrial(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
- vertFlux = -(iLayerLiqFluxSoil(nSoil) - iLayerLiqFluxSoil(0))*dt ! m s-1 --> m
- tranSink = sum(mLayerTranspire)*dt ! m s-1 --> m
- baseSink = sum(mLayerBaseflow)*dt ! m s-1 --> m
- compSink = sum(mLayerCompress(1:nSoil) * mLayerDepth(nSnow+1:nLayers) ) ! dimensionless --> m
- liqError = soilBalance1 - (soilBalance0 + vertFlux + tranSink - baseSink - compSink)
- if(abs(liqError) > absConvTol_liquid*10._rkind)then ! *10 because of precision issues
- !write(*,'(a,1x,f20.10)') 'dt = ', dt
- !write(*,'(a,1x,f20.10)') 'soilBalance0 = ', soilBalance0
- !write(*,'(a,1x,f20.10)') 'soilBalance1 = ', soilBalance1
- !write(*,'(a,1x,f20.10)') 'vertFlux = ', vertFlux
- !write(*,'(a,1x,f20.10)') 'tranSink = ', tranSink
- !write(*,'(a,1x,f20.10)') 'baseSink = ', baseSink
- !write(*,'(a,1x,f20.10)') 'compSink = ', compSink
- !write(*,'(a,1x,f20.10)') 'liqError = ', liqError
- !write(*,'(a,1x,f20.10)') 'absConvTol_liquid = ', absConvTol_liquid
- waterBalanceError = .true.
- return
- endif ! if there is a water balance error
- endif ! if hydrology states exist in the soil domain
-
- endif ! if checking the mass balance
-
- ! -----
- ! * remove untapped melt energy...
- ! --------------------------------
-
- ! only work with energy state variables
- if(size(ixNrgOnly)>0)then ! energy state variables exist
-
- ! loop through energy state variables
- do iState=1,size(ixNrgOnly)
-
- ! get index of the control volume within the domain
- ixSubset = ixNrgOnly(iState) ! index within the state subset
- ixFullVector = ixMapSubset2Full(ixSubset) ! index within full state vector
- ixControlIndex = ixControlVolume(ixFullVector) ! index within a given domain
-
- ! compute volumetric melt (kg m-3)
- volMelt = dt*untappedMelt(ixSubset)/LH_fus ! (kg m-3)
-
- ! update ice content
- select case( ixDomainType(ixFullVector) )
- case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
- case(iname_veg); scalarCanopyIceTrial = scalarCanopyIceTrial - volMelt*canopyDepth ! (kg m-2)
- case(iname_snow); mLayerVolFracIceTrial(ixControlIndex) = mLayerVolFracIceTrial(ixControlIndex) - volMelt/iden_ice ! (-)
- case(iname_soil); mLayerVolFracIceTrial(ixControlIndex+nSnow) = mLayerVolFracIceTrial(ixControlIndex+nSnow) - volMelt/iden_water ! (-)
- case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
- end select
-
- ! update liquid water content
- select case( ixDomainType(ixFullVector) )
- case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
- case(iname_veg); scalarCanopyLiqTrial = scalarCanopyLiqTrial + volMelt*canopyDepth ! (kg m-2)
- case(iname_snow); mLayerVolFracLiqTrial(ixControlIndex) = mLayerVolFracLiqTrial(ixControlIndex) + volMelt/iden_water ! (-)
- case(iname_soil); mLayerVolFracLiqTrial(ixControlIndex+nSnow) = mLayerVolFracLiqTrial(ixControlIndex+nSnow) + volMelt/iden_water ! (-)
- case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
- end select
-
- end do ! looping through energy variables
-
- ! ========================================================================================================
-
- ! *** ice
-
- ! --> check if we removed too much water
- if(scalarCanopyIceTrial < 0._rkind .or. any(mLayerVolFracIceTrial < 0._rkind) )then
-
- ! **
- ! canopy within numerical precision
- if(scalarCanopyIceTrial < 0._rkind)then
-
- if(scalarCanopyIceTrial > -verySmall)then
- scalarCanopyLiqTrial = scalarCanopyLiqTrial - scalarCanopyIceTrial
- scalarCanopyIceTrial = 0._rkind
-
- ! encountered an inconsistency: spit the dummy
- else
- print*, 'dt = ', dt
- print*, 'untappedMelt = ', untappedMelt
- print*, 'untappedMelt*dt = ', untappedMelt*dt
- print*, 'scalarCanopyiceTrial = ', scalarCanopyIceTrial
- message=trim(message)//'melted more than the available water'
- err=20; return
- endif ! (inconsistency)
-
- endif ! if checking the canopy
- ! **
- ! snow+soil within numerical precision
- do iState=1,size(mLayerVolFracIceTrial)
-
- ! snow layer within numerical precision
- if(mLayerVolFracIceTrial(iState) < 0._rkind)then
-
- if(mLayerVolFracIceTrial(iState) > -verySmall)then
- mLayerVolFracLiqTrial(iState) = mLayerVolFracLiqTrial(iState) - mLayerVolFracIceTrial(iState)
- mLayerVolFracIceTrial(iState) = 0._rkind
-
- ! encountered an inconsistency: spit the dummy
- else
- print*, 'dt = ', dt
- print*, 'untappedMelt = ', untappedMelt
- print*, 'untappedMelt*dt = ', untappedMelt*dt
- print*, 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial
- message=trim(message)//'melted more than the available water'
- err=20; return
- endif ! (inconsistency)
-
- endif ! if checking a snow layer
-
- end do ! (looping through state variables)
-
- endif ! (if we removed too much water)
-
- ! ========================================================================================================
-
- ! *** liquid water
-
- ! --> check if we removed too much water
- if(scalarCanopyLiqTrial < 0._rkind .or. any(mLayerVolFracLiqTrial < 0._rkind) )then
-
- ! **
- ! canopy within numerical precision
- if(scalarCanopyLiqTrial < 0._rkind)then
-
- if(scalarCanopyLiqTrial > -verySmall)then
- scalarCanopyIceTrial = scalarCanopyIceTrial - scalarCanopyLiqTrial
- scalarCanopyLiqTrial = 0._rkind
-
-
- ! encountered an inconsistency: spit the dummy
- else
- print*, 'dt = ', dt
- print*, 'untappedMelt = ', untappedMelt
- print*, 'untappedMelt*dt = ', untappedMelt*dt
- print*, 'scalarCanopyLiqTrial = ', scalarCanopyLiqTrial
- message=trim(message)//'frozen more than the available water'
- err=20; return
- endif ! (inconsistency)
-
- endif ! checking the canopy
-
- ! **
- ! snow+soil within numerical precision
- do iState=1,size(mLayerVolFracLiqTrial)
-
- ! snow layer within numerical precision
- if(mLayerVolFracLiqTrial(iState) < 0._rkind)then
-
- if(mLayerVolFracLiqTrial(iState) > -verySmall)then
- mLayerVolFracIceTrial(iState) = mLayerVolFracIceTrial(iState) - mLayerVolFracLiqTrial(iState)
- mLayerVolFracLiqTrial(iState) = 0._rkind
-
- ! encountered an inconsistency: spit the dummy
- else
- print*, 'dt = ', dt
- print*, 'untappedMelt = ', untappedMelt
- print*, 'untappedMelt*dt = ', untappedMelt*dt
- print*, 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial
- message=trim(message)//'frozen more than the available water'
- err=20; return
- endif ! (inconsistency)
-
- endif ! checking a snow layer
-
- end do ! (looping through state variables)
-
- endif ! (if we removed too much water)
-
- endif ! (if energy state variables exist)
-
- ! -----
- ! * update enthalpy as a diagnostic variable...
- ! --------------------------------
- scalarCanairEnthalpy = scalarCanairEnthalpyTrial
- scalarCanopyEnthalpy = scalarCanopyEnthalpyTrial
- mLayerEnthalpy = mLayerEnthalpyTrial
-
- ! -----
- ! * update prognostic variables...
- ! --------------------------------
- ! update state variables for the vegetation canopy
- scalarCanairTemp = scalarCanairTempTrial ! trial value of canopy air temperature (K)
- scalarCanopyTemp = scalarCanopyTempTrial ! trial value of canopy temperature (K)
- scalarCanopyWat = scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
- scalarCanopyLiq = scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
- scalarCanopyIce = scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
-
- ! update state variables for the snow+soil domain
- mLayerTemp = mLayerTempTrial ! trial vector of layer temperature (K)
- mLayerVolFracWat = mLayerVolFracWatTrial ! trial vector of volumetric total water content (-)
- mLayerVolFracLiq = mLayerVolFracLiqTrial ! trial vector of volumetric liquid water content (-)
- mLayerVolFracIce = mLayerVolFracIceTrial ! trial vector of volumetric ice water content (-)
- mLayerMatricHead = mLayerMatricHeadTrial ! trial vector of matric head (m)
- mLayerMatricHeadLiq = mLayerMatricHeadLiqTrial ! trial vector of matric head (m)
-
- ! update state variables for the aquifer
- scalarAquiferStorage = scalarAquiferStorageTrial
-
- ! end associations to info in the data structures
- end associate
-
- end subroutine updateProgSundials
+ ! -----
+ ! * check mass balance...
+ ! -----------------------
+
+ ! NOTE: should not need to do this, since mass balance is checked in the solver
+ if(checkMassBalance)then
+
+ ! check mass balance for the canopy
+ if(ixVegHyd/=integerMissing)then
+
+ ! handle cases where fluxes empty the canopy
+ fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
+ if(-fluxNet*dt > canopyBalance0)then
+
+ ! --> first add water
+ canopyBalance1 = canopyBalance0 + (scalarRainfall - scalarThroughfallRain)*dt
+
+ ! --> next, remove canopy evaporation -- put the unsatisfied evap into sensible heat
+ canopyBalance1 = canopyBalance1 + scalarCanopyEvaporation*dt
+ if(canopyBalance1 < 0._rkind)then
+ ! * get superfluous water and energy
+ superflousWat = -canopyBalance1/dt ! kg m-2 s-1
+ superflousNrg = superflousWat*LH_vap ! W m-2 (J m-2 s-1)
+ ! * update fluxes and states
+ canopyBalance1 = 0._rkind
+ scalarCanopyEvaporation = scalarCanopyEvaporation + superflousWat
+ scalarLatHeatCanopyEvap = scalarLatHeatCanopyEvap + superflousNrg
+ scalarSenHeatCanopy = scalarSenHeatCanopy - superflousNrg
+ endif
+
+ ! --> next, remove canopy drainage
+ canopyBalance1 = canopyBalance1 - scalarCanopyLiqDrainage*dt
+ if(canopyBalance1 < 0._rkind)then
+ superflousWat = -canopyBalance1/dt ! kg m-2 s-1
+ canopyBalance1 = 0._rkind
+ scalarCanopyLiqDrainage = scalarCanopyLiqDrainage + superflousWat
+ endif
+
+ ! update the trial state
+ scalarCanopyWatTrial = canopyBalance1
+
+ ! set the modification flag
+ nrgFluxModified = .true.
+
+ else
+ canopyBalance1 = canopyBalance0 + fluxNet*dt
+ nrgFluxModified = .false.
+ endif ! cases where fluxes empty the canopy
+
+ ! check the mass balance
+ fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
+ liqError = (canopyBalance0 + fluxNet*dt) - scalarCanopyWatTrial
+ if(abs(liqError) > absConvTol_liquid*10._rkind*iden_water)then ! *10 because of precision issues
+ write(*,'(a,1x,f20.10)') 'dt = ', dt
+ write(*,'(a,1x,f20.10)') 'scalarCanopyWatTrial = ', scalarCanopyWatTrial
+ write(*,'(a,1x,f20.10)') 'canopyBalance0 = ', canopyBalance0
+ write(*,'(a,1x,f20.10)') 'canopyBalance1 = ', canopyBalance1
+ write(*,'(a,1x,f20.10)') 'scalarRainfall*dt = ', scalarRainfall*dt
+ write(*,'(a,1x,f20.10)') 'scalarCanopyLiqDrainage*dt = ', scalarCanopyLiqDrainage*dt
+ write(*,'(a,1x,f20.10)') 'scalarCanopyEvaporation*dt = ', scalarCanopyEvaporation*dt
+ write(*,'(a,1x,f20.10)') 'scalarThroughfallRain*dt = ', scalarThroughfallRain*dt
+ write(*,'(a,1x,f20.10)') 'liqError = ', liqError
+ waterBalanceError = .true.
+ return
+ endif ! if there is a water balance error
+ endif ! if veg canopy
+
+ ! check mass balance for soil
+ ! NOTE: fatal errors, though possible to recover using negative error codes
+ if(count(ixSoilOnlyHyd/=integerMissing)==nSoil)then
+ soilBalance1 = sum( (mLayerVolFracLiqTrial(nSnow+1:nLayers) + mLayerVolFracIceTrial(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
+ vertFlux = -(iLayerLiqFluxSoil(nSoil) - iLayerLiqFluxSoil(0))*dt ! m s-1 --> m
+ tranSink = sum(mLayerTranspire)*dt ! m s-1 --> m
+ baseSink = sum(mLayerBaseflow)*dt ! m s-1 --> m
+ compSink = sum(mLayerCompress(1:nSoil) * mLayerDepth(nSnow+1:nLayers) ) ! dimensionless --> m
+ liqError = soilBalance1 - (soilBalance0 + vertFlux + tranSink - baseSink - compSink)
+ if(abs(liqError) > absConvTol_liquid*10._rkind)then ! *10 because of precision issues
+ write(*,'(a,1x,f20.10)') 'dt = ', dt
+ write(*,'(a,1x,f20.10)') 'soilBalance0 = ', soilBalance0
+ write(*,'(a,1x,f20.10)') 'soilBalance1 = ', soilBalance1
+ write(*,'(a,1x,f20.10)') 'vertFlux = ', vertFlux
+ write(*,'(a,1x,f20.10)') 'tranSink = ', tranSink
+ write(*,'(a,1x,f20.10)') 'baseSink = ', baseSink
+ write(*,'(a,1x,f20.10)') 'compSink = ', compSink
+ write(*,'(a,1x,f20.10)') 'liqError = ', liqError
+ write(*,'(a,1x,f20.10)') 'absConvTol_liquid = ', absConvTol_liquid
+ waterBalanceError = .true.
+ return
+ endif ! if there is a water balance error
+ endif ! if hydrology states exist in the soil domain
+ endif ! if checking the mass balance
+
+ ! -----
+ ! * remove untapped melt energy...
+ ! --------------------------------
+
+ ! only work with energy state variables
+ if(size(ixNrgOnly)>0)then ! energy state variables exist
+
+ ! loop through energy state variables
+ do iState=1,size(ixNrgOnly)
+
+ ! get index of the control volume within the domain
+ ixSubset = ixNrgOnly(iState) ! index within the state subset
+ ixFullVector = ixMapSubset2Full(ixSubset) ! index within full state vector
+ ixControlIndex = ixControlVolume(ixFullVector) ! index within a given domain
+
+ ! compute volumetric melt (kg m-3)
+ volMelt = dt*untappedMelt(ixSubset)/LH_fus ! (kg m-3)
+
+ ! update ice content
+ select case( ixDomainType(ixFullVector) )
+ case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
+ case(iname_veg); scalarCanopyIceTrial = scalarCanopyIceTrial - volMelt*canopyDepth ! (kg m-2)
+ case(iname_snow); mLayerVolFracIceTrial(ixControlIndex) = mLayerVolFracIceTrial(ixControlIndex) - volMelt/iden_ice ! (-)
+ case(iname_soil); mLayerVolFracIceTrial(ixControlIndex+nSnow) = mLayerVolFracIceTrial(ixControlIndex+nSnow) - volMelt/iden_water ! (-)
+ case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
+ end select
+
+ ! update liquid water content
+ select case( ixDomainType(ixFullVector) )
+ case(iname_cas); cycle ! do nothing, since there is no snow stored in the canopy air space
+ case(iname_veg); scalarCanopyLiqTrial = scalarCanopyLiqTrial + volMelt*canopyDepth ! (kg m-2)
+ case(iname_snow); mLayerVolFracLiqTrial(ixControlIndex) = mLayerVolFracLiqTrial(ixControlIndex) + volMelt/iden_water ! (-)
+ case(iname_soil); mLayerVolFracLiqTrial(ixControlIndex+nSnow) = mLayerVolFracLiqTrial(ixControlIndex+nSnow) + volMelt/iden_water ! (-)
+ case default; err=20; message=trim(message)//'unable to identify domain type [remove untapped melt energy]'; return
+ end select
+
+ end do ! looping through energy variables
+
+ ! ========================================================================================================
+
+ ! *** ice
+
+ ! --> check if we removed too much water
+ if(scalarCanopyIceTrial < 0._rkind .or. any(mLayerVolFracIceTrial < 0._rkind) )then
+
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyIceTrial < 0._rkind)then
+
+ if(scalarCanopyIceTrial > -verySmall)then
+ scalarCanopyLiqTrial = scalarCanopyLiqTrial - scalarCanopyIceTrial
+ scalarCanopyIceTrial = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'scalarCanopyiceTrial = ', scalarCanopyIceTrial
+ message=trim(message)//'melted more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! if checking the canopy
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracIceTrial)
+
+ ! snow layer within numerical precision
+ if(mLayerVolFracIceTrial(iState) < 0._rkind)then
+
+ if(mLayerVolFracIceTrial(iState) > -verySmall)then
+ mLayerVolFracLiqTrial(iState) = mLayerVolFracLiqTrial(iState) - mLayerVolFracIceTrial(iState)
+ mLayerVolFracIceTrial(iState) = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'mLayerVolFracIceTrial = ', mLayerVolFracIceTrial
+ message=trim(message)//'melted more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! if checking a snow layer
+
+ end do ! (looping through state variables)
+
+ endif ! (if we removed too much water)
+
+ ! ========================================================================================================
+
+ ! *** liquid water
+
+ ! --> check if we removed too much water
+ if(scalarCanopyLiqTrial < 0._rkind .or. any(mLayerVolFracLiqTrial < 0._rkind) )then
+
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyLiqTrial < 0._rkind)then
+
+ if(scalarCanopyLiqTrial > -verySmall)then
+ scalarCanopyIceTrial = scalarCanopyIceTrial - scalarCanopyLiqTrial
+ scalarCanopyLiqTrial = 0._rkind
+
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'scalarCanopyLiqTrial = ', scalarCanopyLiqTrial
+ message=trim(message)//'frozen more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+ endif ! checking the canopy
+
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracLiqTrial)
+
+ ! snow layer within numerical precision
+ if(mLayerVolFracLiqTrial(iState) < 0._rkind)then
+
+ if(mLayerVolFracLiqTrial(iState) > -verySmall)then
+ mLayerVolFracIceTrial(iState) = mLayerVolFracIceTrial(iState) - mLayerVolFracLiqTrial(iState)
+ mLayerVolFracLiqTrial(iState) = 0._rkind
+
+ ! encountered an inconsistency: spit the dummy
+ else
+ print*, 'dt = ', dt
+ print*, 'untappedMelt = ', untappedMelt
+ print*, 'untappedMelt*dt = ', untappedMelt*dt
+ print*, 'mLayerVolFracLiqTrial = ', mLayerVolFracLiqTrial
+ message=trim(message)//'frozen more than the available water'
+ err=20; return
+ endif ! (inconsistency)
+
+ endif ! checking a snow layer
+
+ end do ! (looping through state variables)
+
+ endif ! (if we removed too much water)
+
+ endif ! (if energy state variables exist)
+
+ ! -----
+ ! * update enthalpy as a diagnostic variable...
+ ! --------------------------------
+ scalarCanairEnthalpy = scalarCanairEnthalpyTrial
+ scalarCanopyEnthalpy = scalarCanopyEnthalpyTrial
+ mLayerEnthalpy = mLayerEnthalpyTrial
+
+ ! -----
+ ! * update prognostic variables...
+ ! --------------------------------
+ ! update state variables for the vegetation canopy
+ scalarCanairTemp = scalarCanairTempTrial ! trial value of canopy air temperature (K)
+ scalarCanopyTemp = scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ scalarCanopyWat = scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ scalarCanopyLiq = scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ scalarCanopyIce = scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+
+ ! update state variables for the snow+soil domain
+ mLayerTemp = mLayerTempTrial ! trial vector of layer temperature (K)
+ mLayerVolFracWat = mLayerVolFracWatTrial ! trial vector of volumetric total water content (-)
+ mLayerVolFracLiq = mLayerVolFracLiqTrial ! trial vector of volumetric liquid water content (-)
+ mLayerVolFracIce = mLayerVolFracIceTrial ! trial vector of volumetric ice water content (-)
+ mLayerMatricHead = mLayerMatricHeadTrial ! trial vector of matric head (m)
+ mLayerMatricHeadLiq = mLayerMatricHeadLiqTrial ! trial vector of matric head (m)
+
+ ! update state variables for the aquifer
+ scalarAquiferStorage = scalarAquiferStorageTrial
+
+ ! end associations to info in the data structures
+ end associate
+
+ end subroutine updateProgSundials
end module varSubstepSundials_module
\ No newline at end of file
diff --git a/build/source/engine/systemSolv.f90 b/build/source/engine/systemSolv.f90
index cf83051..9c59345 100755
--- a/build/source/engine/systemSolv.f90
+++ b/build/source/engine/systemSolv.f90
@@ -143,7 +143,7 @@ contains
err,message) ! intent(out): error code and error message
! ---------------------------------------------------------------------------------------
! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ USE allocspace_module,only:allocLocal ! allocate local data structures
! simulation of fluxes and residuals given a trial state vector
USE eval8summa_module,only:eval8summa ! simulation of fluxes and residuals given a trial state vector
USE summaSolve_module,only:summaSolve ! calculate the iteration increment, evaluate the new state, and refine if necessary
diff --git a/build/source/engine/varSubstep.f90 b/build/source/engine/varSubstep.f90
index d5dd079..3936068 100755
--- a/build/source/engine/varSubstep.f90
+++ b/build/source/engine/varSubstep.f90
@@ -1,5 +1,5 @@
! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
+! Copyright (C) 2014-2015 NCAR/RAL
!
! This file is part of SUMMA
!
@@ -43,11 +43,11 @@ 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 (dp)
+ 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 (dp)
- zLookup, &
+ 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
@@ -74,52 +74,52 @@ private
public::varSubstep
! algorithmic parameters
-real(dp),parameter :: verySmall=1.e-6_dp ! used as an additive constant to check if substantial difference among real numbers
+real(rkind),parameter :: verySmall=1.e-6_rkind ! used as an additive constant to check if substantial difference among real numbers
contains
-! **********************************************************************************************************
-! public subroutine varSubstep: run the model for a collection of substeps for a given state subset
-! **********************************************************************************************************
-subroutine varSubstep(&
- ! 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
- err,message) ! intent(out) : error code and error message
+ ! **********************************************************************************************************
+ ! public subroutine varSubstep: run the model for a collection of substeps for a given state subset
+ ! **********************************************************************************************************
+ subroutine varSubstep(&
+ ! 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
+ err,message) ! intent(out) : error code and error message
! ---------------------------------------------------------------------------------------
! structure allocations
- USE allocspace4chm_module,only:allocLocal ! allocate local data structures
+ 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
@@ -132,9 +132,9 @@ subroutine varSubstep(&
! * dummy variables
! ---------------------------------------------------------------------------------------
! input: model control
- real(dp),intent(in) :: dt ! time step (seconds)
- real(dp),intent(in) :: dtInit ! initial time step (seconds)
- real(dp),intent(in) :: dt_min ! minimum time step (seconds)
+ 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
@@ -159,7 +159,7 @@ subroutine varSubstep(&
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(dp),intent(out) :: dtMultiplier ! substep multiplier (-)
+ 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
@@ -177,24 +177,24 @@ subroutine varSubstep(&
integer(i4b) :: ixLayer ! index in a given domain
integer(i4b), dimension(1) :: ixMin,ixMax ! bounds of a given flux vector
! time stepping
- real(dp) :: dtSum ! sum of time from successful steps (seconds)
- real(dp) :: dt_wght ! weight given to a given flux calculation
- real(dp) :: dtSubstep ! length of a substep (s)
+ 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(dp),parameter :: safety=0.85_dp ! safety factor in adaptive sub-stepping
- real(dp),parameter :: reduceMin=0.1_dp ! mimimum factor that time step is reduced
- real(dp),parameter :: increaseMax=4.0_dp ! maximum factor that time step is increased
+ 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) :: niter ! number of iterations taken
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(dp),parameter :: F_inc = 1.25_dp ! factor used to increase time step
- real(dp),parameter :: F_dec = 0.90_dp ! factor used 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(dp) :: untappedMelt(nState) ! un-tapped melt energy (J m-3 s-1)
- real(dp) :: stateVecInit(nState) ! initial state vector (mixed units)
- real(dp) :: stateVecTrial(nState) ! trial state vector (mixed units)
+ 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)
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
@@ -202,38 +202,38 @@ subroutine varSubstep(&
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(dp) :: sumCanopyEvaporation ! sum of canopy evaporation/condensation (kg m-2 s-1)
- real(dp) :: sumLatHeatCanopyEvap ! sum of latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- real(dp) :: sumSenHeatCanopy ! sum of sensible heat flux from the canopy to the canopy air space (W m-2)
- real(dp) :: sumSoilCompress
- real(dp),allocatable :: sumLayerCompress(:)
+ 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)
+ ! 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
! *********************************************************************************************************************************************************
! *********************************************************************************************************************************************************
@@ -254,22 +254,21 @@ subroutine varSubstep(&
! 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(:)
+ flux_temp%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:)
end do
! initialize the total energy fluxes (modified in updateProg)
- sumCanopyEvaporation = 0._dp ! canopy evaporation/condensation (kg m-2 s-1)
- sumLatHeatCanopyEvap = 0._dp ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- sumSenHeatCanopy = 0._dp ! sensible heat flux from the canopy to the canopy air space (W m-2)
- sumSoilCompress = 0._dp ! total soil compression
-
- allocate(sumLayerCompress(nSoil)); sumLayerCompress = 0._dp ! soil compression by layer
+ 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._dp ! keep track of the portion of the time step that is completed
+ dtSum = 0._rkind ! keep track of the portion of the time step that is completed
nSubsteps = 0
! loop through substeps
@@ -289,14 +288,14 @@ subroutine varSubstep(&
! 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
+ ! 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)
! -----
@@ -336,8 +335,8 @@ subroutine varSubstep(&
niter, & ! intent(out): number of iterations taken
err,cmessage) ! intent(out): error code and error message
if(err/=0)then
- message=trim(message)//trim(cmessage)
- if(err>0) return
+ message=trim(message)//trim(cmessage)
+ if(err>0) return
endif
! if too much melt or need to reduce length of the coupled step then return
@@ -349,23 +348,23 @@ subroutine varSubstep(&
! check
if(globalPrintFlag)then
- print*, 'niter, failedSubstep, dtSubstep = ', niter, failedSubstep, dtSubstep
- print*, trim(cmessage)
+ print*, 'niter, failedSubstep, dtSubstep = ', niter, failedSubstep, dtSubstep
+ print*, trim(cmessage)
endif
! reduce step based on failure
if(failedSubstep)then
err=0; message='varSubstep/' ! recover from failed convergence
- dtMultiplier = 0.5_dp ! system failure: step halving
+ dtMultiplier = 0.5_rkind ! system failure: step halving
else
- ! ** implicit Euler: adjust step length based on iteration count
+ ! ** implicit Euler: adjust step length based on iteration count
if(niter<n_inc)then
- dtMultiplier = F_inc
+ dtMultiplier = F_inc
elseif(niter>n_dec)then
- dtMultiplier = F_dec
+ dtMultiplier = F_dec
else
- dtMultiplier = 1._dp
+ dtMultiplier = 1._rkind
endif
endif ! switch between failure and success
@@ -373,16 +372,16 @@ subroutine varSubstep(&
! 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
+ ! 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
+ else ! step is still OK
dtSubstep = dtSubstep*dtMultiplier
cycle subSteps
- endif ! if step is less than the minimum
+ endif ! if step is less than the minimum
endif ! if failed the substep
@@ -394,8 +393,8 @@ subroutine varSubstep(&
! NOTE: we get to here if iterations are successful
if(err/=0)then
- message=trim(message)//'expect err=0 if updating fluxes'
- return
+ message=trim(message)//'expect err=0 if updating fluxes'
+ return
endif
! identify the need to check the mass balance
@@ -404,17 +403,17 @@ subroutine varSubstep(&
! update prognostic variables
call updateProg(dtSubstep,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,checkMassBalance, & ! input: model control
lookup_data,mpar_data,indx_data,flux_temp,prog_data,diag_data,deriv_data, & ! input-output: data structures
- waterBalanceError,nrgFluxModified,tooMuchMelt,err,cmessage) ! output: flags and error control
+ waterBalanceError,nrgFluxModified,err,cmessage) ! output: flags and error control
if(err/=0)then
- message=trim(message)//trim(cmessage)
- 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 .or. tooMuchMelt)then
- message=trim(message)//'water balance error'
- reduceCoupledStep=.true.
- err=-20; return
+ if(waterBalanceError)then
+ message=trim(message)//'water balance error'
+ reduceCoupledStep=.true.
+ err=-20; return
endif
if(globalPrintFlag)&
@@ -423,42 +422,42 @@ subroutine varSubstep(&
! recover from errors in prognostic update
if(err<0)then
- ! modify step
- err=0 ! error recovery
- dtSubstep = dtSubstep/2._dp
+ ! 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
+ ! 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
+ ! minimum OK -- try again
+ else
cycle substeps
- endif
+ endif
endif ! if errors in prognostic update
! get the total energy fluxes (modified in updateProg)
if(nrgFluxModified .or. indx_data%var(iLookINDEX%ixVegNrg)%dat(1)/=integerMissing)then
- sumCanopyEvaporation = sumCanopyEvaporation + dtSubstep*flux_temp%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dtSubstep*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 + dtSubstep*flux_temp%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ sumCanopyEvaporation = sumCanopyEvaporation + dtSubstep*flux_temp%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dtSubstep*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 + dtSubstep*flux_temp%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
else
- sumCanopyEvaporation = sumCanopyEvaporation + dtSubstep*flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dtSubstep*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 + dtSubstep*flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1) ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ sumCanopyEvaporation = sumCanopyEvaporation + dtSubstep*flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) ! canopy evaporation/condensation (kg m-2 s-1)
+ sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dtSubstep*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 + dtSubstep*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
+ ! 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
+ end do
endif
! print progress
@@ -468,37 +467,28 @@ subroutine varSubstep(&
! increment fluxes
dt_wght = dtSubstep/dt ! (define weight applied to each splitting operation)
do iVar=1,size(flux_meta)
- if(count(fluxMask%var(iVar)%dat)>0) then
+ 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
+ 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)
+ 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
-
- ! special case of the transpiration sink from soil layers: only computed for the top soil layer
- if(iVar==iLookFlux%mLayerTranspire)then
- if(ixLayer==1) flux_data%var(iVar)%dat(:) = flux_data%var(iVar)%dat(:) + flux_temp%var(iVar)%dat(:)*dt_wght
-
- ! standard case
- else
flux_data%var(iVar)%dat(ixLayer) = flux_data%var(iVar)%dat(ixLayer) + flux_temp%var(iVar)%dat(ixLayer)*dt_wght
- endif
- fluxCount%var(iVar)%dat(ixLayer) = fluxCount%var(iVar)%dat(ixLayer) + 1
-
+ fluxCount%var(iVar)%dat(ixLayer) = fluxCount%var(iVar)%dat(ixLayer) + 1
endif
- end do
+ end do
endif ! (domain splitting)
- endif ! (if the flux is desired)
+ endif ! (if the flux is desired)
end do ! (loop through fluxes)
! ------------------------------------------------------
@@ -513,274 +503,278 @@ subroutine varSubstep(&
! 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
+ end do substeps ! time steps for variable-dependent sub-stepping
- ! save the energy fluxes
- flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) = sumCanopyEvaporation /dt ! canopy evaporation/condensation (kg m-2 s-1)
- flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) = sumLatHeatCanopyEvap /dt ! 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 ! sensible heat flux from the canopy to the canopy air space (W m-2)
+ ! save the energy fluxes
+ flux_data%var(iLookFLUX%scalarCanopyEvaporation)%dat(1) = sumCanopyEvaporation /dt ! canopy evaporation/condensation (kg m-2 s-1)
+ flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1) = sumLatHeatCanopyEvap /dt ! 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 ! 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
+ ! 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 do
+ deallocate(sumLayerCompress)
- ! end associate statements
- end associate globalVars
+ ! end associate statements
+ end associate globalVars
- ! update error codes
- if(failedMinimumStep)then
+ ! update error codes
+ if(failedMinimumStep)then
err=-20 ! negative = recoverable error
message=trim(message)//'failed minimum step'
- endif
-
- end subroutine varSubstep
-
-
- ! **********************************************************************************************************
- ! private subroutine updateProg: update prognostic variables
- ! **********************************************************************************************************
- subroutine updateProg(dt,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,checkMassBalance, & ! input: model control
- lookup_data,mpar_data,indx_data,flux_data,prog_data,diag_data,deriv_data, & ! input-output: data structures
- waterBalanceError,nrgFluxModified,tooMuchMelt,err,message) ! output: flags and error control
- USE getVectorz_module,only:varExtract ! extract variables from the state vector
- USE updateVars_module,only:updateVars ! update prognostic variables
- implicit none
- ! model control
- real(dp) ,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(dp) ,intent(in) :: untappedMelt(:) ! un-tapped melt energy (J m-3 s-1)
- real(dp) ,intent(in) :: stateVecTrial(:) ! trial state vector (mixed units)
- logical(lgt) ,intent(in) :: checkMassBalance ! flag to check the mass balance
- ! data structures
- type(zLookup), intent(in) :: lookup_data ! lookup tables
- type(var_dlength),intent(in) :: mpar_data ! model parameters
- type(var_ilength),intent(in) :: indx_data ! indices for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
- 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
- logical(lgt) ,intent(out) :: tooMuchMelt ! 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(dp) :: volMelt ! volumetric melt (kg m-3)
- real(dp),parameter :: verySmall=epsilon(1._dp)*2._dp ! a very small number (deal with precision issues)
- ! mass balance
- real(dp) :: canopyBalance0,canopyBalance1 ! canopy storage at start/end of time step
- real(dp) :: soilBalance0,soilBalance1 ! soil storage at start/end of time step
- real(dp) :: vertFlux ! change in storage due to vertical fluxes
- real(dp) :: tranSink,baseSink,compSink ! change in storage due to sink terms
- real(dp) :: liqError ! water balance error
- real(dp) :: fluxNet ! net water fluxes (kg m-2 s-1)
- real(dp) :: superflousWat ! superflous water used for evaporation (kg m-2 s-1)
- real(dp) :: 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(dp) :: scalarCanairTempTrial ! trial value for temperature of the canopy air space (K)
- real(dp) :: scalarCanopyTempTrial ! trial value for temperature of the vegetation canopy (K)
- real(dp) :: scalarCanopyWatTrial ! trial value for liquid water storage in the canopy (kg m-2)
- real(dp),dimension(nLayers) :: mLayerTempTrial ! trial vector for temperature of layers in the snow and soil domains (K)
- real(dp),dimension(nLayers) :: mLayerVolFracWatTrial ! trial vector for volumetric fraction of total water (-)
- real(dp),dimension(nSoil) :: mLayerMatricHeadTrial ! trial vector for total water matric potential (m)
- real(dp),dimension(nSoil) :: mLayerMatricHeadLiqTrial ! trial vector for liquid water matric potential (m)
- real(dp) :: scalarAquiferStorageTrial ! trial value for storage of water in the aquifer (m)
- ! diagnostic variables
- real(dp) :: scalarCanopyLiqTrial ! trial value for mass of liquid water on the vegetation canopy (kg m-2)
- real(dp) :: scalarCanopyIceTrial ! trial value for mass of ice on the vegetation canopy (kg m-2)
- real(dp),dimension(nLayers) :: mLayerVolFracLiqTrial ! trial vector for volumetric fraction of liquid water (-)
- real(dp),dimension(nLayers) :: mLayerVolFracIceTrial ! 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 (-)
- 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)
- ! 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='updateProg/'
-
- ! initialize water balance error
- waterBalanceError=.false.
-
- ! get storage at the start of the step
- canopyBalance0 = merge(scalarCanopyWat, realMissing, computeVegFlux)
- soilBalance0 = sum( (mLayerVolFracLiq(nSnow+1:nLayers) + mLayerVolFracIce(nSnow+1:nLayers) )*mLayerDepth(nSnow+1:nLayers) )
-
- ! -----
- ! * update states...
- ! ------------------
-
- ! extract states from the state vector
- call varExtract(&
- ! input
- stateVecTrial, & ! intent(in): model state vector (mixed units)
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- ! output: variables for the vegetation canopy
- scalarCanairTempTrial, & ! intent(out): trial value of canopy air temperature (K)
- scalarCanopyTempTrial, & ! intent(out): trial value of canopy temperature (K)
- scalarCanopyWatTrial, & ! intent(out): trial value of canopy total water (kg m-2)
- scalarCanopyLiqTrial, & ! intent(out): trial value of canopy liquid water (kg m-2)
- scalarCanopyIceTrial, & ! intent(out): trial value of canopy ice content (kg m-2)
- ! output: variables for the snow-soil domain
- mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
- mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
- mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
- mLayerVolFracIceTrial, & ! intent(out): trial vector of volumetric ice water content (-)
- mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
- mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
- ! output: variables for the aquifer
- scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
-
- !print*, 'after varExtract: scalarCanopyTempTrial =', scalarCanopyTempTrial ! trial value of canopy temperature (K)
- !print*, 'after varExtract: scalarCanopyWatTrial =', scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
- !print*, 'after varExtract: scalarCanopyLiqTrial =', scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
- !print*, 'after varExtract: scalarCanopyIceTrial =', scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
-
- ! check if there was too much melt
- if(nSnow>0) tooMuchMelt = (mLayerTempTrial(1)>Tfreeze)
-
- ! update diagnostic variables
- call updateVars(&
- ! input
- doAdjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
- lookup_data, & ! intent(in): lookup tables for a local HRU
- mpar_data, & ! intent(in): model parameters for a local HRU
- indx_data, & ! intent(in): indices defining model states and layers
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- 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)
- ! 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)
- ! 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)
+ endif
+
+ end subroutine varSubstep
- !print*, 'after updateVars: scalarCanopyTempTrial =', scalarCanopyTempTrial ! trial value of canopy temperature (K)
- !print*, 'after updateVars: scalarCanopyWatTrial =', scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
- !print*, 'after updateVars: scalarCanopyLiqTrial =', scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
- !print*, 'after updateVars: scalarCanopyIceTrial =', scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
- ! -----
- ! * check mass balance...
- ! -----------------------
+ ! **********************************************************************************************************
+ ! private subroutine updateProg: update prognostic variables
+ ! **********************************************************************************************************
+ subroutine updateProg(dt,nSnow,nSoil,nLayers,doAdjustTemp,computeVegFlux,untappedMelt,stateVecTrial,checkMassBalance, & ! 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 updateVars_module,only:updateVars ! update prognostic variables
+ 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)
+ logical(lgt) ,intent(in) :: checkMassBalance ! flag to check the mass balance
+ ! data structures
+ type(zLookup), intent(in) :: lookup_data ! lookup tables
+ type(var_dlength),intent(in) :: mpar_data ! model parameters
+ type(var_ilength),intent(in) :: indx_data ! indices for a local HRU
+ type(var_dlength),intent(inout) :: flux_data ! model fluxes for a local HRU
+ 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 (-)
+ ! -------------------------------------------------------------------------------------------------------------------
+
+ ! -------------------------------------------------------------------------------------------------------------------
+ ! 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 (-)
+ 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)
+ ! 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='updateProg/'
- ! NOTE: should not need to do this, since mass balance is checked in the solver
- if(checkMassBalance)then
+ ! initialize water balance 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...
+ ! ------------------
+
+ ! initialize to state variable from the last update
+ scalarCanairTempTrial = scalarCanairTemp
+ scalarCanopyTempTrial = scalarCanopyTemp
+ scalarCanopyWatTrial = scalarCanopyWat
+ scalarCanopyLiqTrial = scalarCanopyLiq
+ scalarCanopyIceTrial = scalarCanopyIce
+ mLayerTempTrial = mLayerTemp
+ mLayerVolFracWatTrial = mLayerVolFracWat
+ mLayerVolFracLiqTrial = mLayerVolFracLiq
+ mLayerVolFracIceTrial = mLayerVolFracIce
+ mLayerMatricHeadTrial = mLayerMatricHead ! total water matric potential
+ mLayerMatricHeadLiqTrial = mLayerMatricHeadLiq ! liquid water matric potential
+ scalarAquiferStorageTrial = scalarAquiferStorage
+
+ ! 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)
+ ! output: variables for the snow-soil domain
+ mLayerTempTrial, & ! intent(out): trial vector of layer temperature (K)
+ mLayerVolFracWatTrial, & ! intent(out): trial vector of volumetric total water content (-)
+ mLayerVolFracLiqTrial, & ! intent(out): trial vector of volumetric liquid water content (-)
+ mLayerMatricHeadTrial, & ! intent(out): trial vector of total water matric potential (m)
+ mLayerMatricHeadLiqTrial, & ! intent(out): trial vector of liquid water matric potential (m)
+ ! output: variables for the aquifer
+ scalarAquiferStorageTrial,& ! intent(out): trial value of storage of water in the aquifer (m)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ !print*, 'after varExtract: scalarCanopyTempTrial =', scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ !print*, 'after varExtract: scalarCanopyWatTrial =', scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ !print*, 'after varExtract: scalarCanopyLiqTrial =', scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ !print*, 'after varExtract: scalarCanopyIceTrial =', scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+
+ ! update diagnostic variables
+ call updateVars(&
+ ! input
+ doAdjustTemp, & ! intent(in): logical flag to adjust temperature to account for the energy used in melt+freeze
+ lookup_data, & ! intent(in): lookup tables for a local HRU
+ mpar_data, & ! intent(in): model parameters for a local HRU
+ indx_data, & ! intent(in): indices defining model states and layers
+ prog_data, & ! intent(in): model prognostic variables for a local HRU
+ 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)
+ ! 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)
+ ! output: error control
+ err,cmessage) ! intent(out): error control
+ if(err/=0)then; message=trim(message)//trim(cmessage); return; end if ! (check for errors)
+
+ !print*, 'after updateVars: scalarCanopyTempTrial =', scalarCanopyTempTrial ! trial value of canopy temperature (K)
+ !print*, 'after updateVars: scalarCanopyWatTrial =', scalarCanopyWatTrial ! trial value of canopy total water (kg m-2)
+ !print*, 'after updateVars: scalarCanopyLiqTrial =', scalarCanopyLiqTrial ! trial value of canopy liquid water (kg m-2)
+ !print*, 'after updateVars: scalarCanopyIceTrial =', scalarCanopyIceTrial ! trial value of canopy ice content (kg m-2)
+
+ ! -----
+ ! * 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
+ ! 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._dp)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._dp
- scalarCanopyEvaporation = scalarCanopyEvaporation + superflousWat
- scalarLatHeatCanopyEvap = scalarLatHeatCanopyEvap + superflousNrg
- scalarSenHeatCanopy = scalarSenHeatCanopy - superflousNrg
+ 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._dp)then
- superflousWat = -canopyBalance1/dt ! kg m-2 s-1
- canopyBalance1 = 0._dp
- scalarCanopyLiqDrainage = scalarCanopyLiqDrainage + superflousWat
+ if(canopyBalance1 < 0._rkind)then
+ superflousWat = -canopyBalance1/dt ! kg m-2 s-1
+ canopyBalance1 = 0._rkind
+ scalarCanopyLiqDrainage = scalarCanopyLiqDrainage + superflousWat
endif
! update the trial state
@@ -789,43 +783,43 @@ subroutine varSubstep(&
! set the modification flag
nrgFluxModified = .true.
- else
+ 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
- !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
- if(abs(liqError) > absConvTol_liquid*10._dp)then ! *10 because of precision issues
+ endif ! cases where fluxes empty the canopy
+
+ ! check the mass balance
+ fluxNet = scalarRainfall + scalarCanopyEvaporation - scalarThroughfallRain - scalarCanopyLiqDrainage
+ liqError = (canopyBalance0 + fluxNet*dt) - scalarCanopyWatTrial
+ !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
+ if(abs(liqError) > absConvTol_liquid*10._rkind)then ! *10 because of precision issues
waterBalanceError = .true.
return
- endif ! if there is a water balance error
+ 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._dp)then ! *10 because of precision issues
+ 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)') 'vertFlux = ', vertFlux
!write(*,'(a,1x,f20.10)') 'tranSink = ', tranSink
!write(*,'(a,1x,f20.10)') 'baseSink = ', baseSink
!write(*,'(a,1x,f20.10)') 'compSink = ', compSink
@@ -833,46 +827,46 @@ subroutine varSubstep(&
!write(*,'(a,1x,f20.10)') 'absConvTol_liquid = ', absConvTol_liquid
waterBalanceError = .true.
return
- endif ! if there is a water balance error
+ endif ! if there is a water balance error
endif ! if hydrology states exist in the soil domain
- endif ! if checking the mass balance
+ endif ! if checking the mass balance
- ! -----
- ! * remove untapped melt energy...
- ! --------------------------------
+ ! -----
+ ! * remove untapped melt energy...
+ ! --------------------------------
- ! only work with energy state variables
- if(size(ixNrgOnly)>0)then ! energy state variables exist
+ ! 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
+ ! 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)
+ ! compute volumetric melt (kg m-3)
+ volMelt = dt*untappedMelt(ixSubset)/LH_fus ! (kg m-3)
- ! update ice content
- select case( ixDomainType(ixFullVector) )
+ ! 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
+ end select
- ! update liquid water content
- select case( ixDomainType(ixFullVector) )
+ ! 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 select
end do ! looping through energy variables
@@ -881,52 +875,52 @@ subroutine varSubstep(&
! *** ice
! --> check if we removed too much water
- if(scalarCanopyIceTrial < 0._dp .or. any(mLayerVolFracIceTrial < 0._dp) )then
+ if(scalarCanopyIceTrial < 0._rkind .or. any(mLayerVolFracIceTrial < 0._rkind) )then
- ! **
- ! canopy within numerical precision
- if(scalarCanopyIceTrial < 0._dp)then
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyIceTrial < 0._rkind)then
if(scalarCanopyIceTrial > -verySmall)then
- scalarCanopyLiqTrial = scalarCanopyLiqTrial - scalarCanopyIceTrial
- scalarCanopyIceTrial = 0._dp
+ 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
+ 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
+ endif ! if checking the canopy
- ! **
- ! snow+soil within numerical precision
- do iState=1,size(mLayerVolFracIceTrial)
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracIceTrial)
! snow layer within numerical precision
- if(mLayerVolFracIceTrial(iState) < 0._dp)then
+ if(mLayerVolFracIceTrial(iState) < 0._rkind)then
- if(mLayerVolFracIceTrial(iState) > -verySmall)then
+ if(mLayerVolFracIceTrial(iState) > -verySmall)then
mLayerVolFracLiqTrial(iState) = mLayerVolFracLiqTrial(iState) - mLayerVolFracIceTrial(iState)
- mLayerVolFracIceTrial(iState) = 0._dp
+ mLayerVolFracIceTrial(iState) = 0._rkind
- ! encountered an inconsistency: spit the dummy
- else
+ ! 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 ! (inconsistency)
endif ! if checking a snow layer
- end do ! (looping through state variables)
+ end do ! (looping through state variables)
endif ! (if we removed too much water)
@@ -935,82 +929,83 @@ subroutine varSubstep(&
! *** liquid water
! --> check if we removed too much water
- if(scalarCanopyLiqTrial < 0._dp .or. any(mLayerVolFracLiqTrial < 0._dp) )then
+ if(scalarCanopyLiqTrial < 0._rkind .or. any(mLayerVolFracLiqTrial < 0._rkind) )then
- ! **
- ! canopy within numerical precision
- if(scalarCanopyLiqTrial < 0._dp)then
+ ! **
+ ! canopy within numerical precision
+ if(scalarCanopyLiqTrial < 0._rkind)then
if(scalarCanopyLiqTrial > -verySmall)then
- scalarCanopyIceTrial = scalarCanopyIceTrial - scalarCanopyLiqTrial
- scalarCanopyLiqTrial = 0._dp
+ 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
+ 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
+ endif ! checking the canopy
- ! **
- ! snow+soil within numerical precision
- do iState=1,size(mLayerVolFracLiqTrial)
+ ! **
+ ! snow+soil within numerical precision
+ do iState=1,size(mLayerVolFracLiqTrial)
! snow layer within numerical precision
- if(mLayerVolFracLiqTrial(iState) < 0._dp)then
+ if(mLayerVolFracLiqTrial(iState) < 0._rkind)then
- if(mLayerVolFracLiqTrial(iState) > -verySmall)then
+ if(mLayerVolFracLiqTrial(iState) > -verySmall)then
mLayerVolFracIceTrial(iState) = mLayerVolFracIceTrial(iState) - mLayerVolFracLiqTrial(iState)
- mLayerVolFracLiqTrial(iState) = 0._dp
+ mLayerVolFracLiqTrial(iState) = 0._rkind
- ! encountered an inconsistency: spit the dummy
- else
+ ! 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 ! (inconsistency)
endif ! checking a snow layer
- end do ! (looping through state variables)
+ end do ! (looping through state variables)
endif ! (if we removed too much water)
- endif ! (if energy state variables exist)
+ endif ! (if energy state variables exist)
- ! -----
- ! * update prognostic variables...
- ! --------------------------------
+ ! -----
+ ! * 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 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 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
+ ! update state variables for the aquifer
+ scalarAquiferStorage = scalarAquiferStorageTrial
- ! end associations to info in the data structures
- end associate
+ ! end associations to info in the data structures
+ end associate
- end subroutine updateProg
+ end subroutine updateProg
end module varSubstep_module
+
\ No newline at end of file
diff --git a/utils/laugh_tests/BE/colbeck1976/run_test_summa_actors.sh b/utils/laugh_tests/BE/colbeck1976/run_test_summa_actors.sh
index 42b7a5c..27be92c 100755
--- a/utils/laugh_tests/BE/colbeck1976/run_test_summa_actors.sh
+++ b/utils/laugh_tests/BE/colbeck1976/run_test_summa_actors.sh
@@ -1,5 +1,5 @@
#! /bin/bash
-# /Summa-Actors/bin/summaMain -g 1 -n 1 -c /Summa-Actors/utils/laugh_tests/colbeck1976/config/exp1
+/Summa-Actors/bin/summaMain -g 1 -n 1 -c /Summa-Actors/utils/laugh_tests/colbeck1976/config/exp1
/Summa-Actors/bin/summaMain -g 1 -n 1 -c /Summa-Actors/utils/laugh_tests/colbeck1976/config/exp2
-# /Summa-Actors/bin/summaMain -g 1 -n 1 -c /Summa-Actors/utils/laugh_tests/colbeck1976/config/exp3
+/Summa-Actors/bin/summaMain -g 1 -n 1 -c /Summa-Actors/utils/laugh_tests/colbeck1976/config/exp3
--
GitLab