diff --git a/build/source/dshare/globalData.f90 b/build/source/dshare/globalData.f90
deleted file mode 100755
index fc3724362fa3ab05e889493b014a1f840b6da28b..0000000000000000000000000000000000000000
--- a/build/source/dshare/globalData.f90
+++ /dev/null
@@ -1,337 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-! ----------------------------------------------------------------------------------------------------------------
-! * part 1: parameters that are fixed across multiple instantiations
-! ----------------------------------------------------------------------------------------------------------------
-
-MODULE globalData
- ! data types
- USE nrtype
- USE netcdf
- USE,intrinsic :: ieee_arithmetic ! IEEE arithmetic
- USE data_types,only:gru2hru_map ! mapping between the GRUs and HRUs
- USE data_types,only:hru2gru_map ! mapping between the GRUs and HRUs
- USE data_types,only:model_options ! the model decision structure
- USE data_types,only:file_info ! metadata for model forcing datafile
- USE data_types,only:par_info ! default parameter values and parameter bounds
- USE data_types,only:var_info ! metadata for variables in each model structure
- USE data_types,only:flux2state ! extended metadata to define flux-to-state mapping
- USE data_types,only:extended_info ! extended metadata for variables in each model structure
- USE data_types,only:struct_info ! summary information on all data structures
- USE data_types,only:var_i ! vector of integers
-#ifdef ACTORS_ACTIVE
- USE data_types,only:var_forc ! for Actors
- USE data_types,only:dlength ! for Actors
- USE data_types,only:ilength ! for Actors
- USE data_types,only:init_cond ! for Actors
-#endif
- ! number of variables in each data structure
- USE var_lookup,only:maxvarTime ! time: maximum number variables
- USE var_lookup,only:maxvarForc ! forcing data: maximum number variables
- USE var_lookup,only:maxvarAttr ! attributes: maximum number variables
- USE var_lookup,only:maxvarType ! type index: maximum number variables
- USE var_lookup,only:maxvarId ! IDs index: maximum number variables
- USE var_lookup,only:maxvarProg ! prognostic variables: maximum number variables
- USE var_lookup,only:maxvarDiag ! diagnostic variables: maximum number variables
- USE var_lookup,only:maxvarFlux ! model fluxes: maximum number variables
- USE var_lookup,only:maxvarDeriv ! model derivatives: maximum number variables
- USE var_lookup,only:maxvarIndx ! model indices: maximum number variables
- USE var_lookup,only:maxvarMpar ! model parameters: maximum number variables
- USE var_lookup,only:maxvarBvar ! basin-average variables: maximum number variables
- USE var_lookup,only:maxvarBpar ! basin-average parameters: maximum number variables
- USE var_lookup,only:maxvarDecisions ! maximum number of decisions
- USE var_lookup,only:maxvarFreq ! maximum number of output files
- USE var_lookup,only:maxvarLookup ! maximum number of variables in the lookup
- implicit none
- private
-
- ! ----------------------------------------------------------------------------------------------------------------
- ! * part 1: parameters that are fixed across multiple instantiations
- ! ----------------------------------------------------------------------------------------------------------------
-
- ! define missing values
- real(rkind),parameter,public :: quadMissing = nr_quadMissing ! (from nrtype) missing quadruple precision number
- real(rkind),parameter,public :: realMissing = nr_realMissing ! (from nrtype) missing double precision number
- integer(i4b),parameter,public :: integerMissing = nr_integerMissing ! (from nrtype) missing integer
-
- ! define run modes
- integer(i4b),parameter,public :: iRunModeFull=1 ! named variable defining running mode as full run (all GRUs)
- integer(i4b),parameter,public :: iRunModeGRU=2 ! named variable defining running mode as GRU-parallelization run (GRU subset)
- integer(i4b),parameter,public :: iRunModeHRU=3 ! named variable defining running mode as single-HRU run (ONE HRU)
-
- ! define progress modes
- integer(i4b),parameter,public :: ixProgress_im=1000 ! named variable to print progress once per month
- integer(i4b),parameter,public :: ixProgress_id=1001 ! named variable to print progress once per day
- integer(i4b),parameter,public :: ixProgress_ih=1002 ! named variable to print progress once per hour
- integer(i4b),parameter,public :: ixProgress_never=1003 ! named variable to print progress never
- integer(i4b),parameter,public :: ixProgress_it=1004 ! named variable to print progress every timestep
-
- ! define restart frequency
- integer(i4b),parameter,public :: ixRestart_iy=1000 ! named variable to print a re-start file once per year
- integer(i4b),parameter,public :: ixRestart_im=1001 ! named variable to print a re-start file once per month
- integer(i4b),parameter,public :: ixRestart_id=1002 ! named variable to print a re-start file once per day
- integer(i4b),parameter,public :: ixRestart_end=1003 ! named variable to print a re-start file at the end of a run
- integer(i4b),parameter,public :: ixRestart_never=1004 ! named variable to print a re-start file never
-
- ! define output file frequency
- integer(i4b),parameter,public :: noNewFiles=1001 ! no new output files
- integer(i4b),parameter,public :: newFileEveryOct1=1002 ! create a new file on Oct 1 every year (start of the USA water year)
-
- ! define named variables for "yes" and "no"
- integer(i4b),parameter,public :: no=0 ! .false.
- integer(i4b),parameter,public :: yes=1 ! .true.
-
- ! define named variables to describe the domain type
- integer(i4b),parameter,public :: iname_cas =1000 ! named variable to denote a canopy air space state variable
- integer(i4b),parameter,public :: iname_veg =1001 ! named variable to denote a vegetation state variable
- integer(i4b),parameter,public :: iname_soil=1002 ! named variable to denote a soil layer
- integer(i4b),parameter,public :: iname_snow=1003 ! named variable to denote a snow layer
- integer(i4b),parameter,public :: iname_aquifer=1004 ! named variable to denote a snow layer
-
- ! define named variables to describe the state variable type
- integer(i4b),parameter,public :: iname_nrgCanair=2001 ! named variable defining the energy of the canopy air space
- integer(i4b),parameter,public :: iname_nrgCanopy=2002 ! named variable defining the energy of the vegetation canopy
- integer(i4b),parameter,public :: iname_watCanopy=2003 ! named variable defining the mass of total water on the vegetation canopy
- integer(i4b),parameter,public :: iname_liqCanopy=2004 ! named variable defining the mass of liquid water on the vegetation canopy
- integer(i4b),parameter,public :: iname_nrgLayer=3001 ! named variable defining the energy state variable for snow+soil layers
- integer(i4b),parameter,public :: iname_watLayer=3002 ! named variable defining the total water state variable for snow+soil layers
- integer(i4b),parameter,public :: iname_liqLayer=3003 ! named variable defining the liquid water state variable for snow+soil layers
- integer(i4b),parameter,public :: iname_matLayer=3004 ! named variable defining the matric head state variable for soil layers
- integer(i4b),parameter,public :: iname_lmpLayer=3005 ! named variable defining the liquid matric potential state variable for soil layers
- integer(i4b),parameter,public :: iname_watAquifer=3006 ! named variable defining the water storage in the aquifer
-
- ! define named variables to describe the form and structure of the band-diagonal matrices used in the numerical solver
- ! NOTE: This indexing scheme provides the matrix structure expected by lapack and sundials. Specifically, they require kl extra rows for additional storage.
- ! Consequently, all indices are offset by kl and the total number of bands for storage is 2*kl+ku+1 instead of kl+ku+1.
- integer(i4b),parameter,public :: nRHS=1 ! number of unknown variables on the RHS of the linear system A.X=B
- integer(i4b),parameter,public :: ku=3 ! number of super-diagonal bands, ku>=3 to accommodate coupled layer above
- integer(i4b),parameter,public :: kl=4 ! number of sub-diagonal bands, kl>=4 to accommodate vegetation
- integer(i4b),parameter,public :: ixDiag=kl+ku+1 ! index for the diagonal band
- integer(i4b),parameter,public :: nBands=2*kl+ku+1 ! length of the leading dimension of the band diagonal matrix
-
- ! define named variables for the type of matrix used in the numerical solution.
- integer(i4b),parameter,public :: ixFullMatrix=1001 ! named variable for the full Jacobian matrix
- integer(i4b),parameter,public :: ixBandMatrix=1002 ! named variable for the band diagonal matrix
-
- ! define indices describing the first and last layers of the Jacobian to print (for debugging)
- integer(i4b),parameter,public :: iJac1=16 ! first layer of the Jacobian to print
- integer(i4b),parameter,public :: iJac2=20 ! last layer of the Jacobian to print
-
- ! define limit checks
- real(rkind),parameter,public :: verySmall=tiny(1.0_rkind) ! a very small number
- real(rkind),parameter,public :: veryBig=1.e+20_rkind ! a very big number
-
- ! define algorithmic control parameters
- real(rkind),parameter,public :: dx = 1.e-8_rkind ! finite difference increment
-
- ! define summary information on all data structures
- integer(i4b),parameter :: nStruct=14 ! number of data structures
- type(struct_info),parameter,public,dimension(nStruct) :: structInfo=(/&
- struct_info('time', 'TIME' , maxvarTime ), & ! the time data structure
- struct_info('forc', 'FORCE', maxvarForc ), & ! the forcing data structure
- struct_info('attr', 'ATTR' , maxvarAttr ), & ! the attribute data structure
- struct_info('type', 'TYPE' , maxvarType ), & ! the type data structure
- struct_info('id' , 'ID' , maxvarId ), & ! the type data structure
- struct_info('mpar', 'PARAM', maxvarMpar ), & ! the model parameter data structure
- struct_info('bpar', 'BPAR' , maxvarBpar ), & ! the basin parameter data structure
- struct_info('bvar', 'BVAR' , maxvarBvar ), & ! the basin variable data structure
- struct_info('indx', 'INDEX', maxvarIndx ), & ! the model index data structure
- struct_info('prog', 'PROG', maxvarProg ), & ! the prognostic (state) variable data structure
- struct_info('diag', 'DIAG' , maxvarDiag ), & ! the diagnostic variable data structure
- struct_info('flux', 'FLUX' , maxvarFlux ), & ! the flux data structure
- struct_info('deriv', 'DERIV', maxvarDeriv), & ! the model derivative data structure
- struct_info('lookup','LOOKUP',maxvarLookup) /) ! the lookup table data structure
- ! fixed model decisions
- logical(lgt) , parameter, public :: overwriteRSMIN=.false. ! flag to overwrite RSMIN
- integer(i4b) , parameter, public :: maxSoilLayers=10000 ! Maximum Number of Soil Layers
-
- ! ----------------------------------------------------------------------------------------------------------------
- ! * part 2: globally constant variables/structures that require initialization
- ! ----------------------------------------------------------------------------------------------------------------
-
- ! define Not-a-Number (NaN)
- real(rkind),save,public :: dNaN
-
- ! define default parameter values and parameter bounds
- type(par_info),save,public :: localParFallback(maxvarMpar) ! local column default parameters
- type(par_info),save,public :: basinParFallback(maxvarBpar) ! basin-average default parameters
-
- ! define vectors of metadata
- type(var_info),save,public :: time_meta(maxvarTime) ! model time information
- type(var_info),save,public :: forc_meta(maxvarForc) ! model forcing data
- type(var_info),save,public :: attr_meta(maxvarAttr) ! local attributes
- type(var_info),save,public :: type_meta(maxvarType) ! local classification of veg, soil, etc.
- type(var_info),save,public :: id_meta(maxvarId) ! local classification of veg, soil, etc.
- type(var_info),save,public :: mpar_meta(maxvarMpar) ! local model parameters for each HRU
- type(var_info),save,public :: indx_meta(maxvarIndx) ! local model indices for each HRU
- type(var_info),save,public :: prog_meta(maxvarProg) ! local state variables for each HRU
- type(var_info),save,public :: diag_meta(maxvarDiag) ! local diagnostic variables for each HRU
- type(var_info),save,public :: flux_meta(maxvarFlux) ! local model fluxes for each HRU
- type(var_info),save,public :: deriv_meta(maxvarDeriv) ! local model derivatives for each HRU
- type(var_info),save,public :: lookup_meta(maxvarLookup) ! local lookup tables for each HRU
- type(var_info),save,public :: bpar_meta(maxvarBpar) ! basin parameters for aggregated processes
- type(var_info),save,public :: bvar_meta(maxvarBvar) ! basin variables for aggregated processes
-
- ! ancillary metadata structures
- type(flux2state), save,public :: flux2state_orig(maxvarFlux) ! named variables for the states affected by each flux (original)
- type(flux2state), save,public :: flux2state_liq(maxvarFlux) ! named variables for the states affected by each flux (liquid water)
- type(extended_info),save,public,allocatable :: averageFlux_meta(:) ! timestep-average model fluxes
-
- ! mapping from original to child structures
- integer(i4b),save,public,allocatable :: forcChild_map(:) ! index of the child data structure: stats forc
- integer(i4b),save,public,allocatable :: progChild_map(:) ! index of the child data structure: stats prog
- integer(i4b),save,public,allocatable :: diagChild_map(:) ! index of the child data structure: stats diag
- integer(i4b),save,public,allocatable :: fluxChild_map(:) ! index of the child data structure: stats flux
- integer(i4b),save,public,allocatable :: indxChild_map(:) ! index of the child data structure: stats indx
- integer(i4b),save,public,allocatable :: bvarChild_map(:) ! index of the child data structure: stats bvar
-
- ! child metadata structures
- type(extended_info),save,public,allocatable :: statForc_meta(:) ! child metadata for stats
- type(extended_info),save,public,allocatable :: statProg_meta(:) ! child metadata for stats
- type(extended_info),save,public,allocatable :: statDiag_meta(:) ! child metadata for stats
- type(extended_info),save,public,allocatable :: statFlux_meta(:) ! child metadata for stats
- type(extended_info),save,public,allocatable :: statIndx_meta(:) ! child metadata for stats
- type(extended_info),save,public,allocatable :: statBvar_meta(:) ! child metadata for stats
-
- ! ----------------------------------------------------------------------------------------------------------------
- ! * part 3: run time variables
- ! ----------------------------------------------------------------------------------------------------------------
-
- ! define the model decisions
- type(model_options),save,public :: model_decisions(maxvarDecisions) ! the model decision structure
-
- ! define index variables describing the indices of the first and last HRUs in the forcing file
- integer(i4b),save,public :: ixHRUfile_min ! minimum index
- integer(i4b),save,public :: ixHRUfile_max ! maximum index
-
- ! define mapping structures
- type(gru2hru_map),allocatable,save,public :: gru_struc(:) ! gru2hru map
- type(hru2gru_map),allocatable,save,public :: index_map(:) ! hru2gru map
-
- ! define variables used for the vegetation phenology
- real(rkind),dimension(12),save,public :: greenVegFrac_monthly ! fraction of green vegetation in each month (0-1)
-
- ! define the model output file
- character(len=256),save,public :: fileout='' ! output filename
- character(len=256),save,public :: output_fileSuffix='' ! suffix for the output file
-
- ! define controls on model output
- logical(lgt),dimension(maxvarFreq),save,public :: finalizeStats=.false. ! flags to reset statistics
- integer(i4b),save,public :: maxLayers ! maximum number of layers
- integer(i4b),save,public :: maxSnowLayers ! maximum number of snow layers
-
- ! define control variables
- integer(i4b),save,public :: startGRU ! index of the starting GRU for parallelization run
- integer(i4b),save,public :: checkHRU ! index of the HRU for a single HRU run
- integer(i4b),save,public :: iRunMode ! define the current running mode
- integer(i4b),save,public :: nThreads=1 ! number of threads
- integer(i4b),save,public :: ixProgress=ixProgress_id ! define frequency to write progress
- integer(i4b),save,public :: ixRestart=ixRestart_never ! define frequency to write restart files
- integer(i4b),save,public :: newOutputFile=noNewFiles ! define option for new output files
-
- ! define common variables
- integer(i4b),save,public :: numtim ! number of time steps
- integer(i4b),save,public :: nHRUrun ! number of HRUs in the run domain
- integer(i4b),save,public :: nGRUrun ! number of GRUs in the run domain
- real(rkind),save,public :: data_step ! length of the time_step
- real(rkind),save,public :: refJulday ! reference time in fractional julian days
- real(rkind),save,public :: refJulday_data ! reference time in fractional julian days (data files)
- real(rkind),save,public :: dJulianStart ! julian day of start time of simulation
- real(rkind),save,public :: dJulianFinsh ! julian day of end time of simulation
- integer(i4b),save,public :: nHRUfile ! number of HRUs in the file
- integer(i4b),save,public :: urbanVegCategory ! vegetation category for urban areas
- logical(lgt),save,public :: doJacobian=.false. ! flag to compute the Jacobian
- logical(lgt),save,public :: globalPrintFlag=.false. ! flag to compute the Jacobian
- integer(i4b),save,public :: chunksize=1024 ! chunk size for the netcdf read/write
- integer(i4b),save,public :: outputPrecision=nf90_double ! variable type
- integer(i4b),save,public :: outputCompressionLevel=4 ! output netcdf file deflate level: 0-9. 0 is no compression.
-
- ! define result from the time calls
- integer(i4b),dimension(8),save,public :: startInit,endInit ! date/time for the start and end of the initialization
- integer(i4b),dimension(8),save,public :: startSetup,endSetup ! date/time for the start and end of the parameter setup
- integer(i4b),dimension(8),save,public :: startRestart,endRestart ! date/time for the start and end to read restart data
- integer(i4b),dimension(8),save,public :: startRead,endRead ! date/time for the start and end of the data read
- integer(i4b),dimension(8),save,public :: startWrite,endWrite ! date/time for the start and end of the stats/write
- integer(i4b),dimension(8),save,public :: startPhysics,endPhysics ! date/time for the start and end of the physics
-
- ! define elapsed time
- real(rkind),save,public :: elapsedInit ! elapsed time for the initialization
- real(rkind),save,public :: elapsedSetup ! elapsed time for the parameter setup
- real(rkind),save,public :: elapsedRestart ! elapsed time to read restart data
- real(rkind),save,public :: elapsedRead ! elapsed time for the data read
- real(rkind),save,public :: elapsedWrite ! elapsed time for the stats/write
- real(rkind),save,public :: elapsedPhysics ! elapsed time for the physics
-
- ! define ancillary data structures
- type(var_i),save,public :: startTime ! start time for the model simulation
- type(var_i),save,public :: finshTime ! end time for the model simulation
- type(var_i),save,public :: refTime ! reference time for the model simulation
- type(var_i),save,public :: oldTime ! time for the previous model time step
-
- ! output file information
- logical(lgt),dimension(maxvarFreq),save,public :: outFreq ! true if the output frequency is desired
- integer(i4b),dimension(maxvarFreq),save,public :: ncid ! netcdf output file id
-
- ! look-up values for the choice of the time zone information (formerly in modelDecisions module)
- integer(i4b),parameter,public :: ncTime=1 ! time zone information from NetCDF file (timeOffset = longitude/15. - ncTimeOffset)
- integer(i4b),parameter,public :: utcTime=2 ! all times in UTC (timeOffset = longitude/15. hours)
- integer(i4b),parameter,public :: localTime=3 ! all times local (timeOffset = 0)
-
-#ifdef ACTORS_ACTIVE
- ! global data structures are managed by FileAccessActor
- type(var_forc),allocatable,save,public :: forcingDataStruct(:) ! forcingDataStruct(:)%var(:)%dataFromFile(:,:)
- type(dlength),allocatable,save,public :: vecTime(:)
- logical(lgt),allocatable,save,public :: failedHRUs(:) ! list of true and false values to indicate if an HRU has failed
- type(ilength),allocatable,save,public :: outputTimeStep(:) ! timestep in output files
-
- ! inital conditions for Actors
- type(init_cond),allocatable,save,public :: init_cond_prog(:) ! variable data for initial conditions
- type(init_cond),allocatable,save,public :: init_cond_bvar(:) ! variable data for initial conditions
-#else
- ! define metadata for model forcing datafile non-Actors
- type(file_info),save,public,allocatable :: forcFileInfo(:) ! file info for model forcing data
-
- ! define indices in the forcing data files non-Actors
- integer(i4b),save,public :: iFile=1 ! index of current forcing file from forcing file list
- integer(i4b),save,public :: forcingStep=integerMissing ! index of current time step in current forcing file
- integer(i4b),save,public :: forcNcid=integerMissing ! netcdf id for current netcdf forcing file
-
- ! define controls on model output non-Actors
- integer(i4b),dimension(maxvarFreq),save,public :: statCounter=0 ! time counter for stats
- integer(i4b),dimension(maxvarFreq),save,public :: outputTimeStep=0 ! timestep in output files
- logical(lgt),dimension(maxvarFreq),save,public :: resetStats=.true. ! flags to reset statistics
-
- ! define common variables non-Actors
- real(rkind),save,public :: fracJulday ! fractional julian days since the start of year
- real(rkind),save,public :: tmZoneOffsetFracDay ! time zone offset in fractional days
- integer(i4b),save,public :: yearLength ! number of days in the current year
-#endif
-
- ! define fixed dimensions
- integer(i4b),parameter,public :: nBand=2 ! number of spectral bands
- integer(i4b),parameter,public :: nTimeDelay=2000 ! number of time steps in the time delay histogram (default: ~1 season = 24*365/4)
-
- ! printing step frequency
- integer(i4b),parameter,public :: print_step_freq = 1000
-
- character(len=1024),public,save :: fname ! temporary filename
-
-END MODULE globalData
diff --git a/build/source/dshare/var_lookup.f90 b/build/source/dshare/var_lookup.f90
deleted file mode 100644
index f297a362fbf6ef117b452240e86ba470724ea410..0000000000000000000000000000000000000000
--- a/build/source/dshare/var_lookup.f90
+++ /dev/null
@@ -1,953 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-MODULE var_lookup
- ! defines named variables used to index array elements
-#ifdef ACTORS_ACTIVE
- USE, intrinsic :: iso_c_binding
-#endif
- USE nrtype, integerMissing=>nr_integerMissing
- implicit none
- private
- ! local variables
- integer(i4b),parameter :: ixVal =1 ! an example 4 byte integer
- integer(8),parameter :: ix8Val=2 ! an example 8 byte integer
- integer(i4b),parameter :: iLength =storage_size(ixVal) ! size of the example 4 byte integer
- integer(i4b),parameter :: i8Length=storage_size(ix8Val) ! size of the example 8 byte integer
-
- ! ***************************************************************************************
- ! (0) define model decisions
- ! ***************************************************************************************
- type, public :: iLook_decision
- integer(i4b) :: soilCatTbl = integerMissing ! soil-category dateset
- integer(i4b) :: vegeParTbl = integerMissing ! vegetation category dataset
- integer(i4b) :: soilStress = integerMissing ! choice of function for the soil moisture control on stomatal resistance
- integer(i4b) :: stomResist = integerMissing ! choice of function for stomatal resistance
- integer(i4b) :: bbTempFunc = integerMissing ! Ball-Berry: leaf temperature controls on photosynthesis + stomatal resistance
- integer(i4b) :: bbHumdFunc = integerMissing ! Ball-Berry: humidity controls on stomatal resistance
- integer(i4b) :: bbElecFunc = integerMissing ! Ball-Berry: dependence of photosynthesis on PAR
- integer(i4b) :: bbCO2point = integerMissing ! Ball-Berry: use of CO2 compensation point to calculate stomatal resistance
- integer(i4b) :: bbNumerics = integerMissing ! Ball-Berry: iterative numerical solution method
- integer(i4b) :: bbAssimFnc = integerMissing ! Ball-Berry: controls on carbon assimilation
- integer(i4b) :: bbCanIntg8 = integerMissing ! Ball-Berry: scaling of photosynthesis from the leaf to the canopy
- integer(i4b) :: num_method = integerMissing ! choice of numerical method
- integer(i4b) :: fDerivMeth = integerMissing ! method used to calculate flux derivatives
- integer(i4b) :: LAI_method = integerMissing ! method used to determine LAI and SAI
- integer(i4b) :: cIntercept = integerMissing ! choice of parameterization for canopy interception
- integer(i4b) :: f_Richards = integerMissing ! form of richards' equation
- integer(i4b) :: groundwatr = integerMissing ! choice of groundwater parameterization
- integer(i4b) :: hc_profile = integerMissing ! choice of hydraulic conductivity profile
- integer(i4b) :: bcUpprTdyn = integerMissing ! type of upper boundary condition for thermodynamics
- integer(i4b) :: bcLowrTdyn = integerMissing ! type of lower boundary condition for thermodynamics
- integer(i4b) :: bcUpprSoiH = integerMissing ! type of upper boundary condition for soil hydrology
- integer(i4b) :: bcLowrSoiH = integerMissing ! type of lower boundary condition for soil hydrology
- integer(i4b) :: veg_traits = integerMissing ! choice of parameterization for vegetation roughness length and displacement height
- integer(i4b) :: rootProfil = integerMissing ! choice of parameterization for the rooting profile
- integer(i4b) :: canopyEmis = integerMissing ! choice of parameterization for canopy emissivity
- integer(i4b) :: snowIncept = integerMissing ! choice of parameterization for snow interception
- integer(i4b) :: snowUnload = integerMissing ! choice of parameterization for snow unloading
- integer(i4b) :: windPrfile = integerMissing ! choice of canopy wind profile
- integer(i4b) :: astability = integerMissing ! choice of stability function
- integer(i4b) :: canopySrad = integerMissing ! choice of method for canopy shortwave radiation
- integer(i4b) :: alb_method = integerMissing ! choice of albedo representation
- integer(i4b) :: snowLayers = integerMissing ! choice of method to combine and sub-divide snow layers
- integer(i4b) :: compaction = integerMissing ! choice of compaction routine
- integer(i4b) :: thCondSnow = integerMissing ! choice of thermal conductivity representation for snow
- integer(i4b) :: thCondSoil = integerMissing ! choice of thermal conductivity representation for soil
- integer(i4b) :: spatial_gw = integerMissing ! choice of method for spatial representation of groundwater
- integer(i4b) :: subRouting = integerMissing ! choice of method for sub-grid routing
- integer(i4b) :: snowDenNew = integerMissing ! choice of method for new snow density
- integer(i4b) :: howHeatCap = integerMissing ! how to compute heat capacity in energy equation
- endtype iLook_decision
-
- ! ***********************************************************************************************************
- ! (1) define model time
- ! ***********************************************************************************************************
- type, public :: iLook_time
- integer(i4b) :: iyyy = integerMissing ! year
- integer(i4b) :: im = integerMissing ! month
- integer(i4b) :: id = integerMissing ! day
- integer(i4b) :: ih = integerMissing ! hour
- integer(i4b) :: imin = integerMissing ! minute
- integer(i4b) :: ih_tz = integerMissing ! hour for time zone offset
- integer(i4b) :: imin_tz = integerMissing ! minute for time zone offset
- endtype iLook_time
-
- ! ***********************************************************************************************************
- ! (2) define model forcing data
- ! ***********************************************************************************************************
- type, public :: iLook_force
- integer(i4b) :: time = integerMissing ! time since time reference (s)
- integer(i4b) :: pptrate = integerMissing ! precipitation rate (kg m-2 s-1)
- integer(i4b) :: airtemp = integerMissing ! air temperature (K)
- integer(i4b) :: spechum = integerMissing ! specific humidity (g/g)
- integer(i4b) :: windspd = integerMissing ! windspeed (m/s)
- integer(i4b) :: SWRadAtm = integerMissing ! downwelling shortwave radiaiton (W m-2)
- integer(i4b) :: LWRadAtm = integerMissing ! downwelling longwave radiation (W m-2)
- integer(i4b) :: airpres = integerMissing ! pressure (Pa)
- endtype iLook_force
-
- ! ***********************************************************************************************************
- ! (3) define local attributes
- ! ***********************************************************************************************************
- type, public :: iLook_attr
- integer(i4b) :: latitude = integerMissing ! latitude (degrees north)
- integer(i4b) :: longitude = integerMissing ! longitude (degrees east)
- integer(i4b) :: elevation = integerMissing ! elevation (m)
- integer(i4b) :: tan_slope = integerMissing ! tan water table slope, taken as tan local ground surface slope (-)
- integer(i4b) :: contourLength = integerMissing ! length of contour at downslope edge of HRU (m)
- integer(i4b) :: HRUarea = integerMissing ! area of each HRU (m2)
- integer(i4b) :: mHeight = integerMissing ! measurement height above bare ground (m)
- integer(i4b) :: aspect = integerMissing ! mean azimuth of HRU (degrees E of N, range 0-360)
- end type iLook_attr
-
- ! ***********************************************************************************************************
- ! (4) define local classification of veg, soil, etc.; and gru and hru IDs and associated information
- ! ***********************************************************************************************************
- type, public :: iLook_type
- integer(i4b) :: vegTypeIndex = integerMissing ! index defining vegetation type (-)
- integer(i4b) :: soilTypeIndex = integerMissing ! index defining soil type (-)
- integer(i4b) :: slopeTypeIndex= integerMissing ! index defining slope (-)
- integer(i4b) :: downHRUindex = integerMissing ! index of downslope HRU (0 = basin outlet)
- end type iLook_type
-
- type, public :: iLook_id
- integer(8) :: hruId = integerMissing ! ID label defining hydrologic response unit (-)
- end type iLook_id
-
- ! ***********************************************************************************************************
- ! (5) define model parameters
- ! ***********************************************************************************************************
- type, public :: iLook_param
- ! boundary conditions
- integer(i4b) :: upperBoundHead = integerMissing ! matric head of the upper boundary (m)
- integer(i4b) :: lowerBoundHead = integerMissing ! matric head of the lower boundary (m)
- integer(i4b) :: upperBoundTheta = integerMissing ! volumetric liquid water content of the upper boundary (-)
- integer(i4b) :: lowerBoundTheta = integerMissing ! volumetric liquid water content of the lower boundary (-)
- integer(i4b) :: upperBoundTemp = integerMissing ! temperature of the upper boundary (K)
- integer(i4b) :: lowerBoundTemp = integerMissing ! temperature of the lower boundary (K)
- ! precipitation partitioning
- integer(i4b) :: tempCritRain = integerMissing ! critical temperature where precipitation is rain (K)
- integer(i4b) :: tempRangeTimestep = integerMissing ! temperature range over the time step (K)
- integer(i4b) :: frozenPrecipMultip = integerMissing ! frozen precipitation multiplier (-)
- ! snow properties
- integer(i4b) :: snowfrz_scale = integerMissing ! scaling parameter for the freezing curve for snow (K-1)
- integer(i4b) :: fixedThermalCond_snow = integerMissing ! fixed thermal conductivity for snow (W m-1 K-1)
- ! snow albedo
- integer(i4b) :: albedoMax = integerMissing ! maximum snow albedo for a single spectral band (-)
- integer(i4b) :: albedoMinWinter = integerMissing ! minimum snow albedo during winter for a single spectral band (-)
- integer(i4b) :: albedoMinSpring = integerMissing ! minimum snow albedo during spring for a single spectral band (-)
- integer(i4b) :: albedoMaxVisible = integerMissing ! maximum snow albedo in the visible part of the spectrum (-)
- integer(i4b) :: albedoMinVisible = integerMissing ! minimum snow albedo in the visible part of the spectrum (-)
- integer(i4b) :: albedoMaxNearIR = integerMissing ! maximum snow albedo in the near infra-red part of the spectrum (-)
- integer(i4b) :: albedoMinNearIR = integerMissing ! minimum snow albedo in the near infra-red part of the spectrum (-)
- integer(i4b) :: albedoDecayRate = integerMissing ! albedo decay rate (s)
- integer(i4b) :: albedoSootLoad = integerMissing ! soot load factor (-)
- integer(i4b) :: albedoRefresh = integerMissing ! critical mass necessary for albedo refreshment (kg m-2)
- ! radiation transfer within snow
- integer(i4b) :: radExt_snow = integerMissing ! extinction coefficient for radiation penetration into the snowpack (m-1)
- integer(i4b) :: directScale = integerMissing ! scaling factor for fractional driect radiaion parameterization (-)
- integer(i4b) :: Frad_direct = integerMissing ! maximum fraction of direct solar radiation (-)
- integer(i4b) :: Frad_vis = integerMissing ! fraction of radiation in the visible part of the spectrum (-)
- ! new snow density
- integer(i4b) :: newSnowDenMin = integerMissing ! minimum new snow density (kg m-3)
- integer(i4b) :: newSnowDenMult = integerMissing ! multiplier for new snow density (kg m-3)
- integer(i4b) :: newSnowDenScal = integerMissing ! scaling factor for new snow density (K)
- integer(i4b) :: constSnowDen = integerMissing ! constDens, Constant new snow density (kg m-3)
- integer(i4b) :: newSnowDenAdd = integerMissing ! Pahaut 1976, additive factor for new snow density (kg m-3)
- integer(i4b) :: newSnowDenMultTemp = integerMissing ! Pahaut 1976, multiplier for new snow density applied to air temperature (kg m-3 K-1)
- integer(i4b) :: newSnowDenMultWind = integerMissing ! Pahaut 1976, multiplier for new snow density applied to wind speed (kg m-7/2 s-1/2)
- integer(i4b) :: newSnowDenMultAnd = integerMissing ! Anderson 1976, multiplier for new snow density for Anderson function (K-1)
- integer(i4b) :: newSnowDenBase = integerMissing ! Anderson 1976, base value that is rasied to the (3/2) power (K)
- ! snow compaction
- integer(i4b) :: densScalGrowth = integerMissing ! density scaling factor for grain growth (kg-1 m3)
- integer(i4b) :: tempScalGrowth = integerMissing ! temperature scaling factor for grain growth (K-1)
- integer(i4b) :: grainGrowthRate = integerMissing ! rate of grain growth (s-1)
- integer(i4b) :: densScalOvrbdn = integerMissing ! density scaling factor for overburden pressure (kg-1 m3)
- integer(i4b) :: tempScalOvrbdn = integerMissing ! temperature scaling factor for overburden pressure (K-1)
- integer(i4b) :: baseViscosity = integerMissing ! viscosity coefficient at T=T_frz and snow density=0 (kg s m-2)
- ! water flow within snow
- integer(i4b) :: Fcapil = integerMissing ! capillary retention as a fraction of the total pore volume (-)
- integer(i4b) :: k_snow = integerMissing ! hydraulic conductivity of snow (m s-1), 0.0055 = approx. 20 m/hr, from UEB
- integer(i4b) :: mw_exp = integerMissing ! exponent for meltwater flow (-)
- ! turbulent heat fluxes
- integer(i4b) :: z0Snow = integerMissing ! roughness length of snow (m)
- integer(i4b) :: z0Soil = integerMissing ! roughness length of bare soil below the canopy (m)
- integer(i4b) :: z0Canopy = integerMissing ! roughness length of the canopy (m)
- integer(i4b) :: zpdFraction = integerMissing ! zero plane displacement / canopy height (-)
- integer(i4b) :: critRichNumber = integerMissing ! critical value for the bulk Richardson number (-)
- integer(i4b) :: Louis79_bparam = integerMissing ! parameter in Louis (1979) stability function (-)
- integer(i4b) :: Louis79_cStar = integerMissing ! parameter in Louis (1979) stability function (-)
- integer(i4b) :: Mahrt87_eScale = integerMissing ! exponential scaling factor in the Mahrt (1987) stability function (-)
- integer(i4b) :: leafExchangeCoeff = integerMissing ! turbulent exchange coeff between canopy surface and canopy air ( m s-(1/2) )
- integer(i4b) :: windReductionParam = integerMissing ! canopy wind reduction parameter (-)
- ! stomatal conductance
- integer(i4b) :: Kc25 = integerMissing ! Michaelis-Menten constant for CO2 at 25 degrees C (umol mol-1)
- integer(i4b) :: Ko25 = integerMissing ! Michaelis-Menten constant for O2 at 25 degrees C (mol mol-1)
- integer(i4b) :: Kc_qFac = integerMissing ! factor in the q10 function defining temperature controls on Kc (-)
- integer(i4b) :: Ko_qFac = integerMissing ! factor in the q10 function defining temperature controls on Ko (-)
- integer(i4b) :: kc_Ha = integerMissing ! activation energy for the Michaelis-Menten constant for CO2 (J mol-1)
- integer(i4b) :: ko_Ha = integerMissing ! activation energy for the Michaelis-Menten constant for O2 (J mol-1)
- integer(i4b) :: vcmax25_canopyTop = integerMissing ! potential carboxylation rate at 25 degrees C at the canopy top (umol co2 m-2 s-1)
- integer(i4b) :: vcmax_qFac = integerMissing ! factor in the q10 function defining temperature controls on vcmax (-)
- integer(i4b) :: vcmax_Ha = integerMissing ! activation energy in the vcmax function (J mol-1)
- integer(i4b) :: vcmax_Hd = integerMissing ! deactivation energy in the vcmax function (J mol-1)
- integer(i4b) :: vcmax_Sv = integerMissing ! entropy term in the vcmax function (J mol-1 K-1)
- integer(i4b) :: vcmax_Kn = integerMissing ! foliage nitrogen decay coefficient (-)
- integer(i4b) :: jmax25_scale = integerMissing ! scaling factor to relate jmax25 to vcmax25 (-)
- integer(i4b) :: jmax_Ha = integerMissing ! activation energy in the jmax function (J mol-1)
- integer(i4b) :: jmax_Hd = integerMissing ! deactivation energy in the jmax function (J mol-1)
- integer(i4b) :: jmax_Sv = integerMissing ! entropy term in the jmax function (J mol-1 K-1)
- integer(i4b) :: fractionJ = integerMissing ! fraction of light lost by other than the chloroplast lamellae (-)
- integer(i4b) :: quantamYield = integerMissing ! quantam yield (mol e mol-1 q)
- integer(i4b) :: vpScaleFactor = integerMissing ! vapor pressure scaling factor in stomatal conductance function (Pa)
- integer(i4b) :: cond2photo_slope = integerMissing ! slope of conductance-photosynthesis relationship (-)
- integer(i4b) :: minStomatalConductance= integerMissing ! minimum stomatal conductance (umol H2O m-2 s-1)
- ! vegetation properties
- integer(i4b) :: winterSAI = integerMissing ! stem area index prior to the start of the growing season (m2 m-2)
- integer(i4b) :: summerLAI = integerMissing ! maximum leaf area index at the peak of the growing season (m2 m-2)
- integer(i4b) :: rootScaleFactor1 = integerMissing ! 1st scaling factor (a) in Y = 1 - 0.5*( exp(-aZ) + exp(-bZ) ) (m-1)
- integer(i4b) :: rootScaleFactor2 = integerMissing ! 2nd scaling factor (b) in Y = 1 - 0.5*( exp(-aZ) + exp(-bZ) ) (m-1)
- integer(i4b) :: rootingDepth = integerMissing ! rooting depth (m)
- integer(i4b) :: rootDistExp = integerMissing ! exponent controlling the vertical distribution of root density (-)
- integer(i4b) :: plantWiltPsi = integerMissing ! matric head at wilting point (m)
- integer(i4b) :: soilStressParam = integerMissing ! parameter in the exponential soil stress function
- integer(i4b) :: critSoilWilting = integerMissing ! critical vol. liq. water content when plants are wilting (-)
- integer(i4b) :: critSoilTranspire = integerMissing ! critical vol. liq. water content when transpiration is limited (-)
- integer(i4b) :: critAquiferTranspire = integerMissing ! critical aquifer storage value when transpiration is limited (m)
- integer(i4b) :: minStomatalResistance = integerMissing ! minimum canopy resistance (s m-1)
- integer(i4b) :: leafDimension = integerMissing ! characteristic leaf dimension (m)
- integer(i4b) :: heightCanopyTop = integerMissing ! height of top of the vegetation canopy above ground surface (m)
- integer(i4b) :: heightCanopyBottom = integerMissing ! height of bottom of the vegetation canopy above ground surface (m)
- integer(i4b) :: specificHeatVeg = integerMissing ! specific heat of vegetation (J kg-1 K-1)
- integer(i4b) :: maxMassVegetation = integerMissing ! maximum mass of vegetation (full foliage) (kg m-2)
- integer(i4b) :: throughfallScaleSnow = integerMissing ! scaling factor for throughfall (snow) (-)
- integer(i4b) :: throughfallScaleRain = integerMissing ! scaling factor for throughfall (rain) (-)
- integer(i4b) :: refInterceptCapSnow = integerMissing ! reference canopy interception capacity per unit leaf area (snow) (kg m-2)
- integer(i4b) :: refInterceptCapRain = integerMissing ! canopy interception capacity per unit leaf area (rain) (kg m-2)
- integer(i4b) :: snowUnloadingCoeff = integerMissing ! time constant for unloading of snow from the forest canopy (s-1)
- integer(i4b) :: canopyDrainageCoeff = integerMissing ! time constant for drainage of liquid water from the forest canopy (s-1)
- integer(i4b) :: ratioDrip2Unloading = integerMissing ! ratio of canopy drip to unloading of snow from the forest canopy (-)
- integer(i4b) :: canopyWettingFactor = integerMissing ! maximum wetted fraction of the canopy (-)
- integer(i4b) :: canopyWettingExp = integerMissing ! exponent in canopy wetting function (-)
- integer(i4b) :: minTempUnloading = integerMissing ! constant describing the minimum temperature for snow unloading in windySnow parameterization (K)
- integer(i4b) :: rateTempUnloading = integerMissing ! constant describing how quickly snow will unload due to temperature in windySnow parameterization (K s)
- integer(i4b) :: minWindUnloading = integerMissing ! constant describing the minimum windspeed for snow unloading in windySnow parameterization (m s-1)
- integer(i4b) :: rateWindUnloading = integerMissing ! constant describing how quickly snow will unload due to wind in windySnow parameterization (m)
- ! soil properties
- integer(i4b) :: soil_dens_intr = integerMissing ! intrinsic soil density (kg m-3)
- integer(i4b) :: thCond_soil = integerMissing ! thermal conductivity of soil (W m-1 K-1)
- integer(i4b) :: frac_sand = integerMissing ! fraction of sand (-)
- integer(i4b) :: frac_silt = integerMissing ! fraction of silt (-)
- integer(i4b) :: frac_clay = integerMissing ! fraction of clay (-)
- integer(i4b) :: fieldCapacity = integerMissing ! field capacity (-)
- integer(i4b) :: wettingFrontSuction = integerMissing ! Green-Ampt wetting front suction (m)
- integer(i4b) :: theta_mp = integerMissing ! volumetric liquid water content when macropore flow begins (-)
- integer(i4b) :: theta_sat = integerMissing ! porosity (-)
- integer(i4b) :: theta_res = integerMissing ! volumetric residual water content (-)
- integer(i4b) :: vGn_alpha = integerMissing ! van Genuchten "alpha" parameter (m-1)
- integer(i4b) :: vGn_n = integerMissing ! van Genuchten "n" parameter (-)
- integer(i4b) :: mpExp = integerMissing ! empirical exponent in macropore flow equation (-)
- integer(i4b) :: k_soil = integerMissing ! hydraulic conductivity of soil (m s-1)
- integer(i4b) :: k_macropore = integerMissing ! saturated hydraulic conductivity for macropores (m s-1)
- integer(i4b) :: kAnisotropic = integerMissing ! anisotropy factor for lateral hydraulic conductivity (-)
- integer(i4b) :: zScale_TOPMODEL = integerMissing ! TOPMODEL scaling factor used in lower boundary condition for soil (m)
- integer(i4b) :: compactedDepth = integerMissing ! depth where k_soil reaches the compacted value given by CH78 (m)
- integer(i4b) :: aquiferBaseflowRate = integerMissing ! baseflow rate when aquifer storage = aquiferScaleFactor (m s-1)
- integer(i4b) :: aquiferScaleFactor = integerMissing ! scaling factor for aquifer storage in the big bucket (m)
- integer(i4b) :: aquiferBaseflowExp = integerMissing ! baseflow exponent (-)
- integer(i4b) :: qSurfScale = integerMissing ! scaling factor in the surface runoff parameterization (-)
- integer(i4b) :: specificYield = integerMissing ! specific yield (-)
- integer(i4b) :: specificStorage = integerMissing ! specific storage coefficient (m-1)
- integer(i4b) :: f_impede = integerMissing ! ice impedence factor (-)
- integer(i4b) :: soilIceScale = integerMissing ! scaling factor for depth of soil ice, used to get frozen fraction (m)
- integer(i4b) :: soilIceCV = integerMissing ! CV of depth of soil ice, used to get frozen fraction (-)
- ! algorithmic control parameters
- integer(i4b) :: minwind = integerMissing ! minimum wind speed (m s-1)
- integer(i4b) :: minstep = integerMissing ! minimum length of the time step
- integer(i4b) :: maxstep = integerMissing ! maximum length of the time step
- integer(i4b) :: wimplicit = integerMissing ! weight assigned to the start-of-step fluxes
- integer(i4b) :: maxiter = integerMissing ! maximum number of iteration
- integer(i4b) :: relConvTol_liquid = integerMissing ! relative convergence tolerance for vol frac liq water (-)
- integer(i4b) :: absConvTol_liquid = integerMissing ! absolute convergence tolerance for vol frac liq water (-)
- integer(i4b) :: relConvTol_matric = integerMissing ! relative convergence tolerance for matric head (-)
- integer(i4b) :: absConvTol_matric = integerMissing ! absolute convergence tolerance for matric head (m)
- integer(i4b) :: relConvTol_energy = integerMissing ! relative convergence tolerance for energy (-)
- integer(i4b) :: absConvTol_energy = integerMissing ! absolute convergence tolerance for energy (J m-3)
- integer(i4b) :: relConvTol_aquifr = integerMissing ! relative convergence tolerance for aquifer storage (-)
- integer(i4b) :: absConvTol_aquifr = integerMissing ! absolute convergence tolerance for aquifer storage (J m-3)
- integer(i4b) :: zmin = integerMissing ! minimum layer depth (m)
- integer(i4b) :: zmax = integerMissing ! maximum layer depth (m)
- integer(i4b) :: zminLayer1 = integerMissing ! minimum layer depth for the 1st (top) layer (m)
- integer(i4b) :: zminLayer2 = integerMissing ! minimum layer depth for the 2nd layer (m)
- integer(i4b) :: zminLayer3 = integerMissing ! minimum layer depth for the 3rd layer (m)
- integer(i4b) :: zminLayer4 = integerMissing ! minimum layer depth for the 4th layer (m)
- integer(i4b) :: zminLayer5 = integerMissing ! minimum layer depth for the 5th (bottom) layer (m)
- integer(i4b) :: zmaxLayer1_lower = integerMissing ! maximum layer depth for the 1st (top) layer when only 1 layer (m)
- integer(i4b) :: zmaxLayer2_lower = integerMissing ! maximum layer depth for the 2nd layer when only 2 layers (m)
- integer(i4b) :: zmaxLayer3_lower = integerMissing ! maximum layer depth for the 3rd layer when only 3 layers (m)
- integer(i4b) :: zmaxLayer4_lower = integerMissing ! maximum layer depth for the 4th layer when only 4 layers (m)
- integer(i4b) :: zmaxLayer1_upper = integerMissing ! maximum layer depth for the 1st (top) layer when > 1 layer (m)
- integer(i4b) :: zmaxLayer2_upper = integerMissing ! maximum layer depth for the 2nd layer when > 2 layers (m)
- integer(i4b) :: zmaxLayer3_upper = integerMissing ! maximum layer depth for the 3rd layer when > 3 layers (m)
- integer(i4b) :: zmaxLayer4_upper = integerMissing ! maximum layer depth for the 4th layer when > 4 layers (m)
- endtype ilook_param
-
- ! ***********************************************************************************************************
- ! (6) define model prognostic (state) variables
- ! ***********************************************************************************************************
- type, public :: iLook_prog
- ! variables for time stepping
- integer(i4b) :: dt_init = integerMissing ! length of initial time step at start of next data interval (s)
- ! state variables for vegetation
- integer(i4b) :: scalarCanopyIce = integerMissing ! mass of ice on the vegetation canopy (kg m-2)
- integer(i4b) :: scalarCanopyLiq = integerMissing ! mass of liquid water on the vegetation canopy (kg m-2)
- integer(i4b) :: scalarCanopyWat = integerMissing ! mass of total water on the vegetation canopy (kg m-2)
- integer(i4b) :: scalarCanairTemp = integerMissing ! temperature of the canopy air space (Pa)
- integer(i4b) :: scalarCanopyTemp = integerMissing ! temperature of the vegetation canopy (K)
- ! state variables for snow
- integer(i4b) :: spectralSnowAlbedoDiffuse = integerMissing ! diffuse snow albedo for individual spectral bands (-)
- integer(i4b) :: scalarSnowAlbedo = integerMissing ! snow albedo for the entire spectral band (-)
- integer(i4b) :: scalarSnowDepth = integerMissing ! total snow depth (m)
- integer(i4b) :: scalarSWE = integerMissing ! snow water equivalent (kg m-2)
- integer(i4b) :: scalarSfcMeltPond = integerMissing ! ponded water caused by melt of the "snow without a layer" (kg m-2)
- ! state variables for the snow+soil domain
- integer(i4b) :: mLayerTemp = integerMissing ! temperature of each layer (K)
- integer(i4b) :: mLayerVolFracIce = integerMissing ! volumetric fraction of ice in each layer (-)
- integer(i4b) :: mLayerVolFracLiq = integerMissing ! volumetric fraction of liquid water in each layer (-)
- integer(i4b) :: mLayerVolFracWat = integerMissing ! volumetric fraction of total water in each layer (-)
- integer(i4b) :: mLayerMatricHead = integerMissing ! matric head of water in the soil (m)
- ! other state variables
- integer(i4b) :: scalarAquiferStorage = integerMissing ! relative aquifer storage -- above bottom of the soil profile (m)
- integer(i4b) :: scalarSurfaceTemp = integerMissing ! surface temperature (K)
- ! coordinate variables
- integer(i4b) :: mLayerDepth = integerMissing ! depth of each layer (m)
- integer(i4b) :: mLayerHeight = integerMissing ! height at the mid-point of each layer (m)
- integer(i4b) :: iLayerHeight = integerMissing ! height of the layer interface; top of soil = 0 (m)
- endtype iLook_prog
-
- ! ***********************************************************************************************************
- ! (7) define diagnostic variables
- ! ***********************************************************************************************************
- type, public :: iLook_diag
- ! local properties
- integer(i4b) :: scalarCanopyDepth = integerMissing ! canopy depth (m)
- integer(i4b) :: scalarGreenVegFraction = integerMissing ! green vegetation fraction used to compute LAI (-)
- integer(i4b) :: scalarBulkVolHeatCapVeg = integerMissing ! bulk volumetric heat capacity of vegetation (J m-3 K-1)
- integer(i4b) :: scalarCanopyEmissivity = integerMissing ! effective canopy emissivity (-)
- integer(i4b) :: scalarRootZoneTemp = integerMissing ! average temperature of the root zone (K)
- integer(i4b) :: scalarLAI = integerMissing ! one-sided leaf area index (m2 m-2)
- integer(i4b) :: scalarSAI = integerMissing ! one-sided stem area index (m2 m-2)
- integer(i4b) :: scalarExposedLAI = integerMissing ! exposed leaf area index after burial by snow (m2 m-2)
- integer(i4b) :: scalarExposedSAI = integerMissing ! exposed stem area index after burial by snow (m2 m-2)
- integer(i4b) :: scalarAdjMeasHeight = integerMissing ! adjusted measurement height for cases snowDepth>mHeight (m)
- integer(i4b) :: scalarCanopyIceMax = integerMissing ! maximum interception storage capacity for ice (kg m-2)
- integer(i4b) :: scalarCanopyLiqMax = integerMissing ! maximum interception storage capacity for liquid water (kg m-2)
- integer(i4b) :: scalarGrowingSeasonIndex = integerMissing ! growing season index (0=off, 1=on)
- integer(i4b) :: scalarVolHtCap_air = integerMissing ! volumetric heat capacity air (J m-3 K-1)
- integer(i4b) :: scalarVolHtCap_ice = integerMissing ! volumetric heat capacity ice (J m-3 K-1)
- integer(i4b) :: scalarVolHtCap_soil = integerMissing ! volumetric heat capacity dry soil (J m-3 K-1)
- integer(i4b) :: scalarVolHtCap_water = integerMissing ! volumetric heat capacity liquid wat (J m-3 K-1)
- integer(i4b) :: mLayerVolHtCapBulk = integerMissing ! volumetric heat capacity in each layer (J m-3 K-1)
- integer(i4b) :: scalarLambda_drysoil = integerMissing ! thermal conductivity of dry soil (W m-1 K-1)
- integer(i4b) :: scalarLambda_wetsoil = integerMissing ! thermal conductivity of wet soil (W m-1 K-1)
- integer(i4b) :: mLayerThermalC = integerMissing ! thermal conductivity at the mid-point of each layer (W m-1 K-1)
- integer(i4b) :: iLayerThermalC = integerMissing ! thermal conductivity at the interface of each layer (W m-1 K-1)
- ! energy derivatives that might be treated as constant if heat capacity and thermal conductivity not updated
- integer(i4b) :: dVolHtCapBulk_dPsi0 = integerMissing ! derivative in bulk heat capacity w.r.t. matric potential
- integer(i4b) :: dVolHtCapBulk_dTheta = integerMissing ! derivative in bulk heat capacity w.r.t. volumetric water content
- integer(i4b) :: dVolHtCapBulk_dCanWat = integerMissing ! derivative in bulk heat capacity w.r.t. volumetric water content
- integer(i4b) :: dVolHtCapBulk_dTk = integerMissing ! derivative in bulk heat capacity w.r.t. temperature
- integer(i4b) :: dVolHtCapBulk_dTkCanopy = integerMissing ! derivative in bulk heat capacity w.r.t. temperature
- integer(i4b) :: dThermalC_dTempAbove = integerMissing ! derivative in the thermal conductivity w.r.t. energy state in the layer above
- integer(i4b) :: dThermalC_dTempBelow = integerMissing ! derivative in the thermal conductivity w.r.t. energy state in the layer above
- integer(i4b) :: dThermalC_dWatAbove = integerMissing ! derivative in the thermal conductivity w.r.t. water state in the layer above
- integer(i4b) :: dThermalC_dWatBelow = integerMissing ! derivative in the thermal conductivity w.r.t. water state in the layer above
- ! enthalpy
- integer(i4b) :: scalarCanairEnthalpy = integerMissing ! enthalpy of the canopy air space (J m-3)
- integer(i4b) :: scalarCanopyEnthalpy = integerMissing ! enthalpy of the vegetation canopy (J m-3)
- integer(i4b) :: mLayerEnthalpy = integerMissing ! enthalpy of the snow+soil layers (J m-3)
- ! forcing
- integer(i4b) :: scalarVPair = integerMissing ! vapor pressure of the air above the vegetation canopy (Pa)
- integer(i4b) :: scalarVP_CanopyAir = integerMissing ! vapor pressure of the canopy air space (Pa)
- integer(i4b) :: scalarTwetbulb = integerMissing ! wet bulb temperature (K)
- integer(i4b) :: scalarSnowfallTemp = integerMissing ! temperature of fresh snow (K)
- integer(i4b) :: scalarNewSnowDensity = integerMissing ! density of fresh snow (kg m-3)
- integer(i4b) :: scalarO2air = integerMissing ! atmospheric o2 concentration (Pa)
- integer(i4b) :: scalarCO2air = integerMissing ! atmospheric co2 concentration (Pa)
- ! shortwave radiation
- integer(i4b) :: scalarCosZenith = integerMissing ! cosine of the solar zenith angle (0-1)
- integer(i4b) :: scalarFractionDirect = integerMissing ! fraction of direct radiation (0-1)
- integer(i4b) :: scalarCanopySunlitFraction = integerMissing ! sunlit fraction of canopy (-)
- integer(i4b) :: scalarCanopySunlitLAI = integerMissing ! sunlit leaf area (-)
- integer(i4b) :: scalarCanopyShadedLAI = integerMissing ! shaded leaf area (-)
- integer(i4b) :: spectralAlbGndDirect = integerMissing ! direct albedo of underlying surface for each spectral band (-)
- integer(i4b) :: spectralAlbGndDiffuse = integerMissing ! diffuse albedo of underlying surface for each spectral band (-)
- integer(i4b) :: scalarGroundAlbedo = integerMissing ! albedo of the ground surface (-)
- ! turbulent heat transfer
- integer(i4b) :: scalarLatHeatSubVapCanopy = integerMissing ! latent heat of sublimation/vaporization used for veg canopy (J kg-1)
- integer(i4b) :: scalarLatHeatSubVapGround = integerMissing ! latent heat of sublimation/vaporization used for ground surface (J kg-1)
- integer(i4b) :: scalarSatVP_CanopyTemp = integerMissing ! saturation vapor pressure at the temperature of vegetation canopy (Pa)
- integer(i4b) :: scalarSatVP_GroundTemp = integerMissing ! saturation vapor pressure at the temperature of the ground (Pa)
- integer(i4b) :: scalarZ0Canopy = integerMissing ! roughness length of the canopy (m)
- integer(i4b) :: scalarWindReductionFactor = integerMissing ! canopy wind reduction factor (-)
- integer(i4b) :: scalarZeroPlaneDisplacement = integerMissing ! zero plane displacement (m)
- integer(i4b) :: scalarRiBulkCanopy = integerMissing ! bulk Richardson number for the canopy (-)
- integer(i4b) :: scalarRiBulkGround = integerMissing ! bulk Richardson number for the ground surface (-)
- integer(i4b) :: scalarCanopyStabilityCorrection = integerMissing ! stability correction for the canopy (-)
- integer(i4b) :: scalarGroundStabilityCorrection = integerMissing ! stability correction for the ground surface (-)
- ! evapotranspiration
- integer(i4b) :: scalarIntercellularCO2Sunlit = integerMissing ! carbon dioxide partial pressure of leaf interior (sunlit leaves) (Pa)
- integer(i4b) :: scalarIntercellularCO2Shaded = integerMissing ! carbon dioxide partial pressure of leaf interior (shaded leaves) (Pa)
- integer(i4b) :: scalarTranspireLim = integerMissing ! aggregate soil moisture + aquifer storage limit on transpiration (-)
- integer(i4b) :: scalarTranspireLimAqfr = integerMissing ! aquifer storage limit on transpiration (-)
- integer(i4b) :: scalarFoliageNitrogenFactor = integerMissing ! foliage nitrogen concentration, 1=saturated (-)
- integer(i4b) :: scalarSoilRelHumidity = integerMissing ! relative humidity in the soil pores in the upper-most soil layer (-)
- integer(i4b) :: mLayerTranspireLim = integerMissing ! soil moist & veg limit on transpiration for each layer (-)
- integer(i4b) :: mLayerRootDensity = integerMissing ! fraction of roots in each soil layer (-)
- integer(i4b) :: scalarAquiferRootFrac = integerMissing ! fraction of roots below the soil profile (-)
- ! canopy hydrology
- integer(i4b) :: scalarFracLiqVeg = integerMissing ! fraction of liquid water on vegetation (-)
- integer(i4b) :: scalarCanopyWetFraction = integerMissing ! fraction of canopy that is wet
- ! snow hydrology
- integer(i4b) :: scalarSnowAge = integerMissing ! non-dimensional snow age (-)
- integer(i4b) :: scalarGroundSnowFraction = integerMissing ! fraction of ground that is covered with snow (-)
- integer(i4b) :: spectralSnowAlbedoDirect = integerMissing ! direct snow albedo for individual spectral bands (-)
- integer(i4b) :: mLayerFracLiqSnow = integerMissing ! fraction of liquid water in each snow layer (-)
- integer(i4b) :: mLayerThetaResid = integerMissing ! residual volumetric water content in each snow layer (-)
- integer(i4b) :: mLayerPoreSpace = integerMissing ! total pore space in each snow layer (-)
- integer(i4b) :: mLayerMeltFreeze = integerMissing ! change in ice content due to melt/freeze in each layer (kg m-3)
- ! soil hydrology
- integer(i4b) :: scalarInfilArea = integerMissing ! fraction of unfrozen area where water can infiltrate (-)
- integer(i4b) :: scalarFrozenArea = integerMissing ! fraction of area that is considered impermeable due to soil ice (-)
- integer(i4b) :: scalarSoilControl = integerMissing ! soil control on infiltration: 1=controlling; 0=not (-)
- integer(i4b) :: mLayerVolFracAir = integerMissing ! volumetric fraction of air in each layer (-)
- integer(i4b) :: mLayerTcrit = integerMissing ! critical soil temperature above which all water is unfrozen (K)
- integer(i4b) :: mLayerCompress = integerMissing ! change in volumetric water content due to compression of soil (s-1)
- integer(i4b) :: scalarSoilCompress = integerMissing ! change in total soil storage due to compression of the soil matrix (kg m-2 s-1)
- integer(i4b) :: mLayerMatricHeadLiq = integerMissing ! matric potential of liquid water (m)
- ! mass balance check
- integer(i4b) :: scalarSoilWatBalError = integerMissing ! error in the total soil water balance (kg m-2)
- integer(i4b) :: scalarAquiferBalError = integerMissing ! error in the aquifer water balance (kg m-2)
- integer(i4b) :: scalarTotalSoilLiq = integerMissing ! total mass of liquid water in the soil (kg m-2)
- integer(i4b) :: scalarTotalSoilIce = integerMissing ! total mass of ice in the soil (kg m-2)
- integer(i4b) :: scalarTotalSoilWat = integerMissing ! total mass of water in the soil (kg m-2)
- ! variable shortcuts
- integer(i4b) :: scalarVGn_m = integerMissing ! van Genuchten "m" parameter (-)
- integer(i4b) :: scalarKappa = integerMissing ! constant in the freezing curve function (m K-1)
- integer(i4b) :: scalarVolLatHt_fus = integerMissing ! volumetric latent heat of fusion (J m-3)
- ! number of function evaluations
- integer(i4b) :: numFluxCalls = integerMissing ! number of flux calls (-)
- integer(i4b) :: wallClockTime = integerMissing ! wall clock time (s)
- endtype iLook_diag
-
- ! ***********************************************************************************************************
- ! (8) define model fluxes
- ! ***********************************************************************************************************
- type, public :: iLook_flux
- ! net energy and mass fluxes for the vegetation domain
- integer(i4b) :: scalarCanairNetNrgFlux = integerMissing ! net energy flux for the canopy air space (W m-2)
- integer(i4b) :: scalarCanopyNetNrgFlux = integerMissing ! net energy flux for the vegetation canopy (W m-2)
- integer(i4b) :: scalarGroundNetNrgFlux = integerMissing ! net energy flux for the ground surface (W m-2)
- integer(i4b) :: scalarCanopyNetLiqFlux = integerMissing ! net liquid water flux for the vegetation canopy (kg m-2 s-1)
- ! forcing
- integer(i4b) :: scalarRainfall = integerMissing ! computed rainfall rate (kg m-2 s-1)
- integer(i4b) :: scalarSnowfall = integerMissing ! computed snowfall rate (kg m-2 s-1)
- ! shortwave radiation
- integer(i4b) :: spectralIncomingDirect = integerMissing ! incoming direct solar radiation in each wave band (W m-2)
- integer(i4b) :: spectralIncomingDiffuse = integerMissing ! incoming diffuse solar radiation in each wave band (W m-2)
- integer(i4b) :: scalarCanopySunlitPAR = integerMissing ! average absorbed par for sunlit leaves (W m-2)
- integer(i4b) :: scalarCanopyShadedPAR = integerMissing ! average absorbed par for shaded leaves (W m-2)
- integer(i4b) :: spectralBelowCanopyDirect = integerMissing ! downward direct flux below veg layer for each spectral band (W m-2)
- integer(i4b) :: spectralBelowCanopyDiffuse = integerMissing ! downward diffuse flux below veg layer for each spectral band (W m-2)
- integer(i4b) :: scalarBelowCanopySolar = integerMissing ! solar radiation transmitted below the canopy (W m-2)
- integer(i4b) :: scalarCanopyAbsorbedSolar = integerMissing ! solar radiation absorbed by canopy (W m-2)
- integer(i4b) :: scalarGroundAbsorbedSolar = integerMissing ! solar radiation absorbed by ground (W m-2)
- ! longwave radiation
- integer(i4b) :: scalarLWRadCanopy = integerMissing ! longwave radiation emitted from the canopy (W m-2)
- integer(i4b) :: scalarLWRadGround = integerMissing ! longwave radiation emitted at the ground surface (W m-2)
- integer(i4b) :: scalarLWRadUbound2Canopy = integerMissing ! downward atmospheric longwave radiation absorbed by the canopy (W m-2)
- integer(i4b) :: scalarLWRadUbound2Ground = integerMissing ! downward atmospheric longwave radiation absorbed by the ground (W m-2)
- integer(i4b) :: scalarLWRadUbound2Ubound = integerMissing ! atmospheric radiation refl by ground + lost thru upper boundary (W m-2)
- integer(i4b) :: scalarLWRadCanopy2Ubound = integerMissing ! longwave radiation emitted from canopy lost thru upper boundary (W m-2)
- integer(i4b) :: scalarLWRadCanopy2Ground = integerMissing ! longwave radiation emitted from canopy absorbed by the ground (W m-2)
- integer(i4b) :: scalarLWRadCanopy2Canopy = integerMissing ! canopy longwave reflected from ground and absorbed by the canopy (W m-2)
- integer(i4b) :: scalarLWRadGround2Ubound = integerMissing ! longwave radiation emitted from ground lost thru upper boundary (W m-2)
- integer(i4b) :: scalarLWRadGround2Canopy = integerMissing ! longwave radiation emitted from ground and absorbed by the canopy (W m-2)
- integer(i4b) :: scalarLWNetCanopy = integerMissing ! net longwave radiation at the canopy (W m-2)
- integer(i4b) :: scalarLWNetGround = integerMissing ! net longwave radiation at the ground surface (W m-2)
- integer(i4b) :: scalarLWNetUbound = integerMissing ! net longwave radiation at the upper atmospheric boundary (W m-2)
- ! turbulent heat transfer
- integer(i4b) :: scalarEddyDiffusCanopyTop = integerMissing ! eddy diffusivity for heat at the top of the canopy (m2 s-1)
- integer(i4b) :: scalarFrictionVelocity = integerMissing ! friction velocity - canopy momentum sink (m s-1)
- integer(i4b) :: scalarWindspdCanopyTop = integerMissing ! windspeed at the top of the canopy (m s-1)
- integer(i4b) :: scalarWindspdCanopyBottom = integerMissing ! windspeed at the height of the bottom of the canopy (m s-1)
- integer(i4b) :: scalarGroundResistance = integerMissing ! below canopy aerodynamic resistance (s m-1)
- integer(i4b) :: scalarCanopyResistance = integerMissing ! above canopy aerodynamic resistance (s m-1)
- integer(i4b) :: scalarLeafResistance = integerMissing ! mean leaf boundary layer resistance per unit leaf area (s m-1)
- integer(i4b) :: scalarSoilResistance = integerMissing ! soil surface resistance (s m-1)
- integer(i4b) :: scalarSenHeatTotal = integerMissing ! sensible heat from the canopy air space to the atmosphere (W m-2)
- integer(i4b) :: scalarSenHeatCanopy = integerMissing ! sensible heat from the canopy to the canopy air space (W m-2)
- integer(i4b) :: scalarSenHeatGround = integerMissing ! sensible heat from the ground (below canopy or non-vegetated) (W m-2)
- integer(i4b) :: scalarLatHeatTotal = integerMissing ! latent heat from the canopy air space to the atmosphere (W m-2)
- integer(i4b) :: scalarLatHeatCanopyEvap = integerMissing ! evaporation latent heat from the canopy to the canopy air space (W m-2)
- integer(i4b) :: scalarLatHeatCanopyTrans = integerMissing ! transpiration latent heat from the canopy to the canopy air space (W m-2)
- integer(i4b) :: scalarLatHeatGround = integerMissing ! latent heat from the ground (below canopy or non-vegetated) (W m-2)
- integer(i4b) :: scalarCanopyAdvectiveHeatFlux = integerMissing ! heat advected to the canopy surface with rain + snow (W m-2)
- integer(i4b) :: scalarGroundAdvectiveHeatFlux = integerMissing ! heat advected to the ground surface with throughfall and unloading/drainage (W m-2)
- integer(i4b) :: scalarCanopySublimation = integerMissing ! canopy sublimation/frost (kg m-2 s-1)
- integer(i4b) :: scalarSnowSublimation = integerMissing ! snow sublimation/frost (below canopy or non-vegetated) (kg m-2 s-1)
- ! liquid water fluxes associated with evapotranspiration
- integer(i4b) :: scalarStomResistSunlit = integerMissing ! stomatal resistance for sunlit leaves (s m-1)
- integer(i4b) :: scalarStomResistShaded = integerMissing ! stomatal resistance for shaded leaves (s m-1)
- integer(i4b) :: scalarPhotosynthesisSunlit = integerMissing ! sunlit photosynthesis (umolco2 m-2 s-1)
- integer(i4b) :: scalarPhotosynthesisShaded = integerMissing ! shaded photosynthesis (umolco2 m-2 s-1)
- integer(i4b) :: scalarCanopyTranspiration = integerMissing ! canopy transpiration (kg m-2 s-1)
- integer(i4b) :: scalarCanopyEvaporation = integerMissing ! canopy evaporation/condensation (kg m-2 s-1)
- integer(i4b) :: scalarGroundEvaporation = integerMissing ! ground evaporation/condensation -- below canopy or non-vegetated (kg m-2 s-1)
- integer(i4b) :: mLayerTranspire = integerMissing ! transpiration loss from each soil layer (kg m-2 s-1)
- ! liquid and solid water fluxes through the canopy
- integer(i4b) :: scalarThroughfallSnow = integerMissing ! snow that reaches the ground without ever touching the canopy (kg m-2 s-1)
- integer(i4b) :: scalarThroughfallRain = integerMissing ! rain that reaches the ground without ever touching the canopy (kg m-2 s-1)
- integer(i4b) :: scalarCanopySnowUnloading = integerMissing ! unloading of snow from the vegetion canopy (kg m-2 s-1)
- integer(i4b) :: scalarCanopyLiqDrainage = integerMissing ! drainage of liquid water from the vegetation canopy (kg m-2 s-1)
- integer(i4b) :: scalarCanopyMeltFreeze = integerMissing ! melt/freeze of water stored in the canopy (kg m-2 s-1)
- ! energy fluxes and for the snow and soil domains
- integer(i4b) :: iLayerConductiveFlux = integerMissing ! conductive energy flux at layer interfaces (W m-2)
- integer(i4b) :: iLayerAdvectiveFlux = integerMissing ! advective energy flux at layer interfaces (W m-2)
- integer(i4b) :: iLayerNrgFlux = integerMissing ! energy flux at layer interfaces (W m-2)
- integer(i4b) :: mLayerNrgFlux = integerMissing ! net energy flux for each layer in the snow+soil domain (J m-3 s-1)
- ! liquid water fluxes for the snow domain
- integer(i4b) :: scalarSnowDrainage = integerMissing ! drainage from the bottom of the snow profile (m s-1)
- integer(i4b) :: iLayerLiqFluxSnow = integerMissing ! liquid flux at snow layer interfaces (m s-1)
- integer(i4b) :: mLayerLiqFluxSnow = integerMissing ! net liquid water flux for each snow layer (s-1)
- ! liquid water fluxes for the soil domain
- integer(i4b) :: scalarRainPlusMelt = integerMissing ! rain plus melt, as input to soil before calculating surface runoff (m s-1)
- integer(i4b) :: scalarMaxInfilRate = integerMissing ! maximum infiltration rate (m s-1)
- integer(i4b) :: scalarInfiltration = integerMissing ! infiltration of water into the soil profile (m s-1)
- integer(i4b) :: scalarExfiltration = integerMissing ! exfiltration of water from the top of the soil profile (m s-1)
- integer(i4b) :: scalarSurfaceRunoff = integerMissing ! surface runoff (m s-1)
- integer(i4b) :: mLayerSatHydCondMP = integerMissing ! saturated hydraulic conductivity of macropores in each layer (m s-1)
- integer(i4b) :: mLayerSatHydCond = integerMissing ! saturated hydraulic conductivity in each layer (m s-1)
- integer(i4b) :: iLayerSatHydCond = integerMissing ! saturated hydraulic conductivity at each layer interface (m s-1)
- integer(i4b) :: mLayerHydCond = integerMissing ! hydraulic conductivity in each soil layer (m s-1)
- integer(i4b) :: iLayerLiqFluxSoil = integerMissing ! liquid flux at soil layer interfaces (m s-1)
- integer(i4b) :: mLayerLiqFluxSoil = integerMissing ! net liquid water flux for each soil layer (s-1)
- integer(i4b) :: mLayerBaseflow = integerMissing ! baseflow from each soil layer (m s-1)
- integer(i4b) :: mLayerColumnInflow = integerMissing ! total inflow to each layer in a given soil column (m3 s-1)
- integer(i4b) :: mLayerColumnOutflow = integerMissing ! total outflow from each layer in a given soil column (m3 s-1)
- integer(i4b) :: scalarSoilBaseflow = integerMissing ! total baseflow from throughout the soil profile (m s-1)
- integer(i4b) :: scalarSoilDrainage = integerMissing ! drainage from the bottom of the soil profile (m s-1)
- integer(i4b) :: scalarAquiferRecharge = integerMissing ! recharge to the aquifer (m s-1)
- integer(i4b) :: scalarAquiferTranspire = integerMissing ! transpiration from the aquifer (m s-1)
- integer(i4b) :: scalarAquiferBaseflow = integerMissing ! baseflow from the aquifer (m s-1)
- ! derived variables
- integer(i4b) :: scalarTotalET = integerMissing ! total ET (kg m-2 s-1)
- integer(i4b) :: scalarTotalRunoff = integerMissing ! total runoff (m s-1)
- integer(i4b) :: scalarNetRadiation = integerMissing ! net radiation (W m-2)
- endtype iLook_flux
-
- ! ***********************************************************************************************************
- ! (9) define derivatives
- ! ***********************************************************************************************************
- type, public :: iLook_deriv
- ! derivatives in net vegetation energy fluxes w.r.t. relevant state variables
- integer(i4b) :: dCanairNetFlux_dCanairTemp = integerMissing ! derivative in net canopy air space flux w.r.t. canopy air temperature (W m-2 K-1)
- integer(i4b) :: dCanairNetFlux_dCanopyTemp = integerMissing ! derivative in net canopy air space flux w.r.t. canopy temperature (W m-2 K-1)
- integer(i4b) :: dCanairNetFlux_dGroundTemp = integerMissing ! derivative in net canopy air space flux w.r.t. ground temperature (W m-2 K-1)
- integer(i4b) :: dCanopyNetFlux_dCanairTemp = integerMissing ! derivative in net canopy flux w.r.t. canopy air temperature (W m-2 K-1)
- integer(i4b) :: dCanopyNetFlux_dCanopyTemp = integerMissing ! derivative in net canopy flux w.r.t. canopy temperature (W m-2 K-1)
- integer(i4b) :: dCanopyNetFlux_dGroundTemp = integerMissing ! derivative in net canopy flux w.r.t. ground temperature (W m-2 K-1)
- integer(i4b) :: dCanopyNetFlux_dCanWat = integerMissing ! derivative in net canopy fluxes w.r.t. canopy total water content (J kg-1 s-1)
- integer(i4b) :: dGroundNetFlux_dCanairTemp = integerMissing ! derivative in net ground flux w.r.t. canopy air temperature (W m-2 K-1)
- integer(i4b) :: dGroundNetFlux_dCanopyTemp = integerMissing ! derivative in net ground flux w.r.t. canopy temperature (W m-2 K-1)
- integer(i4b) :: dGroundNetFlux_dGroundTemp = integerMissing ! derivative in net ground flux w.r.t. ground temperature (W m-2 K-1)
- integer(i4b) :: dGroundNetFlux_dCanWat = integerMissing ! derivative in net ground fluxes w.r.t. canopy total water content (J kg-1 s-1)
- ! derivatives in evaporative fluxes w.r.t. relevant state variables
- integer(i4b) :: dCanopyEvaporation_dTCanair = integerMissing ! derivative in canopy evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyEvaporation_dTCanopy = integerMissing ! derivative in canopy evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyEvaporation_dTGround = integerMissing ! derivative in canopy evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyEvaporation_dCanWat = integerMissing ! derivative in canopy evaporation w.r.t. canopy total water content (s-1)
- integer(i4b) :: dGroundEvaporation_dTCanair = integerMissing ! derivative in ground evaporation w.r.t. canopy air temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dGroundEvaporation_dTCanopy = integerMissing ! derivative in ground evaporation w.r.t. canopy temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dGroundEvaporation_dTGround = integerMissing ! derivative in ground evaporation w.r.t. ground temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dGroundEvaporation_dCanWat = integerMissing ! derivative in ground evaporation w.r.t. canopy total water content (s-1)
- ! derivatives in transpiration
- integer(i4b) :: dCanopyTrans_dTCanair = integerMissing ! derivative in canopy transpiration w.r.t. canopy air temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyTrans_dTCanopy = integerMissing ! derivative in canopy transpiration w.r.t. canopy temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyTrans_dTGround = integerMissing ! derivative in canopy transpiration w.r.t. ground temperature (kg m-2 s-1 K-1)
- integer(i4b) :: dCanopyTrans_dCanWat = integerMissing ! derivative in canopy transpiration w.r.t. canopy total water content (s-1)
- ! derivatives in canopy water w.r.t canopy temperature
- integer(i4b) :: dTheta_dTkCanopy = integerMissing ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
- integer(i4b) :: d2Theta_dTkCanopy2 = integerMissing ! second derivative of volumetric liquid water content w.r.t. temperature
- integer(i4b) :: dCanLiq_dTcanopy = integerMissing ! derivative of canopy liquid storage w.r.t. temperature (kg m-2 K-1)
- integer(i4b) :: dFracLiqVeg_dTkCanopy = integerMissing ! derivative in fraction of (throughfall + drainage) w.r.t. temperature
- ! derivatives in canopy liquid fluxes w.r.t. canopy water
- integer(i4b) :: scalarCanopyLiqDeriv = integerMissing ! derivative in (throughfall + canopy drainage) w.r.t. canopy liquid water (s-1)
- integer(i4b) :: scalarThroughfallRainDeriv = integerMissing ! derivative in throughfall w.r.t. canopy liquid water (s-1)
- integer(i4b) :: scalarCanopyLiqDrainageDeriv = integerMissing ! derivative in canopy drainage w.r.t. canopy liquid water (s-1)
- ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. temperature in layers above and below
- integer(i4b) :: dNrgFlux_dTempAbove = integerMissing ! derivatives in the flux w.r.t. temperature in the layer above (J m-2 s-1 K-1)
- integer(i4b) :: dNrgFlux_dTempBelow = integerMissing ! derivatives in the flux w.r.t. temperature in the layer below (J m-2 s-1 K-1)
- ! derivatives in energy fluxes at the interface of snow+soil layers w.r.t. water state in layers above and below
- integer(i4b) :: dNrgFlux_dWatAbove = integerMissing ! derivatives in the flux w.r.t. water state in the layer above
- integer(i4b) :: dNrgFlux_dWatBelow = integerMissing ! derivatives in the flux w.r.t. water state in the layer below
- ! derivative in liquid water fluxes at the interface of snow layers w.r.t. volumetric liquid water content in the layer above
- integer(i4b) :: iLayerLiqFluxSnowDeriv = integerMissing ! derivative in vertical liquid water flux at layer interfaces (m s-1)
- ! derivative in liquid water fluxes for the soil domain w.r.t hydrology state variables
- integer(i4b) :: dVolTot_dPsi0 = integerMissing ! derivative in total water content w.r.t. total water matric potential (m-1)
- integer(i4b) :: d2VolTot_d2Psi0 = integerMissing ! second derivative in total water content w.r.t. total water matric potential
- integer(i4b) :: dq_dHydStateAbove = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer above
- integer(i4b) :: dq_dHydStateBelow = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer below
- integer(i4b) :: dq_dHydStateLayerSurfVec = integerMissing ! change in the flux in soil surface interface w.r.t. state variables in layer above and below
- integer(i4b) :: mLayerdTheta_dPsi = integerMissing ! derivative in the soil water characteristic w.r.t. psi (m-1)
- integer(i4b) :: mLayerdPsi_dTheta = integerMissing ! derivative in the soil water characteristic w.r.t. theta (m)
- integer(i4b) :: dCompress_dPsi = integerMissing ! derivative in compressibility w.r.t matric head (m-1)
- ! derivative in baseflow flux w.r.t. aquifer storage
- integer(i4b) :: dBaseflow_dAquifer = integerMissing ! 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
- integer(i4b) :: dq_dNrgStateAbove = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer above
- integer(i4b) :: dq_dNrgStateBelow = integerMissing ! change in the flux in layer interfaces w.r.t. state variables in the layer below
- integer(i4b) :: dq_dNrgStateLayerSurfVec = integerMissing ! change in the flux in soil surface interface w.r.t. state variables in layer above and below
- integer(i4b) :: dPsiLiq_dTemp = integerMissing ! derivative in the liquid water matric potential w.r.t. temperature (m K-1)
- integer(i4b) :: dPsiLiq_dPsi0 = integerMissing ! derivative in liquid water matric potential w.r.t. the total water matric potential (-)
- ! derivatives in soil transpiration w.r.t. canopy state variables
- integer(i4b) :: mLayerdTrans_dTCanair = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy air temperature
- integer(i4b) :: mLayerdTrans_dTCanopy = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy temperature
- integer(i4b) :: mLayerdTrans_dTGround = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. ground temperature
- integer(i4b) :: mLayerdTrans_dCanWat = integerMissing ! derivatives in the soil layer transpiration flux w.r.t. canopy total water
- ! derivatives in aquifer transpiration w.r.t. canopy state variables
- integer(i4b) :: dAquiferTrans_dTCanair = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy air temperature
- integer(i4b) :: dAquiferTrans_dTCanopy = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy temperature
- integer(i4b) :: dAquiferTrans_dTGround = integerMissing ! derivative in the aquifer transpiration flux w.r.t. ground temperature
- integer(i4b) :: dAquiferTrans_dCanWat = integerMissing ! derivative in the aquifer transpiration flux w.r.t. canopy total water
- ! derivative in liquid water fluxes for the soil and snow domain w.r.t temperature
- integer(i4b) :: dFracLiqSnow_dTk = integerMissing ! derivative in fraction of liquid snow w.r.t. temperature
- integer(i4b) :: mLayerdTheta_dTk = integerMissing ! derivative of volumetric liquid water content w.r.t. temperature (K-1)
- integer(i4b) :: mLayerd2Theta_dTk2 = integerMissing ! second derivative of volumetric liquid water content w.r.t. temperature
- ! derivatives in time
- integer(i4b) :: mLayerdTemp_dt = integerMissing ! timestep change in layer temperature
- integer(i4b) :: scalarCanopydTemp_dt = integerMissing ! timestep change in canopy temperature
-
- endtype iLook_deriv
-
- ! ***********************************************************************************************************
- ! (10) define model indices
- ! ***********************************************************************************************************
- type, public :: iLook_index
- ! number of model layers, and layer indices
- integer(i4b) :: nSnow = integerMissing ! number of snow layers (-)
- integer(i4b) :: nSoil = integerMissing ! number of soil layers (-)
- integer(i4b) :: nLayers = integerMissing ! total number of layers (-)
- integer(i4b) :: layerType = integerMissing ! index defining type of layer (snow or soil) (-)
- ! number of state variables of different type
- integer(i4b) :: nCasNrg = integerMissing ! number of energy state variables for the canopy air space (-)
- integer(i4b) :: nVegNrg = integerMissing ! number of energy state variables for the vegetation canopy (-)
- integer(i4b) :: nVegMass = integerMissing ! number of hydrology states for vegetation (mass of water) (-)
- integer(i4b) :: nVegState = integerMissing ! number of vegetation state variables (-)
- integer(i4b) :: nNrgState = integerMissing ! number of energy state variables (-)
- integer(i4b) :: nWatState = integerMissing ! number of "total water" states (vol. total water content) (-)
- integer(i4b) :: nMatState = integerMissing ! number of matric head state variables (-)
- integer(i4b) :: nMassState = integerMissing ! number of hydrology state variables (mass of water) (-)
- integer(i4b) :: nState = integerMissing ! total number of model state variables (-)
- ! number of state variables within different domains in the snow+soil system
- integer(i4b) :: nSnowSoilNrg = integerMissing ! number of energy states in the snow+soil domain (-)
- integer(i4b) :: nSnowOnlyNrg = integerMissing ! number of energy states in the snow domain (-)
- integer(i4b) :: nSoilOnlyNrg = integerMissing ! number of energy states in the soil domain (-)
- integer(i4b) :: nSnowSoilHyd = integerMissing ! number of hydrology states in the snow+soil domain (-)
- integer(i4b) :: nSnowOnlyHyd = integerMissing ! number of hydrology states in the snow domain (-)
- integer(i4b) :: nSoilOnlyHyd = integerMissing ! number of hydrology states in the soil domain (-)
- ! type of model state variables
- integer(i4b) :: ixControlVolume = integerMissing ! index of the control volume for different domains (veg, snow, soil) (-)
- integer(i4b) :: ixDomainType = integerMissing ! index of the type of domain (iname_veg, iname_snow, iname_soil) (-)
- integer(i4b) :: ixStateType = integerMissing ! index of the type of every state variable (iname_nrgCanair, ...) (-)
- integer(i4b) :: ixHydType = integerMissing ! index of the type of hydrology states in snow+soil domain (-)
- ! type of model state variables (state subset)
- integer(i4b) :: ixDomainType_subset = integerMissing ! [state subset] id of domain for desired model state variables (-)
- integer(i4b) :: ixStateType_subset = integerMissing ! [state subset] type of desired model state variables (-)
- ! mapping between state subset and the full state vector
- integer(i4b) :: ixMapFull2Subset = integerMissing ! list of indices of the state subset in the full state vector (-)
- integer(i4b) :: ixMapSubset2Full = integerMissing ! list of indices of the full state vector in the state subset (-)
- ! indices of model specific state variables
- integer(i4b) :: ixCasNrg = integerMissing ! index IN THE STATE SUBSET of canopy air space energy state variable (-)
- integer(i4b) :: ixVegNrg = integerMissing ! index IN THE STATE SUBSET of canopy energy state variable (-)
- integer(i4b) :: ixVegHyd = integerMissing ! index IN THE STATE SUBSET of canopy hydrology state variable (mass) (-)
- integer(i4b) :: ixTopNrg = integerMissing ! index IN THE STATE SUBSET of upper-most energy state in snow+soil domain (-)
- integer(i4b) :: ixTopHyd = integerMissing ! index IN THE STATE SUBSET of upper-most hydrol state in snow+soil domain (-)
- integer(i4b) :: ixAqWat = integerMissing ! index IN THE STATE SUBSET of water storage in the aquifer (-)
- ! vectors of indices for specific state types
- integer(i4b) :: ixNrgOnly = integerMissing ! indices IN THE STATE SUBSET for all energy states (-)
- integer(i4b) :: ixHydOnly = integerMissing ! indices IN THE STATE SUBSET for hydrology states in the snow+soil domain (-)
- integer(i4b) :: ixMatOnly = integerMissing ! indices IN THE STATE SUBSET for matric head state variables (-)
- integer(i4b) :: ixMassOnly = integerMissing ! indices IN THE STATE SUBSET for hydrology states (mass of water) (-)
- ! vectors of indices for specific state types within specific sub-domains
- integer(i4b) :: ixSnowSoilNrg = integerMissing ! indices of model layers for energy states in the snow+soil domain (-)
- integer(i4b) :: ixSnowOnlyNrg = integerMissing ! indices of model layers for energy states in the snow domain (-)
- integer(i4b) :: ixSoilOnlyNrg = integerMissing ! indices of model layers for energy states in the soil domain (-)
- integer(i4b) :: ixSnowSoilHyd = integerMissing ! indices of model layers for hydrology states in the snow+soil domain (-)
- integer(i4b) :: ixSnowOnlyHyd = integerMissing ! indices of model layers for hydrology states in the snow domain (-)
- integer(i4b) :: ixSoilOnlyHyd = integerMissing ! indices of model layers for hydrology states in the soil domain (-)
- ! vectors of indices for specfic state types within specific sub-domains
- integer(i4b) :: ixNrgCanair = integerMissing ! indices IN THE FULL VECTOR for energy states in canopy air space domain (-)
- integer(i4b) :: ixNrgCanopy = integerMissing ! indices IN THE FULL VECTOR for energy states in the canopy domain (-)
- integer(i4b) :: ixHydCanopy = integerMissing ! indices IN THE FULL VECTOR for hydrology states in the canopy domain (-)
- integer(i4b) :: ixNrgLayer = integerMissing ! indices IN THE FULL VECTOR for energy states in the snow+soil domain (-)
- integer(i4b) :: ixHydLayer = integerMissing ! indices IN THE FULL VECTOR for hydrology states in the snow+soil domain (-)
- integer(i4b) :: ixWatAquifer = integerMissing ! indices IN THE FULL VECTOR for the storage of water in the aquifer (-)
- ! vectors of indices for specific state types IN SPECIFIC SUB-DOMAINS
- integer(i4b) :: ixVolFracWat = integerMissing ! indices IN THE SNOW+SOIL VECTOR for hyd states (-)
- integer(i4b) :: ixMatricHead = integerMissing ! indices IN THE SOIL VECTOR for hyd states (-)
- ! indices within state vectors
- integer(i4b) :: ixAllState = integerMissing ! list of indices for all model state variables (-)
- integer(i4b) :: ixSoilState = integerMissing ! list of indices for all soil layers (-)
- integer(i4b) :: ixLayerState = integerMissing ! list of indices for all model layers (-)
- integer(i4b) :: ixLayerActive = integerMissing ! list of indices for active model layers (inactive=integerMissing) (-)
- ! number of trials
- integer(i4b) :: numberFluxCalc = integerMissing ! number of flux calculations (-)
- integer(i4b) :: numberStateSplit = integerMissing ! number of state splitting solutions (-)
- integer(i4b) :: numberDomainSplitNrg = integerMissing ! number of domain splitting solutions for energy (-)
- integer(i4b) :: numberDomainSplitMass = integerMissing ! number of domain splitting solutions for mass (-)
- integer(i4b) :: numberScalarSolutions = integerMissing ! number of scalar solutions (-)
- endtype iLook_index
-
- ! ***********************************************************************************************************
- ! (11) define basin-average model parameters
- ! ***********************************************************************************************************
- type, public :: iLook_bpar
- ! baseflow
- integer(i4b) :: basin__aquiferHydCond = integerMissing ! hydraulic conductivity for the aquifer (m s-1)
- integer(i4b) :: basin__aquiferScaleFactor = integerMissing ! scaling factor for aquifer storage in the big bucket (m)
- integer(i4b) :: basin__aquiferBaseflowExp = integerMissing ! baseflow exponent for the big bucket (-)
- ! within-grid routing
- integer(i4b) :: routingGammaShape = integerMissing ! shape parameter in Gamma distribution used for sub-grid routing (-)
- integer(i4b) :: routingGammaScale = integerMissing ! scale parameter in Gamma distribution used for sub-grid routing (s)
- endtype iLook_bpar
-
- ! ***********************************************************************************************************
- ! (12) define basin-average model variables
- ! ***********************************************************************************************************
- type, public :: iLook_bvar
- ! define derived variables
- integer(i4b) :: basin__totalArea = integerMissing ! total basin area (m2)
- ! define fluxes
- integer(i4b) :: basin__SurfaceRunoff = integerMissing ! surface runoff (m s-1)
- integer(i4b) :: basin__ColumnOutflow = integerMissing ! outflow from all "outlet" HRUs (those with no downstream HRU)
- integer(i4b) :: basin__AquiferStorage = integerMissing ! aquifer storage (m s-1)
- integer(i4b) :: basin__AquiferRecharge = integerMissing ! recharge to the aquifer (m s-1)
- integer(i4b) :: basin__AquiferBaseflow = integerMissing ! baseflow from the aquifer (m s-1)
- integer(i4b) :: basin__AquiferTranspire = integerMissing ! transpiration from the aquifer (m s-1)
- integer(i4b) :: basin__TotalRunoff = integerMissing ! total runoff to channel from all active components (m s-1)
- integer(i4b) :: basin__SoilDrainage = integerMissing ! soil drainage (m s-1)
- ! define variables for runoff
- integer(i4b) :: routingRunoffFuture = integerMissing ! runoff in future time steps (m s-1)
- integer(i4b) :: routingFractionFuture = integerMissing ! fraction of runoff in future time steps (-)
- integer(i4b) :: averageInstantRunoff = integerMissing ! instantaneous runoff (m s-1)
- integer(i4b) :: averageRoutedRunoff = integerMissing ! routed runoff (m s-1)
- endtype iLook_bvar
-
- ! ***********************************************************************************************************
- ! (13) structure for looking up the type of a model variable (this is only needed for backward
- ! compatability, and should be removed eventually)
- ! ***********************************************************************************************************
-#ifdef ACTORS_ACTIVE
- type, public, bind(C) :: iLook_varType
-#else
- type, public :: iLook_varType
-#endif
- integer(i4b) :: scalarv = integerMissing ! scalar variables
- integer(i4b) :: wLength = integerMissing ! # spectral bands
- integer(i4b) :: midSnow = integerMissing ! mid-layer snow variables
- integer(i4b) :: midSoil = integerMissing ! mid-layer soil variables
- integer(i4b) :: midToto = integerMissing ! mid-layer, both snow and soil
- integer(i4b) :: ifcSnow = integerMissing ! interface snow variables
- integer(i4b) :: ifcSoil = integerMissing ! interface soil variables
- integer(i4b) :: ifcToto = integerMissing ! interface, snow and soil
- integer(i4b) :: parSoil = integerMissing ! soil depth
- integer(i4b) :: routing = integerMissing ! routing variables
- integer(i4b) :: outstat = integerMissing ! output statistic
- integer(i4b) :: unknown = integerMissing ! cath-cal alternative type
- endtype iLook_varType
-
- ! ***********************************************************************************************************
- ! (14) structure for looking up statistics
- ! ***********************************************************************************************************
- type, public :: iLook_stat
- integer(i4b) :: totl = integerMissing ! summation
- integer(i4b) :: inst = integerMissing ! instantaneous
- integer(i4b) :: mean = integerMissing ! mean over period
- integer(i4b) :: vari = integerMissing ! variance over period
- integer(i4b) :: mini = integerMissing ! minimum over period
- integer(i4b) :: maxi = integerMissing ! maximum over period
- integer(i4b) :: mode = integerMissing ! mode over period
- endtype iLook_stat
-
- ! ***********************************************************************************************************
- ! (15) structure for looking up output frequencies
- ! ***********************************************************************************************************
- type, public :: iLook_freq
- integer(i4b) :: day = integerMissing ! daily aggregation
- integer(i4b) :: month = integerMissing ! monthly aggregation
- integer(i4b) :: annual = integerMissing ! yearly (annual) aggregation
- integer(i4b) :: timestep = integerMissing ! timestep-level output (no temporal aggregation)
- endtype iLook_freq
-
- ! ***********************************************************************************************************
- ! (16) structure for looking up lookup tables
- ! ***********************************************************************************************************
- type, public :: iLook_vLookup
- integer(i4b) :: temperature = integerMissing ! temperature (K)
- integer(i4b) :: enthalpy = integerMissing ! enthalpy (J m-3)
- integer(i4b) :: deriv2 = integerMissing ! second derivatives of the interpolating function
- endtype iLook_vLookup
-
- ! ***********************************************************************************************************
- ! (X) define data structures and maximum number of variables of each type
- ! ***********************************************************************************************************
-
- ! named variables: model decisions
- type(iLook_decision),public,parameter :: iLookDECISIONS=iLook_decision( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39)
- ! named variables: model time
- type(iLook_time), public,parameter :: iLookTIME =iLook_time ( 1, 2, 3, 4, 5, 6, 7)
-
- ! named variables: model forcing data
- type(iLook_force), public,parameter :: iLookFORCE =iLook_force ( 1, 2, 3, 4, 5, 6, 7, 8)
-
- ! named variables: model attributes
- type(iLook_attr), public,parameter :: iLookATTR =iLook_attr ( 1, 2, 3, 4, 5, 6, 7, 8)
-
- ! named variables: soil and vegetation types
- type(iLook_type), public,parameter :: iLookTYPE =iLook_type ( 1, 2, 3, 4)
-
- ! named variables: hru and gru IDs and associated information
- type(iLook_id), public,parameter :: iLookID =iLook_id ( 1)
-
- ! named variables: model parameters
- type(iLook_param), public,parameter :: iLookPARAM =iLook_param ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
- 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
- 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,&
- 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,&
- 81, 82, 83, 84, 85, 86, 87, 88, 89, 90,&
- 91, 92, 93, 94, 95, 96, 97, 98, 99,100,&
- 101,102,103,104,105,106,107,108,109,110,&
- 111,112,113,114,115,116,117,118,119,120,&
- 121,122,123,124,125,126,127,128,129,130,&
- 131,132,133,134,135,136,137,138,139,140,&
- 141,142,143,144,145,146,147,148,149,150,&
- 151,152,153,154,155,156,157,158,159)
-
- ! named variables: model prognostic (state) variables
- type(iLook_prog), public,parameter :: iLookPROG =iLook_prog ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21)
-
- ! named variables: model diagnostic variables
- type(iLook_diag), public,parameter :: iLookDIAG =iLook_diag ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
- 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
- 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,&
- 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,&
- 81, 82, 83, 84, 85, 86, 87, 88, 89, 90,&
- 91, 92, 93, 94, 95, 96)
- ! named variables: model fluxes
- type(iLook_flux), public,parameter :: iLookFLUX =iLook_flux ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
- 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
- 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,&
- 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,&
- 81, 82, 83, 84, 85, 86, 87, 88, 89)
-
- ! named variables: derivatives in model fluxes w.r.t. relevant state variables
- type(iLook_deriv), public,parameter :: iLookDERIV =iLook_deriv ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
- 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,&
- 61, 62)
-
- ! named variables: model indices
- type(iLook_index), public,parameter :: iLookINDEX =ilook_index ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,&
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,&
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,&
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,&
- 51, 52, 53, 54, 55, 56, 57, 58, 59, 60)
-
- ! named variables: basin-average parameters
- type(iLook_bpar), public,parameter :: iLookBPAR =ilook_bpar ( 1, 2, 3, 4, 5)
-
- ! named variables: basin-average variables
- type(iLook_bvar), public,parameter :: iLookBVAR =ilook_bvar ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12, 13)
-
- ! named variables in varibale type structure
- type(iLook_varType), public,parameter :: iLookVarType =ilook_varType ( 1, 2, 3, 4, 5, 6, 7, 8, 9, 10,&
- 11, 12)
-
- ! number of possible output statistics
- type(iLook_stat), public,parameter :: iLookStat =ilook_stat ( 1, 2, 3, 4, 5, 6, 7)
-
- ! number of possible output frequencies
- type(iLook_freq), public,parameter :: iLookFreq =ilook_freq ( 1, 2, 3, 4)
-
- ! named variables in the lookup table structure
- type(iLook_vLookup), public,parameter :: iLookLOOKUP =ilook_vLookup ( 1, 2, 3)
-
- ! define maximum number of variables of each type
- integer(i4b),parameter,public :: maxvarDecisions = storage_size(iLookDECISIONS)/iLength
- integer(i4b),parameter,public :: maxvarTime = storage_size(iLookTIME)/iLength
- integer(i4b),parameter,public :: maxvarForc = storage_size(iLookFORCE)/iLength
- integer(i4b),parameter,public :: maxvarAttr = storage_size(iLookATTR)/iLength
- integer(i4b),parameter,public :: maxvarType = storage_size(iLookTYPE)/iLength
- integer(i4b),parameter,public :: maxvarId = storage_size(iLookID)/i8Length
- integer(i4b),parameter,public :: maxvarMpar = storage_size(iLookPARAM)/iLength
- integer(i4b),parameter,public :: maxvarProg = storage_size(iLookPROG)/iLength
- integer(i4b),parameter,public :: maxvarDiag = storage_size(iLookDIAG)/iLength
- integer(i4b),parameter,public :: maxvarFlux = storage_size(iLookFLUX)/iLength
- integer(i4b),parameter,public :: maxvarDeriv = storage_size(iLookDERIV)/iLength
- integer(i4b),parameter,public :: maxvarIndx = storage_size(iLookINDEX)/iLength
- integer(i4b),parameter,public :: maxvarBpar = storage_size(iLookBPAR)/iLength
- integer(i4b),parameter,public :: maxvarBvar = storage_size(iLookBVAR)/iLength
- integer(i4b),parameter,public :: maxvarVarType = storage_size(iLookVarType)/iLength
- integer(i4b),parameter,public :: maxvarStat = storage_size(iLookStat)/iLength
- integer(i4b),parameter,public :: maxvarFreq = storage_size(iLookFreq)/iLength
- integer(i4b),parameter,public :: maxvarLookup = storage_size(iLookLOOKUP)/iLength
-
- ! ***********************************************************************************************************
- ! (Y) define ancillary look-up structures
- ! ***********************************************************************************************************
-
- integer(i4b),allocatable,save,public :: childFLUX_MEAN(:) ! index of the child data structure: mean flux
-
-
-END MODULE var_lookup
diff --git a/build/source/engine/coupled_em.f90 b/build/source/engine/coupled_em.f90
deleted file mode 100644
index 85c21fe60399d90e01ea02ab3c8f9f144aa7b8a3..0000000000000000000000000000000000000000
--- a/build/source/engine/coupled_em.f90
+++ /dev/null
@@ -1,1421 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module coupled_em_module
-
-! numerical recipes data types
-USE nrtype
-
-! physical constants
-USE multiconst,only:&
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
-! data types
-USE data_types,only:&
- var_i, & ! x%var(:) (i4b)
- var_d, & ! x%var(:) (dp)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (dp)
- zLookup
-
-! named variables for parent structures
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-USE var_lookup,only:iLookPROG ! named variables for structure elements
-USE var_lookup,only:iLookDIAG ! named variables for structure elements
-USE var_lookup,only:iLookFLUX ! named variables for structure elements
-USE var_lookup,only:iLookPARAM ! named variables for structure elements
-USE var_lookup,only:iLookINDEX ! named variables for structure elements
-USE globalData,only:iname_snow ! named variables for snow
-USE globalData,only:iname_soil ! named variables for soil
-
-! named variables for child structures
-USE var_lookup,only:childFLUX_MEAN
-
-! metadata
-USE globalData,only:indx_meta ! metadata on the model index variables
-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:averageFlux_meta ! metadata on the timestep-average model flux structure
-
-! global data
-USE globalData,only:data_step ! time step of forcing data (s)
-USE globalData,only:model_decisions ! model decision structure
-USE globalData,only:globalPrintFlag ! the global print flag
-
-! look-up values for the maximum interception capacity
-USE mDecisions_module,only: &
- stickySnow, & ! maximum interception capacity an increasing function of temerature
- lightSnow ! maximum interception capacity an inverse function of new snow density
-
-! look-up values for the 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 spatial representation of groundwater
-USE mDecisions_module,only: &
- localColumn ,& ! separate groundwater representation in each local soil column
- singleBasin ! single groundwater store over the entire basin
-
-! privacy
-implicit none
-private
-public::coupled_em
-! algorithmic parameters
-real(dp),parameter :: valueMissing=-9999._dp ! missing value, used when diagnostic or state variables are undefined
-real(dp),parameter :: verySmall=1.e-6_dp ! used as an additive constant to check if substantial difference among real numbers
-real(dp),parameter :: mpe=1.e-6_dp ! prevents overflow error if division by zero
-real(dp),parameter :: dx=1.e-6_dp ! finite difference increment
-contains
-
-
- ! ************************************************************************************************
- ! public subroutine coupled_em: run the coupled energy-mass model for one timestep
- ! ************************************************************************************************
-subroutine coupled_em(&
- ! model control
- indxHRU, & ! intent(in): hruId
- dt_init, & ! intent(inout): used to initialize the size of the sub-step
- dt_init_factor, & ! Used to adjust the length of the timestep in the event of a failure
- computeVegFlux, & ! intent(inout): flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! data structures (input)
- type_data, & ! intent(in): local classification of soil veg etc. for each HRU
- attr_data, & ! intent(in): local attributes for each HRU
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- bvar_data, & ! intent(in): basin-average variables
- lookup_data, & ! intent(in): lookup tables
- ! data structures (input-output)
- indx_data, & ! intent(inout): model indices
- prog_data, & ! intent(inout): prognostic variables for a local HRU
- diag_data, & ! intent(inout): diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- fracJulDay, &
- yearLength, &
- ! error control
- err,message) ! intent(out): error control
- ! structure allocations
- 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)
- USE snowAlbedo_module,only:snowAlbedo ! compute snow albedo
- USE vegSWavRad_module,only:vegSWavRad ! compute canopy sw radiation fluxes
- USE canopySnow_module,only:canopySnow ! compute interception and unloading of snow from the vegetation canopy
- USE volicePack_module,only:newsnwfall ! compute change in the top snow layer due to throughfall and unloading
- USE volicePack_module,only:volicePack ! merge and sub-divide snow layers, if necessary
- USE diagn_evar_module,only:diagn_evar ! compute diagnostic energy variables -- thermal conductivity and heat capacity
- ! the model solver
- USE indexState_module,only:indexState ! define indices for all model state variables and layers
- USE opSplittin_module,only:opSplittin ! solve the system of thermodynamic and hydrology equations for a given substep
- ! additional subroutines
- USE tempAdjust_module,only:tempAdjust ! adjust snow temperature associated with new snowfall
- USE snwDensify_module,only:snwDensify ! snow densification (compaction and cavitation)
- USE var_derive_module,only:calcHeight ! module to calculate height at layer interfaces and layer mid-point
- ! look-up values for the numerical method
- implicit none
- ! model control
- integer(4),intent(in) :: indxHRU ! hruId
- real(dp),intent(inout) :: dt_init ! used to initialize the size of the sub-step
- integer(i4b),intent(in) :: dt_init_factor ! Used to adjust the length of the timestep in the event of a failure
- logical(lgt),intent(inout) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! data structures (input)
- 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_dlength),intent(in) :: bvar_data ! basin-average model variables
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- ! data structures (input-output)
- type(var_ilength),intent(inout) :: indx_data ! state vector geometry
- 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
- real(dp),intent(inout) :: fracJulDay
- integer(i4b),intent(inout) :: yearLength
- ! error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! =====================================================================================================================================================
- ! =====================================================================================================================================================
- ! local variables
- character(len=256) :: cmessage ! error message
- integer(i4b) :: nSnow ! number of snow layers
- integer(i4b) :: nSoil ! number of soil layers
- integer(i4b) :: nLayers ! total number of layers
- integer(i4b) :: nState ! total number of state variables
- real(dp) :: dtSave ! length of last input model sub-step (seconds)
- real(dp) :: dt_sub ! length of model sub-step (seconds)
- real(dp) :: dt_wght ! weight applied to model sub-step (dt_sub/data_step)
- real(dp) :: dt_solv ! seconds in the data step that have been completed
- real(dp) :: dtMultiplier ! time step multiplier (-) based on what happenned in "opSplittin"
- real(dp) :: minstep,maxstep ! minimum and maximum time step length (seconds)
- integer(i4b) :: nsub ! number of substeps
- logical(lgt) :: computeVegFluxOld ! flag to indicate if we are computing fluxes over vegetation on the previous sub step
- logical(lgt) :: includeAquifer ! flag to denote that an aquifer is included
- logical(lgt) :: modifiedLayers ! flag to denote that snow layers were modified
- logical(lgt) :: modifiedVegState ! flag to denote that vegetation states were modified
- type(var_dlength) :: flux_mean ! timestep-average model fluxes for a local HRU
- integer(i4b) :: nLayersRoots ! number of soil layers that contain roots
- real(dp) :: exposedVAI ! exposed vegetation area index
- real(dp) :: dCanopyWetFraction_dWat ! derivative in wetted fraction w.r.t. canopy total water (kg-1 m2)
- real(dp) :: dCanopyWetFraction_dT ! derivative in wetted fraction w.r.t. canopy temperature (K-1)
- real(dp),parameter :: varNotUsed1=-9999._dp ! variables used to calculate derivatives (not needed here)
- real(dp),parameter :: varNotUsed2=-9999._dp ! variables used to calculate derivatives (not needed here)
- integer(i4b) :: iSnow ! index of snow layers
- integer(i4b) :: iLayer ! index of model layers
- real(dp) :: massLiquid ! mass liquid water (kg m-2)
- real(dp) :: superflousSub ! superflous sublimation (kg m-2 s-1)
- real(dp) :: superflousNrg ! superflous energy that cannot be used for sublimation (W m-2 [J m-2 s-1])
- integer(i4b) :: ixSolution ! solution method used by opSplitting
- logical(lgt) :: firstSubStep ! flag to denote if the first time step
- logical(lgt) :: stepFailure ! flag to denote the need to reduce length of the coupled step and try again
- logical(lgt) :: tooMuchMelt ! flag to denote that there was too much melt in a given time step
- logical(lgt) :: doLayerMerge ! flag to denote the need to merge snow layers
- logical(lgt) :: pauseFlag ! flag to pause execution
- logical(lgt),parameter :: backwardsCompatibility=.true. ! flag to denote a desire to ensure backwards compatibility with previous branches.
- type(var_ilength) :: indx_temp ! temporary model index variables
- type(var_dlength) :: prog_temp ! temporary model prognostic variables
- type(var_dlength) :: diag_temp ! temporary model diagnostic variables
- ! check SWE
- real(dp) :: oldSWE ! SWE at the start of the substep
- real(dp) :: newSWE ! SWE at the end of the substep
- real(dp) :: delSWE ! change in SWE over the subtep
- real(dp) :: effRainfall ! effective rainfall (kg m-2 s-1)
- real(dp) :: effSnowfall ! effective snowfall (kg m-2 s-1)
- real(dp) :: sfcMeltPond ! surface melt pond (kg m-2)
- real(dp) :: massBalance ! mass balance error (kg m-2)
- ! balance checks
- integer(i4b) :: iVar ! loop through model variables
- real(dp) :: totalSoilCompress ! total soil compression (kg m-2)
- real(dp) :: scalarCanopyWatBalError ! water balance error for the vegetation canopy (kg m-2)
- real(dp) :: scalarSoilWatBalError ! water balance error (kg m-2)
- real(dp) :: scalarInitCanopyLiq ! initial liquid water on the vegetation canopy (kg m-2)
- real(dp) :: scalarInitCanopyIce ! initial ice on the vegetation canopy (kg m-2)
- real(dp) :: balanceCanopyWater0 ! total water stored in the vegetation canopy at the start of the step (kg m-2)
- real(dp) :: balanceCanopyWater1 ! total water stored in the vegetation canopy at the end of the step (kg m-2)
- real(dp) :: balanceSoilWater0 ! total soil storage at the start of the step (kg m-2)
- real(dp) :: balanceSoilWater1 ! total soil storage at the end of the step (kg m-2)
- real(dp) :: balanceSoilInflux ! input to the soil zone
- real(dp) :: balanceSoilBaseflow ! output from the soil zone
- real(dp) :: balanceSoilDrainage ! output from the soil zone
- real(dp) :: balanceSoilET ! output from the soil zone
- real(dp) :: balanceAquifer0 ! total aquifer storage at the start of the step (kg m-2)
- real(dp) :: balanceAquifer1 ! total aquifer storage at the end of the step (kg m-2)
- ! test balance checks
- logical(lgt), parameter :: printBalance=.false. ! flag to print the balance checks
- real(dp), allocatable :: liqSnowInit(:) ! volumetric liquid water conetnt of snow at the start of the time step
- real(dp), allocatable :: liqSoilInit(:) ! soil moisture at the start of the time step
-
-
- ! ----------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="coupled_em/"
-
- ! check that the decision is supported
- if(model_decisions(iLookDECISIONS%groundwatr)%iDecision==bigBucket .and. &
- model_decisions(iLookDECISIONS%spatial_gw)%iDecision/=localColumn)then
- message=trim(message)//'expect "spatial_gw" decision to equal localColumn when "groundwatr" decision is bigBucket'
- err=20; return
- endif
-
- ! check if the aquifer is included
- includeAquifer = (model_decisions(iLookDECISIONS%groundwatr)%iDecision==bigBucket)
-
- ! initialize the numerix tracking variables
- indx_data%var(iLookINDEX%numberFluxCalc )%dat(1) = 0 ! number of flux calculations (-)
- indx_data%var(iLookINDEX%numberStateSplit )%dat(1) = 0 ! number of state splitting solutions (-)
- indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) = 0 ! number of domain splitting solutions for energy (-)
- indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) = 0 ! number of domain splitting solutions for mass (-)
- indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) = 0 ! number of scalar solutions (-)
-
- ! link canopy depth to the information in the data structure
- canopy: associate(canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ) ! intent(out): [dp] canopy depth (m)
-
-
- ! start by NOT pausing
- pauseFlag=.false.
-
- ! start by assuming that the step is successful
- stepFailure = .false.
- doLayerMerge = .false.
-
- ! initialize flags to modify the veg layers or modify snow layers
- modifiedLayers = .false. ! flag to denote that snow layers were modified
- modifiedVegState = .false. ! flag to denote that vegetation states were modified
-
- ! define the first step
- firstSubStep = .true.
-
- ! count the number of snow and soil layers
- ! NOTE: need to re-compute the number of snow and soil layers at the start of each sub-step because the number of layers may change
- ! (nSnow and nSoil are shared in the data structure)
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
-
- ! compute the total number of snow and soil layers
- nLayers = nSnow + nSoil
-
-
- ! create temporary data structures for prognostic variables
- call resizeData(prog_meta(:),prog_data,prog_temp,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! create temporary data structures for diagnostic variables
- call resizeData(diag_meta(:),diag_data,diag_temp,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! create temporary data structures for index variables
- call resizeData(indx_meta(:),indx_data,indx_temp,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! allocate space for the local fluxes
- call allocLocal(averageFlux_meta(:)%var_info,flux_mean,nSnow,nSoil,err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! initialize compression and surface melt pond
- sfcMeltPond = 0._dp ! change in storage associated with the surface melt pond (kg m-2)
- totalSoilCompress = 0._dp ! change in soil storage associated with compression of the matrix (kg m-2)
-
- ! initialize mean fluxes
- do iVar=1,size(averageFlux_meta)
- flux_mean%var(iVar)%dat(:) = 0._dp
- end do
-
-
- ! associate local variables with information in the data structures
- associate(&
- ! state variables in the vegetation canopy
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! canopy liquid water (kg m-2)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! canopy ice content (kg m-2)
- ! state variables in the soil domain
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1:nLayers) ,& ! depth of each soil layer (m)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat(nSnow+1:nLayers) ,& ! volumetric ice content in each soil layer (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(nSnow+1:nLayers) ,& ! volumetric liquid water content in each soil layer (-)
- scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! aquifer storage (m)
- scalarTotalSoilIce => diag_data%var(iLookDIAG%scalarTotalSoilIce)%dat(1) ,& ! total ice in the soil column (kg m-2)
- scalarTotalSoilLiq => diag_data%var(iLookDIAG%scalarTotalSoilLiq)%dat(1) ,& ! total liquid water in the soil column (kg m-2)
- scalarTotalSoilWat => diag_data%var(iLookDIAG%scalarTotalSoilWat)%dat(1) & ! total water in the soil column (kg m-2)
- ) ! (association of local variables with information in the data structures
-
- ! save the liquid water and ice on the vegetation canopy
- scalarInitCanopyLiq = scalarCanopyLiq ! initial liquid water on the vegetation canopy (kg m-2)
- scalarInitCanopyIce = scalarCanopyIce ! initial ice on the vegetation canopy (kg m-2)
-
- ! compute total soil moisture and ice at the *START* of the step (kg m-2)
- scalarTotalSoilLiq = sum(iden_water*mLayerVolFracLiq(1:nSoil)*mLayerDepth(1:nSoil))
- scalarTotalSoilIce = sum(iden_water*mLayerVolFracIce(1:nSoil)*mLayerDepth(1:nSoil)) ! NOTE: no expansion and hence use iden_water
-
- ! compute storage of water in the canopy and the soil
- balanceCanopyWater0 = scalarCanopyLiq + scalarCanopyIce
- balanceSoilWater0 = scalarTotalSoilLiq + scalarTotalSoilIce
-
- ! get the total aquifer storage at the start of the time step (kg m-2)
- balanceAquifer0 = scalarAquiferStorage*iden_water
-
- ! save liquid water content
- if(printBalance)then
- allocate(liqSnowInit(nSnow), liqSoilInit(nSoil), stat=err)
- if(err/=0)then
- message=trim(message)//'unable to allocate space for the initial vectors'
- print*,message
- err=20;
- return
- endif
- if(nSnow>0) liqSnowInit = prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)
- liqSoilInit = mLayerVolFracLiq
- endif
-
- ! end association of local variables with information in the data structures
- end associate
-
-
- ! short-cut to the algorithmic control parameters
- ! NOTE - temporary assignment of minstep to foce something reasonable
- minstep = 10._dp ! mpar_data%var(iLookPARAM%minstep)%dat(1) ! minimum time step (s)
- maxstep = mpar_data%var(iLookPARAM%maxstep)%dat(1) ! maximum time step (s)
- !print*, 'minstep, maxstep = ', minstep, maxstep
-
- ! compute the number of layers with roots
- nLayersRoots = count(prog_data%var(iLookPROG%iLayerHeight)%dat(nSnow:nLayers-1) < mpar_data%var(iLookPARAM%rootingDepth)%dat(1)-verySmall)
- if(nLayersRoots == 0)then
- message=trim(message)//'no roots within the soil profile'
- print*, message
- err=20; return
- end if
-
- ! define the foliage nitrogen factor
- diag_data%var(iLookDIAG%scalarFoliageNitrogenFactor)%dat(1) = 1._dp ! foliage nitrogen concentration (1.0 = saturated)
-
- ! save SWE
- oldSWE = prog_data%var(iLookPROG%scalarSWE)%dat(1)
- !print*, 'nSnow = ', nSnow
- !print*, 'oldSWE = ', oldSWE
-
- ! *** compute phenology...
- ! ------------------------
-
-
- ! compute the temperature of the root zone: used in vegetation phenology
- diag_data%var(iLookDIAG%scalarRootZoneTemp)%dat(1) = sum(prog_data%var(iLookPROG%mLayerTemp)%dat(nSnow+1:nSnow+nLayersRoots)) / real(nLayersRoots, kind(dp))
-
- ! remember if we compute the vegetation flux on the previous sub-step
- computeVegFluxOld = computeVegFlux
-
- ! compute the exposed LAI and SAI and whether veg is buried by snow
- call vegPhenlgy(&
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- ! output
- computeVegFlux, & ! intent(out): flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- canopyDepth, & ! intent(out): canopy depth (m)
- exposedVAI, & ! intent(out): exposed vegetation area index (m2 m-2)
- fracJulDay, & ! fractional julian days since the start of year
- yearLength, & ! number of days in the current year
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
-
- ! check
- if(computeVegFlux)then
- if(canopyDepth < epsilon(canopyDepth))then
- message=trim(message)//'canopy depth is zero when computeVegFlux flag is .true.'
- print*, message
- err=20; return
- endif
- endif
-
- ! flag the case where number of vegetation states has changed
- modifiedVegState = (computeVegFlux.neqv.computeVegFluxOld)
-
- ! *** compute wetted canopy area...
- ! ---------------------------------
-
- ! compute maximum canopy liquid water (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1) = mpar_data%var(iLookPARAM%refInterceptCapRain)%dat(1)*exposedVAI
-
- ! compute maximum canopy ice content (kg m-2)
- ! NOTE 1: this is used to compute the snow fraction on the canopy, as used in *BOTH* the radiation AND canopy sublimation routines
- ! NOTE 2: this is a different variable than the max ice used in the throughfall (snow interception) calculations
- ! NOTE 3: use maximum per unit leaf area storage capacity for snow (kg m-2)
- select case(model_decisions(iLookDECISIONS%snowIncept)%iDecision)
- case(lightSnow); diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1) = exposedVAI*mpar_data%var(iLookPARAM%refInterceptCapSnow)%dat(1)
- case(stickySnow); diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1) = exposedVAI*mpar_data%var(iLookPARAM%refInterceptCapSnow)%dat(1)*4._dp
- case default
- message=trim(message)//'unable to identify option for maximum branch interception capacity'
- print*, message
- err=20
- return
- end select ! identifying option for maximum branch interception capacity
- !print*, 'diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1) = ', diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1)
- !print*, 'diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1) = ', diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1)
-
- ! compute wetted fraction of the canopy
- ! NOTE: assume that the wetted fraction is constant over the substep for the radiation calculations
- if(computeVegFlux)then
-
- ! compute wetted fraction of the canopy
- call wettedFrac(&
- ! input
- .false., & ! flag to denote if derivatives are required
- .false., & ! flag to denote if derivatives are calculated numerically
- (prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) < Tfreeze), & ! flag to denote if the canopy is frozen
- varNotUsed1, & ! derivative in canopy liquid w.r.t. canopy temperature (kg m-2 K-1)
- varNotUsed2, & ! fraction of liquid water on the canopy
- prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1), & ! canopy liquid water (kg m-2)
- prog_data%var(iLookPROG%scalarCanopyIce)%dat(1), & ! canopy ice (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1), & ! maximum canopy liquid water (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1), & ! maximum canopy ice content (kg m-2)
- mpar_data%var(iLookPARAM%canopyWettingFactor)%dat(1), & ! maximum wetted fraction of the canopy (-)
- mpar_data%var(iLookPARAM%canopyWettingExp)%dat(1), & ! exponent in canopy wetting function (-)
- ! output
- diag_data%var(iLookDIAG%scalarCanopyWetFraction)%dat(1), & ! canopy wetted fraction (-)
- dCanopyWetFraction_dWat, & ! derivative in wetted fraction w.r.t. canopy liquid water content (kg-1 m2)
- dCanopyWetFraction_dT, & ! derivative in wetted fraction w.r.t. canopy liquid water content (kg-1 m2)
- err,cmessage)
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! vegetation is completely buried by snow (or no veg exists at all)
- else
- diag_data%var(iLookDIAG%scalarCanopyWetFraction)%dat(1) = 0._dp
- dCanopyWetFraction_dWat = 0._dp
- dCanopyWetFraction_dT = 0._dp
- end if
-
-
- ! *** compute snow albedo...
- ! --------------------------
- ! NOTE: this should be done before the radiation calculations
- ! NOTE: uses snowfall; should really use canopy throughfall + canopy unloading
- call snowAlbedo(&
- ! input: model control
- data_step, & ! intent(in): model time step (s)
- (nSnow > 0), & ! intent(in): logical flag to denote if snow is present
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- mpar_data, & ! intent(in): model parameters
- flux_data, & ! intent(in): model flux variables
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
-
- ! *** compute canopy sw radiation fluxes...
- ! -----------------------------------------
- call vegSWavRad(&
- data_step, & ! intent(in): time step (s) -- only used in Noah-MP radiation, to compute albedo
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- computeVegFlux, & ! intent(in): logical flag to compute vegetation fluxes (.false. if veg buried by snow)
- type_data, & ! intent(in): type of vegetation and soil
- 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 flux variables
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! *** compute canopy throughfall and unloading...
- ! -----------------------------------------------
- ! NOTE 1: this needs to be done before solving the energy and liquid water equations, to account for the heat advected with precipitation (and throughfall/unloading)
- ! NOTE 2: the unloading flux is computed using canopy drip (scalarCanopyLiqDrainage) from the previous time step
- call canopySnow(&
- ! input: model control
- data_step, & ! intent(in): time step (seconds)
- exposedVAI, & ! intent(in): exposed vegetation area index (m2 m-2)
- computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- flux_data, & ! intent(inout): model flux variables
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! adjust canopy temperature to account for new snow
- if(computeVegFlux)then ! logical flag to compute vegetation fluxes (.false. if veg buried by snow)
- call tempAdjust(&
- ! input: derived parameters
- canopyDepth, & ! intent(in): canopy depth (m)
- ! input/output: data structures
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(out): model diagnostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- return
- end if
- endif ! if computing fluxes over vegetation
-
-
- ! initialize drainage and throughfall
- ! NOTE 1: this needs to be done before solving the energy and liquid water equations, to account for the heat advected with precipitation
- ! NOTE 2: this initialization needs to be done AFTER the call to canopySnow, since canopySnow uses canopy drip drom the previous time step
- if(.not.computeVegFlux)then
- flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) = flux_data%var(iLookFLUX%scalarRainfall)%dat(1)
- flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) = 0._dp
- else
- flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) = 0._dp
- flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) = 0._dp
- end if
-
- ! ****************************************************************************************************
- ! *** MAIN SOLVER ************************************************************************************
- ! ****************************************************************************************************
-
- ! initialize the length of the sub-step
- dt_solv = 0._dp ! length of time step that has been completed (s)
- dt_init = min(data_step,maxstep) / dt_init_factor ! initial substep length (s)
- dt_sub = dt_init ! length of substep
- dtSave = dt_init ! length of substep
-
- ! initialize the number of sub-steps
- nsub=0
-
- ! loop through sub-steps
- substeps: do ! continuous do statement with exit clause (alternative to "while")
-
- ! print progress
- !print*, '*** new substep'
- !write(*,'(a,3(f11.4,1x))') 'dt_sub, dt_init = ', dt_sub, dt_init
-
- ! print progress
- if(globalPrintFlag)then
- write(*,'(a,1x,4(f13.5,1x))') ' start of step: dt_init, dt_sub, dt_solv, data_step: ', dt_init, dt_sub, dt_solv, data_step
- print*, 'stepFailure = ', stepFailure
- print*, 'before resizeData: nSnow, nSoil = ', nSnow, nSoil
- endif
-
- ! increment the number of sub-steps
- nsub = nsub+1
-
- ! resize the "indx_data" structure
- ! NOTE: this is necessary because the length of index variables depends on a given split
- ! --> the resize here is overwritten later (in indexSplit)
- ! --> admittedly ugly, and retained for now
- if(stepFailure)then
- call resizeData(indx_meta(:),indx_temp,indx_data,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
- else
- call resizeData(indx_meta(:),indx_data,indx_temp,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
- endif
-
- ! save/recover copies of index variables
- do iVar=1,size(indx_data%var)
- !print*, 'indx_meta(iVar)%varname = ', trim(indx_meta(iVar)%varname)
- select case(stepFailure)
- case(.false.); indx_temp%var(iVar)%dat(:) = indx_data%var(iVar)%dat(:)
- case(.true.); indx_data%var(iVar)%dat(:) = indx_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- ! save/recover copies of prognostic variables
- do iVar=1,size(prog_data%var)
- !print*, 'prog_meta(iVar)%varname = ', trim(prog_meta(iVar)%varname)
- select case(stepFailure)
- 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(stepFailure)
- 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
-
- ! re-assign dimension lengths
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
- nLayers = nSnow+nSoil
-
-
- ! *** merge/sub-divide snow layers...
- ! -----------------------------------
- call volicePack(&
- ! input/output: model data structures
- doLayerMerge, & ! intent(in): flag to force merge of snow layers
- model_decisions, & ! intent(in): model decisions
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(inout): type of each layer
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- ! output
- modifiedLayers, & ! intent(out): flag to denote that layers were modified
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=55
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! save the number of snow and soil layers
- nSnow = indx_data%var(iLookINDEX%nSnow)%dat(1)
- nSoil = indx_data%var(iLookINDEX%nSoil)%dat(1)
- nLayers = indx_data%var(iLookINDEX%nLayers)%dat(1)
-
-
- ! compute the indices for the model state variables
- if(firstSubStep .or. modifiedVegState .or. modifiedLayers)then
- call indexState(computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- includeAquifer, & ! intent(in): flag to denote if included the aquifer
- nSnow,nSoil,nLayers, & ! intent(in): number of snow and soil layers, and total number of layers
- indx_data, & ! intent(inout): indices defining model states and layers
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
- end if
-
- ! recreate the temporary data structures
- ! NOTE: resizeData(meta, old, new, ..)
- if(modifiedVegState .or. modifiedLayers)then
-
- ! create temporary data structures for prognostic variables
- call resizeData(prog_meta(:),prog_data,prog_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then;
- err=20
- message=trim(message)//trim(cmessage);
- print*, message
- return
- endif
-
- ! create temporary data structures for diagnostic variables
- call resizeData(diag_meta(:),diag_data,diag_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- ! create temporary data structures for index variables
- call resizeData(indx_meta(:),indx_data,indx_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- endif
-
- do iVar=1,size(indx_data%var)
- !print*, 'indx_meta(iVar)%varname = ', trim(indx_meta(iVar)%varname)
- select case(stepFailure)
- case(.false.); indx_temp%var(iVar)%dat(:) = indx_data%var(iVar)%dat(:)
- case(.true.); indx_data%var(iVar)%dat(:) = indx_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- endif ! if modified the states
-
- ! define the number of state variables
- nState = indx_data%var(iLookINDEX%nState)%dat(1)
-
-
- ! *** compute diagnostic variables for each layer...
- ! --------------------------------------------------
- ! NOTE: this needs to be done AFTER volicePack, since layers may have been sub-divided and/or merged
- call diagn_evar(&
- ! input: control variables
- computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- canopyDepth, & ! intent(in): canopy depth (m)
- ! input/output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model layer indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=55;
- message=trim(message)//trim(cmessage)
- return
- end if
-
-
- ! *** compute melt of the "snow without a layer"...
- ! -------------------------------------------------
- ! NOTE: forms a surface melt pond, which drains into the upper-most soil layer through the time step
- ! (check for the special case of "snow without a layer")
- if(nSnow==0)then
- call implctMelt(&
- ! input/output: integrated snowpack properties
- prog_data%var(iLookPROG%scalarSWE)%dat(1), & ! intent(inout): snow water equivalent (kg m-2)
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! intent(inout): snow depth (m)
- prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1), & ! intent(inout): surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- prog_data%var(iLookPROG%mLayerTemp)%dat(nSnow+1), & ! intent(inout): surface layer temperature (K)
- prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1), & ! intent(inout): surface layer depth (m)
- diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat(nSnow+1),& ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- err,cmessage ) ! intent(out): error control
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
- end if ! nsnow == 0
-
- ! *** solve model equations...
- ! ----------------------------
-
- ! save input step
- dtSave = dt_sub
- !write(*,'(a,1x,3(f12.5,1x))') trim(message)//'before opSplittin: dt_init, dt_sub, dt_solv = ', dt_init, dt_sub, dt_solv
-
- ! get the new solution
- call 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 layers
- dt_sub, & ! intent(in): length of the model sub-step
- (nsub==1), & ! intent(in): logical flag to denote the first substep
- computeVegFlux, & ! intent(in): logical flag to compute fluxes within the vegetation canopy
- ! 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
- 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 that the coupled step failed
- ixSolution, & ! intent(out): solution method used in this iteration
- err,cmessage) ! intent(out): error code and error message
-
- ! check for all errors (error recovery within opSplittin)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
-
- ! process the flag for too much melt
- if(tooMuchMelt)then
- stepFailure = .true.
- doLayerMerge = .true.
- else
- doLayerMerge = .false.
- endif
-
- ! handle special case of the step failure
- ! NOTE: need to revert back to the previous state vector that we were happy with and reduce the time step
- ! TODO: ask isn't this what the actors program does without the code block below
- if(stepFailure)then
-
- ! halve step
- dt_sub = dtSave/2._dp
-
- ! check that the step is not tiny
- if(dt_sub < minstep)then
- print*,ixSolution
- print*, 'dtSave, dt_sub', dtSave, dt_sub
- message=trim(message)//'length of the coupled step is below the minimum step length'
- print*, message
- err=20; return
- endif
-
- ! try again
- cycle substeps
-
- endif
-
- ! update first step
- firstSubStep=.false.
-
- ! *** remove ice due to sublimation...
- ! --------------------------------------------------------------
- sublime: associate(&
- scalarCanopySublimation => flux_data%var(iLookFLUX%scalarCanopySublimation)%dat(1), & ! sublimation from the vegetation canopy (kg m-2 s-1)
- scalarSnowSublimation => flux_data%var(iLookFLUX%scalarSnowSublimation)%dat(1), & ! sublimation from the snow surface (kg m-2 s-1)
- scalarLatHeatCanopyEvap => flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1), & ! latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- scalarSenHeatCanopy => flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1), & ! sensible heat flux from the canopy to the canopy air space (W m-2)
- scalarLatHeatGround => flux_data%var(iLookFLUX%scalarLatHeatGround)%dat(1), & ! latent heat flux from ground surface below vegetation (W m-2)
- scalarSenHeatGround => flux_data%var(iLookFLUX%scalarSenHeatGround)%dat(1), & ! sensible heat flux from ground surface below vegetation (W m-2)
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1), & ! liquid water stored on the vegetation canopy (kg m-2)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1), & ! ice stored on the vegetation canopy (kg m-2)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat, & ! volumetric fraction of ice in the snow+soil domain (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat, & ! volumetric fraction of liquid water in the snow+soil domain (-)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat & ! depth of each snow+soil layer (m)
- ) ! associations to variables in data structures
-
- ! * compute change in canopy ice content due to sublimation...
- ! ------------------------------------------------------------
- if(computeVegFlux)then
-
- ! remove mass of ice on the canopy
- scalarCanopyIce = scalarCanopyIce + scalarCanopySublimation*dt_sub
-
- ! if removed all ice, take the remaining sublimation from water
- if(scalarCanopyIce < 0._dp)then
- scalarCanopyLiq = scalarCanopyLiq + scalarCanopyIce
- scalarCanopyIce = 0._dp
- endif
-
- ! modify fluxes if there is insufficient canopy water to support the converged sublimation rate over the time step dt_sub
- if(scalarCanopyLiq < 0._dp)then
- ! --> superfluous sublimation flux
- superflousSub = -scalarCanopyLiq/dt_sub ! kg m-2 s-1
- superflousNrg = superflousSub*LH_sub ! W m-2 (J m-2 s-1)
- ! --> update fluxes and states
- scalarCanopySublimation = scalarCanopySublimation + superflousSub
- scalarLatHeatCanopyEvap = scalarLatHeatCanopyEvap + superflousNrg
- scalarSenHeatCanopy = scalarSenHeatCanopy - superflousNrg
- scalarCanopyLiq = 0._dp
- endif
-
- end if ! (if computing the vegetation flux)
-
- ! * compute change in ice content of the top snow layer due to sublimation...
- ! ---------------------------------------------------------------------------
- ! NOTE: this is done BEFORE densification
- if(nSnow > 0)then ! snow layers exist
-
- ! try to remove ice from the top layer
- iSnow=1
-
- ! save the mass of liquid water (kg m-2)
- massLiquid = mLayerDepth(iSnow)*mLayerVolFracLiq(iSnow)*iden_water
-
- ! add/remove the depth of snow gained/lost by frost/sublimation (m)
- ! NOTE: assume constant density
- mLayerDepth(iSnow) = mLayerDepth(iSnow) + dt_sub*scalarSnowSublimation/(mLayerVolFracIce(iSnow)*iden_ice)
-
- ! check that we did not remove the entire layer
- if(mLayerDepth(iSnow) < verySmall)then
- stepFailure = .true.
- doLayerMerge = .true.
- dt_sub = max(dtSave/2._dp, minstep)
- cycle substeps
- else
- stepFailure = .false.
- doLayerMerge = .false.
- endif
-
- ! update the volumetric fraction of liquid water
- mLayerVolFracLiq(iSnow) = massLiquid / (mLayerDepth(iSnow)*iden_water)
-
- ! no snow
- else
-
- ! no snow: check that sublimation is zero
- if(abs(scalarSnowSublimation) > verySmall)then
- message=trim(message)//'sublimation of snow has been computed when no snow exists'
- print*, message
- err=20; return
- end if
-
- end if ! (if snow layers exist)
-
- ! end associate sublime
-
- ! *** account for compaction and cavitation in the snowpack...
- ! ------------------------------------------------------------
- if(nSnow>0)then
- call snwDensify(&
- ! intent(in): variables
- dt_sub, & ! intent(in): time step (s)
- indx_data%var(iLookINDEX%nSnow)%dat(1), & ! intent(in): number of snow layers
- prog_data%var(iLookPROG%mLayerTemp)%dat(1:nSnow), & ! intent(in): temperature of each layer (K)
- diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat(1:nSnow), & ! intent(in): volumetric melt in each layer (kg m-3)
- ! intent(in): parameters
- mpar_data%var(iLookPARAM%densScalGrowth)%dat(1), & ! intent(in): density scaling factor for grain growth (kg-1 m3)
- mpar_data%var(iLookPARAM%tempScalGrowth)%dat(1), & ! intent(in): temperature scaling factor for grain growth (K-1)
- mpar_data%var(iLookPARAM%grainGrowthRate)%dat(1), & ! intent(in): rate of grain growth (s-1)
- mpar_data%var(iLookPARAM%densScalOvrbdn)%dat(1), & ! intent(in): density scaling factor for overburden pressure (kg-1 m3)
- mpar_data%var(iLookPARAM%tempScalOvrbdn)%dat(1), & ! intent(in): temperature scaling factor for overburden pressure (K-1)
- mpar_data%var(iLookPARAM%baseViscosity)%dat(1), & ! intent(in): viscosity coefficient at T=T_frz and snow density=0 (kg m-2 s)
- ! intent(inout): state variables
- prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow), & ! intent(inout): depth of each layer (m)
- prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow), & ! intent(inout): volumetric fraction of liquid water after itertations (-)
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1:nSnow), & ! intent(inout): volumetric fraction of ice after itertations (-)
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then
- err=55
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- end if ! if snow layers exist
-
- ! update coordinate variables
- call calcHeight(&
- ! input/output: data structures
- indx_data, & ! intent(in): layer type
- prog_data, & ! intent(inout): model variables for a local HRU
- ! output: error control
- err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! recompute snow depth and SWE
- if(nSnow > 0)then
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) = sum( prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow))
- prog_data%var(iLookPROG%scalarSWE)%dat(1) = sum( (prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)*iden_water + &
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1:nSnow)*iden_ice) &
- * prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow) )
- end if
-
- ! increment fluxes
- dt_wght = dt_sub/data_step ! define weight applied to each sub-step
- do iVar=1,size(averageFlux_meta)
- flux_mean%var(iVar)%dat(:) = flux_mean%var(iVar)%dat(:) + flux_data%var(averageFlux_meta(iVar)%ixParent)%dat(:)*dt_wght
- end do
-
- ! increment change in storage associated with the surface melt pond (kg m-2)
- if(nSnow==0) sfcMeltPond = sfcMeltPond + prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1)
-
- ! increment soil compression (kg m-2)
- totalSoilCompress = totalSoilCompress + diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) ! total soil compression over whole layer (kg m-2)
-
- end associate sublime
-
-
- ! ****************************************************************************************************
- ! *** END MAIN SOLVER ********************************************************************************
- ! ****************************************************************************************************
-
- ! increment sub-step
- dt_solv = dt_solv + dt_sub
- ! save the time step to initialize the subsequent step
- if(dt_solv<data_step .or. nsub==1) dt_init = dt_sub
-
- ! check
- if(globalPrintFlag)&
- write(*,'(a,1x,3(f18.5,1x))') 'dt_sub, dt_solv, data_step: ', dt_sub, dt_solv, data_step
-
- ! check that we have completed the sub-step
- if(dt_solv >= data_step-verySmall) then
- exit substeps
- endif
-
- ! adjust length of the sub-step (make sure that we don't exceed the step)
- dt_sub = min(data_step - dt_solv, dt_sub)
-
- end do substeps ! (sub-step loop)
-
- ! *** add snowfall to the snowpack...
- ! -----------------------------------
-
- ! add new snowfall to the snowpack
- ! NOTE: This needs to be done AFTER the call to canopySnow, since throughfall and unloading are computed in canopySnow
- call newsnwfall(&
- ! input: model control
- data_step, & ! time step (seconds)
- (nSnow > 0), & ! logical flag if snow layers exist
- mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1), & ! freeezing curve parameter for snow (K-1)
- ! input: diagnostic scalar variables
- diag_data%var(iLookDIAG%scalarSnowfallTemp)%dat(1), & ! computed temperature of fresh snow (K)
- diag_data%var(iLookDIAG%scalarNewSnowDensity)%dat(1), & ! computed density of new snow (kg m-3)
- flux_data%var(iLookFLUX%scalarThroughfallSnow)%dat(1), & ! throughfall of snow through the canopy (kg m-2 s-1)
- flux_data%var(iLookFLUX%scalarCanopySnowUnloading)%dat(1), & ! unloading of snow from the canopy (kg m-2 s-1)
- ! input/output: state variables
- prog_data%var(iLookPROG%scalarSWE)%dat(1), & ! SWE (kg m-2)
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! total snow depth (m)
- prog_data%var(iLookPROG%mLayerTemp)%dat(1), & ! temperature of the top layer (K)
- prog_data%var(iLookPROG%mLayerDepth)%dat(1), & ! depth of the top layer (m)
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1), & ! volumetric fraction of ice of the top layer (-)
- prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1), & ! volumetric fraction of liquid water of the top layer (-)
- ! output: error control
- err,cmessage) ! error control
- if(err/=0)then
- err=30
- message=trim(message)//trim(cmessage)
- print*,message
- return
- end if
-
- ! re-compute snow depth and SWE
- if(nSnow > 0)then
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) = sum( prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow))
- prog_data%var(iLookPROG%scalarSWE)%dat(1) = sum( (prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)*iden_water + &
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1:nSnow)*iden_ice) &
- * prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow) )
- end if
- !print*, 'SWE after snowfall = ', prog_data%var(iLookPROG%scalarSWE)%dat(1)
-
- ! re-assign dimension lengths
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
- nLayers = nSnow+nSoil
-
- ! update coordinate variables
- call calcHeight(&
- ! input/output: data structures
- indx_data, & ! intent(in): layer type
- prog_data, & ! intent(inout): model variables for a local HRU
- ! output: error control
- err,cmessage)
- if(err/=0)then
- err=20
- message=trim(message)//trim(cmessage)
- print*, message
- return
- end if
-
- ! overwrite flux_data with flux_mean (returns timestep-average fluxes for scalar variables)
- do iVar=1,size(averageFlux_meta)
- flux_data%var(averageFlux_meta(iVar)%ixParent)%dat(:) = flux_mean%var(iVar)%dat(:)
- end do
-
- ! ***********************************************************************************************************************************
- ! ***********************************************************************************************************************************
- ! ***********************************************************************************************************************************
- ! ***********************************************************************************************************************************
-
- ! ---
- ! *** balance checks...
- ! ---------------------
-
- ! save the average compression and melt pond storage in the data structures
- prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) = sfcMeltPond
-
- ! associate local variables with information in the data structures
- associate(&
- ! model forcing
- scalarSnowfall => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowfall) )%dat(1) ,& ! computed snowfall rate (kg m-2 s-1)
- scalarRainfall => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarRainfall) )%dat(1) ,& ! computed rainfall rate (kg m-2 s-1)
- ! canopy fluxes
- averageThroughfallSnow => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarThroughfallSnow) )%dat(1) ,& ! snow that reaches the ground without ever touching the canopy (kg m-2 s-1)
- averageThroughfallRain => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarThroughfallRain) )%dat(1) ,& ! rain that reaches the ground without ever touching the canopy (kg m-2 s-1)
- averageCanopySnowUnloading => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopySnowUnloading))%dat(1) ,& ! unloading of snow from the vegetion canopy (kg m-2 s-1)
- averageCanopyLiqDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyLiqDrainage) )%dat(1) ,& ! drainage of liquid water from the vegetation canopy (kg m-2 s-1)
- averageCanopySublimation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopySublimation) )%dat(1) ,& ! canopy sublimation/frost (kg m-2 s-1)
- averageCanopyEvaporation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyEvaporation) )%dat(1) ,& ! canopy evaporation/condensation (kg m-2 s-1)
- ! snow fluxes
- averageSnowSublimation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowSublimation) )%dat(1) ,& ! sublimation from the snow surface (kg m-2 s-1)
- averageSnowDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowDrainage) )%dat(1) ,& ! drainage from the bottom of the snowpack (m s-1)
- ! soil fluxes
- averageSoilInflux => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarInfiltration) )%dat(1) ,& ! influx of water at the top of the soil profile (m s-1)
- averageSoilDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSoilDrainage) )%dat(1) ,& ! drainage from the bottom of the soil profile (m s-1)
- averageSoilBaseflow => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSoilBaseflow) )%dat(1) ,& ! total baseflow from throughout the soil profile (m s-1)
- averageGroundEvaporation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarGroundEvaporation) )%dat(1) ,& ! soil evaporation (kg m-2 s-1)
- averageCanopyTranspiration => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyTranspiration))%dat(1) ,& ! canopy transpiration (kg m-2 s-1)
- ! state variables in the vegetation canopy
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! canopy liquid water (kg m-2)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! canopy ice content (kg m-2)
- ! state variables in the soil domain
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1:nLayers) ,& ! depth of each soil layer (m)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat(nSnow+1:nLayers) ,& ! volumetric ice content in each soil layer (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(nSnow+1:nLayers) ,& ! volumetric liquid water content in each soil layer (-)
- scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! aquifer storage (m)
- ! error tolerance
- absConvTol_liquid => mpar_data%var(iLookPARAM%absConvTol_liquid)%dat(1) ,& ! absolute convergence tolerance for vol frac liq water (-)
- scalarTotalSoilIce => diag_data%var(iLookDIAG%scalarTotalSoilIce)%dat(1) ,& ! total ice in the soil column (kg m-2)
- scalarTotalSoilLiq => diag_data%var(iLookDIAG%scalarTotalSoilLiq)%dat(1) & ! total liquid water in the soil column (kg m-2)
- ) ! (association of local variables with information in the data structures
-
- ! -----
- ! * balance checks for the canopy...
- ! ----------------------------------
-
- ! if computing the vegetation flux
- if(computeVegFlux)then
-
- ! canopy water balance
- balanceCanopyWater1 = scalarCanopyLiq + scalarCanopyIce
-
- ! balance checks for the canopy
- ! NOTE: need to put the balance checks in the sub-step loop so that we can re-compute if necessary
- scalarCanopyWatBalError = balanceCanopyWater1 - (balanceCanopyWater0 + (scalarSnowfall - averageThroughfallSnow)*data_step + (scalarRainfall - averageThroughfallRain)*data_step &
- - averageCanopySnowUnloading*data_step - averageCanopyLiqDrainage*data_step + averageCanopySublimation*data_step + averageCanopyEvaporation*data_step)
- if(abs(scalarCanopyWatBalError) > absConvTol_liquid*iden_water*10._dp)then
- print*, '** canopy water balance error:'
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'balanceCanopyWater0 = ', balanceCanopyWater0
- write(*,'(a,1x,f20.10)') 'balanceCanopyWater1 = ', balanceCanopyWater1
- write(*,'(a,1x,f20.10)') 'scalarSnowfall = ', scalarSnowfall
- write(*,'(a,1x,f20.10)') 'scalarRainfall = ', scalarRainfall
- write(*,'(a,1x,f20.10)') '(scalarSnowfall - averageThroughfallSnow) = ', (scalarSnowfall - averageThroughfallSnow)!*data_step
- write(*,'(a,1x,f20.10)') '(scalarRainfall - averageThroughfallRain) = ', (scalarRainfall - averageThroughfallRain)!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopySnowUnloading = ', averageCanopySnowUnloading!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopyLiqDrainage = ', averageCanopyLiqDrainage!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopySublimation = ', averageCanopySublimation!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopyEvaporation = ', averageCanopyEvaporation!*data_step
- write(*,'(a,1x,f20.10)') 'scalarCanopyWatBalError = ', scalarCanopyWatBalError
- message=trim(message)//'canopy hydrology does not balance'
- print*, message
- err=20; return
- end if
-
- endif ! if computing the vegetation flux
-
- ! -----
- ! * balance checks for SWE...
- ! ---------------------------
-
- ! recompute snow depth (m) and SWE (kg m-2)
- if(nSnow > 0)then
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) = sum( prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow))
- prog_data%var(iLookPROG%scalarSWE)%dat(1) = sum( (prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)*iden_water + &
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1:nSnow)*iden_ice) &
- * prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow) )
- end if
-
- ! check the individual layers
- if(printBalance .and. nSnow>0)then
- write(*,'(a,1x,10(f12.8,1x))') 'liqSnowInit = ', liqSnowInit
- write(*,'(a,1x,10(f12.8,1x))') 'volFracLiq = ', prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)
- write(*,'(a,1x,10(f12.8,1x))') 'iLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%iLayerLiqFluxSnow)%dat*iden_water*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'mLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%mLayerLiqFluxSnow)%dat*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'change volFracLiq = ', prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow) - liqSnowInit
- deallocate(liqSnowInit, stat=err)
- if(err/=0)then
- message=trim(message)//'unable to deallocate space for the initial volumetric liquid water content of snow'
- print*, message
- err=20; return
- endif
- endif
-
- ! check SWE
- if(nSnow>0)then
- effSnowfall = averageThroughfallSnow + averageCanopySnowUnloading
- effRainfall = averageThroughfallRain + averageCanopyLiqDrainage
- newSWE = prog_data%var(iLookPROG%scalarSWE)%dat(1)
- delSWE = newSWE - (oldSWE - sfcMeltPond)
- massBalance = delSWE - (effSnowfall + effRainfall + averageSnowSublimation - averageSnowDrainage*iden_water)*data_step
-
- if(abs(massBalance) > absConvTol_liquid*iden_water*10._dp)then
- print*, 'nSnow = ', nSnow
- print*, 'nSub = ', nSub
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'oldSWE = ', oldSWE
- write(*,'(a,1x,f20.10)') 'newSWE = ', newSWE
- write(*,'(a,1x,f20.10)') 'delSWE = ', delSWE
- write(*,'(a,1x,f20.10)') 'effRainfall = ', effRainfall*data_step
- write(*,'(a,1x,f20.10)') 'effSnowfall = ', effSnowfall*data_step
- write(*,'(a,1x,f20.10)') 'sublimation = ', averageSnowSublimation*data_step
- write(*,'(a,1x,f20.10)') 'snwDrainage = ', averageSnowDrainage*iden_water*data_step
- write(*,'(a,1x,f20.10)') 'sfcMeltPond = ', sfcMeltPond
- write(*,'(a,1x,f20.10)') 'massBalance = ', massBalance
- message=trim(message)//'SWE does not balance'
- print*,message
- err=20; return
- endif ! if failed mass balance check
- endif ! if snow layers exist
-
- ! -----
- ! * balance checks for soil...
- ! ----------------------------
-
- ! compute the liquid water and ice content at the end of the time step
- scalarTotalSoilLiq = sum(iden_water*mLayerVolFracLiq(1:nSoil)*mLayerDepth(1:nSoil))
- scalarTotalSoilIce = sum(iden_water*mLayerVolFracIce(1:nSoil)*mLayerDepth(1:nSoil)) ! NOTE: no expansion of soil, hence use iden_water
-
- ! get the total water in the soil (liquid plus ice) at the end of the time step (kg m-2)
- balanceSoilWater1 = scalarTotalSoilLiq + scalarTotalSoilIce
-
- ! get the total aquifer storage at the start of the time step (kg m-2)
- balanceAquifer1 = scalarAquiferStorage*iden_water
-
- ! get the input and output to/from the soil zone (kg m-2)
- balanceSoilInflux = averageSoilInflux*iden_water*data_step
- balanceSoilBaseflow = averageSoilBaseflow*iden_water*data_step
- balanceSoilDrainage = averageSoilDrainage*iden_water*data_step
- balanceSoilET = (averageCanopyTranspiration + averageGroundEvaporation)*data_step
-
- ! check the individual layers
- if(printBalance)then
- write(*,'(a,1x,10(f12.8,1x))') 'liqSoilInit = ', liqSoilInit
- write(*,'(a,1x,10(f12.8,1x))') 'volFracLiq = ', mLayerVolFracLiq
- write(*,'(a,1x,10(f12.8,1x))') 'iLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat*iden_water*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'mLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%mLayerLiqFluxSoil)%dat*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'change volFracLiq = ', mLayerVolFracLiq - liqSoilInit
- deallocate(liqSoilInit, stat=err)
- if(err/=0)then
- message=trim(message)//'unable to deallocate space for the initial soil moisture'
- err=20; return
- print*, message
- endif
- endif
-
- ! check the soil water balance
- scalarSoilWatBalError = balanceSoilWater1 - (balanceSoilWater0 + (balanceSoilInflux + balanceSoilET - balanceSoilBaseflow - balanceSoilDrainage - totalSoilCompress) )
- if(abs(scalarSoilWatBalError) > absConvTol_liquid*iden_water*10._dp)then ! NOTE: kg m-2, so need coarse tolerance to account for precision issues
- write(*,*) 'solution method = ', ixSolution
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'totalSoilCompress = ', totalSoilCompress
- write(*,'(a,1x,f20.10)') 'scalarTotalSoilLiq = ', scalarTotalSoilLiq
- write(*,'(a,1x,f20.10)') 'scalarTotalSoilIce = ', scalarTotalSoilIce
- write(*,'(a,1x,f20.10)') 'balanceSoilWater0 = ', balanceSoilWater0
- write(*,'(a,1x,f20.10)') 'balanceSoilWater1 = ', balanceSoilWater1
- write(*,'(a,1x,f20.10)') 'balanceSoilInflux = ', balanceSoilInflux
- write(*,'(a,1x,f20.10)') 'balanceSoilBaseflow = ', balanceSoilBaseflow
- write(*,'(a,1x,f20.10)') 'balanceSoilDrainage = ', balanceSoilDrainage
- write(*,'(a,1x,f20.10)') 'balanceSoilET = ', balanceSoilET
- write(*,'(a,1x,f20.10)') 'scalarSoilWatBalError = ', scalarSoilWatBalError
- write(*,'(a,1x,f20.10)') 'scalarSoilWatBalError = ', scalarSoilWatBalError/iden_water
- write(*,'(a,1x,f20.10)') 'absConvTol_liquid = ', absConvTol_liquid
- ! error control
- message=trim(message)//'soil hydrology does not balance'
- print*, message
- err=20; return
- end if
-
- ! end association of local variables with information in the data structures
- end associate
-
- ! end association to canopy depth
- end associate canopy
-
- ! Save the total soil water (Liquid+Ice)
- diag_data%var(iLookDIAG%scalarTotalSoilWat)%dat(1) = balanceSoilWater1
- ! save the surface temperature (just to make things easier to visualize)
- prog_data%var(iLookPROG%scalarSurfaceTemp)%dat(1) = prog_data%var(iLookPROG%mLayerTemp)%dat(1)
-
- ! overwrite flux data with the timestep-average value
- if(.not.backwardsCompatibility)then
- do iVar=1,size(flux_mean%var)
- flux_data%var(averageFlux_meta(iVar)%ixParent)%dat = flux_mean%var(iVar)%dat
- end do
- end if
-
- iLayer = nSnow+1
- !print*, 'nsub, mLayerTemp(iLayer), mLayerVolFracIce(iLayer) = ', nsub, mLayerTemp(iLayer), mLayerVolFracIce(iLayer)
- !print*, 'nsub = ', nsub
- if(nsub>50000)then
- write(message,'(a,i0)') trim(cmessage)//'number of sub-steps > 50000 for HRU ', indxHRU
- err=20; return
- end if
-
-end subroutine coupled_em
-
-
- ! *********************************************************************************************************
- ! 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(dp),intent(inout) :: scalarSWE ! snow water equivalent (kg m-2)
- real(dp),intent(inout) :: scalarSnowDepth ! snow depth (m)
- real(dp),intent(inout) :: scalarSfcMeltPond ! surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- real(dp),intent(inout) :: soilTemp ! surface layer temperature (K)
- real(dp),intent(inout) :: soilDepth ! surface layer depth (m)
- real(dp),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(dp) :: nrgRequired ! energy required to melt all the snow (J m-2)
- real(dp) :: nrgAvailable ! energy available to melt the snow (J m-2)
- real(dp) :: snwDensity ! snow density (kg m-3)
- ! initialize error control
- err=0; message='implctMelt/'
-
- if(scalarSWE > 0._dp)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._dp
- 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._dp ! kg m-2
- end if ! (if the temperature of the top soil layer is greater than Tfreeze)
- else ! melt is zero if the "snow without a layer" does not exist
- scalarSfcMeltPond = 0._dp ! kg m-2
- end if ! (if the "snow without a layer" exists)
-
- end subroutine implctMelt
-
-end module coupled_em_module
diff --git a/build/source/engine/derivforce.f90 b/build/source/engine/derivforce.f90
deleted file mode 100755
index 5d0c5e3dbcab104f6326b1c29c881a5949adab20..0000000000000000000000000000000000000000
--- a/build/source/engine/derivforce.f90
+++ /dev/null
@@ -1,353 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module derivforce_module
-
-! data types
-USE nrtype
-USE data_types,only:var_dlength ! data structure: x%var(:)%dat (rkind)
-
-! model constants
-USE multiconst,only:Tfreeze ! freezing point of pure water (K)
-USE multiconst,only:secprday ! number of seconds in a day
-USE multiconst,only:secprhour ! number of seconds in an hour
-USE multiconst,only:minprhour ! number of minutes in an hour
-
-! global time information
-USE globalData,only:refJulday ! reference time (fractional julian days)
-USE globalData,only:data_step ! length of the data step (s)
-
-! model decisions
-USE globalData,only:model_decisions ! model decision structure
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-
-! named variables for structure elements
-USE var_lookup,only:iLookTIME,iLookATTR ! named variables for structure elements
-USE var_lookup,only:iLookPARAM,iLookFORCE ! named variables for structure elements
-USE var_lookup,only:iLookPROG,iLookDIAG,iLookFLUX ! named variables for structure elements
-
-! look-up values for the choice of the time zone information
-USE globalData,only:ncTime,utcTime,localTime ! time zone info: as in NetCDF file, UTC, or local
-
-! look-up values for the choice of snow albedo options
-USE mDecisions_module,only: &
- constDens, & ! Constant new snow density
- anderson, & ! Anderson 1976
- hedAndPom, & ! Hedstrom and Pomeroy (1998), expoential increase
- pahaut_76 ! Pahaut 1976, wind speed dependent (derived from Col de Porte, French Alps)
-
-! privacy
-implicit none
-private
-public::derivforce
-contains
-
- ! ************************************************************************************************
- ! public subroutine derivforce: compute derived forcing data
- ! ************************************************************************************************
- subroutine derivforce(time_data,forc_data,attr_data,mpar_data,prog_data,diag_data,flux_data,tmZoneOffsetFracDay,err,message)
- USE sunGeomtry_module,only:clrsky_rad ! compute cosine of the solar zenith angle
- USE conv_funcs_module,only:vapPress ! compute vapor pressure of air (Pa)
- USE conv_funcs_module,only:SPHM2RELHM,RELHM2SPHM,WETBULBTMP ! conversion functions
- USE snow_utils_module,only:fracliquid,templiquid ! functions to compute temperature/liquid water
- USE time_utils_module,only:compcalday ! convert julian day to calendar date
- USE summaFileManager,only: NC_TIME_ZONE ! time zone option from control file
- ! compute derived forcing data variables
- implicit none
- ! input variable
- integer(i4b),intent(in) :: time_data(:) ! vector of time data for a given time step
- real(rkind),intent(inout) :: forc_data(:) ! vector of forcing data for a given time step
- real(rkind),intent(in) :: attr_data(:) ! vector of model attributes
- type(var_dlength),intent(in) :: mpar_data ! vector of model parameters
- type(var_dlength),intent(in) :: prog_data ! data structure of model prognostic variables for a local HRU
- ! output variables
- type(var_dlength),intent(inout) :: diag_data ! data structure of model diagnostic variables for a local HRU
- type(var_dlength),intent(inout) :: flux_data ! data structure of model fluxes for a local HRU
- real(rkind),intent(inout) :: tmZoneOffsetFracDay
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local time
- integer(i4b) :: jyyy,jm,jd ! year, month, day
- integer(i4b) :: jh,jmin ! hour, minute
- real(rkind) :: dsec ! double precision seconds (not used)
- real(rkind) :: timeOffset ! time offset from Grenwich (days)
- real(rkind) :: julianTime ! local julian time
- ! cosine of the solar zenith angle
- real(rkind) :: ahour ! hour at start of time step
- real(rkind) :: dataStep ! data step (hours)
- real(rkind),parameter :: slope=0._rkind ! terrain slope (assume flat)
- real(rkind),parameter :: azimuth=0._rkind ! terrain azimuth (assume zero)
- real(rkind) :: hri ! average radiation index over time step DT
- ! general local variables
- character(len=256) :: cmessage ! error message for downwind routine
- integer(i4b),parameter :: nBands=2 ! number of spectral bands
- real(rkind),parameter :: valueMissing=-9999._rkind ! missing value
- real(rkind),parameter :: co2Factor=355.e-6_rkind ! empirical factor to obtain partial pressure of co2
- real(rkind),parameter :: o2Factor=0.209_rkind ! empirical factor to obtain partial pressure of o2
- real(rkind),parameter :: minMeasHeight=1._rkind ! minimum measurement height (m)
- real(rkind) :: relhum ! relative humidity (-)
- real(rkind) :: fracrain ! fraction of precipitation that falls as rain
- real(rkind) :: maxFrozenSnowTemp ! maximum temperature of snow when the snow is predominantely frozen (K)
- real(rkind),parameter :: unfrozenLiq=0.01_rkind ! unfrozen liquid water used to compute maxFrozenSnowTemp (-)
- real(rkind),parameter :: eps=epsilon(fracrain) ! a number that is almost negligible
- real(rkind) :: Tmin,Tmax ! minimum and maximum wet bulb temperature in the time step (K)
- real(rkind),parameter :: pomNewSnowDenMax=150._rkind ! Upper limit for new snow density limit in Hedstrom and Pomeroy 1998. 150 was used because at was the highest observed density at air temperatures used in this study. See Figure 4 of Hedstrom and Pomeroy (1998).
- real(rkind),parameter :: andersonWarmDenLimit=2._rkind ! Upper air temperature limit in Anderson (1976) new snow density (C)
- real(rkind),parameter :: andersonColdDenLimit=15._rkind! Lower air temperature limit in Anderson (1976) new snow density (C)
- real(rkind),parameter :: andersonDenScal=1.5_rkind ! Scalar parameter in Anderson (1976) new snow density function (-)
- real(rkind),parameter :: pahautDenWindScal=0.5_rkind ! Scalar parameter for wind impacts on density using Pahaut (1976) function (-)
- ! ************************************************************************************************
- ! associate local variables with the information in the data structures
- associate(&
- ! model parameters
- Frad_vis => mpar_data%var(iLookPARAM%Frad_vis)%dat(1) , & ! fraction radiation absorbed in visible part of spectrum (-)
- directScale => mpar_data%var(iLookPARAM%directScale)%dat(1) , & ! scaling factor for fractional driect radiaion parameterization (-)
- Frad_direct => mpar_data%var(iLookPARAM%Frad_direct)%dat(1) , & ! maximum fraction direct radiation (-)
- minwind => mpar_data%var(iLookPARAM%minwind)%dat(1) , & ! minimum windspeed (m s-1)
- fc_param => mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1) , & ! freezing curve parameter for snow (K-1)
- tempCritRain => mpar_data%var(iLookPARAM%tempCritRain)%dat(1) , & ! critical temperature where precipitation is rain (K)
- tempRangeTimestep => mpar_data%var(iLookPARAM%tempRangeTimestep)%dat(1) , & ! temperature range over the time step (K)
- frozenPrecipMultip => mpar_data%var(iLookPARAM%frozenPrecipMultip)%dat(1) , & ! frozen precipitation multiplier (-)
- newSnowDenMin => mpar_data%var(iLookPARAM%newSnowDenMin)%dat(1) , & ! minimum new snow density (kg m-3)
- newSnowDenMult => mpar_data%var(iLookPARAM%newSnowDenMult)%dat(1) , & ! multiplier for new snow density (kg m-3)
- newSnowDenScal => mpar_data%var(iLookPARAM%newSnowDenScal)%dat(1) , & ! scaling factor for new snow density (K)
- constSnowDen => mpar_data%var(iLookPARAM%constSnowDen)%dat(1) , & ! Constant new snow density (kg m-3)
- newSnowDenAdd => mpar_data%var(iLookPARAM%newSnowDenAdd)%dat(1) , & ! Pahaut 1976, additive factor for new snow density (kg m-3)
- newSnowDenMultTemp => mpar_data%var(iLookPARAM%newSnowDenMultTemp)%dat(1) , & ! Pahaut 1976, multiplier for new snow density applied to air temperature (kg m-3 K-1)
- newSnowDenMultWind => mpar_data%var(iLookPARAM%newSnowDenMultWind)%dat(1) , & ! Pahaut 1976, multiplier for new snow density applied to wind speed (kg m-7/2 s-1/2)
- newSnowDenMultAnd => mpar_data%var(iLookPARAM%newSnowDenMultAnd)%dat(1) , & ! Anderson 1976, multiplier for new snow density for Anderson function (K-1)
- newSnowDenBase => mpar_data%var(iLookPARAM%newSnowDenBase)%dat(1) , & ! Anderson 1976, base value that is rasied to the (3/2) power (K)
- ! radiation geometry variables
- iyyy => time_data(iLookTIME%iyyy) , & ! year
- im => time_data(iLookTIME%im) , & ! month
- id => time_data(iLookTIME%id) , & ! day
- ih => time_data(iLookTIME%ih) , & ! hour
- imin => time_data(iLookTIME%imin) , & ! minute
- latitude => attr_data(iLookATTR%latitude) , & ! latitude (degrees north)
- longitude => attr_data(iLookATTR%longitude) , & ! longitude (degrees east)
- tan_slope => attr_data(iLookATTR%tan_slope) , & ! tan HRU ground surface slope (-)
- aspect => attr_data(iLookATTR%aspect) , & ! mean azimuth of HRU in degrees E of N (degrees)
- cosZenith => diag_data%var(iLookDIAG%scalarCosZenith)%dat(1) , & ! average cosine of the zenith angle over time step DT
- ! measurement height
- mHeight => attr_data(iLookATTR%mHeight) , & ! latitude (degrees north)
- adjMeasHeight => diag_data%var(iLookDIAG%scalarAdjMeasHeight)%dat(1) , & ! adjusted measurement height (m)
- scalarSnowDepth => prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) , & ! snow depth on the ground surface (m)
- heightCanopyTop => mpar_data%var(iLookPARAM%heightCanopyTop)%dat(1) , & ! height of the top of the canopy layer (m)
- ! model time
- secondsSinceRefTime => forc_data(iLookFORCE%time) , & ! time = seconds since reference time
- ! model forcing data
- SWRadAtm => forc_data(iLookFORCE%SWRadAtm) , & ! downward shortwave radiation (W m-2)
- airtemp => forc_data(iLookFORCE%airtemp) , & ! air temperature at 2 meter height (K)
- windspd => forc_data(iLookFORCE%windspd) , & ! wind speed at 10 meter height (m s-1)
- airpres => forc_data(iLookFORCE%airpres) , & ! air pressure at 2 meter height (Pa)
- spechum => forc_data(iLookFORCE%spechum) , & ! specific humidity at 2 meter height (g g-1)
- pptrate => forc_data(iLookFORCE%pptrate) , & ! precipitation rate (kg m-2 s-1)
- ! derived model forcing data
- scalarO2air => diag_data%var(iLookDIAG%scalarO2air)%dat(1) , & ! atmospheric o2 concentration (Pa)
- scalarCO2air => diag_data%var(iLookDIAG%scalarCO2air)%dat(1) , & ! atmospheric co2 concentration (Pa)
- ! radiation variables
- scalarFractionDirect => diag_data%var(iLookDIAG%scalarFractionDirect)%dat(1) , & ! fraction of direct radiation (0-1)
- spectralIncomingDirect => flux_data%var(iLookFLUX%spectralIncomingDirect)%dat , & ! downwelling direct shortwave radiation for each waveband (W m-2)
- spectralIncomingDiffuse => flux_data%var(iLookFLUX%spectralIncomingDiffuse)%dat , & ! downwelling diffuse shortwave radiation for each waveband (W m-2)
- ! snow accumulation variables
- rainfall => flux_data%var(iLookFLUX%scalarRainfall)%dat(1) , & ! computed rainfall rate (kg m-2 s-1)
- snowfall => flux_data%var(iLookFLUX%scalarSnowfall)%dat(1) , & ! computed snowfall rate (kg m-2 s-1)
- VPair => diag_data%var(iLookDIAG%scalarVPair)%dat(1) , & ! vapor pressure of the air above the vegetation canopy (Pa)
- twetbulb => diag_data%var(iLookDIAG%scalarTwetbulb)%dat(1) , & ! wet bulb temperature (K)
- snowfallTemp => diag_data%var(iLookDIAG%scalarSnowfallTemp)%dat(1) , & ! computed temperature of fresh snow (K)
- newSnowDensity => diag_data%var(iLookDIAG%scalarNewSnowDensity)%dat(1) & ! computed density of new snow (kg m-3)
- ) ! (associating local variables with the information in the data structures)
-
- ! initialize error control
- err=0; message="derivforce/"
-
- ! check spectral dimension
- if(size(spectralIncomingDirect) /= nBands .or. size(spectralIncomingDiffuse) /= nBands)then
- write(message,'(a,i0,a)') trim(message)//'expect ', nBands, 'spectral classes for radiation'
- err=20; return
- end if
-
- ! adjust the measurement height for the vegetation canopy
- ! NOTE: could return an error or a warning
- ! NOTE: this does not need to be done every time step -- doing here for consistency with the snow adjustment
- if(mHeight < heightCanopyTop)then
- adjMeasHeight = heightCanopyTop+minMeasHeight ! measurement height at least minMeasHeight above the canopy
- else
- adjMeasHeight = mHeight
- endif
-
- ! adjust the measurement height for snow depth
- if(adjMeasHeight < scalarSnowDepth+minMeasHeight)then
- adjMeasHeight = scalarSnowDepth+minMeasHeight ! measurement height at least minMeasHeight above the snow surface
- endif
-
- ! compute the partial pressure of o2 and co2
- scalarCO2air = co2Factor * airpres ! atmospheric co2 concentration (Pa)
- scalarO2air = o2Factor * airpres ! atmospheric o2 concentration (Pa)
-
- ! determine timeOffset based on tmZoneInfo option number`
- select case(trim(NC_TIME_ZONE))
- ! Time zone information from NetCDF file
- case('ncTime')
- timeOffset = longitude/360._rkind - tmZoneOffsetFracDay ! time offset in days
- ! All times in UTC
- case('utcTime')
- timeOffset = longitude/360._rkind ! time offset in days
- ! All times local
- case('localTime')
- timeOffset = 0._rkind ! time offset in days
- case default; message=trim(message)//'unable to identify option for tmZoneInfo'; err=20; return
- end select ! identifying option tmZoneInfo
-
- ! constrain timeOffset so that it is in the [-0.5, 0.5] range
- if(timeOffset<-0.5)then
- timeOffset = timeOffset+1
- else if(timeOffset>0.5)then
- timeOffset = timeOffset-1
- endif
-
- ! compute the local time
- julianTime = secondsSinceRefTime/secprday + refJulday ! julian time (days)
-
- ! convert julian day to year/month/day/hour/minute
- call compcalday(julianTime+timeOffset, & ! input = julian day
- jyyy,jm,jd,jh,jmin,dsec, & ! output = year, month, day, hour, minute, second
- err,cmessage) ! output = error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the decimal hour at the start of the time step
- dataStep = data_step/secprhour ! time step (hours)
- ahour = real(jh,kind(rkind)) + real(jmin,kind(rkind))/minprhour - data_step/secprhour ! decimal hour (start of the step)
-
- ! check slope/aspect intent for radiation calculation
- if(aspect == nr_realMissing)then
- azimuth = 0._rkind ! if aspect is not an input attribute, slope & azimuth = zero (flat Earth)
- slope = 0._rkind
- else
- azimuth = aspect ! in degrees
- slope = atan(abs(tan_slope))*180._rkind/PI_D ! convert from m/m to degrees
- endif
-
- ! compute the cosine of the solar zenith angle
- call clrsky_rad(jm,jd,ahour,dataStep, & ! intent(in): time variables
- slope,azimuth,latitude, & ! intent(in): location variables
- hri,cosZenith) ! intent(out): cosine of the solar zenith angle
- !write(*,'(a,1x,4(i2,1x),3(f9.3,1x))') 'im,id,ih,imin,ahour,dataStep,cosZenith = ', &
-
- ! ensure solar radiation is non-negative
- if(SWRadAtm < 0._rkind) SWRadAtm = 0._rkind
- ! compute the fraction of direct radiation using the parameterization of Nijssen and Lettenmaier (1999)
- if(cosZenith > 0._rkind)then
- scalarFractionDirect = Frad_direct*cosZenith/(cosZenith + directScale)
- else
- scalarFractionDirect = 0._rkind
- end if
- ! compute direct shortwave radiation, in the visible and near-infra-red part of the spectrum
- spectralIncomingDirect(1) = SWRadAtm*scalarFractionDirect*Frad_vis ! (direct vis)
- spectralIncomingDirect(2) = SWRadAtm*scalarFractionDirect*(1._rkind - Frad_vis) ! (direct nir)
- ! compute diffuse shortwave radiation, in the visible and near-infra-red part of the spectrum
- spectralIncomingDiffuse(1) = SWRadAtm*(1._rkind - scalarFractionDirect)*Frad_vis ! (diffuse vis)
- spectralIncomingDiffuse(2) = SWRadAtm*(1._rkind - scalarFractionDirect)*(1._rkind - Frad_vis) ! (diffuse nir)
-
- ! ensure wind speed is above a prescribed minimum value
- if(windspd < minwind) windspd=minwind
- ! compute relative humidity (-)
- relhum = SPHM2RELHM(spechum, airpres, airtemp)
- ! if relative humidity exceeds saturation, then set relative and specific humidity to saturation
- if(relhum > 1._rkind)then
- relhum = 1._rkind
- spechum = RELHM2SPHM(relhum, airpres, airtemp)
- end if
-
- ! compute vapor pressure of the air above the vegetation canopy (Pa)
- VPair = vapPress(spechum,airpres)
- !print*, 'VPair = ', VPair
-
- ! compute wet bulb temperature (K)
- twetbulb = WETBULBTMP(airtemp, relhum, airpres)
-
- ! compute the maximum temperature of snow when the snow is predominantely frozen (K)
- maxFrozenSnowTemp = templiquid(unfrozenLiq,fc_param)
-
- ! compute fraction of rain and temperature of fresh snow
- Tmin = twetbulb - tempRangeTimestep/2._rkind
- Tmax = twetbulb + tempRangeTimestep/2._rkind
- if(Tmax < tempCritRain)then
- fracrain = 0._rkind
- snowfallTemp = twetbulb
- elseif(Tmin > tempCritRain)then
- fracrain = 1._rkind
- snowfallTemp = maxFrozenSnowTemp
- else
- fracrain = (Tmax - tempCritRain)/(Tmax - Tmin)
- snowfallTemp = 0.5_rkind*(Tmin + maxFrozenSnowTemp)
- end if
-
- ! ensure that snowfall temperature creates predominantely solid precipitation
- snowfallTemp = min(maxFrozenSnowTemp,snowfallTemp) ! snowfall temperature
-
- ! ensure precipitation rate can be resolved by the data model
- if(pptrate<eps)then
- ! set rainfall and snowfall to zero
- rainfall = 0._rkind
- snowfall = 0._rkind
- else
- ! compute rainfall and snowfall
- rainfall = fracrain*pptrate
- snowfall = (1._rkind - fracrain)*pptrate*frozenPrecipMultip
- end if
-
- ! compute density of new snow
- if(snowfall > tiny(fracrain))then
- ! Determine which method to use
- select case(model_decisions(iLookDECISIONS%snowDenNew)%iDecision)
- ! Hedstrom and Pomeroy 1998
- case(hedAnrkindom)
- newSnowDensity = min(pomNewSnowDenMax,newSnowDenMin + newSnowDenMult*exp((airtemp-Tfreeze)/newSnowDenScal)) ! new snow density (kg m-3)
- ! Pahaut 1976 (Boone et al. 2002)
- case(pahaut_76)
- newSnowDensity = max(newSnowDenMin,newSnowDenAdd + (newSnowDenMultTemp * (airtemp-Tfreeze))+(newSnowDenMultWind*((windspd)**pahautDenWindScal))); ! new snow density (kg m-3)
- ! Anderson 1976
- case(anderson)
- if(airtemp>(Tfreeze+andersonWarmDenLimit))then
- newSnowDensity = newSnowDenMin + newSnowDenMultAnd*(newSnowDenBase)**(andersonDenScal) ! new snow density (kg m-3)
- elseif(airtemp<=(Tfreeze-andersonColdDenLimit))then
- newSnowDensity = newSnowDenMin ! new snow density (kg m-3)
- else
- newSnowDensity = newSnowDenMin + newSnowDenMultAnd*(airtemp-Tfreeze+newSnowDenBase)**(andersonDenScal) ! new snow density (kg m-3)
- end if
- ! Constant new snow density
- case(constDens)
- newSnowDensity = constSnowDen ! new snow density (kg m-3)
- case default; message=trim(message)//'unable to identify option for new snow density'; err=20; return
- end select ! identifying option for new snow density
- else
- newSnowDensity = valueMissing
- rainfall = rainfall + snowfall ! in most cases snowfall will be zero here
- snowfall = 0._rkind
- end if
-
- ! end association of local variables with the information in the data structures
- end associate
-
- end subroutine derivforce
-
-
-end module derivforce_module
diff --git a/build/source/engine/mDecisions.f90 b/build/source/engine/mDecisions.f90
deleted file mode 100755
index db481e044b51200545505537f83887cb882717ff..0000000000000000000000000000000000000000
--- a/build/source/engine/mDecisions.f90
+++ /dev/null
@@ -1,753 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module mDecisions_module
-USE, intrinsic :: iso_c_binding
-USE nrtype
-USE var_lookup, only: maxvarDecisions ! maximum number of decisions
-implicit none
-private
-public::mDecisions
-! look-up values for the choice of function for the soil moisture control on stomatal resistance
-integer(i4b),parameter,public :: NoahType = 1 ! thresholded linear function of volumetric liquid water content
-integer(i4b),parameter,public :: CLM_Type = 2 ! thresholded linear function of matric head
-integer(i4b),parameter,public :: SiB_Type = 3 ! exponential of the log of matric head
-! look-up values for the choice of stomatal resistance formulation
-integer(i4b),parameter,public :: BallBerry = 1 ! Ball-Berry
-integer(i4b),parameter,public :: Jarvis = 2 ! Jarvis
-integer(i4b),parameter,public :: simpleResistance = 3 ! simple resistance formulation
-integer(i4b),parameter,public :: BallBerryFlex = 4 ! flexible Ball-Berry scheme
-integer(i4b),parameter,public :: BallBerryTest = 5 ! flexible Ball-Berry scheme (testing)
-! look-up values to define leaf temperature controls on photosynthesis + stomatal resistance
-integer(i4b),parameter,public :: q10Func = 11 ! the q10 function used in CLM4 and Noah-MP
-integer(i4b),parameter,public :: Arrhenius = 12 ! the Arrhenious functions used in CLM5 and Cable
-! look-up values to define humidity controls on stomatal resistance
-integer(i4b),parameter,public :: humidLeafSurface = 21 ! humidity at the leaf surface [Bonan et al., 2011]
-integer(i4b),parameter,public :: scaledHyperbolic = 22 ! scaled hyperbolic function [Leuning et al., 1995]
-! look-up values to define the electron transport function (dependence of photosynthesis on PAR)
-integer(i4b),parameter,public :: linear = 31 ! linear function used in CLM4 and Noah-MP
-integer(i4b),parameter,public :: linearJmax = 32 ! linear jmax function used in Cable [Wang et al., Ag Forest Met 1998, eq D5]
-integer(i4b),parameter,public :: quadraticJmax = 33 ! the quadratic Jmax function, used in SSiB and CLM5
-! look up values to define the use of CO2 compensation point to calculate stomatal resistance
-integer(i4b),parameter,public :: origBWB = 41 ! the original BWB approach
-integer(i4b),parameter,public :: Leuning = 42 ! the Leuning approach
-! look up values to define the iterative numerical solution method used in the Ball-Berry stomatal resistance parameterization
-integer(i4b),parameter,public :: NoahMPsolution = 51 ! the NoahMP solution (and CLM4): fixed point iteration; max 3 iterations
-integer(i4b),parameter,public :: newtonRaphson = 52 ! full Newton-Raphson iterative solution to convergence
-! look up values to define the controls on carbon assimilation
-integer(i4b),parameter,public :: colimitation = 61 ! enable colimitation, as described by Collatz et al. (1991) and Sellers et al. (1996)
-integer(i4b),parameter,public :: minFunc = 62 ! do not enable colimitation: use minimum of the three controls on carbon assimilation
-! look up values to define the scaling of photosynthesis from the leaves to the canopy
-integer(i4b),parameter,public :: constantScaling = 71 ! constant scaling factor
-integer(i4b),parameter,public :: laiScaling = 72 ! exponential function of LAI (Leuning, Plant Cell Env 1995: "Scaling from..." [eq 9])
-! look-up values for the choice of numerical method
-integer(i4b),parameter,public :: iterative = 81 ! iterative
-integer(i4b),parameter,public :: nonIterative = 82 ! non-iterative
-integer(i4b),parameter,public :: iterSurfEnergyBal = 83 ! iterate only on the surface energy balance
-! look-up values for method used to compute derivative
-integer(i4b),parameter,public :: numerical = 91 ! numerical solution
-integer(i4b),parameter,public :: analytical = 92 ! analytical solution
-! look-up values for method used to determine LAI and SAI
-integer(i4b),parameter,public :: monthlyTable = 101 ! LAI/SAI taken directly from a monthly table for different vegetation classes
-integer(i4b),parameter,public :: specified = 102 ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
-! look-up values for the choice of the canopy interception parameterization
-integer(i4b),parameter,public :: sparseCanopy = 111 ! fraction of rainfall that never hits the canopy (throughfall); drainage above threshold
-integer(i4b),parameter,public :: storageFunc = 112 ! throughfall a function of canopy storage; 100% throughfall when canopy is at capacity
-integer(i4b),parameter,public :: unDefined = 113 ! option is undefined (backwards compatibility)
-! look-up values for the form of Richards' equation
-integer(i4b),parameter,public :: moisture = 121 ! moisture-based form of Richards' equation
-integer(i4b),parameter,public :: mixdform = 122 ! mixed form of Richards' equation
-! look-up values for the choice of groundwater parameterization
-integer(i4b),parameter,public :: qbaseTopmodel = 131 ! TOPMODEL-ish baseflow parameterization
-integer(i4b),parameter,public :: bigBucket = 132 ! a big bucket (lumped aquifer model)
-integer(i4b),parameter,public :: noExplicit = 133 ! no explicit groundwater parameterization
-! look-up values for the choice of hydraulic conductivity profile
-integer(i4b),parameter,public :: constant = 141 ! constant hydraulic conductivity with depth
-integer(i4b),parameter,public :: powerLaw_profile = 142 ! power-law profile
-! look-up values for the choice of boundary conditions for thermodynamics
-integer(i4b),parameter,public :: prescribedTemp = 151 ! prescribed temperature
-integer(i4b),parameter,public :: energyFlux = 152 ! energy flux
-integer(i4b),parameter,public :: zeroFlux = 153 ! zero flux
-! look-up values for the choice of boundary conditions for hydrology
-integer(i4b),parameter,public :: liquidFlux = 161 ! liquid water flux
-integer(i4b),parameter,public :: prescribedHead = 162 ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
-integer(i4b),parameter,public :: funcBottomHead = 163 ! function of matric head in the lower-most layer
-integer(i4b),parameter,public :: freeDrainage = 164 ! free drainage
-! look-up values for the choice of parameterization for vegetation roughness length and displacement height
-integer(i4b),parameter,public :: Raupach_BLM1994 = 171 ! Raupach (BLM 1994) "Simplified expressions..."
-integer(i4b),parameter,public :: CM_QJRMS1988 = 172 ! Choudhury and Monteith (QJRMS 1988) "A four layer model for the heat budget..."
-integer(i4b),parameter,public :: vegTypeTable = 173 ! constant parameters dependent on the vegetation type
-! look-up values for the choice of parameterization for the rooting profile
-integer(i4b),parameter,public :: powerLaw = 181 ! simple power-law rooting profile
-integer(i4b),parameter,public :: doubleExp = 182 ! the double exponential function of Xeng et al. (JHM 2001)
-! look-up values for the choice of parameterization for canopy emissivity
-integer(i4b),parameter,public :: simplExp = 191 ! simple exponential function
-integer(i4b),parameter,public :: difTrans = 192 ! parameterized as a function of diffuse transmissivity
-! look-up values for the choice of parameterization for snow interception
-integer(i4b),parameter,public :: stickySnow = 201 ! maximum interception capacity an increasing function of temerature
-integer(i4b),parameter,public :: lightSnow = 202 ! maximum interception capacity an inverse function of new snow density
-! look-up values for the choice of wind profile
-integer(i4b),parameter,public :: exponential = 211 ! exponential wind profile extends to the surface
-integer(i4b),parameter,public :: logBelowCanopy = 212 ! logarithmic profile below the vegetation canopy
-! look-up values for the choice of stability function
-integer(i4b),parameter,public :: standard = 221 ! standard MO similarity, a la Anderson (1976)
-integer(i4b),parameter,public :: louisInversePower = 222 ! Louis (1979) inverse power function
-integer(i4b),parameter,public :: mahrtExponential = 223 ! Mahrt (1987) exponential
-! look-up values for the choice of canopy shortwave radiation method
-integer(i4b),parameter,public :: noah_mp = 231 ! full Noah-MP implementation (including albedo)
-integer(i4b),parameter,public :: CLM_2stream = 232 ! CLM 2-stream model (see CLM documentation)
-integer(i4b),parameter,public :: UEB_2stream = 233 ! UEB 2-stream model (Mahat and Tarboton, WRR 2011)
-integer(i4b),parameter,public :: NL_scatter = 234 ! Simplified method Nijssen and Lettenmaier (JGR 1999)
-integer(i4b),parameter,public :: BeersLaw = 235 ! Beer's Law (as implemented in VIC)
-! look-up values for the choice of albedo representation
-integer(i4b),parameter,public :: constantDecay = 241 ! constant decay (e.g., VIC, CLASS)
-integer(i4b),parameter,public :: variableDecay = 242 ! variable decay (e.g., BATS approach, with destructive metamorphism + soot content)
-! look-up values for the choice of compaction routine
-integer(i4b),parameter,public :: constantSettlement = 251 ! constant settlement rate
-integer(i4b),parameter,public :: andersonEmpirical = 252 ! semi-empirical method of Anderson (1976)
-! look-up values for the choice of method to combine and sub-divide snow layers
-integer(i4b),parameter,public :: sameRulesAllLayers = 261 ! same combination/sub-division rules applied to all layers
-integer(i4b),parameter,public :: rulesDependLayerIndex= 262 ! combination/sub-dividion rules depend on layer index
-! look-up values for the choice of thermal conductivity representation for snow
-integer(i4b),parameter,public :: Yen1965 = 271 ! Yen (1965)
-integer(i4b),parameter,public :: Mellor1977 = 272 ! Mellor (1977)
-integer(i4b),parameter,public :: Jordan1991 = 273 ! Jordan (1991)
-integer(i4b),parameter,public :: Smirnova2000 = 274 ! Smirnova et al. (2000)
-! look-up values for the choice of thermal conductivityi representation for soil
-integer(i4b),parameter,public :: funcSoilWet = 281 ! function of soil wetness
-integer(i4b),parameter,public :: mixConstit = 282 ! mixture of constituents
-integer(i4b),parameter,public :: hanssonVZJ = 283 ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
-! look-up values for the choice of method for the spatial representation of groundwater
-integer(i4b),parameter,public :: localColumn = 291 ! separate groundwater representation in each local soil column
-integer(i4b),parameter,public :: singleBasin = 292 ! single groundwater store over the entire basin
-! look-up values for the choice of sub-grid routing method
-integer(i4b),parameter,public :: timeDelay = 301 ! time-delay histogram
-integer(i4b),parameter,public :: qInstant = 302 ! instantaneous routing
-! look-up values for the choice of new snow density method
-integer(i4b),parameter,public :: constDens = 311 ! Constant new snow density
-integer(i4b),parameter,public :: anderson = 312 ! Anderson 1976
-integer(i4b),parameter,public :: hedAndPom = 313 ! Hedstrom and Pomeroy (1998), expoential increase
-integer(i4b),parameter,public :: pahaut_76 = 314 ! Pahaut 1976, wind speed dependent (derived from Col de Porte, French Alps)
-! look-up values for the choice of snow unloading from the canopy
-integer(i4b),parameter,public :: meltDripUnload = 321 ! Hedstrom and Pomeroy (1998), Storck et al 2002 (snowUnloadingCoeff & ratioDrip2Unloading)
-integer(i4b),parameter,public :: windUnload = 322 ! Roesch et al 2001, formulate unloading based on wind and temperature
-! -----------------------------------------------------------------------------------------------------------
-
-contains
-
- ! ************************************************************************************************
- ! public subroutine mDecisions: save model decisions as named integers
- ! ************************************************************************************************
- subroutine mDecisions(num_steps, err) bind(C, name='mDecisions')
- ! model time structures
- USE multiconst,only:secprday ! number of seconds in a day
- USE var_lookup,only:iLookTIME ! named variables that identify indices in the time structures
- USE globalData,only:refTime,refJulday ! reference time
- USE globalData,only:oldTime ! time from the previous time step
- USE globalData,only:startTime,finshTime ! start/end time of simulation
- USE globalData,only:dJulianStart ! julian day of start time of simulation
- USE globalData,only:dJulianFinsh ! julian day of end time of simulation
- USE globalData,only:data_step ! length of data step (s)
- USE globalData,only:numtim ! number of time steps in the simulation
- ! model decision structures
- USE globaldata,only:model_decisions ! model decision structure
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- ! forcing metadata
- USE globalData,only:forc_meta ! metadata structures
- USE var_lookup,only:iLookFORCE ! named variables to define structure elements
- ! Noah-MP decision structures
- USE noahmp_globals,only:DVEG ! decision for dynamic vegetation
- USE noahmp_globals,only:OPT_RAD ! decision for canopy radiation
- USE noahmp_globals,only:OPT_ALB ! decision for snow albedo
- ! time utility programs
- USE time_utils_module,only:extractTime ! extract time info from units string
- USE time_utils_module,only:compjulday ! compute the julian day
- USE time_utils_module,only:fracDay ! compute fractional day
- USE summaFileManager,only: SIM_START_TM, SIM_END_TM ! time info from control file module
-
- implicit none
- ! define output
- integer(c_int),intent(out) :: num_steps
- integer(c_int),intent(out) :: err ! error code
- ! define local variables
- character(len=256) :: message ! error message
- character(len=256) :: cmessage ! error message for downwind routine
- real(rkind) :: dsec,dsec_tz ! second
- ! initialize error control
- err=0; message='mDecisions/'
-
- ! -------------------------------------------------------------------------------------------------
- ! -------------------------------------------------------------------------------------------------
-
- ! read information from model decisions file, and populate model decisions structure
- call readoption(err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! -------------------------------------------------------------------------------------------------
-
- ! put reference time information into the time structures
- call extractTime(forc_meta(iLookFORCE%time)%varunit, & ! date-time string
- refTime%var(iLookTIME%iyyy), & ! year
- refTime%var(iLookTIME%im), & ! month
- refTime%var(iLookTIME%id), & ! day
- refTime%var(iLookTIME%ih), & ! hour
- refTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- refTime%var(iLookTIME%ih_tz), & ! time zone hour
- refTime%var(iLookTIME%imin_tz), & ! time zone minute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the reference time
- call compjulday(&
- refTime%var(iLookTIME%iyyy), & ! year
- refTime%var(iLookTIME%im), & ! month
- refTime%var(iLookTIME%id), & ! day
- refTime%var(iLookTIME%ih), & ! hour
- refTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- refJulday, & ! julian date for the start of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! put simulation start time information into the time structures
- call extractTime(trim(SIM_START_TM), & ! date-time string
- startTime%var(iLookTIME%iyyy), & ! year
- startTime%var(iLookTIME%im), & ! month
- startTime%var(iLookTIME%id), & ! day
- startTime%var(iLookTIME%ih), & ! hour
- startTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- startTime%var(iLookTIME%ih_tz), & ! time zone hour
- startTime%var(iLookTIME%imin_tz), & ! time zone minnute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the start of the simulation
- call compjulday(&
- startTime%var(iLookTIME%iyyy), & ! year
- startTime%var(iLookTIME%im), & ! month
- startTime%var(iLookTIME%id), & ! day
- startTime%var(iLookTIME%ih), & ! hour
- startTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- dJulianStart, & ! julian date for the start of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! put simulation end time information into the time structures
- call extractTime(trim(SIM_END_TM), & ! date-time string
- finshTime%var(iLookTIME%iyyy), & ! year
- finshTime%var(iLookTIME%im), & ! month
- finshTime%var(iLookTIME%id), & ! day
- finshTime%var(iLookTIME%ih), & ! hour
- finshTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- finshTime%var(iLookTIME%ih_tz), & ! time zone hour
- finshTime%var(iLookTIME%imin_tz), & ! time zone minnute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the end of the simulation
- call compjulday(&
- finshTime%var(iLookTIME%iyyy), & ! year
- finshTime%var(iLookTIME%im), & ! month
- finshTime%var(iLookTIME%id), & ! day
- finshTime%var(iLookTIME%ih), & ! hour
- finshTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- dJulianFinsh, & ! julian date for the end of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! check start and finish time
- write(*,'(a,i4,1x,4(i2,1x))') 'startTime: iyyy, im, id, ih, imin = ', startTime%var(1:5)
- write(*,'(a,i4,1x,4(i2,1x))') 'finshTime: iyyy, im, id, ih, imin = ', finshTime%var(1:5)
-
- ! check that simulation end time is > start time
- if(dJulianFinsh < dJulianStart)then; err=20; message=trim(message)//'end time of simulation occurs before start time'; return; end if
-
- ! initialize the old time vector (time from the previous time step)
- oldTime%var(:) = startTime%var(:)
-
- ! compute the number of time steps
- numtim = nint( (dJulianFinsh - dJulianStart)*secprday/data_step ) + 1
- num_steps = numtim
-
- ! -------------------------------------------------------------------------------------------------
-
- ! set Noah-MP options
- DVEG=3 ! option for dynamic vegetation
- OPT_RAD=3 ! option for canopy radiation
- OPT_ALB=2 ! option for snow albedo
-
- ! set zero option for thee category tables
- ! NOTE: we want to keep track of these decisions, but not used in the physics routines
- model_decisions(iLookDECISIONS%soilCatTbl)%iDecision = 0
- model_decisions(iLookDECISIONS%vegeParTbl)%iDecision = 0
-
- ! identify the choice of function for the soil moisture control on stomatal resistance
- select case(trim(model_decisions(iLookDECISIONS%soilStress)%cDecision))
- case('NoahType'); model_decisions(iLookDECISIONS%soilStress)%iDecision = NoahType ! thresholded linear function of volumetric liquid water content
- case('CLM_Type'); model_decisions(iLookDECISIONS%soilStress)%iDecision = CLM_Type ! thresholded linear function of matric head
- case('SiB_Type'); model_decisions(iLookDECISIONS%soilStress)%iDecision = SiB_Type ! exponential of the log of matric head
- case default
- err=10; message=trim(message)//"unknown soil moisture function [option="//trim(model_decisions(iLookDECISIONS%soilStress)%cDecision)//"]"; return
- end select
-
- ! identify the choice of function for stomatal resistance
- select case(trim(model_decisions(iLookDECISIONS%stomResist)%cDecision))
- case('BallBerry' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerry ! Ball-Berry
- case('Jarvis' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = Jarvis ! Jarvis
- case('simpleResistance' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = simpleResistance ! simple resistance formulation
- case('BallBerryFlex' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerryFlex ! flexible Ball-Berry scheme
- case('BallBerryTest' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerryTest ! flexible Ball-Berry scheme (testing)
- case default
- err=10; message=trim(message)//"unknown stomatal resistance function [option="//trim(model_decisions(iLookDECISIONS%stomResist)%cDecision)//"]"; return
- end select
-
- ! identify the leaf temperature controls on photosynthesis + stomatal resistance
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbTempFunc)%cDecision))
- case('q10Func' ); model_decisions(iLookDECISIONS%bbTempFunc)%iDecision = q10Func
- case('Arrhenius' ); model_decisions(iLookDECISIONS%bbTempFunc)%iDecision = Arrhenius
- case default
- err=10; message=trim(message)//"unknown leaf temperature function [option="//trim(model_decisions(iLookDECISIONS%bbTempFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the humidity controls on stomatal resistance
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbHumdFunc)%cDecision))
- case('humidLeafSurface' ); model_decisions(iLookDECISIONS%bbHumdFunc)%iDecision = humidLeafSurface
- case('scaledHyperbolic' ); model_decisions(iLookDECISIONS%bbHumdFunc)%iDecision = scaledHyperbolic
- case default
- err=10; message=trim(message)//"unknown humidity function [option="//trim(model_decisions(iLookDECISIONS%bbHumdFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify functions for electron transport function (dependence of photosynthesis on PAR)
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbElecFunc)%cDecision))
- case('linear' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = linear
- case('linearJmax' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = linearJmax
- case('quadraticJmax' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = quadraticJmax
- case default
- err=10; message=trim(message)//"unknown electron transport function [option="//trim(model_decisions(iLookDECISIONS%bbElecFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the use of the co2 compensation point in the stomatal conductance calaculations
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbCO2point)%cDecision))
- case('origBWB' ); model_decisions(iLookDECISIONS%bbCO2point)%iDecision = origBWB
- case('Leuning' ); model_decisions(iLookDECISIONS%bbCO2point)%iDecision = Leuning
- case default
- err=10; message=trim(message)//"unknown option for the co2 compensation point [option="//trim(model_decisions(iLookDECISIONS%bbCO2point)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the iterative numerical solution method used in the Ball-Berry stomatal resistance parameterization
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbNumerics)%cDecision))
- case('NoahMPsolution' ); model_decisions(iLookDECISIONS%bbNumerics)%iDecision = NoahMPsolution ! the NoahMP solution (and CLM4): fixed point iteration; max 3 iterations
- case('newtonRaphson' ); model_decisions(iLookDECISIONS%bbNumerics)%iDecision = newtonRaphson ! full Newton-Raphson iterative solution to convergence
- case default
- err=10; message=trim(message)//"unknown option for the Ball-Berry numerical solution [option="//trim(model_decisions(iLookDECISIONS%bbNumerics)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the controls on carbon assimilation
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbAssimFnc)%cDecision))
- case('colimitation' ); model_decisions(iLookDECISIONS%bbAssimFnc)%iDecision = colimitation ! enable colimitation, as described by Collatz et al. (1991) and Sellers et al. (1996)
- case('minFunc' ); model_decisions(iLookDECISIONS%bbAssimFnc)%iDecision = minFunc ! do not enable colimitation: use minimum of the three controls on carbon assimilation
- case default
- err=10; message=trim(message)//"unknown option for the controls on carbon assimilation [option="//trim(model_decisions(iLookDECISIONS%bbAssimFnc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the scaling of photosynthesis from the leaf to the canopy
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbCanIntg8)%cDecision))
- case('constantScaling' ); model_decisions(iLookDECISIONS%bbCanIntg8)%iDecision = constantScaling ! constant scaling factor
- case('laiScaling' ); model_decisions(iLookDECISIONS%bbCanIntg8)%iDecision = laiScaling ! exponential function of LAI (Leuning, Plant Cell Env 1995: "Scaling from..." [eq 9])
- case default
- err=10; message=trim(message)//"unknown option for scaling of photosynthesis from the leaf to the canopy [option="//trim(model_decisions(iLookDECISIONS%bbCanIntg8)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the numerical method
- select case(trim(model_decisions(iLookDECISIONS%num_method)%cDecision))
- case('itertive'); model_decisions(iLookDECISIONS%num_method)%iDecision = iterative ! iterative
- case('non_iter'); model_decisions(iLookDECISIONS%num_method)%iDecision = nonIterative ! non-iterative
- case('itersurf'); model_decisions(iLookDECISIONS%num_method)%iDecision = iterSurfEnergyBal ! iterate only on the surface energy balance
- case default
- err=10; message=trim(message)//"unknown numerical method [option="//trim(model_decisions(iLookDECISIONS%num_method)%cDecision)//"]"; return
- end select
-
- ! identify the method used to calculate flux derivatives
- select case(trim(model_decisions(iLookDECISIONS%fDerivMeth)%cDecision))
- case('numericl'); model_decisions(iLookDECISIONS%fDerivMeth)%iDecision = numerical ! numerical
- case('analytic'); model_decisions(iLookDECISIONS%fDerivMeth)%iDecision = analytical ! analytical
- case default
- err=10; message=trim(message)//"unknown method used to calculate flux derivatives [option="//trim(model_decisions(iLookDECISIONS%fDerivMeth)%cDecision)//"]"; return
- end select
-
- ! identify the method used to determine LAI and SAI
- select case(trim(model_decisions(iLookDECISIONS%LAI_method)%cDecision))
- case('monTable'); model_decisions(iLookDECISIONS%LAI_method)%iDecision = monthlyTable ! LAI/SAI taken directly from a monthly table for different vegetation classes
- case('specified'); model_decisions(iLookDECISIONS%LAI_method)%iDecision = specified ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
- case default
- err=10; message=trim(message)//"unknown method to determine LAI and SAI [option="//trim(model_decisions(iLookDECISIONS%LAI_method)%cDecision)//"]"; return
- end select
-
- ! identify the canopy interception parameterization
- select case(trim(model_decisions(iLookDECISIONS%cIntercept)%cDecision))
- case('notPopulatedYet'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = unDefined
- case('sparseCanopy'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = sparseCanopy
- case('storageFunc'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = storageFunc
- case default
- err=10; message=trim(message)//"unknown canopy interception parameterization [option="//trim(model_decisions(iLookDECISIONS%cIntercept)%cDecision)//"]"; return
- end select
-
- ! identify the form of Richards' equation
- select case(trim(model_decisions(iLookDECISIONS%f_Richards)%cDecision))
- case('moisture'); model_decisions(iLookDECISIONS%f_Richards)%iDecision = moisture ! moisture-based form
- case('mixdform'); model_decisions(iLookDECISIONS%f_Richards)%iDecision = mixdform ! mixed form
- case default
- err=10; message=trim(message)//"unknown form of Richards' equation [option="//trim(model_decisions(iLookDECISIONS%f_Richards)%cDecision)//"]"; return
- end select
-
- ! identify the groundwater parameterization
- select case(trim(model_decisions(iLookDECISIONS%groundwatr)%cDecision))
- case('qTopmodl'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = qbaseTopmodel ! TOPMODEL-ish baseflow parameterization
- case('bigBuckt'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = bigBucket ! a big bucket (lumped aquifer model)
- case('noXplict'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = noExplicit ! no explicit groundwater parameterization
- case default
- err=10; message=trim(message)//"unknown groundwater parameterization [option="//trim(model_decisions(iLookDECISIONS%groundwatr)%cDecision)//"]"; return
- end select
-
- ! identify the hydraulic conductivity profile
- select case(trim(model_decisions(iLookDECISIONS%hc_profile)%cDecision))
- case('constant'); model_decisions(iLookDECISIONS%hc_profile)%iDecision = constant ! constant hydraulic conductivity with depth
- case('pow_prof'); model_decisions(iLookDECISIONS%hc_profile)%iDecision = powerLaw_profile ! power-law profile
- case default
- err=10; message=trim(message)//"unknown hydraulic conductivity profile [option="//trim(model_decisions(iLookDECISIONS%hc_profile)%cDecision)//"]"; return
- end select
-
- ! identify the upper boundary conditions for thermodynamics
- select case(trim(model_decisions(iLookDECISIONS%bcUpprTdyn)%cDecision))
- case('presTemp'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = prescribedTemp ! prescribed temperature
- case('nrg_flux'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = energyFlux ! energy flux
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown upper boundary conditions for thermodynamics [option="//trim(model_decisions(iLookDECISIONS%bcUpprTdyn)%cDecision)//"]"; return
- end select
-
- ! identify the lower boundary conditions for thermodynamics
- select case(trim(model_decisions(iLookDECISIONS%bcLowrTdyn)%cDecision))
- case('presTemp'); model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision = prescribedTemp ! prescribed temperature
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown lower boundary conditions for thermodynamics [option="//trim(model_decisions(iLookDECISIONS%bcLowrTdyn)%cDecision)//"]"; return
- end select
-
- ! identify the upper boundary conditions for soil hydrology
- select case(trim(model_decisions(iLookDECISIONS%bcUpprSoiH)%cDecision))
- case('presHead'); model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision = prescribedHead ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- case('liq_flux'); model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision = liquidFlux ! liquid water flux
- case default
- err=10; message=trim(message)//"unknown upper boundary conditions for soil hydrology [option="//trim(model_decisions(iLookDECISIONS%bcUpprSoiH)%cDecision)//"]"; return
- end select
-
- ! identify the lower boundary conditions for soil hydrology
- select case(trim(model_decisions(iLookDECISIONS%bcLowrSoiH)%cDecision))
- case('presHead'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = prescribedHead ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- case('bottmPsi'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = funcBottomHead ! function of matric head in the lower-most layer
- case('drainage'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = freeDrainage ! free drainage
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown lower boundary conditions for soil hydrology [option="//trim(model_decisions(iLookDECISIONS%bcLowrSoiH)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for vegetation roughness length and displacement height
- select case(trim(model_decisions(iLookDECISIONS%veg_traits)%cDecision))
- case('Raupach_BLM1994'); model_decisions(iLookDECISIONS%veg_traits)%iDecision = Raupach_BLM1994 ! Raupach (BLM 1994) "Simplified expressions..."
- case('CM_QJRMS1988' ); model_decisions(iLookDECISIONS%veg_traits)%iDecision = CM_QJRMS1988 ! Choudhury and Monteith (QJRMS 1998) "A four layer model for the heat budget..."
- case('vegTypeTable' ); model_decisions(iLookDECISIONS%veg_traits)%iDecision = vegTypeTable ! constant parameters dependent on the vegetation type
- case default
- err=10; message=trim(message)//"unknown parameterization for vegetation roughness length and displacement height [option="//trim(model_decisions(iLookDECISIONS%veg_traits)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for the rooting profile
- ! NOTE: for backwards compatibility select powerLaw if rooting profile is undefined
- select case(trim(model_decisions(iLookDECISIONS%rootProfil)%cDecision))
- case('powerLaw','notPopulatedYet'); model_decisions(iLookDECISIONS%rootProfil)%iDecision = powerLaw ! simple power-law rooting profile
- case('doubleExp'); model_decisions(iLookDECISIONS%rootProfil)%iDecision = doubleExp ! the double exponential function of Xeng et al. (JHM 2001)
- case default
- err=10; message=trim(message)//"unknown parameterization for rooting profile [option="//trim(model_decisions(iLookDECISIONS%rootProfil)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for canopy emissivity
- select case(trim(model_decisions(iLookDECISIONS%canopyEmis)%cDecision))
- case('simplExp'); model_decisions(iLookDECISIONS%canopyEmis)%iDecision = simplExp ! simple exponential function
- case('difTrans'); model_decisions(iLookDECISIONS%canopyEmis)%iDecision = difTrans ! parameterized as a function of diffuse transmissivity
- case default
- err=10; message=trim(message)//"unknown parameterization for canopy emissivity [option="//trim(model_decisions(iLookDECISIONS%canopyEmis)%cDecision)//"]"; return
- end select
-
- ! choice of parameterization for snow interception
- select case(trim(model_decisions(iLookDECISIONS%snowIncept)%cDecision))
- case('stickySnow'); model_decisions(iLookDECISIONS%snowIncept)%iDecision = stickySnow ! maximum interception capacity an increasing function of temerature
- case('lightSnow' ); model_decisions(iLookDECISIONS%snowIncept)%iDecision = lightSnow ! maximum interception capacity an inverse function of new snow density
- case default
- err=10; message=trim(message)//"unknown option for snow interception capacity[option="//trim(model_decisions(iLookDECISIONS%snowIncept)%cDecision)//"]"; return
- end select
-
- ! identify the choice of wind profile
- select case(trim(model_decisions(iLookDECISIONS%windPrfile)%cDecision))
- case('exponential' ); model_decisions(iLookDECISIONS%windPrfile)%iDecision = exponential ! exponential wind profile extends to the surface
- case('logBelowCanopy'); model_decisions(iLookDECISIONS%windPrfile)%iDecision = logBelowCanopy ! logarithmic profile below the vegetation canopy
- case default
- err=10; message=trim(message)//"unknown option for choice of wind profile[option="//trim(model_decisions(iLookDECISIONS%windPrfile)%cDecision)//"]"; return
- end select
-
- ! identify the choice of atmospheric stability function
- select case(trim(model_decisions(iLookDECISIONS%astability)%cDecision))
- case('standard'); model_decisions(iLookDECISIONS%astability)%iDecision = standard ! standard MO similarity, a la Anderson (1976)
- case('louisinv'); model_decisions(iLookDECISIONS%astability)%iDecision = louisInversePower ! Louis (1979) inverse power function
- case('mahrtexp'); model_decisions(iLookDECISIONS%astability)%iDecision = mahrtExponential ! Mahrt (1987) exponential
- case default
- err=10; message=trim(message)//"unknown stability function [option="//trim(model_decisions(iLookDECISIONS%astability)%cDecision)//"]"; return
- end select
-
- ! choice of canopy shortwave radiation method
- select case(trim(model_decisions(iLookDECISIONS%canopySrad)%cDecision))
- case('noah_mp' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = noah_mp ! full Noah-MP implementation (including albedo)
- case('CLM_2stream'); model_decisions(iLookDECISIONS%canopySrad)%iDecision = CLM_2stream ! CLM 2-stream model (see CLM documentation)
- case('UEB_2stream'); model_decisions(iLookDECISIONS%canopySrad)%iDecision = UEB_2stream ! UEB 2-stream model (Mahat and Tarboton, WRR 2011)
- case('NL_scatter' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = NL_scatter ! Simplified method Nijssen and Lettenmaier (JGR 1999)
- case('BeersLaw' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = BeersLaw ! Beer's Law (as implemented in VIC)
- case default
- err=10; message=trim(message)//"unknown canopy radiation method [option="//trim(model_decisions(iLookDECISIONS%canopySrad)%cDecision)//"]"; return
- end select
-
- ! choice of albedo representation
- select case(trim(model_decisions(iLookDECISIONS%alb_method)%cDecision))
- case('conDecay'); model_decisions(iLookDECISIONS%alb_method)%iDecision = constantDecay ! constant decay (e.g., VIC, CLASS)
- case('varDecay'); model_decisions(iLookDECISIONS%alb_method)%iDecision = variableDecay ! variable decay (e.g., BATS approach, with destructive metamorphism + soot content)
- case default
- err=10; message=trim(message)//"unknown option for snow albedo [option="//trim(model_decisions(iLookDECISIONS%alb_method)%cDecision)//"]"; return
- end select
-
- ! choice of snow compaction routine
- select case(trim(model_decisions(iLookDECISIONS%compaction)%cDecision))
- case('consettl'); model_decisions(iLookDECISIONS%compaction)%iDecision = constantSettlement ! constant settlement rate
- case('anderson'); model_decisions(iLookDECISIONS%compaction)%iDecision = andersonEmpirical ! semi-empirical method of Anderson (1976)
- case default
- err=10; message=trim(message)//"unknown option for snow compaction [option="//trim(model_decisions(iLookDECISIONS%compaction)%cDecision)//"]"; return
- end select
-
- ! choice of method to combine and sub-divide snow layers
- select case(trim(model_decisions(iLookDECISIONS%snowLayers)%cDecision))
- case('jrdn1991'); model_decisions(iLookDECISIONS%snowLayers)%iDecision = sameRulesAllLayers ! SNTHERM option: same combination/sub-dividion rules applied to all layers
- case('CLM_2010'); model_decisions(iLookDECISIONS%snowLayers)%iDecision = rulesDependLayerIndex ! CLM option: combination/sub-dividion rules depend on layer index
- case default
- err=10; message=trim(message)//"unknown option for combination/sub-division of snow layers [option="//trim(model_decisions(iLookDECISIONS%snowLayers)%cDecision)//"]"; return
- end select
-
- ! choice of thermal conductivity representation for snow
- select case(trim(model_decisions(iLookDECISIONS%thCondSnow)%cDecision))
- case('tyen1965'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Yen1965 ! Yen (1965)
- case('melr1977'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Mellor1977 ! Mellor (1977)
- case('jrdn1991'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Jordan1991 ! Jordan (1991)
- case('smnv2000'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Smirnova2000 ! Smirnova et al. (2000)
- case default
- err=10; message=trim(message)//"unknown option for thermal conductivity of snow [option="//trim(model_decisions(iLookDECISIONS%thCondSnow)%cDecision)//"]"; return
- end select
-
- ! choice of thermal conductivity representation for soil
- select case(trim(model_decisions(iLookDECISIONS%thCondSoil)%cDecision))
- case('funcSoilWet'); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = funcSoilWet ! function of soil wetness
- case('mixConstit' ); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = mixConstit ! mixture of constituents
- case('hanssonVZJ' ); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = hanssonVZJ ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
- case default
- err=10; message=trim(message)//"unknown option for thermal conductivity of soil [option="//trim(model_decisions(iLookDECISIONS%thCondSoil)%cDecision)//"]"; return
- end select
-
- ! choice of method for the spatial representation of groundwater
- select case(trim(model_decisions(iLookDECISIONS%spatial_gw)%cDecision))
- case('localColumn'); model_decisions(iLookDECISIONS%spatial_gw)%iDecision = localColumn ! separate groundwater in each local soil column
- case('singleBasin'); model_decisions(iLookDECISIONS%spatial_gw)%iDecision = singleBasin ! single groundwater store over the entire basin
- case default
- err=10; message=trim(message)//"unknown option for spatial representation of groundwater [option="//trim(model_decisions(iLookDECISIONS%spatial_gw)%cDecision)//"]"; return
- end select
-
- ! choice of routing method
- select case(trim(model_decisions(iLookDECISIONS%subRouting)%cDecision))
- case('timeDlay'); model_decisions(iLookDECISIONS%subRouting)%iDecision = timeDelay ! time-delay histogram
- case('qInstant'); model_decisions(iLookDECISIONS%subRouting)%iDecision = qInstant ! instantaneous routing
- case default
- err=10; message=trim(message)//"unknown option for sub-grid routing [option="//trim(model_decisions(iLookDECISIONS%subRouting)%cDecision)//"]"; return
- end select
-
- ! choice of new snow density
- ! NOTE: use hedAndPom as the default, where density method is undefined (not populated yet)
- select case(trim(model_decisions(iLookDECISIONS%snowDenNew)%cDecision))
- case('hedAndPom','notPopulatedYet'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = hedAndPom ! Hedstrom and Pomeroy (1998), expoential increase
- case('anderson'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = anderson ! Anderson 1976
- case('pahaut_76'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = pahaut_76 ! Pahaut 1976, wind speed dependent (derived from Col de Porte, French Alps)
- case('constDens'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = constDens ! Constant new snow density
- case default
- err=10; message=trim(message)//"unknown option for new snow density [option="//trim(model_decisions(iLookDECISIONS%snowDenNew)%cDecision)//"]"; return
- end select
-
- ! choice of snow unloading from canopy
- select case(trim(model_decisions(iLookDECISIONS%snowUnload)%cDecision))
- case('meltDripUnload','notPopulatedYet'); model_decisions(iLookDECISIONS%snowUnload)%iDecision = meltDripUnload ! Hedstrom and Pomeroy (1998), Storck et al 2002 (snowUnloadingCoeff & ratioDrip2Unloading)
- case('windUnload'); model_decisions(iLookDECISIONS%snowUnload)%iDecision = windUnload ! Roesch et al 2001, formulate unloading based on wind and temperature
- case default
- err=10; message=trim(message)//"unknown option for snow unloading [option="//trim(model_decisions(iLookDECISIONS%snowUnload)%cDecision)//"]"; return
- end select
-
-
- ! -----------------------------------------------------------------------------------------------------------------------------------------------
- ! check for consistency among options
- ! -----------------------------------------------------------------------------------------------------------------------------------------------
-
- ! check there is prescribedHead for soil hydrology when zeroFlux or prescribedTemp for thermodynamics
- !select case(model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision)
- ! case(prescribedTemp,zeroFlux)
- ! if(model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision /= prescribedHead)then
- ! message=trim(message)//'upper boundary condition for soil hydology must be presHead with presTemp and zeroFlux options for thermodynamics'
- ! err=20; return
- ! end if
- !end select
-
- ! check there is prescribedTemp or zeroFlux for thermodynamics when using prescribedHead for soil hydrology
- !select case(model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision)
- ! case(prescribedHead)
- ! ! check that upper boundary condition for thermodynamics is presTemp or zeroFlux
- ! select case(model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision)
- ! case(prescribedTemp,zeroFlux) ! do nothing: this is OK
- ! case default
- ! message=trim(message)//'upper boundary condition for thermodynamics must be presTemp or zeroFlux with presHead option for soil hydology'
- ! err=20; return
- ! end select
- !end select
-
- ! check zero flux lower boundary for topmodel baseflow option
- select case(model_decisions(iLookDECISIONS%groundwatr)%iDecision)
- case(qbaseTopmodel)
- if(model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision /= zeroFlux)then
- message=trim(message)//'lower boundary condition for soil hydology must be zeroFlux with qbaseTopmodel option for groundwater'
- err=20; return
- end if
- end select
-
- ! check power-law profile is selected when using topmodel baseflow option
- select case(model_decisions(iLookDECISIONS%groundwatr)%iDecision)
- case(qbaseTopmodel)
- if(model_decisions(iLookDECISIONS%hc_profile)%iDecision /= powerLaw_profile)then
- message=trim(message)//'power-law transmissivity profile must be selected when using topmodel baseflow option'
- err=20; return
- end if
- end select
-
- ! check bigBucket groundwater option is used when for spatial groundwater is singleBasin
- if(model_decisions(iLookDECISIONS%spatial_gw)%iDecision == singleBasin)then
- if(model_decisions(iLookDECISIONS%groundwatr)%iDecision /= bigBucket)then
- message=trim(message)//'groundwater parameterization must be bigBucket when using singleBasin for spatial_gw'
- err=20; return
- end if
- end if
-
- ! ensure that the LAI seaonality option is switched off (this was a silly idea, in retrospect)
- !if(model_decisions(iLookDECISIONS%LAI_method)%iDecision == specified)then
- ! message=trim(message)//'parameterization of LAI in terms of seasonal cycle of green veg fraction was a silly idea '&
- ! //' -- the LAI_method option ["specified"] is no longer supported'
- ! err=20; return
- !end if
-
- end subroutine mDecisions
-
-
- ! ************************************************************************************************
- ! private subroutine readoption: read information from model decisions file
- ! ************************************************************************************************
- subroutine readoption(err,message)
- ! used to read information from model decisions file
- USE ascii_util_module,only:file_open ! open file
- USE ascii_util_module,only:linewidth ! max character number for one line
- USE ascii_util_module,only:get_vlines ! get a vector of non-comment lines
- USE summaFileManager,only:SETTINGS_PATH ! path for metadata files
- USE summaFileManager,only:M_DECISIONS ! definition of modeling options
- USE get_ixname_module,only:get_ixdecisions ! identify index of named variable
- USE globalData,only:model_decisions ! model decision structure
- implicit none
- ! define output
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! define local variables
- character(len=256) :: cmessage ! error message for downwind routine
- character(LEN=256) :: infile ! input filename
- integer(i4b) :: unt ! file unit (free unit output from file_open)
- character(LEN=linewidth),allocatable :: charline(:) ! vector of character strings
- integer(i4b) :: nDecisions ! number of model decisions
- integer(i4b) :: iDecision ! index of model decisions
- character(len=32) :: decision ! name of model decision
- character(len=32) :: option ! option for model decision
- integer(i4b) :: iVar ! index of the decision in the data structure
- ! Start procedure here
- err=0; message='readoption/'
- ! build filename
- infile = trim(SETTINGS_PATH)//trim(M_DECISIONS)
- write(*,'(2(a,1x))') 'decisions file = ', trim(infile)
- ! open file
- call file_open(trim(infile),unt,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! get a list of character strings from non-comment lines
- call get_vlines(unt,charline,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! close the file unit
- close(unt)
- ! get the number of model decisions
- nDecisions = size(charline)
- ! populate the model decisions structure
- do iDecision=1,nDecisions
- ! extract name of decision and the decision selected
- read(charline(iDecision),*,iostat=err) option, decision
- if (err/=0) then; err=30; message=trim(message)//"errorReadLine"; return; end if
- ! get the index of the decision in the data structure
- iVar = get_ixdecisions(trim(option))
- write(*,'(i4,1x,a)') iDecision, trim(option)//': '//trim(decision)
- if(iVar<=0)then; err=40; message=trim(message)//"cannotFindDecisionIndex[name='"//trim(option)//"']"; return; end if
- ! populate the model decisions structure
- model_decisions(iVar)%cOption = trim(option)
- model_decisions(iVar)%cDecision = trim(decision)
- end do
- end subroutine readoption
-
-
-end module mDecisions_module
diff --git a/build/source/engine/run_oneHRU.f90 b/build/source/engine/run_oneHRU.f90
deleted file mode 100644
index 8b0fc3ce0f541f15516f3cd4f592795f6c40962e..0000000000000000000000000000000000000000
--- a/build/source/engine/run_oneHRU.f90
+++ /dev/null
@@ -1,245 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module run_oneHRU_module
-
-! numerical recipes data types
-USE nrtype
-
-! data types
-USE data_types,only:&
- var_i, & ! x%var(:) (i4b)
- var_d, & ! x%var(:) (rkind)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (rkind)
- zLookup ! x%z(:)%var(:)%lookup(:) (rkind)
-
-! access vegetation data
-USE globalData,only:greenVegFrac_monthly ! fraction of green vegetation in each month (0-1)
-USE globalData,only:overwriteRSMIN ! flag to overwrite RSMIN
-USE globalData,only:maxSoilLayers ! Maximum Number of Soil Layers
-
-! provide access to Noah-MP constants
-USE module_sf_noahmplsm,only:isWater ! parameter for water land cover type
-
-! provide access to the named variables that describe elements of parameter structures
-USE var_lookup,only:iLookTYPE ! look-up values for classification of veg, soils etc.
-USE var_lookup,only:iLookATTR ! look-up values for local attributes
-USE var_lookup,only:iLookPARAM ! look-up values for local column model parameters
-
-! provide access to the named variables that describe elements of variable structures
-USE var_lookup,only:iLookPROG ! look-up values for local column model prognostic (state) variables
-USE var_lookup,only:iLookDIAG ! look-up values for local column model diagnostic variables
-USE var_lookup,only:iLookINDEX ! look-up values for local column index variables
-
-! provide access to model decisions
-USE globalData,only:model_decisions ! model decision structure
-USE var_lookup,only:iLookDECISIONS ! look-up values for model decisions
-
-! these are needed because we cannot access them in modules locally if we might use those modules with Actors
-USE globalData,only:fracJulday ! fractional julian days since the start of year
-USE globalData,only:yearLength ! number of days in the current year
-USE globalData,only:tmZoneOffsetFracDay ! time zone offset in fractional days
-
-! provide access to the named variables that describe model decisions
-USE mDecisions_module,only: & ! look-up values for LAI decisions
- monthlyTable,& ! LAI/SAI taken directly from a monthly table for different vegetation classes
- specified ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
-
-! ----- global variables that are modified ------------------------------------------------------------------------------------------
-
-! Noah-MP parameters
-USE NOAHMP_VEG_PARAMETERS,only:SAIM,LAIM ! 2-d tables for stem area index and leaf area index (vegType,month)
-USE NOAHMP_VEG_PARAMETERS,only:HVT,HVB ! height at the top and bottom of vegetation (vegType)
-USE noahmp_globals,only:RSMIN ! minimum stomatal resistance (vegType)
-
-! urban vegetation category (could be local)
-USE globalData,only:urbanVegCategory ! vegetation category for urban areas
-
-implicit none
-private
-public::run_oneHRU
-
-contains
-
- ! ************************************************************************************************
- ! public subroutine run_oneGRU: simulation for a single GRU
- ! ************************************************************************************************
-
- ! simulation for a single HRU
- subroutine run_oneHRU(&
- ! model control
- hru_nc, & ! intent(in): hru index in netcdf
- hruId, & ! intent(in): hruId
- dt_init, & ! intent(inout): used to initialize the length of the sub-step for each HRU
- computeVegFlux, & ! intent(inout): flag to indicate if we are computing fluxes over vegetation (false=no, true=yes)
- nSnow,nSoil,nLayers, & ! intent(inout): number of snow and soil layers
- ! data structures (input)
- timeVec, & ! intent(in): model time data
- typeData, & ! intent(in): local classification of soil veg etc. for each HRU
- attrData, & ! intent(in): local attributes for each HRU
- lookupData, & ! intent(in): local lookup tables for each HRU
- bvarData, & ! intent(in): basin-average variables
- ! data structures (input-output)
- mparData, & ! intent(inout): local model parameters
- indxData, & ! intent(inout): model indices
- forcData, & ! intent(inout): model forcing data
- progData, & ! intent(inout): prognostic variables for a local HRU
- diagData, & ! intent(inout): diagnostic variables for a local HRU
- fluxData, & ! intent(inout): model fluxes for a local HRU
- ! error control
- err,message) ! intent(out): error control
-
- ! ----- define downstream subroutines -----------------------------------------------------------------------------------
-
- USE module_sf_noahmplsm,only:redprm ! module to assign more Noah-MP parameters
- USE derivforce_module,only:derivforce ! module to compute derived forcing data
- USE coupled_em_module,only:coupled_em ! module to run the coupled energy and mass model
- implicit none
-
- ! ----- define dummy variables ------------------------------------------------------------------------------------------
-
- ! model control
- integer(i4b) , intent(in) :: hru_nc ! hru index in netcdf
- integer(8) , intent(in) :: hruId ! hruId
- real(rkind) , intent(inout) :: dt_init ! used to initialize the length of the sub-step for each HRU
- logical(lgt) , intent(inout) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (false=no, true=yes)
- integer(i4b) , intent(inout) :: nSnow,nSoil,nLayers ! number of snow and soil layers
- ! data structures (input)
- integer(i4b) , intent(in) :: timeVec(:) ! int vector -- model time data
- type(var_i) , intent(in) :: typeData ! x%var(:) -- local classification of soil veg etc. for each HRU
- type(var_d) , intent(in) :: attrData ! x%var(:) -- local attributes for each HRU
- type(zLookup) , intent(in) :: lookupData ! x%z(:)%var(:)%lookup(:) -- local lookup tables for each HRU
- type(var_dlength) , intent(in) :: bvarData ! x%var(:)%dat -- basin-average variables
- ! data structures (input-output)
- type(var_dlength) , intent(inout) :: mparData ! x%var(:)%dat -- local (HRU) model parameters
- type(var_ilength) , intent(inout) :: indxData ! x%var(:)%dat -- model indices
- type(var_d) , intent(inout) :: forcData ! x%var(:) -- model forcing data
- type(var_dlength) , intent(inout) :: progData ! x%var(:)%dat -- model prognostic (state) variables
- type(var_dlength) , intent(inout) :: diagData ! x%var(:)%dat -- model diagnostic variables
- type(var_dlength) , intent(inout) :: fluxData ! x%var(:)%dat -- model fluxes
- ! error control
- integer(i4b) , intent(out) :: err ! error code
- character(*) , intent(out) :: message ! error message
-
- ! ----- define local variables ------------------------------------------------------------------------------------------
-
- ! local variables
- character(len=256) :: cmessage ! error message
- real(rkind) , allocatable :: zSoilReverseSign(:) ! height at bottom of each soil layer, negative downwards (m)
-
- ! initialize error control
- err=0; write(message, '(A21,I0,A10,I0,A2)' ) 'run_oneHRU (hru nc = ',hru_nc -1 ,', hruId = ',hruId,')/' !netcdf index starts with 0 if want to subset
-
- ! ----- hru initialization ---------------------------------------------------------------------------------------------
-
- ! water pixel: do nothing
- if (typeData%var(iLookTYPE%vegTypeIndex) == isWater) return
-
- ! get height at bottom of each soil layer, negative downwards (used in Noah MP)
- allocate(zSoilReverseSign(nSoil),stat=err)
- if(err/=0)then
- message=trim(message)//'problem allocating space for zSoilReverseSign'
- err=20; return
- endif
- zSoilReverseSign(:) = -progData%var(iLookPROG%iLayerHeight)%dat(nSnow+1:nLayers)
-
- ! populate parameters in Noah-MP modules
- ! Passing a maxSoilLayer in order to pass the check for NROOT, that is done to avoid making any changes to Noah-MP code.
- ! --> NROOT from Noah-MP veg tables (as read here) is not used in SUMMA
- call REDPRM(typeData%var(iLookTYPE%vegTypeIndex), & ! vegetation type index
- typeData%var(iLookTYPE%soilTypeIndex), & ! soil type
- typeData%var(iLookTYPE%slopeTypeIndex), & ! slope type index
- zSoilReverseSign, & ! * not used: height at bottom of each layer [NOTE: negative] (m)
- maxSoilLayers, & ! number of soil layers
- urbanVegCategory) ! vegetation category for urban areas
-
- ! deallocate height at bottom of each soil layer(used in Noah MP)
- deallocate(zSoilReverseSign,stat=err)
- if(err/=0)then
- message=trim(message)//'problem deallocating space for zSoilReverseSign'
- err=20; return
- endif
-
- ! overwrite the minimum resistance
- if(overwriteRSMIN) RSMIN = mparData%var(iLookPARAM%minStomatalResistance)%dat(1)
-
- ! overwrite the vegetation height
- HVT(typeData%var(iLookTYPE%vegTypeIndex)) = mparData%var(iLookPARAM%heightCanopyTop)%dat(1)
- HVB(typeData%var(iLookTYPE%vegTypeIndex)) = mparData%var(iLookPARAM%heightCanopyBottom)%dat(1)
-
- ! overwrite the tables for LAI and SAI
- if(model_decisions(iLookDECISIONS%LAI_method)%iDecision == specified)then
- SAIM(typeData%var(iLookTYPE%vegTypeIndex),:) = mparData%var(iLookPARAM%winterSAI)%dat(1)
- LAIM(typeData%var(iLookTYPE%vegTypeIndex),:) = mparData%var(iLookPARAM%summerLAI)%dat(1)*greenVegFrac_monthly
- end if
-
- ! ----- hru forcing ----------------------------------------------------------------------------------------------------
-
- ! compute derived forcing variables
- call derivforce(timeVec, & ! vector of time information
- forcData%var, & ! vector of model forcing data
- attrData%var, & ! vector of model attributes
- mparData, & ! data structure of model parameters
- progData, & ! data structure of model prognostic variables
- diagData, & ! data structure of model diagnostic variables
- fluxData, & ! data structure of model fluxes
- tmZoneOffsetFracDay & ! time zone offset in fractional days
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! ----- run the model --------------------------------------------------------------------------------------------------
-
- ! initialize the number of flux calls
- diagData%var(iLookDIAG%numFluxCalls)%dat(1) = 0._rkind
-
- ! run the model for a single HRU
- call coupled_em(&
- ! model control
- hruId, & ! intent(in): hruId
- dt_init, & ! intent(inout): initial time step
- 1._rkind, & ! intent(in): used to adjust the length of the timestep with failure in Actors (non-Actors here, always 1)
- computeVegFlux, & ! intent(inout): flag to indicate if we are computing fluxes over vegetation
- ! data structures (input)
- typeData, & ! intent(in): local classification of soil veg etc. for each HRU
- attrData, & ! intent(in): local attributes for each HRU
- forcData, & ! intent(in): model forcing data
- mparData, & ! intent(in): model parameters
- bvarData, & ! intent(in): basin-average model variables
- lookupData, & ! intent(in): lookup tables
- ! data structures (input-output)
- indxData, & ! intent(inout): model indices
- progData, & ! intent(inout): model prognostic variables for a local HRU
- diagData, & ! intent(inout): model diagnostic variables for a local HRU
- fluxData, & ! intent(inout): model fluxes for a local HRU
- fracJulDay, & ! intent(in): fractional julian days since the start of year
- yearLength, & ! intent(in): number of days in the current year
- ! error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! update the number of layers
- nSnow = indxData%var(iLookINDEX%nSnow)%dat(1) ! number of snow layers
- nSoil = indxData%var(iLookINDEX%nSoil)%dat(1) ! number of soil layers
- nLayers = indxData%var(iLookINDEX%nLayers)%dat(1) ! total number of layers
-
- end subroutine run_oneHRU
-
-end module run_oneHRU_module
diff --git a/build/source/engine/sundials/coupled_em.f90 b/build/source/engine/sundials/coupled_em.f90
deleted file mode 100644
index dcaaff1947a20d2c594a34710b87e103c7ab1b14..0000000000000000000000000000000000000000
--- a/build/source/engine/sundials/coupled_em.f90
+++ /dev/null
@@ -1,1424 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module coupled_em_module
-
-! numerical recipes data types
-USE nrtype
-
-! physical constants
-USE multiconst,only:&
- Tfreeze, & ! temperature at freezing (K)
- LH_fus, & ! latent heat of fusion (J kg-1)
- LH_sub, & ! latent heat of sublimation (J kg-1)
- iden_ice, & ! intrinsic density of ice (kg m-3)
- iden_water ! intrinsic density of liquid water (kg m-3)
-
-! data types
-USE data_types,only:&
- var_i, & ! x%var(:) (i4b)
- var_d, & ! x%var(:) (rkind)
- var_ilength, & ! x%var(:)%dat (i4b)
- var_dlength, & ! x%var(:)%dat (rkind)
- zLookup ! x%z(:)%var(:)%lookup(:) (rkind)
-
-! named variables for parent structures
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-USE var_lookup,only:iLookPROG ! named variables for structure elements
-USE var_lookup,only:iLookDIAG ! named variables for structure elements
-USE var_lookup,only:iLookFLUX ! named variables for structure elements
-USE var_lookup,only:iLookPARAM ! named variables for structure elements
-USE var_lookup,only:iLookINDEX ! named variables for structure elements
-USE globalData,only:iname_snow ! named variables for snow
-USE globalData,only:iname_soil ! named variables for soil
-
-! named variables for child structures
-USE var_lookup,only:childFLUX_MEAN
-
-! metadata
-USE globalData,only:flux_meta ! metadata on the model fluxes
-USE globalData,only:indx_meta ! metadata on the model index variables
-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:averageFlux_meta ! metadata on the timestep-average model flux structure
-
-! global data
-USE globalData,only:data_step ! time step of forcing data (s)
-USE globalData,only:model_decisions ! model decision structure
-USE globalData,only:globalPrintFlag ! the global print flag
-
-! look-up values for the maximum interception capacity
-USE mDecisions_module,only: &
- stickySnow, & ! maximum interception capacity an increasing function of temerature
- lightSnow ! maximum interception capacity an inverse function of new snow density
-
-! look-up values for the 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 spatial representation of groundwater
-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 numerical method
-USE mDecisions_module,only: &
- sundials ,& ! SUNDIALS/IDA solution
- bEuler ! home-grown backward Euler solution with long time step
-
-! privacy
-implicit none
-private
-public::coupled_em
-! algorithmic parameters
-real(rkind),parameter :: valueMissing=-9999._rkind ! missing value, used when diagnostic or state variables are undefined
-real(rkind),parameter :: verySmall=1.e-6_rkind ! used as an additive constant to check if substantial difference among real numbers
-real(rkind),parameter :: mpe=1.e-6_rkind ! prevents overflow error if division by zero
-real(rkind),parameter :: dx=1.e-6_rkind ! finite difference increment
-contains
-
-
-! ************************************************************************************************
-! public subroutine coupled_em: run the coupled energy-mass model for one timestep
-! ************************************************************************************************
-subroutine coupled_em(&
- ! model control
- hruId, & ! intent(in): hruId
- dt_init, & ! intent(inout): used to initialize the size of the sub-step
- dt_init_factor, & ! intent(in): Used to adjust the length of the timestep in the event of a failure
- computeVegFlux, & ! intent(inout): flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! data structures (input)
- type_data, & ! intent(in): local classification of soil veg etc. for each HRU
- attr_data, & ! intent(in): local attributes for each HRU
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- bvar_data, & ! intent(in): basin-average variables
- lookup_data, & ! intent(in): lookup tables
- ! data structures (input-output)
- indx_data, & ! intent(inout): model indices
- prog_data, & ! intent(inout): prognostic variables for a local HRU
- diag_data, & ! intent(inout): diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- fracJulDay, & ! intent(in): fractional julian days since the start of year
- yearLength, & ! intent(in): number of days in the current year
- ! error control
- err,message) ! intent(out): error control
- ! structure allocations
- USE allocspace_module,only:allocLocal ! allocate local data structures
- USE allocspace_module,only:resizeData ! clone a data structure
- ! simulation of fluxes and residuals given a trial state vector
- USE soil_utils_module,only:liquidHead ! compute the liquid water matric potential
- ! 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)
- USE snowAlbedo_module,only:snowAlbedo ! compute snow albedo
- USE vegSWavRad_module,only:vegSWavRad ! compute canopy sw radiation fluxes
- USE canopySnow_module,only:canopySnow ! compute interception and unloading of snow from the vegetation canopy
- USE volicePack_module,only:newsnwfall ! compute change in the top snow layer due to throughfall and unloading
- USE volicePack_module,only:volicePack ! merge and sub-divide snow layers, if necessary
- USE diagn_evar_module,only:diagn_evar ! compute diagnostic energy variables -- thermal conductivity and heat capacity
- ! the model solver
- USE indexState_module,only:indexState ! define indices for all model state variables and layers
- USE opSplittin_module,only:opSplittin ! solve the system of thermodynamic and hydrology equations for a given substep
- USE time_utils_module,only:elapsedSec ! calculate the elapsed time
- ! additional subroutines
- USE tempAdjust_module,only:tempAdjust ! adjust snow temperature associated with new snowfall
- USE var_derive_module,only:calcHeight ! module to calculate height at layer interfaces and layer mid-point
- USE computSnowDepth_module,only:computSnowDepth
-
- implicit none
- ! model control
-#ifdef ACTORS_ACTIVE
- integer(4),intent(in) :: hruId ! hruId
-#else
- integer(8),intent(in) :: hruId ! hruId
-#endif
- real(rkind),intent(inout) :: dt_init ! used to initialize the size of the sub-step
- integer(i4b),intent(in) :: dt_init_factor ! Used to adjust the length of the timestep in the event of a failure
- logical(lgt),intent(inout) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- ! data structures (input)
- 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_dlength),intent(in) :: bvar_data ! basin-average model variables
- type(zLookup),intent(in) :: lookup_data ! lookup tables
- ! data structures (input-output)
- type(var_ilength),intent(inout) :: indx_data ! state vector geometry
- 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
- real(rkind),intent(inout) :: fracJulday
- integer(i4b),intent(inout) :: yearLength
- ! error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! =====================================================================================================================================================
- ! =====================================================================================================================================================
- ! local variables
- character(len=256) :: cmessage ! error message
- integer(i4b) :: nSnow ! number of snow layers
- integer(i4b) :: nSoil ! number of soil layers
- integer(i4b) :: nLayers ! total number of layers
- integer(i4b) :: nState ! total number of state variables
- real(rkind) :: dtSave ! length of last input model whole sub-step (seconds)
- real(rkind) :: dt_sub ! length of model sub-step (seconds)
- real(rkind) :: dt_wght ! weight applied to model sub-step (dt_sub/data_step)
- real(rkind) :: dt_solv ! seconds in the data step that have been completed
- real(rkind) :: dtMultiplier ! time step multiplier (-) based on what happenned in "opSplittin"
- real(rkind) :: minstep,maxstep ! minimum and maximum time step length (seconds)
- real(rkind) :: maxstep_op ! maximum time step length (seconds) to run opSplittin over
- real(rkind) :: whole_step ! step the surface pond drainage and sublimation calculated over
- integer(i4b) :: nsub ! number of substeps
- logical(lgt) :: computeVegFluxOld ! flag to indicate if we are computing fluxes over vegetation on the previous sub step
- logical(lgt) :: includeAquifer ! flag to denote that an aquifer is included
- logical(lgt) :: modifiedLayers ! flag to denote that snow layers were modified
- logical(lgt) :: modifiedVegState ! flag to denote that vegetation states were modified
- integer(i4b) :: nLayersRoots ! number of soil layers that contain roots
- real(rkind) :: exposedVAI ! exposed vegetation area index
- real(rkind) :: dCanopyWetFraction_dWat ! derivative in wetted fraction w.r.t. canopy total water (kg-1 m2)
- real(rkind) :: dCanopyWetFraction_dT ! derivative in wetted fraction w.r.t. canopy temperature (K-1)
- real(rkind),parameter :: varNotUsed1=-9999._rkind ! variables used to calculate derivatives (not needed here)
- real(rkind),parameter :: varNotUsed2=-9999._rkind ! variables used to calculate derivatives (not needed here)
- integer(i4b) :: iSnow ! index of snow layers
- integer(i4b) :: iLayer ! index of model layers
- real(rkind) :: massLiquid ! mass liquid water (kg m-2)
- 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) :: ixSolution ! solution method used by opSplittin
- logical(lgt) :: firstSubStep ! flag to denote if the first time step
- logical(lgt) :: stepFailure ! flag to denote the need to reduce length of the coupled step and try again
- logical(lgt) :: tooMuchMelt ! flag to denote that there was too much melt in a given time step
- logical(lgt) :: tooMuchSublim ! flag to denote that there was too much sublimation in a given time step
- logical(lgt) :: doLayerMerge ! flag to denote the need to merge snow layers
- logical(lgt) :: pauseFlag ! flag to pause execution
- logical(lgt),parameter :: backwardsCompatibility=.true. ! flag to denote a desire to ensure backwards compatibility with previous branches
- logical(lgt) :: checkMassBalance ! flag to check the mass balance
- type(var_ilength) :: indx_temp ! temporary model index variables saved only on outer loop
- type(var_ilength) :: indx_temp0 ! temporary model index variables saved every time
- type(var_dlength) :: prog_temp ! temporary model prognostic variables
- type(var_dlength) :: diag_temp ! temporary model diagnostic variables
- real(rkind),allocatable :: mLayerVolFracIceInit(:)! initial vector for volumetric fraction of ice (-)
- ! check SWE
- real(rkind) :: oldSWE ! SWE at the start of the substep
- real(rkind) :: newSWE ! SWE at the end of the substep
- real(rkind) :: delSWE ! change in SWE over the subtep
- real(rkind) :: innerEffRainfall ! inner step average effective rainfall into snow (kg m-2 s-1)
- real(rkind) :: effRainfall ! timestep-average effective rainfall into snow (kg m-2 s-1)
- real(rkind) :: effSnowfall ! effective snowfall (kg m-2 s-1)
- real(rkind) :: sfcMeltPond ! surface melt pond (kg m-2)
- real(rkind) :: massBalance ! mass balance error (kg m-2)
- ! energy fluxes
- integer(i4b) :: iSoil ! index of soil layers
- type(var_dlength) :: flux_mean ! timestep-average model fluxes for a local HRU
- type(var_dlength) :: flux_inner ! inner step average model fluxes for a local HRU
- real(rkind) :: meanSoilCompress ! timestep-average soil compression
- real(rkind) :: innerSoilCompress ! inner step average soil compression
- ! sublimation sums over substep and means over data_step
- real(rkind) :: sumCanopySublimation ! sum of sublimation from the vegetation canopy (kg m-2 s-1) over substep
- real(rkind) :: sumSnowSublimation ! sum of sublimation from the snow surface (kg m-2 s-1) over substep
- real(rkind) :: sumLatHeatCanopyEvap ! sum of latent heat flux for evaporation from the canopy to the canopy air space (W m-2) over substep
- real(rkind) :: sumSenHeatCanopy ! sum of sensible heat flux from the canopy to the canopy air space (W m-2) over substep
- real(rkind) :: meanCanopySublimation ! timestep-average sublimation from the vegetation canopy (kg m-2 s-1)
- real(rkind) :: meanLatHeatCanopyEvap ! timestep-average latent heat flux for evaporation from the canopy to the canopy air space (W m-2)
- real(rkind) :: meanSenHeatCanopy ! timestep-average sensible heat flux from the canopy to the canopy air space (W m-2)
- ! balance checks
- integer(i4b) :: iVar ! loop through model variables
- real(rkind) :: balanceSoilCompress ! total soil compression (kg m-2)
- real(rkind) :: scalarCanopyWatBalError! water balance error for the vegetation canopy (kg m-2)
- real(rkind) :: scalarSoilWatBalError ! water balance error (kg m-2)
- real(rkind) :: scalarInitCanopyLiq ! initial liquid water on the vegetation canopy (kg m-2)
- real(rkind) :: scalarInitCanopyIce ! initial ice on the vegetation canopy (kg m-2)
- real(rkind) :: balanceCanopyWater0 ! total water stored in the vegetation canopy at the start of the step (kg m-2)
- real(rkind) :: balanceCanopyWater1 ! total water stored in the vegetation canopy at the end of the step (kg m-2)
- real(rkind) :: balanceSoilWater0 ! total soil storage at the start of the step (kg m-2)
- real(rkind) :: balanceSoilWater1 ! total soil storage at the end of the step (kg m-2)
- real(rkind) :: balanceSoilInflux ! input to the soil zone
- real(rkind) :: balanceSoilBaseflow ! output from the soil zone
- real(rkind) :: balanceSoilDrainage ! output from the soil zone
- real(rkind) :: balanceSoilET ! output from the soil zone
- real(rkind) :: balanceAquifer0 ! total aquifer storage at the start of the step (kg m-2)
- real(rkind) :: balanceAquifer1 ! total aquifer storage at the end of the step (kg m-2)
- ! test balance checks
- logical(lgt), parameter :: printBalance=.false. ! flag to print the balance checks
- real(rkind), allocatable :: liqSnowInit(:) ! volumetric liquid water conetnt of snow at the start of the time step
- real(rkind), allocatable :: liqSoilInit(:) ! soil moisture at the start of the time step
- ! timing information
- real(rkind) :: startTime ! start time (used to compute wall clock time)
- real(rkind) :: endTime ! end time (used to compute wall clock time)
- ! outer loop control
- logical(lgt) :: firstInnerStep ! flag to denote if the first time step in maxstep subStep
- logical(lgt) :: lastInnerStep ! flag to denote if the last time step in maxstep subStep
- logical(lgt) :: do_outer ! flag to denote if doing the outer steps surrounding the call to opSplittin
- real(rkind) :: dt_solvInner ! seconds in the maxstep subStep that have been completed
-
- ! ----------------------------------------------------------------------------------------------------------------------------------------------
- ! initialize error control
- err=0; message="coupled_em/"
-
- ! This is the start of a data step for a local HRU
-
- ! get the start time
- call cpu_time(startTime)
-
- ! check that the decision is supported
- if(model_decisions(iLookDECISIONS%groundwatr)%iDecision==bigBucket .and. &
- model_decisions(iLookDECISIONS%spatial_gw)%iDecision/=localColumn)then
- message=trim(message)//'expect "spatial_gw" decision to equal localColumn when "groundwatr" decision is bigBucket'
- err=20; return
- endif
-
- ! check if the aquifer is included
- includeAquifer = (model_decisions(iLookDECISIONS%groundwatr)%iDecision==bigBucket)
-
- ! initialize the numerix tracking variables
- indx_data%var(iLookINDEX%numberFluxCalc )%dat(1) = 0 ! number of flux calculations (-)
- indx_data%var(iLookINDEX%numberStateSplit )%dat(1) = 0 ! number of state splitting solutions (-)
- indx_data%var(iLookINDEX%numberDomainSplitNrg )%dat(1) = 0 ! number of domain splitting solutions for energy (-)
- indx_data%var(iLookINDEX%numberDomainSplitMass)%dat(1) = 0 ! number of domain splitting solutions for mass (-)
- indx_data%var(iLookINDEX%numberScalarSolutions)%dat(1) = 0 ! number of scalar solutions (-)
-
- ! link canopy depth to the information in the data structure
- canopy: associate(canopyDepth => diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1) ) ! intent(out): [dp] canopy depth (m)
-
- ! start by NOT pausing
- pauseFlag=.false.
-
- ! start by assuming that the step is successful
- stepFailure = .false.
- doLayerMerge = .false.
-
- ! initialize flags to modify the veg layers or modify snow layers
- modifiedLayers = .false. ! flag to denote that snow layers were modified
- modifiedVegState = .false. ! flag to denote that vegetation states were modified
-
- ! define the first step and first and last inner steps
- firstSubStep = .true.
- firstInnerStep = .true.
- lastInnerStep = .false.
-
- ! count the number of snow and soil layers
- ! NOTE: need to re-compute the number of snow and soil layers at the start of each sub-step because the number of layers may change
- ! (nSnow and nSoil are shared in the data structure)
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
-
- ! compute the total number of snow and soil layers
- nLayers = nSnow + nSoil
-
- ! create temporary data structures for prognostic variables
- call resizeData(prog_meta(:),prog_data,prog_temp,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! create temporary data structures for diagnostic variables
- call resizeData(diag_meta(:),diag_data,diag_temp,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! create temporary data structures for index variables
- call resizeData(indx_meta(:),indx_data,indx_temp,err=err,message=cmessage)
- call resizeData(indx_meta(:),indx_data,indx_temp0,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! allocate space for the local fluxes
- call allocLocal(averageFlux_meta(:)%var_info,flux_mean,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
- call allocLocal(averageFlux_meta(:)%var_info,flux_inner,nSnow,nSoil,err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! initialize surface melt pond
- sfcMeltPond = 0._rkind ! change in storage associated with the surface melt pond (kg m-2)
-
- ! initialize fluxes to average over data_step (averaged over substep in varSubStep)
- do iVar=1,size(averageFlux_meta)
- flux_mean%var(iVar)%dat(:) = 0._rkind
- end do
- meanSoilCompress = 0._rkind ! mean total soil compression
- meanCanopySublimation = 0._rkind ! mean canopy sublimation
- meanLatHeatCanopyEvap = 0._rkind ! mean latent heat flux for evaporation from the canopy
- meanSenHeatCanopy = 0._rkind ! mean sensible heat flux from the canopy
- effRainfall = 0._rkind ! mean total effective rainfall over snow
-
-
- ! associate local variables with information in the data structures
- associate(&
- ! state variables in the vegetation canopy
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1) ,& ! canopy liquid water (kg m-2)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! canopy ice content (kg m-2)
- ! state variables in the soil domain
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1:nLayers) ,& ! depth of each soil layer (m)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat(nSnow+1:nLayers) ,& ! volumetric ice content in each soil layer (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(nSnow+1:nLayers) ,& ! volumetric liquid water content in each soil layer (-)
- scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! aquifer storage (m)
- scalarTotalSoilIce => diag_data%var(iLookDIAG%scalarTotalSoilIce)%dat(1) ,& ! total ice in the soil column (kg m-2)
- scalarTotalSoilLiq => diag_data%var(iLookDIAG%scalarTotalSoilLiq)%dat(1) ,& ! total liquid water in the soil column (kg m-2)
- scalarTotalSoilWat => diag_data%var(iLookDIAG%scalarTotalSoilWat)%dat(1) & ! total water in the soil column (kg m-2)
- ) ! (association of local variables with information in the data structures
-
- ! save the liquid water and ice on the vegetation canopy
- scalarInitCanopyLiq = scalarCanopyLiq ! initial liquid water on the vegetation canopy (kg m-2)
- scalarInitCanopyIce = scalarCanopyIce ! initial ice on the vegetation canopy (kg m-2)
-
- ! compute total soil moisture and ice at the *START* of the step (kg m-2)
- scalarTotalSoilLiq = sum(iden_water*mLayerVolFracLiq(1:nSoil)*mLayerDepth(1:nSoil))
- scalarTotalSoilIce = sum(iden_water*mLayerVolFracIce(1:nSoil)*mLayerDepth(1:nSoil)) ! NOTE: no expansion and hence use iden_water
-
- ! compute storage of water in the canopy and the soil
- balanceCanopyWater0 = scalarCanopyLiq + scalarCanopyIce
- balanceSoilWater0 = scalarTotalSoilLiq + scalarTotalSoilIce
-
- ! get the total aquifer storage at the start of the time step (kg m-2)
- balanceAquifer0 = scalarAquiferStorage*iden_water
-
- ! save liquid water content
- if(printBalance)then
- allocate(liqSnowInit(nSnow), liqSoilInit(nSoil), stat=err)
- if(err/=0)then
- message=trim(message)//'unable to allocate space for the initial vectors'
- err=20; return
- endif
- if(nSnow>0) liqSnowInit = prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)
- liqSoilInit = mLayerVolFracLiq
- endif
-
- ! end association of local variables with information in the data structures
- end associate
-
- ! short-cut to the algorithmic control parameters
- ! NOTE - temporary assignment of minstep to foce something reasonable
- ! change maxstep with hard code here to make the outer and inner loop computations here in coupled_em happen more frequently
- ! change maxstep_op with hard code here to make the inner loop computations in opSplittin happen more frequently
- minstep = 10._rkind ! mpar_data%var(iLookPARAM%minstep)%dat(1) ! minimum time step (s)
- maxstep = mpar_data%var(iLookPARAM%maxstep)%dat(1) ! maximum time step (s)
- maxstep_op = mpar_data%var(iLookPARAM%maxstep)%dat(1) ! maximum time step (s) to run opSplittin over
-
- ! compute the number of layers with roots
- nLayersRoots = count(prog_data%var(iLookPROG%iLayerHeight)%dat(nSnow:nLayers-1) < mpar_data%var(iLookPARAM%rootingDepth)%dat(1)-verySmall)
- if(nLayersRoots == 0)then
- message=trim(message)//'no roots within the soil profile'
- err=20; return
- end if
-
- ! define the foliage nitrogen factor
- diag_data%var(iLookDIAG%scalarFoliageNitrogenFactor)%dat(1) = 1._rkind ! foliage nitrogen concentration (1.0 = saturated)
-
- ! save SWE
- oldSWE = prog_data%var(iLookPROG%scalarSWE)%dat(1)
-
- ! *** compute phenology...
- ! ------------------------
-
- ! compute the temperature of the root zone: used in vegetation phenology
- diag_data%var(iLookDIAG%scalarRootZoneTemp)%dat(1) = sum(prog_data%var(iLookPROG%mLayerTemp)%dat(nSnow+1:nSnow+nLayersRoots)) / real(nLayersRoots, kind(rkind))
-
- ! remember if we compute the vegetation flux on the previous sub-step
- computeVegFluxOld = computeVegFlux
-
- ! compute the exposed LAI and SAI and whether veg is buried by snow
- call vegPhenlgy(&
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- ! output
- computeVegFlux, & ! intent(out): flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- canopyDepth, & ! intent(out): canopy depth (m)
- exposedVAI, & ! intent(out): exposed vegetation area index (m2 m-2)
- fracJulDay, & ! fractional julian days since the start of year
- yearLength, & ! number of days in the current year
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! check
- if(computeVegFlux)then
- if(canopyDepth < epsilon(canopyDepth))then
- message=trim(message)//'canopy depth is zero when computeVegFlux flag is .true.'
- err=20; return
- endif
- endif
-
- ! flag the case where number of vegetation states has changed
- modifiedVegState = (computeVegFlux.neqv.computeVegFluxOld)
-
- ! *** compute wetted canopy area...
- ! ---------------------------------
-
- ! compute maximum canopy liquid water (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1) = mpar_data%var(iLookPARAM%refInterceptCapRain)%dat(1)*exposedVAI
-
- ! compute maximum canopy ice content (kg m-2)
- ! NOTE 1: this is used to compute the snow fraction on the canopy, as used in *BOTH* the radiation AND canopy sublimation routines
- ! NOTE 2: this is a different variable than the max ice used in the throughfall (snow interception) calculations
- ! NOTE 3: use maximum per unit leaf area storage capacity for snow (kg m-2)
- select case(model_decisions(iLookDECISIONS%snowIncept)%iDecision)
- case(lightSnow); diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1) = exposedVAI*mpar_data%var(iLookPARAM%refInterceptCapSnow)%dat(1)
- case(stickySnow); diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1) = exposedVAI*mpar_data%var(iLookPARAM%refInterceptCapSnow)%dat(1)*4._rkind
- case default; message=trim(message)//'unable to identify option for maximum branch interception capacity'; err=20; return
- end select ! identifying option for maximum branch interception capacity
-
- ! compute wetted fraction of the canopy
- ! NOTE: assume that the wetted fraction is constant over the substep for the radiation calculations
- if(computeVegFlux)then
-
- ! compute wetted fraction of the canopy
- call wettedFrac(&
- ! input
- .false., & ! flag to denote if derivatives are required
- .false., & ! flag to denote if derivatives are calculated numerically
- (prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1) < Tfreeze), & ! flag to denote if the canopy is frozen
- varNotUsed1, & ! derivative in canopy liquid w.r.t. canopy temperature (kg m-2 K-1)
- varNotUsed2, & ! fraction of liquid water on the canopy
- prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1), & ! canopy liquid water (kg m-2)
- prog_data%var(iLookPROG%scalarCanopyIce)%dat(1), & ! canopy ice (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyLiqMax)%dat(1), & ! maximum canopy liquid water (kg m-2)
- diag_data%var(iLookDIAG%scalarCanopyIceMax)%dat(1), & ! maximum canopy ice content (kg m-2)
- mpar_data%var(iLookPARAM%canopyWettingFactor)%dat(1), & ! maximum wetted fraction of the canopy (-)
- mpar_data%var(iLookPARAM%canopyWettingExp)%dat(1), & ! exponent in canopy wetting function (-)
- ! output
- diag_data%var(iLookDIAG%scalarCanopyWetFraction)%dat(1), & ! canopy wetted fraction (-)
- dCanopyWetFraction_dWat, & ! derivative in wetted fraction w.r.t. canopy liquid water content (kg-1 m2)
- dCanopyWetFraction_dT, & ! derivative in wetted fraction w.r.t. canopy liquid water content (kg-1 m2)
- err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- ! vegetation is completely buried by snow (or no veg exists at all)
- else
- diag_data%var(iLookDIAG%scalarCanopyWetFraction)%dat(1) = 0._rkind
- dCanopyWetFraction_dWat = 0._rkind
- dCanopyWetFraction_dT = 0._rkind
- end if
-
- ! *** compute snow albedo...
- ! --------------------------
- ! NOTE: this should be done before the radiation calculations
- ! NOTE: uses snowfall; should really use canopy throughfall + canopy unloading
- call snowAlbedo(&
- ! input: model control
- data_step, & ! intent(in): model time step (s)
- (nSnow > 0), & ! intent(in): logical flag to denote if snow is present
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- mpar_data, & ! intent(in): model parameters
- flux_data, & ! intent(in): model flux variables
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
-
- ! *** compute canopy sw radiation fluxes...
- ! -----------------------------------------
- call vegSWavRad(&
- data_step, & ! intent(in): time step (s) -- only used in Noah-MP radiation, to compute albedo
- nSnow, & ! intent(in): number of snow layers
- nSoil, & ! intent(in): number of soil layers
- nLayers, & ! intent(in): total number of layers
- computeVegFlux, & ! intent(in): logical flag to compute vegetation fluxes (.false. if veg buried by snow)
- type_data, & ! intent(in): type of vegetation and soil
- 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 flux variables
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
-
- ! *** compute canopy throughfall and unloading...
- ! -----------------------------------------------
- ! NOTE 1: this needs to be done before solving the energy and liquid water equations, to account for the heat advected with precipitation (and throughfall/unloading)
- ! NOTE 2: the unloading flux is computed using canopy drip (scalarCanopyLiqDrainage) from the previous time step
- ! this changes canopy ice
- call canopySnow(&
- ! input: model control
- data_step, & ! intent(in): time step (seconds)
- exposedVAI, & ! intent(in): exposed vegetation area index (m2 m-2)
- computeVegFlux, & ! intent(in): flag to denote if computing energy flux over vegetation
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- forc_data, & ! intent(in): model forcing data
- mpar_data, & ! intent(in): model parameters
- diag_data, & ! intent(in): model diagnostic variables for a local HRU
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- flux_data, & ! intent(inout): model flux variables
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! adjust canopy temperature to account for new snow
- if(computeVegFlux)then ! logical flag to compute vegetation fluxes (.false. if veg buried by snow)
- call tempAdjust(&
- ! input: derived parameters
- canopyDepth, & ! intent(in): canopy depth (m)
- ! input/output: data structures
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(out): model diagnostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
- endif ! if computing fluxes over vegetation
-
- ! initialize drainage and throughfall
- ! NOTE 1: this needs to be done before solving the energy and liquid water equations, to account for the heat advected with precipitation
- ! NOTE 2: this initialization needs to be done AFTER the call to canopySnow, since canopySnow uses canopy drip drom the previous time step
- if(.not.computeVegFlux)then
- flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) = flux_data%var(iLookFLUX%scalarRainfall)%dat(1)
- flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) = 0._rkind
- else
- flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) = 0._rkind
- flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) = 0._rkind
- end if
-
- ! ****************************************************************************************************
- ! *** MAIN SOLVER ************************************************************************************
- ! ****************************************************************************************************
-
- ! initialize the length of the sub-step and counters
- whole_step = maxstep
- dt_solv = 0._rkind ! length of time step that has been completed (s)
- dt_solvInner = 0._rkind ! length of time step that has been completed (s) in whole_step subStep
- dt_init = min(data_step,whole_step,maxstep_op) / dt_init_factor ! initial substep length (s)
- dt_sub = dt_init
- dtSave = whole_step ! length of whole substep
-
- ! initialize the number of sub-steps
- nsub=0
-
- ! loop through sub-steps
- substeps: do ! continuous do statement with exit clause (alternative to "while")
-
- dt_sub = min(data_step,whole_step,maxstep_op,dt_sub) ! adjust for possible whole_step changes
-
- ! print progress
- if(globalPrintFlag)then
- write(*,'(a,1x,4(f13.5,1x))') ' start of step: dt_init, dt_sub, dt_solv, data_step: ', dt_init, dt_sub, dt_solv, data_step
- print*, 'stepFailure = ', stepFailure
- print*, 'before resizeData: nSnow, nSoil = ', nSnow, nSoil
- endif
-
- ! increment the number of sub-steps
- nsub = nsub+1
-
- ! resize the "indx_data" structure
- ! NOTE: this is necessary because the length of index variables depends on a given split
- ! --> the resize here is overwritten later (in indexSplit)
- ! --> admittedly ugly, and retained for now
- if(stepFailure)then ! resize temp to current data, later in code current data is set to lastInnerStep data
- call resizeData(indx_meta(:),indx_temp,indx_data,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
- else ! resize current data to temp0, temp0 is saved for next run
- call resizeData(indx_meta(:),indx_data,indx_temp0,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
- do iVar=1,size(indx_data%var)
- indx_temp0%var(iVar)%dat(:) = indx_data%var(iVar)%dat(:)
- end do
- endif
-
- ! check if on outer loop, always do outer if after failed step and on then on reduced whole_step
- do_outer = .false.
- if(stepFailure) firstInnerStep = .true.
- if(firstInnerStep) do_outer = .true.
-
- if(do_outer)then
-
- if(.not.stepFailure)then
- call resizeData(indx_meta(:),indx_data,indx_temp,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
- endif
-
- ! save/recover copies of index variables, temp saved on lastInnerStep, failed starts at lastInnerStep
- do iVar=1,size(indx_data%var)
- select case(stepFailure)
- case(.false.); indx_temp%var(iVar)%dat(:) = indx_data%var(iVar)%dat(:)
- case(.true.); indx_data%var(iVar)%dat(:) = indx_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- ! save/recover copies of prognostic variables
- do iVar=1,size(prog_data%var)
- select case(stepFailure)
- 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(stepFailure)
- 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
-
- ! re-assign dimension lengths
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
- nLayers = nSnow+nSoil
-
- ! *** merge/sub-divide snow layers...
- ! -----------------------------------
- call volicePack(&
- ! input/output: model data structures
- doLayerMerge, & ! intent(in): flag to force merge of snow layers
- model_decisions, & ! intent(in): model decisions
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(inout): type of each layer
- prog_data, & ! intent(inout): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- flux_data, & ! intent(inout): model fluxes for a local HRU
- ! output
- modifiedLayers, & ! intent(out): flag to denote that layers were modified
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=55; message=trim(message)//trim(cmessage); return; end if
-
- ! save the number of snow and soil layers
- nSnow = indx_data%var(iLookINDEX%nSnow)%dat(1)
- nSoil = indx_data%var(iLookINDEX%nSoil)%dat(1)
- nLayers = indx_data%var(iLookINDEX%nLayers)%dat(1)
-
- ! compute the indices for the model state variables
- if(firstSubStep .or. modifiedVegState .or. modifiedLayers)then
- call indexState(computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- includeAquifer, & ! intent(in): flag to denote if included the aquifer
- nSnow,nSoil,nLayers, & ! intent(in): number of snow and soil layers, and total number of layers
- indx_data, & ! intent(inout): indices defining model states and layers
- err,cmessage) ! intent(out): error control
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
-
- end if
-
- ! recreate the temporary data structures
- ! NOTE: resizeData(meta, old, new, ..)
- if(modifiedVegState .or. modifiedLayers)then
-
- ! create temporary data structures for prognostic variables
- call resizeData(prog_meta(:),prog_data,prog_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! create temporary data structures for diagnostic variables
- call resizeData(diag_meta(:),diag_data,diag_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- ! create temporary data structures for index variables
- call resizeData(indx_meta(:),indx_data,indx_temp,copy=.true.,err=err,message=cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; endif
-
- do iVar=1,size(indx_data%var)
- select case(stepFailure)
- case(.false.); indx_temp%var(iVar)%dat(:) = indx_data%var(iVar)%dat(:)
- case(.true.); indx_data%var(iVar)%dat(:) = indx_temp%var(iVar)%dat(:)
- end select
- end do ! looping through variables
-
- endif ! if modified the states
-
- ! define the number of state variables
- nState = indx_data%var(iLookINDEX%nState)%dat(1)
-
- ! *** compute diagnostic variables for each layer...
- ! --------------------------------------------------
- ! NOTE: this needs to be done AFTER volicePack, since layers may have been sub-divided and/or merged
- call diagn_evar(&
- ! input: control variables
- computeVegFlux, & ! intent(in): flag to denote if computing the vegetation flux
- diag_data%var(iLookDIAG%scalarCanopyDepth)%dat(1), & ! intent(in): canopy depth (m)
- ! input/output: data structures
- mpar_data, & ! intent(in): model parameters
- indx_data, & ! intent(in): model layer indices
- prog_data, & ! intent(in): model prognostic variables for a local HRU
- diag_data, & ! intent(inout): model diagnostic variables for a local HRU
- ! output: error control
- err,cmessage) ! intent(out): error control
- if(err/=0)then; err=55; message=trim(message)//trim(cmessage); return; end if
-
- ! *** compute melt of the "snow without a layer"...
- ! -------------------------------------------------
- ! NOTE: forms a surface melt pond, which drains into the upper-most soil layer through the time step
- ! (check for the special case of "snow without a layer")
- ! this pond melts evenly over entire time of maxstep until it gets recomputed because based on SWE when computed
- if(nSnow==0) then
- call implctMelt(&
- ! input/output: integrated snowpack properties
- prog_data%var(iLookPROG%scalarSWE)%dat(1), & ! intent(inout): snow water equivalent (kg m-2)
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! intent(inout): snow depth (m)
- prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1), & ! intent(inout): surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- prog_data%var(iLookPROG%mLayerTemp)%dat(nSnow+1), & ! intent(inout): surface layer temperature (K)
- prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1), & ! intent(inout): surface layer depth (m)
- diag_data%var(iLookDIAG%mLayerVolHtCapBulk)%dat(nSnow+1),& ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- err,cmessage ) ! intent(out): error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
- endif
-
- ! save volumetric ice content at the start of the step
- ! NOTE: used for volumetric loss due to melt-freeze
- allocate(mLayerVolFracIceInit(nLayers)); mLayerVolFracIceInit = prog_data%var(iLookPROG%mLayerVolFracIce)%dat
-
- ! make sure have consistent state variables to start, later done in updateVars
- ! associate local variables with information in the data structures
- init: associate(&
- ! 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 (-)
- ! state variables in the vegetation canopy
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1) ,& ! intent(in): [dp] mass of ice 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)
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! intent(out): [dp] mass of total water on the vegetation canopy (kg m-2)
- ! state variables in the snow and soil domains
- 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(out): [dp(:)] volumetric fraction of total water (-)
- mLayerMatricHead => prog_data%var(iLookPROG%mLayerMatricHead)%dat ,& ! intent(in): [dp(:)] matric head (m)
- mLayerMatricHeadLiq => diag_data%var(iLookDIAG%mLayerMatricHeadLiq)%dat & ! intent(out): [dp(:)] matric potential of liquid water (m)
- ) ! associations to variables in data structures
-
- ! compute the total water content in the vegetation canopy
- scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce ! kg m-2
-
- ! 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)
-
- end associate init
-
- ! correct increments (if need to redo inner step) and reset increment
- dt_solv = dt_solv - dt_solvInner
- dt_solvInner = 0._rkind
- lastInnerStep = .false.
-
- ! initialize sublimation sums to average over whole_step
- sumCanopySublimation = 0._rkind
- sumSnowSublimation = 0._rkind
- sumLatHeatCanopyEvap = 0._rkind
- sumSenHeatCanopy = 0._rkind
- ! initialize fluxes to average over whole_step (averaged over substep in varSubStep)
- do iVar=1,size(averageFlux_meta)
- flux_inner%var(iVar)%dat(:) = 0._rkind
- end do
- innerSoilCompress = 0._rkind ! mean total soil compression
- innerEffRainfall = 0._rkind ! mean total effective rainfall over snow
-
- endif ! (do_outer loop)
-
- ! *** solve model equations...
- ! ----------------------------
- ! save input step
- dtSave = whole_step
-
- ! get the new solution
- call 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 layers
- dt_sub, & ! intent(in): length of the model sub-step
- whole_step, & ! intent(in): length of whole step for surface drainage and average flux
- (nsub==1), & ! intent(in): logical flag to denote the first substep
- firstInnerStep, & ! intent(in): flag to denote if the first time step in maxstep subStep
- computeVegFlux, & ! intent(in): logical flag to compute fluxes within the vegetation canopy
- ! 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 that the coupled step failed
- ixSolution, & ! intent(out): solution method used in this iteration
- err,cmessage) ! intent(out): error code and error message
-
- ! check for all errors (error recovery within opSplittin)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! process the flag for too much melt
- if(tooMuchMelt)then
- stepFailure = .true.
- doLayerMerge = .true.
- else
- doLayerMerge = .false.
- endif
-
- ! handle special case of the step failure
- ! NOTE: need to revert back to the previous state vector that we were happy with and reduce the time step
- ! TODO: ask isn't this what the actors program does without the code block below
- if(stepFailure)then
- ! halve whole_step, for more frequent outer loop updates
- whole_step = dtSave/2._rkind
- ! check that the step is not tiny
- if(whole_step < minstep)then
- print*,ixSolution
- print*, 'dtSave, dt_sub', dtSave, whole_step
- message=trim(message)//'length of the coupled step is below the minimum step length'
- err=20; return
- endif
- ! try again, restart step
- deallocate(mLayerVolFracIceInit)
- cycle substeps
- endif
-
- ! increment sublimation sums
- sumCanopySublimation = sumCanopySublimation + dt_sub*flux_data%var(iLookFLUX%scalarCanopySublimation)%dat(1)
- sumSnowSublimation = sumSnowSublimation + dt_sub*flux_data%var(iLookFLUX%scalarSnowSublimation)%dat(1)
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + dt_sub*flux_data%var(iLookFLUX%scalarLatHeatCanopyEvap)%dat(1)
- sumSenHeatCanopy = sumSenHeatCanopy + dt_sub*flux_data%var(iLookFLUX%scalarSenHeatCanopy)%dat(1)
-
- ! update first step and first and last inner steps
- firstSubStep = .false.
- firstInnerStep = .false.
- if(dt_solvInner + dt_sub >= whole_step) lastInnerStep = .true.
- if(dt_solv + dt_sub >= data_step-verySmall) lastInnerStep = .true.
-
- ! check if on outer loop
- do_outer = .false.
- if(lastInnerStep) do_outer = .true.
-
- if(do_outer)then
-
- ! *** remove ice due to sublimation and freeze calculations...
- ! NOTE: In the future this should be moved into the solver, makes a big difference
- ! --------------------------------------------------------------
- sublime: associate(&
- mLayerMeltFreeze => diag_data%var(iLookDIAG%mLayerMeltFreeze)%dat, & ! melt-freeze in each snow and soil layer (kg m-3)
- scalarCanopyLiq => prog_data%var(iLookPROG%scalarCanopyLiq)%dat(1), & ! liquid water stored on the vegetation canopy (kg m-2)
- scalarCanopyIce => prog_data%var(iLookPROG%scalarCanopyIce)%dat(1), & ! ice stored on the vegetation canopy (kg m-2)
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1), & ! canopy ice content (kg m-2)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat, & ! volumetric fraction of ice in the snow+soil domain (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat, & ! volumetric fraction of liquid water in the snow+soil domain (-)
- mLayerVolFracWat => prog_data%var(iLookPROG%mLayerVolFracWat)%dat, & ! volumetric fraction of total water (-)
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat & ! depth of each snow+soil layer (m)
- ) ! associations to variables in data structures
-
- ! compute the melt in each snow and soil layer
- if(nSnow>0)&
- mLayerMeltFreeze(1:nSnow) = -( mLayerVolFracIce(1:nSnow) - mLayerVolFracIceInit(1:nSnow) ) * iden_ice
- mLayerMeltFreeze(nSnow+1:nLayers) = -( mLayerVolFracIce(nSnow+1:nLayers) - mLayerVolFracIceInit(nSnow+1:nLayers) )*iden_water
- deallocate(mLayerVolFracIceInit)
-
- ! * compute change in canopy ice content due to sublimation...
- ! ------------------------------------------------------------
- if(computeVegFlux)then
-
- ! remove mass of ice on the canopy
- scalarCanopyIce = scalarCanopyIce + sumCanopySublimation
-
- ! if removed all ice, take the remaining sublimation from water
- if(scalarCanopyIce < 0._rkind)then
- scalarCanopyLiq = scalarCanopyLiq + scalarCanopyIce
- scalarCanopyIce = 0._rkind
- endif
-
- ! modify fluxes and mean fluxes if there is insufficient canopy water to support the converged sublimation rate over the whole time step
- if(scalarCanopyLiq < 0._rkind)then
- ! --> superfluous sublimation flux
- superflousSub = -scalarCanopyLiq/whole_step ! kg m-2 s-1
- superflousNrg = superflousSub*LH_sub ! W m-2 (J m-2 s-1)
- ! --> update fluxes and states
- sumCanopySublimation = sumCanopySublimation + superflousSub*whole_step
- sumLatHeatCanopyEvap = sumLatHeatCanopyEvap + superflousNrg*whole_step
- sumSenHeatCanopy = sumSenHeatCanopy - superflousNrg*whole_step
- scalarCanopyLiq = 0._rkind
- endif
-
- ! update water
- scalarCanopyWat = scalarCanopyLiq + scalarCanopyIce
-
- end if ! (if computing the vegetation flux)
-
- call computSnowDepth(&
- whole_step, & ! intent(in)
- nSnow, & ! intent(in)
- sumSnowSublimation/whole_step, & ! intent(in)
- mLayerVolFracLiq, & ! intent(inout)
- mLayerVolFracIce, & ! intent(inout)
- prog_data%var(iLookPROG%mLayerTemp)%dat, & ! intent(in)
- mLayerMeltFreeze, & ! intent(in)
- mpar_data, & ! intent(in)
- ! output
- tooMuchSublim, & ! intent(out): flag to denote that there was too much sublimation in a given time step
- mLayerDepth, & ! intent(inout)
- ! error control
- err,message) ! intent(out): error control
- if(err/=0)then; err=55; return; end if
-
- ! process the flag for too much sublimation
- if(tooMuchSublim)then
- stepFailure = .true.
- doLayerMerge = .true.
- else
- doLayerMerge = .false.
- endif
-
- ! handle special case of the step failure
- ! NOTE: need to revert back to the previous state vector that we were happy with and reduce the time step
- if(stepFailure)then
- ! halve whole_step, for more frequent outer loop updates
- whole_step = dtSave/2._rkind
- ! check that the step is not tiny
- if(whole_step < minstep)then
- print*,ixSolution
- print*, 'dtSave, dt_sub', dtSave, whole_step
- message=trim(message)//'length of the coupled step is below the minimum step length'
- err=20; return
- endif
- ! try again, restart step (at end inner step)
- cycle substeps
- endif
-
- ! update coordinate variables
- call calcHeight(&
- ! input/output: data structures
- indx_data, & ! intent(in): layer type
- prog_data, & ! intent(inout): model variables for a local HRU
- ! output: error control
- err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! recompute snow depth, SWE, and layer water
- if(nSnow > 0)then
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) = sum( mLayerDepth(1:nSnow) )
- prog_data%var(iLookPROG%scalarSWE)%dat(1) = sum( (mLayerVolFracLiq(1:nSnow)*iden_water &
- + mLayerVolFracIce(1:nSnow)*iden_ice) * mLayerDepth(1:nSnow) )
- mLayerVolFracWat(1:nSnow) = mLayerVolFracLiq(1:nSnow) + mLayerVolFracIce(1:nSnow)*iden_ice/iden_water
- endif
-
- end associate sublime
-
- ! increment change in storage associated with the surface melt pond (kg m-2)
- if(nSnow==0) sfcMeltPond = sfcMeltPond + prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1)
-
- endif ! (do_outer loop)
-
- ! ****************************************************************************************************
- ! *** END MAIN SOLVER ********************************************************************************
- ! ****************************************************************************************************
-
- ! increment mean fluxes, soil compression, and canopy sublimation, reset on whole_step
- dt_wght = dt_sub/whole_step ! define weight applied to each sub-step
- do iVar=1,size(averageFlux_meta)
- flux_inner%var(iVar)%dat(:) = flux_inner%var(iVar)%dat(:) + flux_data%var(averageFlux_meta(iVar)%ixParent)%dat(:)*dt_wght
- end do
- innerSoilCompress = innerSoilCompress + diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1)*dt_wght
- if (nSnow>0) innerEffRainfall = innerEffRainfall + ( flux_data%var(iLookFLUX%scalarThroughfallRain)%dat(1) + flux_data%var(iLookFLUX%scalarCanopyLiqDrainage)%dat(1) )*dt_wght
-
- ! increment sub-step accepted step
- dt_solvInner = dt_solvInner + dt_sub
- dt_solv = dt_solv + dt_sub
-
- ! update first and last inner steps if did successful lastInnerStep, increment fluxes over data_step
- if (lastInnerStep)then
- firstInnerStep = .true.
- lastInnerStep = .false.
- dt_solvInner = 0._rkind
-
- dt_wght = whole_step/data_step ! define weight applied to each sub-step
- do iVar=1,size(averageFlux_meta)
- flux_mean%var(iVar)%dat(:) = flux_mean%var(iVar)%dat(:) + flux_inner%var(iVar)%dat(:)*dt_wght
- end do
- meanSoilCompress = meanSoilCompress + innerSoilCompress*dt_wght
- meanCanopySublimation = meanCanopySublimation + sumCanopySublimation/data_step
- meanLatHeatCanopyEvap = meanLatHeatCanopyEvap + sumLatHeatCanopyEvap/data_step
- meanSenHeatCanopy = meanSenHeatCanopy + sumSenHeatCanopy/data_step
- effRainfall = effRainfall + innerEffRainfall*dt_wght
- flux_mean%var(childFLUX_MEAN(iLookDIAG%scalarSoilCompress))%dat(1) = meanSoilCompress
- flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopySublimation))%dat(1) = meanCanopySublimation
- flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarLatHeatCanopyEvap))%dat(1) = meanLatHeatCanopyEvap
- flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSenHeatCanopy))%dat(1) = meanSenHeatCanopy
- endif
-
- ! save the time step to initialize the subsequent step
- if(dt_solv<data_step .or. nsub==1) dt_init = dt_sub
-
- ! check
- if(globalPrintFlag)&
- write(*,'(a,1x,3(f18.5,1x))') 'dt_sub, dt_solv, data_step: ', dt_sub, dt_solv, data_step
-
- ! check that we have completed the sub-step
- if(dt_solv >= data_step-verySmall) then
- exit substeps
- endif
-
- ! adjust length of the sub-step (make sure that we don't exceed the step)
- dt_sub = min(data_step - dt_solv, dt_sub)
-
- end do substeps ! (sub-step loop)
-
- ! *** add snowfall to the snowpack...
- ! -----------------------------------
- ! add new snowfall to the snowpack
- ! NOTE: This needs to be done AFTER the call to canopySnow, since throughfall and unloading are computed in canopySnow
- call newsnwfall(&
- ! input: model control
- data_step, & ! time step (seconds)
- (nSnow > 0), & ! logical flag if snow layers exist
- mpar_data%var(iLookPARAM%snowfrz_scale)%dat(1), & ! freeezing curve parameter for snow (K-1)
- ! input: diagnostic scalar variables
- diag_data%var(iLookDIAG%scalarSnowfallTemp)%dat(1), & ! computed temperature of fresh snow (K)
- diag_data%var(iLookDIAG%scalarNewSnowDensity)%dat(1), & ! computed density of new snow (kg m-3)
- flux_data%var(iLookFLUX%scalarThroughfallSnow)%dat(1), & ! throughfall of snow through the canopy (kg m-2 s-1)
- flux_data%var(iLookFLUX%scalarCanopySnowUnloading)%dat(1), & ! unloading of snow from the canopy (kg m-2 s-1)
- ! input/output: state variables
- prog_data%var(iLookPROG%scalarSWE)%dat(1), & ! SWE (kg m-2)
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! total snow depth (m)
- prog_data%var(iLookPROG%mLayerTemp)%dat(1), & ! temperature of the top layer (K)
- prog_data%var(iLookPROG%mLayerDepth)%dat(1), & ! depth of the top layer (m)
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1), & ! volumetric fraction of ice of the top layer (-)
- prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1), & ! volumetric fraction of liquid water of the top layer (-)
- ! output: error control
- err,cmessage) ! error control
- if(err/=0)then; err=30; message=trim(message)//trim(cmessage); return; end if
-
- ! re-compute snow depth, SWE, and top layer water
- if(nSnow > 0)then
- prog_data%var(iLookPROG%scalarSnowDepth)%dat(1) = sum( prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow))
- prog_data%var(iLookPROG%scalarSWE)%dat(1) = sum( (prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)*iden_water + &
- prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1:nSnow)*iden_ice) &
- * prog_data%var(iLookPROG%mLayerDepth)%dat(1:nSnow) )
- prog_data%var(iLookPROG%mLayerVolFracWat)%dat(1) = prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1) &
- + prog_data%var(iLookPROG%mLayerVolFracIce)%dat(1)*iden_ice/iden_water
- end if
-
- ! re-assign dimension lengths
- nSnow = count(indx_data%var(iLookINDEX%layerType)%dat==iname_snow)
- nSoil = count(indx_data%var(iLookINDEX%layerType)%dat==iname_soil)
- nLayers = nSnow+nSoil
-
- ! update coordinate variables
- call calcHeight(&
- ! input/output: data structures
- indx_data, & ! intent(in): layer type
- prog_data, & ! intent(inout): model variables for a local HRU
- ! output: error control
- err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! overwrite flux_data and soil compression with the timestep-average value (returns timestep-average fluxes for scalar variables)
- do iVar=1,size(averageFlux_meta)
- flux_data%var(averageFlux_meta(iVar)%ixParent)%dat(:) = flux_mean%var(iVar)%dat(:)
- end do
- diag_data%var(iLookDIAG%scalarSoilCompress)%dat(1) = meanSoilCompress
-
- ! ***********************************************************************************************************************************
- ! ---
- ! *** balance checks...
- ! ---------------------
-
- ! save the average compression and melt pond storage in the data structures
- prog_data%var(iLookPROG%scalarSfcMeltPond)%dat(1) = sfcMeltPond
-
- ! associate local variables with information in the data structures
- associate(&
- ! model decisions
- ixNumericalMethod => model_decisions(iLookDECISIONS%num_method)%iDecision ,& ! choice of numerical method, backward Euler or SUNDIALS/IDA
- ! model forcing
- scalarSnowfall => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowfall) )%dat(1) ,& ! computed snowfall rate (kg m-2 s-1)
- scalarRainfall => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarRainfall) )%dat(1) ,& ! computed rainfall rate (kg m-2 s-1)
- ! canopy fluxes
- averageThroughfallSnow => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarThroughfallSnow) )%dat(1) ,& ! snow that reaches the ground without ever touching the canopy (kg m-2 s-1)
- averageThroughfallRain => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarThroughfallRain) )%dat(1) ,& ! rain that reaches the ground without ever touching the canopy (kg m-2 s-1)
- averageCanopySnowUnloading => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopySnowUnloading))%dat(1) ,& ! unloading of snow from the vegetion canopy (kg m-2 s-1)
- averageCanopyLiqDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyLiqDrainage) )%dat(1) ,& ! drainage of liquid water from the vegetation canopy (kg m-2 s-1)
- averageCanopySublimation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopySublimation) )%dat(1) ,& ! canopy sublimation/frost (kg m-2 s-1)
- averageCanopyEvaporation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyEvaporation) )%dat(1) ,& ! canopy evaporation/condensation (kg m-2 s-1)
- ! snow fluxes
- averageSnowSublimation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowSublimation) )%dat(1) ,& ! sublimation from the snow surface (kg m-2 s-1)
- averageSnowDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSnowDrainage) )%dat(1) ,& ! drainage from the bottom of the snowpack (m s-1)
- ! soil fluxes
- averageSoilInflux => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarInfiltration) )%dat(1) ,& ! influx of water at the top of the soil profile (m s-1)
- averageSoilDrainage => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSoilDrainage) )%dat(1) ,& ! drainage from the bottom of the soil profile (m s-1)
- averageSoilBaseflow => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarSoilBaseflow) )%dat(1) ,& ! total baseflow from throughout the soil profile (m s-1)
- averageSoilCompress => flux_mean%var(childFLUX_MEAN(iLookDIAG%scalarSoilCompress) )%dat(1) ,& ! soil compression (kg m-2 s-1)
- averageGroundEvaporation => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarGroundEvaporation) )%dat(1) ,& ! soil evaporation (kg m-2 s-1)
- averageCanopyTranspiration => flux_mean%var(childFLUX_MEAN(iLookFLUX%scalarCanopyTranspiration))%dat(1) ,& ! canopy transpiration (kg m-2 s-1)
- ! state variables in the vegetation canopy
- scalarCanopyWat => prog_data%var(iLookPROG%scalarCanopyWat)%dat(1) ,& ! canopy ice content (kg m-2)
- ! state variables in the soil domain
- mLayerDepth => prog_data%var(iLookPROG%mLayerDepth)%dat(nSnow+1:nLayers) ,& ! depth of each soil layer (m)
- mLayerVolFracIce => prog_data%var(iLookPROG%mLayerVolFracIce)%dat(nSnow+1:nLayers) ,& ! volumetric ice content in each soil layer (-)
- mLayerVolFracLiq => prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(nSnow+1:nLayers) ,& ! volumetric liquid water content in each soil layer (-)
- scalarAquiferStorage => prog_data%var(iLookPROG%scalarAquiferStorage)%dat(1) ,& ! aquifer storage (m)
- ! error tolerance
- absConvTol_liquid => mpar_data%var(iLookPARAM%absConvTol_liquid)%dat(1) ,& ! absolute convergence tolerance for vol frac liq water (-)
- scalarTotalSoilIce => diag_data%var(iLookDIAG%scalarTotalSoilIce)%dat(1) ,& ! total ice in the soil column (kg m-2)
- scalarTotalSoilLiq => diag_data%var(iLookDIAG%scalarTotalSoilLiq)%dat(1) & ! total liquid water in the soil column (kg m-2)
- ) ! (association of local variables with information in the data structures
-
- ! identify the need to check the mass balance, both methods should work if tolerance coarse enough
- select case(ixNumericalMethod)
- case(sundials); checkMassBalance = .true. ! sundials gives instantaneous fluxes and were summed for an average flux for checks
- case(bEuler); checkMassBalance = .true. ! bEuler gives finite difference dt_sub fluxes and were summed for an average flux for checks
- case default; err=20; message=trim(message)//'expect num_method to be sundials or bEuler (or itertive, which is bEuler)'; return
- end select
-
- ! -----
- ! * balance checks for the canopy...
- ! ----------------------------------
-
- ! if computing the vegetation flux
- if(computeVegFlux)then
- ! get the canopy water balance at the end of the time step
- balanceCanopyWater1 = scalarCanopyWat
-
- ! balance checks for the canopy
- ! NOTE: need to put the balance checks in the sub-step loop so that we can re-compute if necessary
- scalarCanopyWatBalError = balanceCanopyWater1 - (balanceCanopyWater0 + (scalarSnowfall - averageThroughfallSnow)*data_step + (scalarRainfall - averageThroughfallRain)*data_step &
- - averageCanopySnowUnloading*data_step - averageCanopyLiqDrainage*data_step + averageCanopySublimation*data_step + averageCanopyEvaporation*data_step)
- if(abs(scalarCanopyWatBalError) > absConvTol_liquid*iden_water*10._rkind .and. checkMassBalance)then
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'balanceCanopyWater0 = ', balanceCanopyWater0
- write(*,'(a,1x,f20.10)') 'balanceCanopyWater1 = ', balanceCanopyWater1
- write(*,'(a,1x,f20.10)') 'scalarSnowfall = ', scalarSnowfall
- write(*,'(a,1x,f20.10)') 'scalarRainfall = ', scalarRainfall
- write(*,'(a,1x,f20.10)') '(scalarSnowfall - averageThroughfallSnow) = ', (scalarSnowfall - averageThroughfallSnow)!*data_step
- write(*,'(a,1x,f20.10)') '(scalarRainfall - averageThroughfallRain) = ', (scalarRainfall - averageThroughfallRain)!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopySnowUnloading = ', averageCanopySnowUnloading!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopyLiqDrainage = ', averageCanopyLiqDrainage!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopySublimation = ', averageCanopySublimation!*data_step
- write(*,'(a,1x,f20.10)') 'averageCanopyEvaporation = ', averageCanopyEvaporation!*data_step
- write(*,'(a,1x,f20.10)') 'scalarCanopyWatBalError = ', scalarCanopyWatBalError
- message=trim(message)//'canopy hydrology does not balance'
- err=20; return
- end if
-
- endif ! if computing the vegetation flux
-
- ! -----
- ! * balance checks for SWE...
- ! ---------------------------
-
- ! check the individual layers
- if(printBalance .and. nSnow>0)then
- write(*,'(a,1x,10(f12.8,1x))') 'liqSnowInit = ', liqSnowInit
- write(*,'(a,1x,10(f12.8,1x))') 'volFracLiq = ', prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow)
- write(*,'(a,1x,10(f12.8,1x))') 'iLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%iLayerLiqFluxSnow)%dat*iden_water*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'mLayerLiqFluxSnow = ', flux_data%var(iLookFLUX%mLayerLiqFluxSnow)%dat*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'change volFracLiq = ', prog_data%var(iLookPROG%mLayerVolFracLiq)%dat(1:nSnow) - liqSnowInit
- deallocate(liqSnowInit, stat=err)
- if(err/=0)then
- message=trim(message)//'unable to deallocate space for the initial volumetric liquid water content of snow'
- err=20; return
- endif
- endif
-
- ! check SWE
- if(nSnow>0)then
- effSnowfall = averageThroughfallSnow + averageCanopySnowUnloading
- ! effRainfall is averageThroughfallRain + averageCanopyLiqDrainage only over snow
- newSWE = prog_data%var(iLookPROG%scalarSWE)%dat(1)
- delSWE = newSWE - (oldSWE - sfcMeltPond)
- massBalance = delSWE - (effSnowfall + effRainfall + averageSnowSublimation - averageSnowDrainage*iden_water)*data_step
- if(abs(massBalance) > absConvTol_liquid*iden_water*10._rkind .and. checkMassBalance)then
- print*, 'nSnow = ', nSnow
- print*, 'nSub = ', nSub
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'oldSWE = ', oldSWE
- write(*,'(a,1x,f20.10)') 'newSWE = ', newSWE
- write(*,'(a,1x,f20.10)') 'delSWE = ', delSWE
- write(*,'(a,1x,f20.10)') 'effRainfall = ', effRainfall*data_step
- write(*,'(a,1x,f20.10)') 'effSnowfall = ', effSnowfall*data_step
- write(*,'(a,1x,f20.10)') 'sublimation = ', averageSnowSublimation*data_step
- write(*,'(a,1x,f20.10)') 'snwDrainage = ', averageSnowDrainage*iden_water*data_step
- write(*,'(a,1x,f20.10)') 'sfcMeltPond = ', sfcMeltPond
- write(*,'(a,1x,f20.10)') 'massBalance = ', massBalance
- message=trim(message)//'SWE does not balance'
- err=20; return
- endif ! if failed mass balance check
- endif ! if snow layers exist
-
- ! -----
- ! * balance checks for soil...
- ! ----------------------------
-
- ! compute the liquid water and ice content at the end of the time step
- scalarTotalSoilLiq = sum(iden_water*mLayerVolFracLiq(1:nSoil)*mLayerDepth(1:nSoil))
- scalarTotalSoilIce = sum(iden_water*mLayerVolFracIce(1:nSoil)*mLayerDepth(1:nSoil)) ! NOTE: no expansion of soil, hence use iden_water
-
- ! get the total water in the soil (liquid plus ice) at the end of the time step (kg m-2)
- balanceSoilWater1 = scalarTotalSoilLiq + scalarTotalSoilIce
-
- ! get the total aquifer storage at the start of the time step (kg m-2)
- balanceAquifer1 = scalarAquiferStorage*iden_water
-
- ! get the input and output to/from the soil zone (kg m-2)
- balanceSoilInflux = averageSoilInflux*iden_water*data_step
- balanceSoilBaseflow = averageSoilBaseflow*iden_water*data_step
- balanceSoilDrainage = averageSoilDrainage*iden_water*data_step
- balanceSoilET = (averageCanopyTranspiration + averageGroundEvaporation)*data_step
- balanceSoilCompress = averageSoilCompress*data_step
-
- ! check the individual layers
- if(printBalance)then
- write(*,'(a,1x,10(f12.8,1x))') 'liqSoilInit = ', liqSoilInit
- write(*,'(a,1x,10(f12.8,1x))') 'volFracLiq = ', mLayerVolFracLiq
- write(*,'(a,1x,10(f12.8,1x))') 'iLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%iLayerLiqFluxSoil)%dat*iden_water*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'mLayerLiqFluxSoil = ', flux_data%var(iLookFLUX%mLayerLiqFluxSoil)%dat*data_step
- write(*,'(a,1x,10(f12.8,1x))') 'change volFracLiq = ', mLayerVolFracLiq - liqSoilInit
- deallocate(liqSoilInit, stat=err)
- if(err/=0)then
- message=trim(message)//'unable to deallocate space for the initial soil moisture'
- err=20; return
- endif
- endif
-
- ! check the soil water balance
- scalarSoilWatBalError = balanceSoilWater1 - (balanceSoilWater0 + (balanceSoilInflux + balanceSoilET - balanceSoilBaseflow - balanceSoilDrainage - balanceSoilCompress) )
- if(abs(scalarSoilWatBalError) > absConvTol_liquid*iden_water*10._rkind .and. checkMassBalance)then ! NOTE: kg m-2, so need coarse tolerance to account for precision issues
- write(*,*) 'solution method = ', ixSolution
- write(*,'(a,1x,f20.10)') 'data_step = ', data_step
- write(*,'(a,1x,f20.10)') 'balanceSoilCompress = ', balanceSoilCompress
- write(*,'(a,1x,f20.10)') 'scalarTotalSoilLiq = ', scalarTotalSoilLiq
- write(*,'(a,1x,f20.10)') 'scalarTotalSoilIce = ', scalarTotalSoilIce
- write(*,'(a,1x,f20.10)') 'balanceSoilWater0 = ', balanceSoilWater0
- write(*,'(a,1x,f20.10)') 'balanceSoilWater1 = ', balanceSoilWater1
- write(*,'(a,1x,f20.10)') 'balanceSoilInflux = ', balanceSoilInflux
- write(*,'(a,1x,f20.10)') 'balanceSoilBaseflow = ', balanceSoilBaseflow
- write(*,'(a,1x,f20.10)') 'balanceSoilDrainage = ', balanceSoilDrainage
- write(*,'(a,1x,f20.10)') 'balanceSoilET = ', balanceSoilET
- write(*,'(a,1x,f20.10)') 'scalarSoilWatBalError = ', scalarSoilWatBalError
- message=trim(message)//'soil hydrology does not balance'
- err=20; return
- end if
-
- ! end association of local variables with information in the data structures
- end associate
-
- ! end association to canopy depth
- end associate canopy
-
- ! Save the total soil water (Liquid+Ice)
- diag_data%var(iLookDIAG%scalarTotalSoilWat)%dat(1) = balanceSoilWater1
- ! save the surface temperature (just to make things easier to visualize)
- prog_data%var(iLookPROG%scalarSurfaceTemp)%dat(1) = prog_data%var(iLookPROG%mLayerTemp)%dat(1)
-
- ! overwrite flux data with timestep-average value for all flux_mean vars, hard-coded to not happen
- if(.not.backwardsCompatibility)then
- do iVar=1,size(flux_mean%var)
- flux_data%var(averageFlux_meta(iVar)%ixParent)%dat = flux_mean%var(iVar)%dat
- end do
- end if
-
- iLayer = nSnow+1
- if(nsub>50000)then
- write(message,'(a,i0)') trim(cmessage)//'number of sub-steps > 50000 for HRU ', hruId
- err=20; return
- end if
-
- ! get the end time
- call cpu_time(endTime)
-
- ! get the elapsed time
- diag_data%var(iLookDIAG%wallClockTime)%dat(1) = endTime - startTime
-
-end subroutine coupled_em
-
-
-! *********************************************************************************************************
-! private subroutine implctMelt: compute melt of the "snow without a layer"
-! *********************************************************************************************************
-subroutine implctMelt(&
- ! input/output: integrated snowpack properties
- scalarSWE, & ! intent(inout): snow water equivalent (kg m-2)
- scalarSnowDepth, & ! intent(inout): snow depth (m)
- scalarSfcMeltPond, & ! intent(inout): surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- soilTemp, & ! intent(inout): surface layer temperature (K)
- soilDepth, & ! intent(inout): surface layer depth (m)
- soilHeatcap, & ! intent(inout): surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- err,message ) ! intent(out): error control
- implicit none
- ! input/output: integrated snowpack properties
- real(rkind),intent(inout) :: scalarSWE ! snow water equivalent (kg m-2)
- real(rkind),intent(inout) :: scalarSnowDepth ! snow depth (m)
- real(rkind),intent(inout) :: scalarSfcMeltPond ! surface melt pond (kg m-2)
- ! input/output: properties of the upper-most soil layer
- real(rkind),intent(inout) :: soilTemp ! surface layer temperature (K)
- real(rkind),intent(inout) :: soilDepth ! surface layer depth (m)
- real(rkind),intent(inout) :: soilHeatcap ! surface layer volumetric heat capacity (J m-3 K-1)
- ! output: error control
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! local variables
- real(rkind) :: nrgRequired ! energy required to melt all the snow (J m-2)
- real(rkind) :: nrgAvailable ! energy available to melt the snow (J m-2)
- real(rkind) :: snwDensity ! snow density (kg m-3)
- ! initialize error control
- err=0; message='implctMelt/'
-
- if(scalarSWE > 0._rkind)then
- ! only melt if temperature of the top soil layer is greater than Tfreeze
- if(soilTemp > Tfreeze)then
- ! compute the energy required to melt all the snow (J m-2)
- nrgRequired = scalarSWE*LH_fus
- ! compute the energy available to melt the snow (J m-2)
- nrgAvailable = soilHeatcap*(soilTemp - Tfreeze)*soilDepth
- ! compute the snow density (not saved)
- snwDensity = scalarSWE/scalarSnowDepth
- ! compute the amount of melt, and update SWE (kg m-2)
- if(nrgAvailable > nrgRequired)then
- scalarSfcMeltPond = scalarSWE
- scalarSWE = 0._rkind
- else
- scalarSfcMeltPond = nrgAvailable/LH_fus
- scalarSWE = scalarSWE - scalarSfcMeltPond
- end if
- ! update depth
- scalarSnowDepth = scalarSWE/snwDensity
- ! update temperature of the top soil layer (K)
- soilTemp = soilTemp - (LH_fus*scalarSfcMeltPond/soilDepth)/soilHeatcap
- else ! melt is zero if the temperature of the top soil layer is less than Tfreeze
- scalarSfcMeltPond = 0._rkind ! kg m-2
- end if ! (if the temperature of the top soil layer is greater than Tfreeze)
- else ! melt is zero if the "snow without a layer" does not exist
- scalarSfcMeltPond = 0._rkind ! kg m-2
- end if ! (if the "snow without a layer" exists)
-
-end subroutine implctMelt
-
-end module coupled_em_module
diff --git a/build/source/engine/sundials/mDecisions.f90 b/build/source/engine/sundials/mDecisions.f90
deleted file mode 100755
index 233b802051ba24e43ca0254603947f37b1522832..0000000000000000000000000000000000000000
--- a/build/source/engine/sundials/mDecisions.f90
+++ /dev/null
@@ -1,745 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module mDecisions_module
-#ifdef ACTORS_ACTIVE
-USE, intrinsic :: iso_c_binding
-#endif
-USE nrtype
-USE var_lookup, only: maxvarDecisions ! maximum number of decisions
-implicit none
-private
-public::mDecisions
-! look-up values for the choice of function for the soil moisture control on stomatal resistance
-integer(i4b),parameter,public :: NoahType = 1 ! thresholded linear function of volumetric liquid water content
-integer(i4b),parameter,public :: CLM_Type = 2 ! thresholded linear function of matric head
-integer(i4b),parameter,public :: SiB_Type = 3 ! exponential of the log of matric head
-! look-up values for the choice of stomatal resistance formulation
-integer(i4b),parameter,public :: BallBerry = 1 ! Ball-Berry
-integer(i4b),parameter,public :: Jarvis = 2 ! Jarvis
-integer(i4b),parameter,public :: simpleResistance = 3 ! simple resistance formulation
-integer(i4b),parameter,public :: BallBerryFlex = 4 ! flexible Ball-Berry scheme
-integer(i4b),parameter,public :: BallBerryTest = 5 ! flexible Ball-Berry scheme (testing)
-! look-up values to define leaf temperature controls on photosynthesis + stomatal resistance
-integer(i4b),parameter,public :: q10Func = 11 ! the q10 function used in CLM4 and Noah-MP
-integer(i4b),parameter,public :: Arrhenius = 12 ! the Arrhenious functions used in CLM5 and Cable
-! look-up values to define humidity controls on stomatal resistance
-integer(i4b),parameter,public :: humidLeafSurface = 21 ! humidity at the leaf surface [Bonan et al., 2011]
-integer(i4b),parameter,public :: scaledHyperbolic = 22 ! scaled hyperbolic function [Leuning et al., 1995]
-! look-up values to define the electron transport function (dependence of photosynthesis on PAR)
-integer(i4b),parameter,public :: linear = 31 ! linear function used in CLM4 and Noah-MP
-integer(i4b),parameter,public :: linearJmax = 32 ! linear jmax function used in Cable [Wang et al., Ag Forest Met 1998, eq D5]
-integer(i4b),parameter,public :: quadraticJmax = 33 ! the quadratic Jmax function, used in SSiB and CLM5
-! look up values to define the use of CO2 compensation point to calculate stomatal resistance
-integer(i4b),parameter,public :: origBWB = 41 ! the original BWB approach
-integer(i4b),parameter,public :: Leuning = 42 ! the Leuning approach
-! look up values to define the iterative numerical solution method used in the Ball-Berry stomatal resistance parameterization
-integer(i4b),parameter,public :: NoahMPsolution = 51 ! the NoahMP solution (and CLM4): fixed point iteration; max 3 iterations
-integer(i4b),parameter,public :: newtonRaphson = 52 ! full Newton-Raphson iterative solution to convergence
-! look up values to define the controls on carbon assimilation
-integer(i4b),parameter,public :: colimitation = 61 ! enable colimitation, as described by Collatz et al. (1991) and Sellers et al. (1996)
-integer(i4b),parameter,public :: minFunc = 62 ! do not enable colimitation: use minimum of the three controls on carbon assimilation
-! look up values to define the scaling of photosynthesis from the leaves to the canopy
-integer(i4b),parameter,public :: constantScaling = 71 ! constant scaling factor
-integer(i4b),parameter,public :: laiScaling = 72 ! exponential function of LAI (Leuning, Plant Cell Env 1995: "Scaling from..." [eq 9])
-! look-up values for the choice of numerical method
-integer(i4b),parameter,public :: bEuler = 81 ! home-grown backward Euler solution with long time steps
-integer(i4b),parameter,public :: sundials = 82 ! SUNDIALS/IDA solution
-! look-up values for method used to compute derivative
-integer(i4b),parameter,public :: numerical = 91 ! numerical solution
-integer(i4b),parameter,public :: analytical = 92 ! analytical solution
-! look-up values for method used to determine LAI and SAI
-integer(i4b),parameter,public :: monthlyTable = 101 ! LAI/SAI taken directly from a monthly table for different vegetation classes
-integer(i4b),parameter,public :: specified = 102 ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
-! look-up values for the choice of the canopy interception parameterization
-integer(i4b),parameter,public :: sparseCanopy = 111 ! fraction of rainfall that never hits the canopy (throughfall); drainage above threshold
-integer(i4b),parameter,public :: storageFunc = 112 ! throughfall a function of canopy storage; 100% throughfall when canopy is at capacity
-integer(i4b),parameter,public :: unDefined = 113 ! option is undefined (backwards compatibility)
-! look-up values for the form of Richards' equation
-integer(i4b),parameter,public :: moisture = 121 ! moisture-based form of Richards' equation
-integer(i4b),parameter,public :: mixdform = 122 ! mixed form of Richards' equation
-! look-up values for the choice of groundwater parameterization
-integer(i4b),parameter,public :: qbaseTopmodel = 131 ! TOPMODEL-ish baseflow parameterization
-integer(i4b),parameter,public :: bigBucket = 132 ! a big bucket (lumped aquifer model)
-integer(i4b),parameter,public :: noExplicit = 133 ! no explicit groundwater parameterization
-! look-up values for the choice of hydraulic conductivity profile
-integer(i4b),parameter,public :: constant = 141 ! constant hydraulic conductivity with depth
-integer(i4b),parameter,public :: powerLaw_profile = 142 ! power-law profile
-! look-up values for the choice of boundary conditions for thermodynamics
-integer(i4b),parameter,public :: prescribedTemp = 151 ! prescribed temperature
-integer(i4b),parameter,public :: energyFlux = 152 ! energy flux
-integer(i4b),parameter,public :: zeroFlux = 153 ! zero flux
-! look-up values for the choice of boundary conditions for hydrology
-integer(i4b),parameter,public :: liquidFlux = 161 ! liquid water flux
-integer(i4b),parameter,public :: prescribedHead = 162 ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
-integer(i4b),parameter,public :: funcBottomHead = 163 ! function of matric head in the lower-most layer
-integer(i4b),parameter,public :: freeDrainage = 164 ! free drainage
-! look-up values for the choice of parameterization for vegetation roughness length and displacement height
-integer(i4b),parameter,public :: Raupach_BLM1994 = 171 ! Raupach (BLM 1994) "Simplified expressions..."
-integer(i4b),parameter,public :: CM_QJRMS1988 = 172 ! Choudhury and Monteith (QJRMS 1988) "A four layer model for the heat budget..."
-integer(i4b),parameter,public :: vegTypeTable = 173 ! constant parameters dependent on the vegetation type
-! look-up values for the choice of parameterization for the rooting profile
-integer(i4b),parameter,public :: powerLaw = 181 ! simple power-law rooting profile
-integer(i4b),parameter,public :: doubleExp = 182 ! the double exponential function of Xeng et al. (JHM 2001)
-! look-up values for the choice of parameterization for canopy emissivity
-integer(i4b),parameter,public :: simplExp = 191 ! simple exponential function
-integer(i4b),parameter,public :: difTrans = 192 ! parameterized as a function of diffuse transmissivity
-! look-up values for the choice of parameterization for snow interception
-integer(i4b),parameter,public :: stickySnow = 201 ! maximum interception capacity an increasing function of temerature
-integer(i4b),parameter,public :: lightSnow = 202 ! maximum interception capacity an inverse function of new snow density
-! look-up values for the choice of wind profile
-integer(i4b),parameter,public :: exponential = 211 ! exponential wind profile extends to the surface
-integer(i4b),parameter,public :: logBelowCanopy = 212 ! logarithmic profile below the vegetation canopy
-! look-up values for the choice of stability function
-integer(i4b),parameter,public :: standard = 221 ! standard MO similarity, a la Anderson (1976)
-integer(i4b),parameter,public :: louisInversePower = 222 ! Louis (1979) inverse power function
-integer(i4b),parameter,public :: mahrtExponential = 223 ! Mahrt (1987) exponential
-! look-up values for the choice of canopy shortwave radiation method
-integer(i4b),parameter,public :: noah_mp = 231 ! full Noah-MP implementation (including albedo)
-integer(i4b),parameter,public :: CLM_2stream = 232 ! CLM 2-stream model (see CLM documentation)
-integer(i4b),parameter,public :: UEB_2stream = 233 ! UEB 2-stream model (Mahat and Tarboton, WRR 2011)
-integer(i4b),parameter,public :: NL_scatter = 234 ! Simplified method Nijssen and Lettenmaier (JGR 1999)
-integer(i4b),parameter,public :: BeersLaw = 235 ! Beer's Law (as implemented in VIC)
-! look-up values for the choice of albedo representation
-integer(i4b),parameter,public :: constantDecay = 241 ! constant decay (e.g., VIC, CLASS)
-integer(i4b),parameter,public :: variableDecay = 242 ! variable decay (e.g., BATS approach, with destructive metamorphism + soot content)
-! look-up values for the choice of compaction routine
-integer(i4b),parameter,public :: constantSettlement = 251 ! constant settlement rate
-integer(i4b),parameter,public :: andersonEmpirical = 252 ! semi-empirical method of Anderson (1976)
-! look-up values for the choice of method to combine and sub-divide snow layers
-integer(i4b),parameter,public :: sameRulesAllLayers = 261 ! same combination/sub-division rules applied to all layers
-integer(i4b),parameter,public :: rulesDependLayerIndex= 262 ! combination/sub-dividion rules depend on layer index
-! look-up values for the choice of thermal conductivity representation for snow
-integer(i4b),parameter,public :: Yen1965 = 271 ! Yen (1965)
-integer(i4b),parameter,public :: Mellor1977 = 272 ! Mellor (1977)
-integer(i4b),parameter,public :: Jordan1991 = 273 ! Jordan (1991)
-integer(i4b),parameter,public :: Smirnova2000 = 274 ! Smirnova et al. (2000)
-! look-up values for the choice of thermal conductivityi representation for soil
-integer(i4b),parameter,public :: funcSoilWet = 281 ! function of soil wetness
-integer(i4b),parameter,public :: mixConstit = 282 ! mixture of constituents
-integer(i4b),parameter,public :: hanssonVZJ = 283 ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
-! look-up values for the choice of method for the spatial representation of groundwater
-integer(i4b),parameter,public :: localColumn = 291 ! separate groundwater representation in each local soil column
-integer(i4b),parameter,public :: singleBasin = 292 ! single groundwater store over the entire basin
-! look-up values for the choice of sub-grid routing method
-integer(i4b),parameter,public :: timeDelay = 301 ! time-delay histogram
-integer(i4b),parameter,public :: qInstant = 302 ! instantaneous routing
-! look-up values for the choice of new snow density method
-integer(i4b),parameter,public :: constDens = 311 ! Constant new snow density
-integer(i4b),parameter,public :: anderson = 312 ! Anderson 1976
-integer(i4b),parameter,public :: hedAndPom = 313 ! Hedstrom and Pomeroy (1998), expoential increase
-integer(i4b),parameter,public :: pahaut_76 = 314 ! Pahaut 1976, wind speed dependent (derived from Col de Porte, French Alps)
-! look-up values for the choice of snow unloading from the canopy
-integer(i4b),parameter,public :: meltDripUnload = 321 ! Hedstrom and Pomeroy (1998), Storck et al 2002 (snowUnloadingCoeff & ratioDrip2Unloading)
-integer(i4b),parameter,public :: windUnload = 322 ! Roesch et al 2001, formulate unloading based on wind and temperature
-! look-up values for the choice of energy equation
-integer(i4b),parameter,public :: enthalpyFD = 323 ! enthalpyFD
-integer(i4b),parameter,public :: closedForm = 324 ! closedForm
-! -----------------------------------------------------------------------------------------------------------
-
-contains
-
-! ************************************************************************************************
-! public subroutine mDecisions: save model decisions as named integers
-! ************************************************************************************************
-#ifdef ACTORS_ACTIVE
-subroutine mDecisions(num_steps,err) bind(C, name='mDecisions')
-#else
-subroutine mDecisions(err,message)
-#endif
- ! model time structures
- USE multiconst,only:secprday ! number of seconds in a day
- USE var_lookup,only:iLookTIME ! named variables that identify indices in the time structures
- USE globalData,only:refTime,refJulday ! reference time
- USE globalData,only:oldTime ! time from the previous time step
- USE globalData,only:startTime,finshTime ! start/end time of simulation
- USE globalData,only:dJulianStart ! julian day of start time of simulation
- USE globalData,only:dJulianFinsh ! julian day of end time of simulation
- USE globalData,only:data_step ! length of data step (s)
- USE globalData,only:numtim ! number of time steps in the simulation
- ! model decision structures
- USE globaldata,only:model_decisions ! model decision structure
- USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
- ! forcing metadata
- USE globalData,only:forc_meta ! metadata structures
- USE var_lookup,only:iLookFORCE ! named variables to define structure elements
- ! Noah-MP decision structures
- USE noahmp_globals,only:DVEG ! decision for dynamic vegetation
- USE noahmp_globals,only:OPT_RAD ! decision for canopy radiation
- USE noahmp_globals,only:OPT_ALB ! decision for snow albedo
- ! time utility programs
- USE time_utils_module,only:extractTime ! extract time info from units string
- USE time_utils_module,only:compjulday ! compute the julian day
- USE time_utils_module,only:fracDay ! compute fractional day
- USE summaFileManager,only: SIM_START_TM, SIM_END_TM ! time info from control file module
-
- implicit none
- ! define output, depends on if using Actors
-#ifdef ACTORS_ACTIVE
- integer(c_int),intent(out) :: num_steps ! number of time steps in the simulation
- integer(c_int),intent(out) :: err ! error code
- character(*) :: message ! error message
-#else
- integer(i4b) :: num_steps ! number of time steps in the simulation
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
-#endif
- ! define local variables
- character(len=256) :: cmessage ! error message for downwind routine
- real(rkind) :: dsec,dsec_tz ! second
- ! initialize error control
- err=0; message='mDecisions/'
-
- ! read information from model decisions file, and populate model decisions structure
- call readoption(err,cmessage)
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
-
- ! put reference time information into the time structures
- call extractTime(forc_meta(iLookFORCE%time)%varunit, & ! date-time string
- refTime%var(iLookTIME%iyyy), & ! year
- refTime%var(iLookTIME%im), & ! month
- refTime%var(iLookTIME%id), & ! day
- refTime%var(iLookTIME%ih), & ! hour
- refTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- refTime%var(iLookTIME%ih_tz), & ! time zone hour
- refTime%var(iLookTIME%imin_tz), & ! time zone minute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the reference time
- call compjulday(&
- refTime%var(iLookTIME%iyyy), & ! year
- refTime%var(iLookTIME%im), & ! month
- refTime%var(iLookTIME%id), & ! day
- refTime%var(iLookTIME%ih), & ! hour
- refTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- refJulday, & ! julian date for the start of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! put simulation start time information into the time structures
- call extractTime(trim(SIM_START_TM), & ! date-time string
- startTime%var(iLookTIME%iyyy), & ! year
- startTime%var(iLookTIME%im), & ! month
- startTime%var(iLookTIME%id), & ! day
- startTime%var(iLookTIME%ih), & ! hour
- startTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- startTime%var(iLookTIME%ih_tz), & ! time zone hour
- startTime%var(iLookTIME%imin_tz), & ! time zone minnute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the start of the simulation
- call compjulday(&
- startTime%var(iLookTIME%iyyy), & ! year
- startTime%var(iLookTIME%im), & ! month
- startTime%var(iLookTIME%id), & ! day
- startTime%var(iLookTIME%ih), & ! hour
- startTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- dJulianStart, & ! julian date for the start of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! put simulation end time information into the time structures
- call extractTime(trim(SIM_END_TM), & ! date-time string
- finshTime%var(iLookTIME%iyyy), & ! year
- finshTime%var(iLookTIME%im), & ! month
- finshTime%var(iLookTIME%id), & ! day
- finshTime%var(iLookTIME%ih), & ! hour
- finshTime%var(iLookTIME%imin), & ! minute
- dsec, & ! second
- finshTime%var(iLookTIME%ih_tz), & ! time zone hour
- finshTime%var(iLookTIME%imin_tz), & ! time zone minnute
- dsec_tz, & ! time zone seconds
- err,cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! compute the julian date (fraction of day) for the end of the simulation
- call compjulday(&
- finshTime%var(iLookTIME%iyyy), & ! year
- finshTime%var(iLookTIME%im), & ! month
- finshTime%var(iLookTIME%id), & ! day
- finshTime%var(iLookTIME%ih), & ! hour
- finshTime%var(iLookTIME%imin), & ! minute
- 0._rkind, & ! second
- dJulianFinsh, & ! julian date for the end of the simulation
- err, cmessage) ! error control
- if(err/=0)then; err=20; message=trim(message)//trim(cmessage); return; end if
-
- ! check start and finish time
- write(*,'(a,i4,1x,4(i2,1x))') 'startTime: iyyy, im, id, ih, imin = ', startTime%var(1:5)
- write(*,'(a,i4,1x,4(i2,1x))') 'finshTime: iyyy, im, id, ih, imin = ', finshTime%var(1:5)
-
- ! check that simulation end time is > start time
- if(dJulianFinsh < dJulianStart)then; err=20; message=trim(message)//'end time of simulation occurs before start time'; return; end if
-
- ! initialize the old time vector (time from the previous time step)
- oldTime%var(:) = startTime%var(:)
-
- ! compute the number of time steps
- num_steps = nint( (dJulianFinsh - dJulianStart)*secprday/data_step ) + 1
- numtim = num_steps
-#ifndef ACTORS_ACTIVE
- write(*,'(a,1x,i10)') 'number of time steps = ', numtim
-#endif
-
- ! set Noah-MP options
- DVEG=3 ! option for dynamic vegetation
- OPT_RAD=3 ! option for canopy radiation
- OPT_ALB=2 ! option for snow albedo
-
- ! set zero option for thee category tables
- ! NOTE: we want to keep track of these decisions, but not used in the physics routines
- model_decisions(iLookDECISIONS%soilCatTbl)%iDecision = 0
- model_decisions(iLookDECISIONS%vegeParTbl)%iDecision = 0
-
- ! identify the choice of function for the soil moisture control on stomatal resistance
- select case(trim(model_decisions(iLookDECISIONS%soilStress)%cDecision))
- case('NoahType'); model_decisions(iLookDECISIONS%soilStress)%iDecision = NoahType ! thresholded linear function of volumetric liquid water content
- case('CLM_Type'); model_decisions(iLookDECISIONS%soilStress)%iDecision = CLM_Type ! thresholded linear function of matric head
- case('SiB_Type'); model_decisions(iLookDECISIONS%soilStress)%iDecision = SiB_Type ! exponential of the log of matric head
- case default
- err=10; message=trim(message)//"unknown soil moisture function [option="//trim(model_decisions(iLookDECISIONS%soilStress)%cDecision)//"]"; return
- end select
-
- ! identify the choice of function for stomatal resistance
- select case(trim(model_decisions(iLookDECISIONS%stomResist)%cDecision))
- case('BallBerry' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerry ! Ball-Berry
- case('Jarvis' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = Jarvis ! Jarvis
- case('simpleResistance' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = simpleResistance ! simple resistance formulation
- case('BallBerryFlex' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerryFlex ! flexible Ball-Berry scheme
- case('BallBerryTest' ); model_decisions(iLookDECISIONS%stomResist)%iDecision = BallBerryTest ! flexible Ball-Berry scheme (testing)
- case default
- err=10; message=trim(message)//"unknown stomatal resistance function [option="//trim(model_decisions(iLookDECISIONS%stomResist)%cDecision)//"]"; return
- end select
-
- ! identify the leaf temperature controls on photosynthesis + stomatal resistance
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbTempFunc)%cDecision))
- case('q10Func' ); model_decisions(iLookDECISIONS%bbTempFunc)%iDecision = q10Func
- case('Arrhenius' ); model_decisions(iLookDECISIONS%bbTempFunc)%iDecision = Arrhenius
- case default
- err=10; message=trim(message)//"unknown leaf temperature function [option="//trim(model_decisions(iLookDECISIONS%bbTempFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the humidity controls on stomatal resistance
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbHumdFunc)%cDecision))
- case('humidLeafSurface' ); model_decisions(iLookDECISIONS%bbHumdFunc)%iDecision = humidLeafSurface
- case('scaledHyperbolic' ); model_decisions(iLookDECISIONS%bbHumdFunc)%iDecision = scaledHyperbolic
- case default
- err=10; message=trim(message)//"unknown humidity function [option="//trim(model_decisions(iLookDECISIONS%bbHumdFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify functions for electron transport function (dependence of photosynthesis on PAR)
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbElecFunc)%cDecision))
- case('linear' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = linear
- case('linearJmax' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = linearJmax
- case('quadraticJmax' ); model_decisions(iLookDECISIONS%bbElecFunc)%iDecision = quadraticJmax
- case default
- err=10; message=trim(message)//"unknown electron transport function [option="//trim(model_decisions(iLookDECISIONS%bbElecFunc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the use of the co2 compensation point in the stomatal conductance calaculations
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbCO2point)%cDecision))
- case('origBWB' ); model_decisions(iLookDECISIONS%bbCO2point)%iDecision = origBWB
- case('Leuning' ); model_decisions(iLookDECISIONS%bbCO2point)%iDecision = Leuning
- case default
- err=10; message=trim(message)//"unknown option for the co2 compensation point [option="//trim(model_decisions(iLookDECISIONS%bbCO2point)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the iterative numerical solution method used in the Ball-Berry stomatal resistance parameterization
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbNumerics)%cDecision))
- case('NoahMPsolution' ); model_decisions(iLookDECISIONS%bbNumerics)%iDecision = NoahMPsolution ! the NoahMP solution (and CLM4): fixed point iteration; max 3 iterations
- case('newtonRaphson' ); model_decisions(iLookDECISIONS%bbNumerics)%iDecision = newtonRaphson ! full Newton-Raphson iterative solution to convergence
- case default
- err=10; message=trim(message)//"unknown option for the Ball-Berry numerical solution [option="//trim(model_decisions(iLookDECISIONS%bbNumerics)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the controls on carbon assimilation
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbAssimFnc)%cDecision))
- case('colimitation' ); model_decisions(iLookDECISIONS%bbAssimFnc)%iDecision = colimitation ! enable colimitation, as described by Collatz et al. (1991) and Sellers et al. (1996)
- case('minFunc' ); model_decisions(iLookDECISIONS%bbAssimFnc)%iDecision = minFunc ! do not enable colimitation: use minimum of the three controls on carbon assimilation
- case default
- err=10; message=trim(message)//"unknown option for the controls on carbon assimilation [option="//trim(model_decisions(iLookDECISIONS%bbAssimFnc)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the scaling of photosynthesis from the leaf to the canopy
- if(model_decisions(iLookDECISIONS%stomResist)%iDecision >= BallBerryFlex)then
- select case(trim(model_decisions(iLookDECISIONS%bbCanIntg8)%cDecision))
- case('constantScaling' ); model_decisions(iLookDECISIONS%bbCanIntg8)%iDecision = constantScaling ! constant scaling factor
- case('laiScaling' ); model_decisions(iLookDECISIONS%bbCanIntg8)%iDecision = laiScaling ! exponential function of LAI (Leuning, Plant Cell Env 1995: "Scaling from..." [eq 9])
- case default
- err=10; message=trim(message)//"unknown option for scaling of photosynthesis from the leaf to the canopy [option="//trim(model_decisions(iLookDECISIONS%bbCanIntg8)%cDecision)//"]"; return
- end select
- end if
-
- ! identify the numerical method
- select case(trim(model_decisions(iLookDECISIONS%num_method)%cDecision))
- case('bEuler' ); model_decisions(iLookDECISIONS%num_method)%iDecision = bEuler ! home-grown backward Euler solution with long time steps
- case('itertive' ); model_decisions(iLookDECISIONS%num_method)%iDecision = bEuler ! home-grown backward Euler solution (included for backwards compatibility)
- case('sundials' ); model_decisions(iLookDECISIONS%num_method)%iDecision = sundials ! SUNDIALS/IDA solution
- case default
- err=10; message=trim(message)//"unknown numerical method [option="//trim(model_decisions(iLookDECISIONS%num_method)%cDecision)//"]"; return
- end select
-
- ! how to compute heat capacity in energy equation, choice enthalpyFD has better coincidence of energy conservation with sundials tolerance.
- select case(trim(model_decisions(iLookDECISIONS%howHeatCap)%cDecision))
- case('enthalpyFD'); model_decisions(iLookDECISIONS%howHeatCap)%iDecision = enthalpyFD ! heat capacity using enthalpy
- case('closedForm'); model_decisions(iLookDECISIONS%howHeatCap)%iDecision = closedForm ! heat capacity using closed form, not using enthalpy
- case default
- if (trim(model_decisions(iLookDECISIONS%num_method)%cDecision)=='itertive')then
- model_decisions(iLookDECISIONS%howHeatCap)%iDecision = closedForm ! included for backwards compatibility
- else
- err=10; message=trim(message)//"unknown Cp computation [option="//trim(model_decisions(iLookDECISIONS%howHeatCap)%cDecision)//"]"; return
- endif
- end select
-
- ! identify the method used to calculate flux derivatives
- select case(trim(model_decisions(iLookDECISIONS%fDerivMeth)%cDecision))
- case('numericl'); model_decisions(iLookDECISIONS%fDerivMeth)%iDecision = numerical ! numerical
- case('analytic'); model_decisions(iLookDECISIONS%fDerivMeth)%iDecision = analytical ! analytical
- case default
- err=10; message=trim(message)//"unknown method used to calculate flux derivatives [option="//trim(model_decisions(iLookDECISIONS%fDerivMeth)%cDecision)//"]"; return
- end select
-
- ! identify the method used to determine LAI and SAI
- select case(trim(model_decisions(iLookDECISIONS%LAI_method)%cDecision))
- case('monTable'); model_decisions(iLookDECISIONS%LAI_method)%iDecision = monthlyTable ! LAI/SAI taken directly from a monthly table for different vegetation classes
- case('specified'); model_decisions(iLookDECISIONS%LAI_method)%iDecision = specified ! LAI/SAI computed from green vegetation fraction and winterSAI and summerLAI parameters
- case default
- err=10; message=trim(message)//"unknown method to determine LAI and SAI [option="//trim(model_decisions(iLookDECISIONS%LAI_method)%cDecision)//"]"; return
- end select
-
- ! identify the canopy interception parameterization
- select case(trim(model_decisions(iLookDECISIONS%cIntercept)%cDecision))
- case('notPopulatedYet'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = unDefined
- case('sparseCanopy'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = sparseCanopy
- case('storageFunc'); model_decisions(iLookDECISIONS%cIntercept)%iDecision = storageFunc
- case default
- err=10; message=trim(message)//"unknown canopy interception parameterization [option="//trim(model_decisions(iLookDECISIONS%cIntercept)%cDecision)//"]"; return
- end select
-
- ! identify the form of Richards' equation
- select case(trim(model_decisions(iLookDECISIONS%f_Richards)%cDecision))
- case('moisture'); model_decisions(iLookDECISIONS%f_Richards)%iDecision = moisture ! moisture-based form
- case('mixdform'); model_decisions(iLookDECISIONS%f_Richards)%iDecision = mixdform ! mixed form
- case default
- err=10; message=trim(message)//"unknown form of Richards' equation [option="//trim(model_decisions(iLookDECISIONS%f_Richards)%cDecision)//"]"; return
- end select
-
- ! identify the groundwater parameterization
- select case(trim(model_decisions(iLookDECISIONS%groundwatr)%cDecision))
- case('qTopmodl'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = qbaseTopmodel ! TOPMODEL-ish baseflow parameterization
- case('bigBuckt'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = bigBucket ! a big bucket (lumped aquifer model)
- case('noXplict'); model_decisions(iLookDECISIONS%groundwatr)%iDecision = noExplicit ! no explicit groundwater parameterization
- case default
- err=10; message=trim(message)//"unknown groundwater parameterization [option="//trim(model_decisions(iLookDECISIONS%groundwatr)%cDecision)//"]"; return
- end select
-
- ! identify the hydraulic conductivity profile
- select case(trim(model_decisions(iLookDECISIONS%hc_profile)%cDecision))
- case('constant'); model_decisions(iLookDECISIONS%hc_profile)%iDecision = constant ! constant hydraulic conductivity with depth
- case('pow_prof'); model_decisions(iLookDECISIONS%hc_profile)%iDecision = powerLaw_profile ! power-law profile
- case default
- err=10; message=trim(message)//"unknown hydraulic conductivity profile [option="//trim(model_decisions(iLookDECISIONS%hc_profile)%cDecision)//"]"; return
- end select
-
- ! identify the upper boundary conditions for thermodynamics
- select case(trim(model_decisions(iLookDECISIONS%bcUpprTdyn)%cDecision))
- case('presTemp'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = prescribedTemp ! prescribed temperature
- case('nrg_flux'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = energyFlux ! energy flux
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown upper boundary conditions for thermodynamics [option="//trim(model_decisions(iLookDECISIONS%bcUpprTdyn)%cDecision)//"]"; return
- end select
-
- ! identify the lower boundary conditions for thermodynamics
- select case(trim(model_decisions(iLookDECISIONS%bcLowrTdyn)%cDecision))
- case('presTemp'); model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision = prescribedTemp ! prescribed temperature
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcLowrTdyn)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown lower boundary conditions for thermodynamics [option="//trim(model_decisions(iLookDECISIONS%bcLowrTdyn)%cDecision)//"]"; return
- end select
-
- ! identify the upper boundary conditions for soil hydrology
- select case(trim(model_decisions(iLookDECISIONS%bcUpprSoiH)%cDecision))
- case('presHead'); model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision = prescribedHead ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- case('liq_flux'); model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision = liquidFlux ! liquid water flux
- case default
- err=10; message=trim(message)//"unknown upper boundary conditions for soil hydrology [option="//trim(model_decisions(iLookDECISIONS%bcUpprSoiH)%cDecision)//"]"; return
- end select
-
- ! identify the lower boundary conditions for soil hydrology
- select case(trim(model_decisions(iLookDECISIONS%bcLowrSoiH)%cDecision))
- case('presHead'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = prescribedHead ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- case('bottmPsi'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = funcBottomHead ! function of matric head in the lower-most layer
- case('drainage'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = freeDrainage ! free drainage
- case('zeroFlux'); model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision = zeroFlux ! zero flux
- case default
- err=10; message=trim(message)//"unknown lower boundary conditions for soil hydrology [option="//trim(model_decisions(iLookDECISIONS%bcLowrSoiH)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for vegetation roughness length and displacement height
- select case(trim(model_decisions(iLookDECISIONS%veg_traits)%cDecision))
- case('Raupach_BLM1994'); model_decisions(iLookDECISIONS%veg_traits)%iDecision = Raupach_BLM1994 ! Raupach (BLM 1994) "Simplified expressions..."
- case('CM_QJRMS1988' ); model_decisions(iLookDECISIONS%veg_traits)%iDecision = CM_QJRMS1988 ! Choudhury and Monteith (QJRMS 1998) "A four layer model for the heat budget..."
- case('vegTypeTable' ); model_decisions(iLookDECISIONS%veg_traits)%iDecision = vegTypeTable ! constant parameters dependent on the vegetation type
- case default
- err=10; message=trim(message)//"unknown parameterization for vegetation roughness length and displacement height [option="//trim(model_decisions(iLookDECISIONS%veg_traits)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for the rooting profile
- ! NOTE: for backwards compatibility select powerLaw if rooting profile is undefined
- select case(trim(model_decisions(iLookDECISIONS%rootProfil)%cDecision))
- case('powerLaw','notPopulatedYet'); model_decisions(iLookDECISIONS%rootProfil)%iDecision = powerLaw ! simple power-law rooting profile
- case('doubleExp'); model_decisions(iLookDECISIONS%rootProfil)%iDecision = doubleExp ! the double exponential function of Xeng et al. (JHM 2001)
- case default
- err=10; message=trim(message)//"unknown parameterization for rooting profile [option="//trim(model_decisions(iLookDECISIONS%rootProfil)%cDecision)//"]"; return
- end select
-
- ! identify the choice of parameterization for canopy emissivity
- select case(trim(model_decisions(iLookDECISIONS%canopyEmis)%cDecision))
- case('simplExp'); model_decisions(iLookDECISIONS%canopyEmis)%iDecision = simplExp ! simple exponential function
- case('difTrans'); model_decisions(iLookDECISIONS%canopyEmis)%iDecision = difTrans ! parameterized as a function of diffuse transmissivity
- case default
- err=10; message=trim(message)//"unknown parameterization for canopy emissivity [option="//trim(model_decisions(iLookDECISIONS%canopyEmis)%cDecision)//"]"; return
- end select
-
- ! choice of parameterization for snow interception
- select case(trim(model_decisions(iLookDECISIONS%snowIncept)%cDecision))
- case('stickySnow'); model_decisions(iLookDECISIONS%snowIncept)%iDecision = stickySnow ! maximum interception capacity an increasing function of temerature
- case('lightSnow' ); model_decisions(iLookDECISIONS%snowIncept)%iDecision = lightSnow ! maximum interception capacity an inverse function of new snow density
- case default
- err=10; message=trim(message)//"unknown option for snow interception capacity[option="//trim(model_decisions(iLookDECISIONS%snowIncept)%cDecision)//"]"; return
- end select
-
- ! identify the choice of wind profile
- select case(trim(model_decisions(iLookDECISIONS%windPrfile)%cDecision))
- case('exponential' ); model_decisions(iLookDECISIONS%windPrfile)%iDecision = exponential ! exponential wind profile extends to the surface
- case('logBelowCanopy'); model_decisions(iLookDECISIONS%windPrfile)%iDecision = logBelowCanopy ! logarithmic profile below the vegetation canopy
- case default
- err=10; message=trim(message)//"unknown option for choice of wind profile[option="//trim(model_decisions(iLookDECISIONS%windPrfile)%cDecision)//"]"; return
- end select
-
- ! identify the choice of atmospheric stability function
- select case(trim(model_decisions(iLookDECISIONS%astability)%cDecision))
- case('standard'); model_decisions(iLookDECISIONS%astability)%iDecision = standard ! standard MO similarity, a la Anderson (1976)
- case('louisinv'); model_decisions(iLookDECISIONS%astability)%iDecision = louisInversePower ! Louis (1979) inverse power function
- case('mahrtexp'); model_decisions(iLookDECISIONS%astability)%iDecision = mahrtExponential ! Mahrt (1987) exponential
- case default
- err=10; message=trim(message)//"unknown stability function [option="//trim(model_decisions(iLookDECISIONS%astability)%cDecision)//"]"; return
- end select
-
- ! choice of canopy shortwave radiation method
- select case(trim(model_decisions(iLookDECISIONS%canopySrad)%cDecision))
- case('noah_mp' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = noah_mp ! full Noah-MP implementation (including albedo)
- case('CLM_2stream'); model_decisions(iLookDECISIONS%canopySrad)%iDecision = CLM_2stream ! CLM 2-stream model (see CLM documentation)
- case('UEB_2stream'); model_decisions(iLookDECISIONS%canopySrad)%iDecision = UEB_2stream ! UEB 2-stream model (Mahat and Tarboton, WRR 2011)
- case('NL_scatter' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = NL_scatter ! Simplified method Nijssen and Lettenmaier (JGR 1999)
- case('BeersLaw' ); model_decisions(iLookDECISIONS%canopySrad)%iDecision = BeersLaw ! Beer's Law (as implemented in VIC)
- case default
- err=10; message=trim(message)//"unknown canopy radiation method [option="//trim(model_decisions(iLookDECISIONS%canopySrad)%cDecision)//"]"; return
- end select
-
- ! choice of albedo representation
- select case(trim(model_decisions(iLookDECISIONS%alb_method)%cDecision))
- case('conDecay'); model_decisions(iLookDECISIONS%alb_method)%iDecision = constantDecay ! constant decay (e.g., VIC, CLASS)
- case('varDecay'); model_decisions(iLookDECISIONS%alb_method)%iDecision = variableDecay ! variable decay (e.g., BATS approach, with destructive metamorphism + soot content)
- case default
- err=10; message=trim(message)//"unknown option for snow albedo [option="//trim(model_decisions(iLookDECISIONS%alb_method)%cDecision)//"]"; return
- end select
-
- ! choice of snow compaction routine
- select case(trim(model_decisions(iLookDECISIONS%compaction)%cDecision))
- case('consettl'); model_decisions(iLookDECISIONS%compaction)%iDecision = constantSettlement ! constant settlement rate
- case('anderson'); model_decisions(iLookDECISIONS%compaction)%iDecision = andersonEmpirical ! semi-empirical method of Anderson (1976)
- case default
- err=10; message=trim(message)//"unknown option for snow compaction [option="//trim(model_decisions(iLookDECISIONS%compaction)%cDecision)//"]"; return
- end select
-
- ! choice of method to combine and sub-divide snow layers
- select case(trim(model_decisions(iLookDECISIONS%snowLayers)%cDecision))
- case('jrdn1991'); model_decisions(iLookDECISIONS%snowLayers)%iDecision = sameRulesAllLayers ! SNTHERM option: same combination/sub-dividion rules applied to all layers
- case('CLM_2010'); model_decisions(iLookDECISIONS%snowLayers)%iDecision = rulesDependLayerIndex ! CLM option: combination/sub-dividion rules depend on layer index
- case default
- err=10; message=trim(message)//"unknown option for combination/sub-division of snow layers [option="//trim(model_decisions(iLookDECISIONS%snowLayers)%cDecision)//"]"; return
- end select
-
- ! choice of thermal conductivity representation for snow
- select case(trim(model_decisions(iLookDECISIONS%thCondSnow)%cDecision))
- case('tyen1965'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Yen1965 ! Yen (1965)
- case('melr1977'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Mellor1977 ! Mellor (1977)
- case('jrdn1991'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Jordan1991 ! Jordan (1991)
- case('smnv2000'); model_decisions(iLookDECISIONS%thCondSnow)%iDecision = Smirnova2000 ! Smirnova et al. (2000)
- case default
- err=10; message=trim(message)//"unknown option for thermal conductivity of snow [option="//trim(model_decisions(iLookDECISIONS%thCondSnow)%cDecision)//"]"; return
- end select
-
- ! choice of thermal conductivity representation for soil
- select case(trim(model_decisions(iLookDECISIONS%thCondSoil)%cDecision))
- case('funcSoilWet'); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = funcSoilWet ! function of soil wetness
- case('mixConstit' ); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = mixConstit ! mixture of constituents
- case('hanssonVZJ' ); model_decisions(iLookDECISIONS%thCondSoil)%iDecision = hanssonVZJ ! test case for the mizoguchi lab experiment, Hansson et al. VZJ 2004
- case default
- err=10; message=trim(message)//"unknown option for thermal conductivity of soil [option="//trim(model_decisions(iLookDECISIONS%thCondSoil)%cDecision)//"]"; return
- end select
-
- ! choice of method for the spatial representation of groundwater
- select case(trim(model_decisions(iLookDECISIONS%spatial_gw)%cDecision))
- case('localColumn'); model_decisions(iLookDECISIONS%spatial_gw)%iDecision = localColumn ! separate groundwater in each local soil column
- case('singleBasin'); model_decisions(iLookDECISIONS%spatial_gw)%iDecision = singleBasin ! single groundwater store over the entire basin
- case default
- err=10; message=trim(message)//"unknown option for spatial representation of groundwater [option="//trim(model_decisions(iLookDECISIONS%spatial_gw)%cDecision)//"]"; return
- end select
-
- ! choice of routing method
- select case(trim(model_decisions(iLookDECISIONS%subRouting)%cDecision))
- case('timeDlay'); model_decisions(iLookDECISIONS%subRouting)%iDecision = timeDelay ! time-delay histogram
- case('qInstant'); model_decisions(iLookDECISIONS%subRouting)%iDecision = qInstant ! instantaneous routing
- case default
- err=10; message=trim(message)//"unknown option for sub-grid routing [option="//trim(model_decisions(iLookDECISIONS%subRouting)%cDecision)//"]"; return
- end select
-
- ! choice of new snow density
- ! NOTE: use hedAndPom as the default, where density method is undefined (not populated yet)
- select case(trim(model_decisions(iLookDECISIONS%snowDenNew)%cDecision))
- case('hedAndPom','notPopulatedYet'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = hedAndPom ! Hedstrom and Pomeroy (1998), expoential increase
- case('anderson'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = anderson ! Anderson 1976
- case('pahaut_76'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = pahaut_76 ! Pahaut 1976, wind speed dependent (derived from Col de Porte, French Alps)
- case('constDens'); model_decisions(iLookDECISIONS%snowDenNew)%iDecision = constDens ! Constant new snow density
- case default
- err=10; message=trim(message)//"unknown option for new snow density [option="//trim(model_decisions(iLookDECISIONS%snowDenNew)%cDecision)//"]"; return
- end select
-
- ! choice of snow unloading from canopy
- select case(trim(model_decisions(iLookDECISIONS%snowUnload)%cDecision))
- case('meltDripUnload','notPopulatedYet'); model_decisions(iLookDECISIONS%snowUnload)%iDecision = meltDripUnload ! Hedstrom and Pomeroy (1998), Storck et al 2002 (snowUnloadingCoeff & ratioDrip2Unloading)
- case('windUnload'); model_decisions(iLookDECISIONS%snowUnload)%iDecision = windUnload ! Roesch et al 2001, formulate unloading based on wind and temperature
- case default
- err=10; message=trim(message)//"unknown option for snow unloading [option="//trim(model_decisions(iLookDECISIONS%snowUnload)%cDecision)//"]"; return
- end select
-
-
- ! -----------------------------------------------------------------------------------------------------------------------------------------------
- ! check for consistency among options
- ! -----------------------------------------------------------------------------------------------------------------------------------------------
- ! check zero flux lower boundary for topmodel baseflow option
- select case(model_decisions(iLookDECISIONS%groundwatr)%iDecision)
- case(qbaseTopmodel)
- if(model_decisions(iLookDECISIONS%bcLowrSoiH)%iDecision /= zeroFlux)then
- message=trim(message)//'lower boundary condition for soil hydology must be zeroFlux with qbaseTopmodel option for groundwater'
- err=20; return
- end if
- end select
-
- ! check power-law profile is selected when using topmodel baseflow option
- select case(model_decisions(iLookDECISIONS%groundwatr)%iDecision)
- case(qbaseTopmodel)
- if(model_decisions(iLookDECISIONS%hc_profile)%iDecision /= powerLaw_profile)then
- message=trim(message)//'power-law transmissivity profile must be selected when using topmodel baseflow option'
- err=20; return
- end if
- end select
-
- ! check bigBucket groundwater option is used when for spatial groundwater is singleBasin
- if(model_decisions(iLookDECISIONS%spatial_gw)%iDecision == singleBasin)then
- if(model_decisions(iLookDECISIONS%groundwatr)%iDecision /= bigBucket)then
- message=trim(message)//'groundwater parameterization must be bigBucket when using singleBasin for spatial_gw'
- err=20; return
- end if
- end if
-
-end subroutine mDecisions
-
-
-! ************************************************************************************************
-! private subroutine readoption: read information from model decisions file
-! ************************************************************************************************
-subroutine readoption(err,message)
- ! used to read information from model decisions file
- USE ascii_util_module,only:file_open ! open file
- USE ascii_util_module,only:linewidth ! max character number for one line
- USE ascii_util_module,only:get_vlines ! get a vector of non-comment lines
- USE summaFileManager,only:SETTINGS_PATH ! path for metadata files
- USE summaFileManager,only:M_DECISIONS ! definition of modeling options
- USE get_ixname_module,only:get_ixdecisions ! identify index of named variable
- USE globalData,only:model_decisions ! model decision structure
- implicit none
- ! define output
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! define local variables
- character(len=256) :: cmessage ! error message for downwind routine
- character(LEN=256) :: infile ! input filename
- integer(i4b) :: unt ! file unit (free unit output from file_open)
- character(LEN=linewidth),allocatable :: charline(:) ! vector of character strings
- integer(i4b) :: nDecisions ! number of model decisions
- integer(i4b) :: iDecision ! index of model decisions
- character(len=32) :: decision ! name of model decision
- character(len=32) :: option ! option for model decision
- integer(i4b) :: iVar ! index of the decision in the data structure
- ! Start procedure here
- err=0; message='readoption/'
- ! build filename
- infile = trim(SETTINGS_PATH)//trim(M_DECISIONS)
- write(*,'(2(a,1x))') 'decisions file = ', trim(infile)
- ! open file
- call file_open(trim(infile),unt,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! get a list of character strings from non-comment lines
- call get_vlines(unt,charline,err,cmessage)
- if(err/=0)then; message=trim(message)//trim(cmessage); return; end if
- ! close the file unit
- close(unt)
- ! get the number of model decisions
- nDecisions = size(charline)
- ! populate the model decisions structure
- do iDecision=1,nDecisions
- ! extract name of decision and the decision selected
- read(charline(iDecision),*,iostat=err) option, decision
- if (err/=0) then; err=30; message=trim(message)//"errorReadLine"; return; end if
- ! get the index of the decision in the data structure
- iVar = get_ixdecisions(trim(option))
- write(*,'(i4,1x,a)') iDecision, trim(option)//': '//trim(decision)
- if(iVar<=0)then; err=40; message=trim(message)//"cannotFindDecisionIndex[name='"//trim(option)//"']"; return; end if
- ! populate the model decisions structure
- model_decisions(iVar)%cOption = trim(option)
- model_decisions(iVar)%cDecision = trim(decision)
- end do
-end subroutine readoption
-end module mDecisions_module
diff --git a/build/source/engine/vegPhenlgy.f90 b/build/source/engine/vegPhenlgy.f90
deleted file mode 100755
index e55bf289ffa4750f61d037694c8e80040b3e8688..0000000000000000000000000000000000000000
--- a/build/source/engine/vegPhenlgy.f90
+++ /dev/null
@@ -1,198 +0,0 @@
-! SUMMA - Structure for Unifying Multiple Modeling Alternatives
-! Copyright (C) 2014-2020 NCAR/RAL; University of Saskatchewan; University of Washington
-!
-! This file is part of SUMMA
-!
-! For more information see: http://www.ral.ucar.edu/projects/summa
-!
-! This program is free software: you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License
-! along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-module vegPhenlgy_module
-
-! data types
-USE nrtype
-
-! global variables
-USE globalData,only:urbanVegCategory ! vegetation category for urban areas
-
-! 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_dlength, & ! data vector with variable length dimension (rkind)
- model_options ! defines the model decisions
-
-! named variables defining elements in the data structures
-USE var_lookup,only:iLookTYPE,iLookATTR,iLookPARAM,iLookDIAG,iLookPROG ! named variables for structure elements
-USE var_lookup,only:iLookDECISIONS ! named variables for elements of the decision structure
-
-! look-up values for the boundary conditions
-USE mDecisions_module,only: &
- prescribedHead, & ! prescribed head (volumetric liquid water content for mixed form of Richards' eqn)
- prescribedTemp, & ! prescribed temperature
- zeroFlux ! zero flux
-
-! look-up values for the choice of canopy shortwave radiation method
-USE mDecisions_module,only: &
- noah_mp, & ! full Noah-MP implementation (including albedo)
- CLM_2stream, & ! CLM 2-stream model (see CLM documentation)
- UEB_2stream, & ! UEB 2-stream model (Mahat and Tarboton, WRR 2011)
- NL_scatter, & ! Simplified method Nijssen and Lettenmaier (JGR 1999)
- BeersLaw ! Beer's Law (as implemented in VIC)
-
-! privacy
-implicit none
-private
-public::vegPhenlgy
-! algorithmic parameters
-real(rkind),parameter :: valueMissing=-9999._rkind ! missing value, used when diagnostic or state variables are undefined
-real(rkind),parameter :: verySmall=1.e-6_rkind ! used as an additive constant to check if substantial difference among real numbers
-contains
-
-
- ! ************************************************************************************************
- ! public subroutine vegPhenlgy: compute vegetation phenology
- ! ************************************************************************************************
- subroutine vegPhenlgy(&
- ! input/output: data structures
- model_decisions, & ! intent(in): model decisions
- type_data, & ! intent(in): type of vegetation and soil
- attr_data, & ! intent(in): spatial attributes
- mpar_data, & ! intent(in): model parameters
- prog_data, & ! intent(in): prognostic variables for a local HRU
- diag_data, & ! intent(inout): diagnostic variables for a local HRU
- ! output
- computeVegFlux, & ! intent(out): flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- canopyDepth, & ! intent(out): canopy depth (m)
- exposedVAI, & ! intent(out): exposed vegetation area index (LAI + SAI)
- fracJulDay, &
- yearLength, &
- err,message) ! intent(out): error control
- ! -------------------------------------------------------------------------------------------------
- ! modules
- USE NOAHMP_ROUTINES,only:phenology ! determine vegetation phenology
- implicit none
- ! -------------------------------------------------------------------------------------------------
- ! input/output
- type(model_options),intent(in) :: model_decisions(:) ! model decisions
- 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_dlength),intent(in) :: prog_data ! prognostic variables for a local HRU
- type(var_dlength),intent(inout) :: diag_data ! diagnostic variables for a local HRU
- ! output
- logical(lgt),intent(out) :: computeVegFlux ! flag to indicate if we are computing fluxes over vegetation (.false. means veg is buried with snow)
- real(rkind),intent(out) :: canopyDepth ! canopy depth (m)
- real(rkind),intent(out) :: exposedVAI ! exposed vegetation area index (LAI + SAI)
- real(rkind),intent(inout) :: fracJulday
- integer(i4b),intent(inout) :: yearLength
- integer(i4b),intent(out) :: err ! error code
- character(*),intent(out) :: message ! error message
- ! -------------------------------------------------------------------------------------------------
- ! local
- real(rkind) :: notUsed_heightCanopyTop ! height of the top of the canopy layer (m)
- real(rkind) :: heightAboveSnow ! height top of canopy is above the snow surface (m)
- ! initialize error control
- err=0; message="vegPhenlgy/"
- ! ----------------------------------------------------------------------------------------------------------------------------------
- ! associate variables in the data structure
- associate(&
-
- ! input: model decisions
- ix_bcUpprTdyn => model_decisions(iLookDECISIONS%bcUpprTdyn)%iDecision, & ! intent(in): [i4b] choice of upper boundary condition for thermodynamics
- ix_bcUpprSoiH => model_decisions(iLookDECISIONS%bcUpprSoiH)%iDecision, & ! intent(in): [i4b] index of method used for the upper boundary condition for soil hydrology
-
- ! local attributes
- vegTypeIndex => type_data%var(iLookTYPE%vegTypeIndex), & ! intent(in): [i4b] vegetation type index
- latitude => attr_data%var(iLookATTR%latitude), & ! intent(in): [dp] latitude
-
- ! model state variables
- scalarSnowDepth => prog_data%var(iLookPROG%scalarSnowDepth)%dat(1), & ! intent(in): [dp] snow depth on the ground surface (m)
- scalarCanopyTemp => prog_data%var(iLookPROG%scalarCanopyTemp)%dat(1), & ! intent(in): [dp] temperature of the vegetation canopy at the start of the sub-step (K)
-
- ! diagnostic variables and parameters (input)
- heightCanopyTop => mpar_data%var(iLookPARAM%heightCanopyTop)%dat(1), & ! intent(in): [dp] height of the top of the canopy layer (m)
- heightCanopyBottom => mpar_data%var(iLookPARAM%heightCanopyBottom)%dat(1), & ! intent(in): [dp] height of the bottom of the canopy layer (m)
- scalarRootZoneTemp => diag_data%var(iLookDIAG%scalarRootZoneTemp)%dat(1), & ! intent(in): [dp] root zone temperature (K)
-
- ! diagnostic variables and parameters (input/output)
- scalarLAI => diag_data%var(iLookDIAG%scalarLAI)%dat(1), & ! intent(inout): [dp] one-sided leaf area index (m2 m-2)
- scalarSAI => diag_data%var(iLookDIAG%scalarSAI)%dat(1), & ! intent(inout): [dp] one-sided stem area index (m2 m-2)
-
- ! diagnostic variables and parameters (output)
- scalarExposedLAI => diag_data%var(iLookDIAG%scalarExposedLAI)%dat(1), & ! intent(out): [dp] exposed leaf area index after burial by snow (m2 m-2)
- scalarExposedSAI => diag_data%var(iLookDIAG%scalarExposedSAI)%dat(1), & ! intent(out): [dp] exposed stem area index after burial by snow (m2 m-2)
- scalarGrowingSeasonIndex => diag_data%var(iLookDIAG%scalarGrowingSeasonIndex)%dat(1) & ! intent(out): [dp] growing season index (0=off, 1=on)
-
- ) ! associate variables in data structure
- ! ----------------------------------------------------------------------------------------------------------------------------------
-
- ! check if we have isolated the snow-soil domain (used in test cases)
- if(ix_bcUpprTdyn == prescribedTemp .or. ix_bcUpprTdyn == zeroFlux .or. ix_bcUpprSoiH == prescribedHead)then
-
- ! isolated snow-soil domain: do not compute fluxes over vegetation
- computeVegFlux = .false.
-
- ! set vegetation phenology variables to missing
- scalarLAI = valueMissing ! one-sided leaf area index (m2 m-2)
- scalarSAI = valueMissing ! one-sided stem area index (m2 m-2)
- scalarExposedLAI = valueMissing ! exposed leaf area index after burial by snow (m2 m-2)
- scalarExposedSAI = valueMissing ! exposed stem area index after burial by snow (m2 m-2)
- scalarGrowingSeasonIndex = valueMissing ! growing season index (0=off, 1=on)
- exposedVAI = valueMissing ! exposed vegetation area index (m2 m-2)
- canopyDepth = valueMissing ! canopy depth (m)
- heightAboveSnow = valueMissing ! height top of canopy is above the snow surface (m)
-
- ! compute vegetation phenology (checks for complete burial of vegetation)
- else
-
- ! determine vegetation phenology
- ! NOTE: recomputing phenology every sub-step accounts for changes in exposed vegetation associated with changes in snow depth
- call phenology(&
- ! input
- vegTypeIndex, & ! intent(in): vegetation type index
- urbanVegCategory, & ! intent(in): vegetation category for urban areas
- scalarSnowDepth, & ! intent(in): snow depth on the ground surface (m)
- scalarCanopyTemp, & ! intent(in): temperature of the vegetation canopy at the start of the sub-step (K)
- latitude, & ! intent(in): latitude
- yearLength, & ! intent(in): number of days in the current year
- fracJulDay, & ! intent(in): fractional julian days since the start of year
- scalarLAI, & ! intent(inout): one-sided leaf area index (m2 m-2)
- scalarSAI, & ! intent(inout): one-sided stem area index (m2 m-2)
- scalarRootZoneTemp, & ! intent(in): root zone temperature (K)
- ! output
- notUsed_heightCanopyTop, & ! intent(out): height of the top of the canopy layer (m)
- scalarExposedLAI, & ! intent(out): exposed leaf area index after burial by snow (m2 m-2)
- scalarExposedSAI, & ! intent(out): exposed stem area index after burial by snow (m2 m-2)
- scalarGrowingSeasonIndex ) ! intent(out): growing season index (0=off, 1=on)
-
- ! determine additional phenological variables
- exposedVAI = scalarExposedLAI + scalarExposedSAI ! exposed vegetation area index (m2 m-2)
- canopyDepth = heightCanopyTop - heightCanopyBottom ! canopy depth (m)
- heightAboveSnow = heightCanopyTop - scalarSnowDepth ! height top of canopy is above the snow surface (m)
-
- ! determine if need to include vegetation in the energy flux routines
- computeVegFlux = (exposedVAI > 0.05_rkind .and. heightAboveSnow > 0.05_rkind)
- !write(*,'(a,1x,i2,1x,L1,1x,10(f12.5,1x))') 'vegTypeIndex, computeVegFlux, heightCanopyTop, heightAboveSnow, scalarSnowDepth = ', &
- ! vegTypeIndex, computeVegFlux, heightCanopyTop, heightAboveSnow, scalarSnowDepth
-
- end if ! (check if the snow-soil column is isolated)
-
- ! end association to variables in the data structure
- end associate
-
- end subroutine vegPhenlgy
-
-
-end module vegPhenlgy_module