/*
* Function name : linear_2d_interp
*
* Return type : intensity value of the interploted pixel.
*
* Argument : in_img -- input image.
* Argument : h -- height of the input image.
* Argument : w -- width of the input image.
* Argument : old_x, old_y -- intended location of the pixel.
*
*/
float linear_2d_interp (float *in_img, int h, int w, float old_x, float old_y, float default_value)
{
int floor_x, floor_y, ceil_x, ceil_y, offset1, offset2;
float rem_x, rem_y;
float out_value;
if (old_x < 0. || old_x > w-1.0 || old_y < 0. || old_y > h - 1.0)
out_value = default_value;
else{
floor_y = ((int) floor(old_y)) % h;
ceil_y = ((int) ceil(old_y)) % h;
rem_y = old_y - ((float) floor_y);
floor_x = ((int) floor(old_x)) % w;
ceil_x = ((int) ceil(old_x)) % w;
rem_x = old_x - ((float) floor_x);
offset1 = floor_y * w;
offset2 = ceil_y * w;
out_value = linear_interp(linear_interp(in_img[offset1+floor_x],
in_img[offset2+floor_x], rem_y), linear_interp(in_img[offset1+ceil_x],
in_img[offset2+ceil_x], rem_y), rem_x);
}
return out_value;
}
/* assume graph starts off at ymax and drops to ymin
Determine time to go from 90% to 10% of drop */
int get_fall_time( int setl, double *xv, double *yv, double min, double max,
double *width )
{
int x10, x90=0;
double amp10, amp90;
amp10 = min + (max-min)*0.1;
amp90 = min + (max-min)*0.9;
while( x90<setl && yv[x90]>amp90 )
x90++;
if( x90==setl || x90==0)
return 1;
x10= x90+1;
while( x10<setl && yv[x10]>amp10 )
x10++;
if( x10==setl )
return 1;
*width = linear_interp( yv[x10-1], xv[x10-1], yv[x10], xv[x10], amp10 )-
linear_interp( yv[x90-1], xv[x90-1], yv[x90], xv[x90], amp90 );
return 0;
}
static std::complex<double> get_fe_correction(
const std::string &key, const double lo_freq
){
const std::vector<fe_cal_t> &datas = fe_cal_cache[key];
if (datas.empty()) throw uhd::runtime_error("empty calibration table " + key);
//search for lo freq
size_t lo_index = 0;
size_t hi_index = datas.size()-1;
for (size_t i = 0; i < datas.size(); i++){
if (is_same_freq(datas[i].lo_freq, lo_freq))
{
hi_index = i;
lo_index = i;
break;
}
if (datas[i].lo_freq > lo_freq){
hi_index = i;
break;
}
lo_index = i;
}
if (lo_index == 0) return std::complex<double>(datas[lo_index].iq_corr_real, datas[lo_index].iq_corr_imag);
if (hi_index == lo_index) return std::complex<double>(datas[hi_index].iq_corr_real, datas[hi_index].iq_corr_imag);
//interpolation time
return std::complex<double>(
linear_interp(lo_freq, datas[lo_index].lo_freq, datas[lo_index].iq_corr_real, datas[hi_index].lo_freq, datas[hi_index].iq_corr_real),
linear_interp(lo_freq, datas[lo_index].lo_freq, datas[lo_index].iq_corr_imag, datas[hi_index].lo_freq, datas[hi_index].iq_corr_imag)
);
}
Var* ff_interp(vfuncptr func, Var* arg)
{
Var* v[3] = {NULL, NULL, NULL};
float ignore = FLT_MIN;
const char* usage = "usage: %s(y1,x1,x2,[type={'linear'|'cubic'}]";
char* type = (char*)"";
const char* types[] = {"linear", "cubic", NULL};
Var* out;
Alist alist[9];
alist[0] = make_alist("object", ID_VAL, NULL, &v[0]);
alist[1] = make_alist("from", ID_VAL, NULL, &v[1]);
alist[2] = make_alist("to", ID_VAL, NULL, &v[2]);
alist[3] = make_alist("ignore", DV_FLOAT, NULL, &ignore);
alist[4] = make_alist("type", ID_ENUM, types, &type);
alist[5] = make_alist("y1", ID_VAL, NULL, &v[0]);
alist[6] = make_alist("x1", ID_VAL, NULL, &v[1]);
alist[7] = make_alist("x2", ID_VAL, NULL, &v[2]);
alist[8].name = NULL;
if (parse_args(func, arg, alist) == 0) return (NULL);
if (v[0] == NULL) {
parse_error("%s: y1 not specified.", func->name);
parse_error(usage, func->name);
return (NULL);
}
if (v[1] == NULL) {
parse_error("%s: x1 not specified.", func->name);
parse_error(usage, func->name);
return (NULL);
}
if (v[2] == NULL) {
parse_error("%s: x2 not specified.", func->name);
parse_error(usage, func->name);
return (NULL);
}
if (V_DSIZE(v[0]) != V_DSIZE(v[1])) {
parse_error("Object and From values must be same size\n");
}
if (type == NULL || strlen(type) == 0 || !strcasecmp(type, "linear")) {
out = linear_interp(v[0], v[1], v[2], ignore);
} else if (!strncasecmp(type, "cubic", 5)) {
out = cubic_interp(v[0], v[1], v[2], type, ignore);
} else {
parse_error("%s: Unrecognized type: %s\n", func->name, type);
}
return (out);
}
/*
* assume curve starts at min, rises to max and then drops towards min
*/
int get_half_max_width( int setl, double *xv, double *yv, double min, double max,
double *width )
{
int xu=0, xd=0;
double amp;
amp = (min + max)*0.5;
while( xu<setl && yv[xu]<amp )
xu++;
if( xu==setl )
return 1;
xd= xu+1;
while( xd<setl && yv[xd]>amp )
xd++;
if( xd==setl )
return 1;
*width = linear_interp( yv[xd-1], xv[xd-1], yv[xd], xv[xd], amp ) -
linear_interp( yv[xu-1], xv[xu-1], yv[xu], xv[xu], amp );
return 0;
}
int get_zero_crossing( int setl, double *xv, double *yv, double *crossing )
{
int i=0;
while( i<setl && yv[i] != 0. && yv[i]*yv[i+1]>0. )
i++;
if( i==setl )
return 1;
if( yv[i] == 0 )
*crossing = xv[i];
else
*crossing = linear_interp( yv[i], xv[i], yv[i+1], xv[i+1], 0 );
return 0;
}
void
TestInterpolation<T>::testInterpNegative()
{
USING_NK_NS
USING_NKHIVE_NS
// construct volume
T default_val(1);
vec3d res(1.0);
vec3d kernel_offset(0.5);
typename Volume<T>::shared_ptr volume(
new Volume<T>(2, 1, default_val, res, kernel_offset));
// set some cell values
volume->set(-1, -2, -1, T(2));
volume->set(-1, -2, -2, T(2));
volume->set(-2, -2, -1, T(2));
volume->set(-2, -2, -2, T(2));
// create interpolation object
LinearInterpolation<T> linear_interp(volume);
// test interior point
T result(0);
linear_interp.interp(-1.0, -1.0, -1.0, result);
CHECK_RESULT(1.5);
// test boundary point
linear_interp.interp(-1.0, 0.0, -1.0, result);
CHECK_RESULT(1.0);
// test boundary point
linear_interp.interp(-1.0, -2.0, -1.0, result);
CHECK_RESULT(1.5);
// test interior point
linear_interp.interp(-1.0, -0.75, -1.0, result);
CHECK_RESULT(1.25);
// test interior point
linear_interp.interp(-1.0, -1.25, -1.0, result);
CHECK_RESULT(1.75);
}
void
adjust_height(float *input_image,
unsigned int width,
unsigned int height,
float *output_image,
unsigned int height_out,
float ymin,
float ymax,
int *nerr)
{
int i,j;
float *input_vector, *output_vector;
if((input_vector = (float *)malloc(height*sizeof(float))) == NULL){
printf("error allocating input_vector--adjust_height\n");
*nerr = 301;
return;
}
if((output_vector = (float *)malloc(height_out*sizeof(float))) == NULL){
printf("error allocating output_vector--adjust_height\n");
*nerr = 301;
free(input_vector);
return;
}
/* use the linear interpolation routine to adjust data height */
for( i=0; i<(int)width; i++){
for (j=0; j<(int)height; j++)input_vector[j] = input_image[j*width+i];
linear_interp(input_vector, ymin, ymax, (int)height,
output_vector, (int)height_out, nerr);
for (j=0; j<(int)height_out; j++)output_image[j*width+i] = output_vector[j];
}
free(input_vector);
free(output_vector);
return;
}
void
TestInterpolation<T>::testLinear()
{
USING_NK_NS
USING_NKHIVE_NS
// construct volume
T default_val(1);
vec3d res(1.0);
vec3d kernel_offset(0.5);
typename Volume<T>::shared_ptr volume(
new Volume<T>(2, 1, default_val, res, kernel_offset));
// set some cell values
volume->set(0, 1, 0, T(2));
volume->set(0, 1, 1, T(2));
volume->set(1, 1, 0, T(2));
volume->set(1, 1, 1, T(2));
// create interpolation object
LinearInterpolation<T> linear_interp(volume);
// test interior point
T result(0);
linear_interp.interp(1.0, 1.0, 1.0, result);
CHECK_RESULT(1.5);
// test boundary point
linear_interp.interp(1.0, 0.0, 1.0, result);
CHECK_RESULT(1.0);
// test boundary point
linear_interp.interp(1.0, 2.0, 1.0, result);
CHECK_RESULT(1.5);
// test interior point
linear_interp.interp(1.0, 0.75, 1.0, result);
CHECK_RESULT(1.25);
// test interior point
linear_interp.interp(1.0, 1.25, 1.0, result);
CHECK_RESULT(1.75);
// test y axis
// destroy and create new one
// clear would be nice here
volume = typename Volume<T>::shared_ptr(
new Volume<T>(2, 1, default_val, res, kernel_offset));
// set some cell values
volume->set(1, 0, 0, T(2));
volume->set(1, 0, 1, T(2));
volume->set(1, 1, 0, T(2));
volume->set(1, 1, 1, T(2));
// create interpolation object
LinearInterpolation<T> linear_interp2(volume);
// test interior point
linear_interp2.interp(1.0, 1.0, 1.0, result);
CHECK_RESULT(1.5);
// test boundary point
linear_interp2.interp(0.0, 0.75, 1.0, result);
CHECK_RESULT(1.0);
// test boundary point
linear_interp2.interp(2.0, 1.0, 1.0, result);
CHECK_RESULT(1.5);
// test z axis
// destroy and create new one
// clear would be nice here
volume = typename Volume<T>::shared_ptr(
new Volume<T>(2, 1, default_val, res, kernel_offset));
// set some cell values
volume->set(0, 0, 1, T(2));
volume->set(1, 0, 1, T(2));
volume->set(0, 1, 1, T(2));
volume->set(1, 1, 1, T(2));
// create interpolation object
LinearInterpolation<T> linear_interp3(volume);
// test interior point
linear_interp3.interp(1.0, 1.0, 1.0, result);
CHECK_RESULT(1.5);
// test boundary point
linear_interp3.interp(1.0, 1.9, 0.0, result);
CHECK_RESULT(1.0);
// test boundary point
linear_interp3.interp(1.0, 1.0, 2.0, result);
CHECK_RESULT(1.5);
// test some more interior points
volume = typename Volume<T>::shared_ptr(
new Volume<T>(2, 1, default_val, res, kernel_offset));
// set some cell values
volume->set(0,0,0, T(1));
volume->set(0,0,1, T(2));
volume->set(0,1,0, T(3));
volume->set(0,1,1, T(4));
volume->set(1,0,0, T(5));
volume->set(1,0,1, T(6));
volume->set(1,1,0, T(7));
volume->set(1,1,1, T(8));
LinearInterpolation<T> linear_interp4(volume);
linear_interp4.interp(0.75, 1.15, 0.9, result);
CHECK_RESULT(3.7);
}
int update_thermal_nodes(all_vars_struct *all_vars,
int Nveg,
int Nnodes,
soil_con_struct *soil_con,
veg_con_struct *veg_con)
/**********************************************************************
update_thermal_nodes Jennifer Adam August 16, 2007
This routine is run after subsidence occurs (used only for EXCESS_ICE option).
This routine updates the node depths and interpolates the current
node temperatures to the new depths, then recalculates the nodal
thermal properties. Much of this routine is taken directly from
initialize_model_state.
Modifications:
2009-Feb-09 Removed dz_node from call to
distribute_node_moisture_properties. KAC via TJB
2009-Feb-09 Removed dz_node from call to find_0_degree_front. KAC via TJB
2012-Jan-16 Removed LINK_DEBUG code BN
2013-Dec-26 Removed EXCESS_ICE option. TJB
**********************************************************************/
{
extern option_struct options;
extern veg_lib_struct *veg_lib;
char ErrStr[MAXSTRING];
char FIRST_VEG;
int veg, index;
int lidx;
int band;
int ErrorFlag;
double Cv;
double Zsum, dp;
double tmpdp, tmpadj, Bexp;
double moist[MAX_VEG][MAX_BANDS][MAX_LAYERS];
cell_data_struct **cell;
energy_bal_struct **energy;
double Tnode_prior[MAX_NODES];
double Zsum_prior[MAX_NODES];
cell = all_vars->cell;
energy = all_vars->energy;
dp = soil_con->dp;
FIRST_VEG = TRUE;
/*****************************************************************
Update soil thermal node depths, thicknesses, and temperatures.
CASE 3: Initialize Energy Balance Variables if not using quick
ground heat flux, and no Initial Condition File Given
*****************************************************************/
/*****************************************************************
Update soil thermal node depths and thicknesses.
*****************************************************************/
//set previous Zsum
for ( index = 0; index < Nnodes; index++ )
Zsum_prior[index] = soil_con->Zsum_node[index];
if(!options.EXP_TRANS){
/* Nodes set at surface, the depth of the first layer,
twice the depth of the first layer, and at the
damping depth. Extra nodes are placed equal distance
between the damping depth and twice the depth of the
first layer. */
soil_con->dz_node[0] = soil_con->depth[0];
soil_con->dz_node[1] = soil_con->depth[0];
soil_con->dz_node[2] = soil_con->depth[0];
soil_con->Zsum_node[0] = 0;
soil_con->Zsum_node[1] = soil_con[0].depth[0];
Zsum = 2. * soil_con[0].depth[0];
soil_con->Zsum_node[2] = Zsum;
tmpdp = dp - soil_con[0].depth[0] * 2.5;
tmpadj = 3.5;
for ( index = 3; index < Nnodes-1; index++ ) {
soil_con->dz_node[index] = tmpdp/(((double)Nnodes-tmpadj));
Zsum += (soil_con->dz_node[index]
+soil_con->dz_node[index-1])/2.;
soil_con->Zsum_node[index] = Zsum;
}
soil_con->dz_node[Nnodes-1] = (dp - Zsum
- soil_con->dz_node[Nnodes-2]
/ 2. ) * 2.;
Zsum += (soil_con->dz_node[Nnodes-2]
+soil_con->dz_node[Nnodes-1])/2.;
soil_con->Zsum_node[Nnodes-1] = Zsum;
if((int)(Zsum*1000+0.5) != (int)(dp*1000+0.5)) {
sprintf(ErrStr,"Sum of thermal node thicknesses (%f) in initialize_model_state do not equal dp (%f), check initialization procedure",Zsum,dp);
nrerror(ErrStr);
}
}
else{ /* exponential grid transformation, EXP_TRANS = TRUE*/
/*calculate exponential function parameter */
Bexp = logf(dp+1.)/(double)(Nnodes-1); //to force Zsum=dp at bottom node
for ( index = 0; index <= Nnodes-1; index++ )
soil_con->Zsum_node[index] = expf(Bexp*index)-1.;
//top node
index=0;
soil_con->dz_node[index] = soil_con->Zsum_node[index+1]-soil_con->Zsum_node[index];
//middle nodes
for ( index = 1; index < Nnodes-1; index++ ) {
soil_con->dz_node[index] = (soil_con->Zsum_node[index+1]-soil_con->Zsum_node[index])/2.+(soil_con->Zsum_node[index]-soil_con->Zsum_node[index-1])/2.;
}
//bottom node
index=Nnodes-1;
soil_con->dz_node[index] = soil_con->Zsum_node[index]-soil_con->Zsum_node[index-1];
}
#if VERBOSE
fprintf(stderr,"More updated parameters in soil_con: dz_node and Zsum_node.\n");
#endif
/******************************************
Update soil thermal node temperatures via linear interpolation.
******************************************/
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
if ( soil_con->AreaFract[band] > 0. ) {
//set previous temperatures
for ( index = 0; index < Nnodes; index++ )
Tnode_prior[index] = energy[veg][band].T[index];
//top node: no need to update surface temperature
//remaining nodes
for ( index = 1; index < Nnodes; index++ ) {
energy[veg][band].T[index] = linear_interp(soil_con->Zsum_node[index],Zsum_prior[index-1],Zsum_prior[index],Tnode_prior[index-1],Tnode_prior[index]);
}//node
}
}//band
}
}//veg
/******************************************
Update soil thermal node properties
******************************************/
FIRST_VEG = TRUE;
for ( veg = 0 ; veg <= Nveg ; veg++) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
// Initialize soil for existing snow elevation bands
if ( soil_con->AreaFract[band] > 0. ) {
/** Set soil properties for all soil nodes **/
if(FIRST_VEG) {
FIRST_VEG = FALSE;
set_node_parameters(soil_con->dz_node, soil_con->Zsum_node, soil_con->max_moist_node,
soil_con->expt_node, soil_con->bubble_node,
soil_con->alpha, soil_con->beta,
soil_con->gamma, soil_con->depth,
soil_con->max_moist, soil_con->expt,
soil_con->bubble, soil_con->quartz,
Nnodes, options.Nlayer, soil_con->FS_ACTIVE);
}
for ( lidx = 0; lidx < options.Nlayer; lidx++ )
moist[veg][band][lidx] = cell[veg][band].layer[lidx].moist;
/* set soil moisture properties for all soil thermal nodes */
if ( !( options.LAKES && veg_con->LAKE != 0 ) ) {
ErrorFlag = distribute_node_moisture_properties(energy[veg][band].moist,
energy[veg][band].ice,
energy[veg][band].kappa_node,
energy[veg][band].Cs_node,
soil_con->Zsum_node,
energy[veg][band].T,
soil_con->max_moist_node,
soil_con->expt_node,
soil_con->bubble_node,
moist[veg][band],
soil_con->depth,
soil_con->soil_dens_min,
soil_con->bulk_dens_min,
soil_con->quartz,
soil_con->soil_density,
soil_con->bulk_density,
soil_con->organic,
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
if ( ErrorFlag == ERROR ) return ( ErrorFlag );
}
/* initialize layer moistures and ice contents */
if ( !( options.LAKES && veg_con->LAKE != 0 ) ) {
if (options.QUICK_FLUX) {
ErrorFlag = estimate_layer_ice_content_quick_flux(cell[veg][band].layer,
soil_con->depth, soil_con->dp,
energy[veg][band].T[0], energy[veg][band].T[1],
soil_con->avg_temp, soil_con->max_moist,
soil_con->expt, soil_con->bubble,
soil_con->frost_fract, soil_con->frost_slope,
soil_con->FS_ACTIVE);
}
else {
ErrorFlag = estimate_layer_ice_content(cell[veg][band].layer,
soil_con->Zsum_node,
energy[veg][band].T,
soil_con->max_moist_node,
soil_con->expt_node,
soil_con->bubble_node,
soil_con->depth,
soil_con->max_moist,
soil_con->expt,
soil_con->bubble,
soil_con->frost_fract,
soil_con->frost_slope,
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
}
}
/* Find freezing and thawing front depths */
if(!options.QUICK_FLUX && soil_con->FS_ACTIVE)
if ( !( options.LAKES && veg_con->LAKE != 0 ) )
find_0_degree_fronts(&energy[veg][band], soil_con->Zsum_node, energy[veg][band].T, Nnodes);
}
}//band
}
}//veg
return(0);
}
void initialize_model_state(dist_prcp_struct *prcp,
dmy_struct dmy,
global_param_struct *global_param,
filep_struct filep,
int cellnum,
int Nveg,
int Nnodes,
int Ndist,
double surf_temp,
soil_con_struct *soil_con,
veg_con_struct *veg_con,
char *init_STILL_STORM,
int *init_DRY_TIME,
save_data_struct *save_data)
/**********************************************************************
initialize_model_state Keith Cherkauer April 17, 2000
This routine initializes the model state (energy balance, water balance,
and snow components). If a state file is provided to the model than its
contents are checked to see if it agrees with the current simulation
set-up, if so it is used to initialize the model state. If no state
file is provided the model initializes all variables with defaults and
the user should expect to throw out the beginning of the simulation
period as model start-up.
UNITS: (m, s, kg, C, moisture in mm) unless otherwise specified
Modifications:
4-17-00 Modified from initialize_energy_bal.c and initialize_snow.c
to provide a single controlling routine for initializing the
model state.
2-10-03 Fixed looping problem with initialization of soil moisture. KAC
3-12-03 Modified so that soil layer ice content is only calculated
when frozen soil is implemented and active in the current
grid cell. KAC
04-10-03 Modified to read storm parameters from model state file. KAC
07-May-04 Initialize soil_con->dz_node[Nnodes] to 0.0, since it is
accessed in set_node_parameters(). TJB
2006-Sep-14 Implemented ALMA-compliant input and output; uses the new
save_data structure to track changes in moisture storage
over each time step; this needs initialization here. TJB
2006-Oct-25 Inserted "if (veg < Nveg)" before the line updating
save_data->wdew, since Wdew is undefined for veg == Nveg. TJB
2006-Oct-26 Merged infiles and outfiles structs into filep_struct;
This included removing the unused init_snow file. TJB
2006-Nov-15 Changed initial state reading from statefile to init_state GCT
**********************************************************************/
{
extern option_struct options;
extern veg_lib_struct *veg_lib;
#if LINK_DEBUG
extern debug_struct debug;
#endif
#if QUICK_FS
extern double temps[];
#endif
char tmpstr[MAXSTRING];
char ErrStr[MAXSTRING];
char FIRST_VEG;
int i, j, ii, veg, index, dist;
int nidx, lidx;
int tmpint;
int dry;
int band;
int zindex;
double sum, Lsum, Zsum, dp, Ltotal;
double tmpdp, tmpadj;
double *kappa, *Cs, *M;
double moist[MAX_VEG][MAX_BANDS][MAX_LAYERS];
double ice[MAX_VEG][MAX_BANDS][MAX_LAYERS];
double unfrozen, frozen;
double **layer_ice;
double **layer_tmp;
double *EMPTY;
#if QUICK_FS
double Aufwc, Bufwc;
#endif
char *EMPTY_C;
double Cv;
double mu;
double TreeAdjustFactor[MAX_BANDS];
cell_data_struct ***cell;
snow_data_struct **snow;
energy_bal_struct **energy;
veg_var_struct ***veg_var;
cell = prcp->cell;
veg_var = prcp->veg_var;
snow = prcp->snow;
energy = prcp->energy;
dp = soil_con->dp;
Ltotal = 0;
for(index=0;index<options.Nlayer;index++) Ltotal += soil_con->depth[index];
FIRST_VEG = TRUE;
// initialize storm parameters to start a new simulation
(*init_DRY_TIME) = -999;
/********************************************
Initialize all snow pack variables
- some may be reset if state file present
********************************************/
initialize_snow(snow, Nveg, cellnum);
/********************************************
Initialize all soil layer variables
- some may be reset if state file present
********************************************/
initialize_soil(cell[WET], soil_con, Nveg);
/********************************************
Initialize all vegetation variables
- some may be reset if state file present
********************************************/
initialize_veg(veg_var[WET], veg_con, global_param);
#if QUICK_FS
if(options.FROZEN_SOIL) {
/***********************************************************
Prepare table of maximum unfrozen water content values
- This linearizes the equation for maximum unfrozen water
content, reducing computation time for the frozen soil
model.
***********************************************************/
for(lidx=0;lidx<options.Nlayer;lidx++) {
for(ii=0;ii<QUICK_FS_TEMPS;ii++) {
Aufwc = maximum_unfrozen_water(temps[ii], 1.0,
soil_con->bubble[lidx],
soil_con->expt[lidx]);
Bufwc = maximum_unfrozen_water(temps[ii+1], 1.0,
soil_con->bubble[lidx],
soil_con->expt[lidx]);
soil_con->ufwc_table_layer[lidx][ii][0]
= linear_interp(0., temps[ii], temps[ii+1], Aufwc, Bufwc);
soil_con->ufwc_table_layer[lidx][ii][1]
= (Bufwc - Aufwc) / (temps[ii+1] - temps[ii]);
}
}
}
#endif
/************************************************************************
CASE 1: Not using quick ground heat flux, and initial conditions files
provided
************************************************************************/
if(options.INIT_STATE) {
read_initial_model_state(filep.init_state, prcp, global_param,
Nveg, options.SNOW_BAND, cellnum, soil_con,
Ndist, init_STILL_STORM, init_DRY_TIME);
for( veg = 0; veg <= Nveg; veg++ )
for( band = 0; band < options.SNOW_BAND; band++ )
for( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = cell[0][veg][band].layer[lidx].moist;
ice[veg][band][lidx] = cell[0][veg][band].layer[lidx].ice;
}
}
/************************************************************************
CASE 2: Initialize soil if using quick heat flux, and no initial
soil properties file given
************************************************************************/
else if(options.QUICK_FLUX) {
for ( veg = 0 ; veg <= Nveg ; veg++) {
for ( band = 0; band < options.SNOW_BAND; band++ ) {
/* Initialize soil node temperatures and thicknesses */
soil_con->dz_node[0] = soil_con->depth[0];
soil_con->dz_node[1] = soil_con->depth[0];
soil_con->dz_node[2] = 2. * (dp - 1.5 * soil_con->depth[0]);
energy[veg][band].T[0] = surf_temp;
energy[veg][band].T[1] = surf_temp;
energy[veg][band].T[2] = soil_con->avg_temp;
for ( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = soil_con->init_moist[lidx];
ice[veg][band][lidx] = 0.;
}
}
}
}
/*****************************************************************
CASE 3: Initialize Energy Balance Variables if not using quick
ground heat flux, and no Initial Condition File Given
*****************************************************************/
else if(!options.QUICK_FLUX) {
for ( veg = 0 ; veg <= Nveg ; veg++) {
for ( band = 0; band < options.SNOW_BAND; band++ ) {
/* Initialize soil node temperatures and thicknesses
Nodes set at surface, the depth of the first layer,
twice the depth of the first layer, and at the
damping depth. Extra nodes are placed equal distance
between the damping depth and twice the depth of the
first layer. */
energy[veg][band].T[0] = surf_temp;
soil_con->dz_node[0] = soil_con->depth[0];
soil_con->dz_node[1] = soil_con->depth[0];
soil_con->dz_node[2] = soil_con->depth[0];
energy[veg][band].T[Nnodes-1] = soil_con->avg_temp;
energy[veg][band].T[1] = exp_interp(soil_con->depth[0], 0., dp,
surf_temp, soil_con->avg_temp);
energy[veg][band].T[2] = exp_interp(2. * soil_con->depth[0], 0., dp,
surf_temp, soil_con->avg_temp);
Zsum = 2. * soil_con[0].depth[0];
tmpdp = dp - soil_con[0].depth[0] * 2.5;
tmpadj = 3.5;
for(index=3;index<Nnodes-1;index++) {
if(veg==0 && band==0)
soil_con->dz_node[index] = tmpdp/(((double)Nnodes-tmpadj));
Zsum += (soil_con->dz_node[index]
+soil_con->dz_node[index-1])/2.;
energy[veg][band].T[index] = exp_interp(Zsum,0.,soil_con[0].dp,
surf_temp,
soil_con[0].avg_temp);
}
if(veg==0 && band==0) {
soil_con->dz_node[Nnodes-1] = (dp - Zsum
- soil_con->dz_node[Nnodes-2]
/ 2. ) * 2.;
Zsum += (soil_con->dz_node[Nnodes-2]
+soil_con->dz_node[Nnodes-1])/2.;
if((int)(Zsum*1000+0.5) != (int)(dp*1000+0.5)) {
sprintf(ErrStr,"Sum of thermal node thicknesses (%f) in initialize_model_state do not equal dp (%f), check initialization procedure",Zsum,dp);
nrerror(ErrStr);
}
}
for ( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = soil_con->init_moist[lidx];
ice[veg][band][lidx] = 0.;
}
}
}
}
/*********************************
CASE 4: Unknown option
*********************************/
else {
for ( veg = 0 ; veg <= Nveg ; veg++) {
for ( band = 0; band < options.SNOW_BAND; band++ ) {
for ( index = 0; index < options.Nlayer; index++ ) {
soil_con->dz_node[index] = 1.;
}
}
}
}
/******************************************
Initialize soil thermal node properties
******************************************/
/* dz_node[Nnodes] is accessed later despite not being set. This can
cause run-time errors on some platforms. Therefore, set it to zero */
soil_con->dz_node[Nnodes]=0.0;
if ( options.GRND_FLUX ) {
for ( veg = 0 ; veg <= Nveg ; veg++) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
/** Set soil properties for all soil nodes **/
if(FIRST_VEG) {
FIRST_VEG = FALSE;
set_node_parameters(soil_con->dz_node, soil_con->max_moist_node,
soil_con->expt_node, soil_con->bubble_node,
soil_con->alpha, soil_con->beta,
soil_con->gamma, soil_con->depth,
soil_con->max_moist, soil_con->expt,
soil_con->bubble, soil_con->quartz,
soil_con->layer_node_fract,
#if QUICK_FS
soil_con->ufwc_table_node,
#endif
Nnodes, options.Nlayer, soil_con->FS_ACTIVE);
sum = soil_con->dz_node[0]/2. + soil_con->dz_node[Nnodes-1]/2.;
for(nidx=1;nidx<Nnodes-1;nidx++) sum += soil_con->dz_node[nidx];
}
/* set soil moisture properties for all soil thermal nodes */
distribute_node_moisture_properties(energy[veg][band].moist,
energy[veg][band].ice,
energy[veg][band].kappa_node,
energy[veg][band].Cs_node,
soil_con->dz_node,
energy[veg][band].T,
soil_con->max_moist_node,
#if QUICK_FS
soil_con->ufwc_table_node,
#else
soil_con->expt_node,
soil_con->bubble_node,
#endif
moist[veg][band], soil_con->depth,
soil_con->soil_density,
soil_con->bulk_density,
soil_con->quartz,
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
/* initialize layer moistures and ice contents */
for(dry = 0; dry < Ndist; dry++) {
for(lidx=0;lidx<options.Nlayer;lidx++) {
cell[dry][veg][band].layer[lidx].moist = moist[veg][band][lidx];
cell[dry][veg][band].layer[lidx].ice = ice[veg][band][lidx];
}
if(soil_con->FS_ACTIVE && options.FROZEN_SOIL)
estimate_layer_ice_content(cell[dry][veg][band].layer,
soil_con->dz_node,
energy[veg][band].T,
soil_con->max_moist_node,
#if QUICK_FS
soil_con->ufwc_table_node,
#else
soil_con->expt_node,
soil_con->bubble_node,
#endif
soil_con->depth,
soil_con->max_moist,
#if QUICK_FS
soil_con->ufwc_table_layer,
#else
soil_con->expt,
soil_con->bubble,
#endif
soil_con->bulk_density,
soil_con->soil_density,
soil_con->quartz,
soil_con->layer_node_fract,
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
}
/* Find freezing and thawing front depths */
if(!options.QUICK_FLUX && soil_con->FS_ACTIVE)
find_0_degree_fronts(&energy[veg][band], soil_con->dz_node,
energy[veg][band].T, Nnodes);
}
}
}
// Compute treeline adjustment factors
for ( band = 0; band < options.SNOW_BAND; band++ ) {
if ( soil_con->AboveTreeLine[band] ) {
Cv = 0;
for ( veg = 0 ; veg < veg_con[0].vegetat_type_num ; veg++ ) {
if ( veg_lib[veg_con[veg].veg_class].overstory )
Cv += veg_con[veg].Cv;
}
TreeAdjustFactor[band] = 1. / ( 1. - Cv );
}
else TreeAdjustFactor[band] = 1.;
}
// Save initial moisture storages for differencing at end of time step
save_data->total_soil_moist = 0;
save_data->swe = 0;
save_data->wdew = 0;
for( veg = 0; veg <= Nveg; veg++ ) {
if ( veg < veg_con[0].vegetat_type_num )
Cv = veg_con[veg].Cv;
else
Cv = (1.0 - veg_con[0].Cv_sum);
if ( Cv > 0 ) {
for ( dist = 0; dist < Ndist; dist++ ) {
if(dist==0)
mu = prcp[0].mu[veg];
else
mu = 1. - prcp[0].mu[veg];
for( band = 0; band < options.SNOW_BAND; band++ ) {
if (soil_con->AreaFract[band] > 0.
&& ( veg == veg_con[0].vegetat_type_num
|| ( !soil_con->AboveTreeLine[band]
|| (soil_con->AboveTreeLine[band] && !veg_lib[veg_con[veg].veg_class].overstory)))) {
for(lidx=0;lidx<options.Nlayer;lidx++) {
save_data->total_soil_moist +=
(cell[dist][veg][band].layer[lidx].moist) // layer[].moist appears to contain both liquid and ice
* Cv * mu * soil_con->AreaFract[band] * TreeAdjustFactor[band];
}
if (veg < Nveg)
save_data->wdew += veg_var[dist][veg][band].Wdew * Cv * mu * soil_con->AreaFract[band] * TreeAdjustFactor[band];
}
}
}
for( band = 0; band < options.SNOW_BAND; band++ ) {
save_data->swe += snow[veg][band].swq * Cv * soil_con->AreaFract[band] * TreeAdjustFactor[band];
}
}
}
}
void polywave_perform64(t_polywave *x, t_object *dsp64, double **ins, long numins, double **outs, long numouts, long sampleframes, long flags, void *userparam)
{
int i;
t_double *out = outs[0];
t_double *in1 = ins[0];
t_double *in2 = ins[1];
int n = sampleframes;
if(x->numbufs == 0 || !x->w_connected[0])
{
while (n--)
*out++ = 0.;
return;
}
int idx_connected = x->w_connected[1];
long numbufs = x->numbufs;
long frames[numbufs], nchans[numbufs];
t_buffer_obj *buffer[numbufs];
t_float *tab[numbufs];
int valid[numbufs], modified[numbufs];
for (i=0; i<numbufs; i++) {
buffer[i] = buffer_ref_getobject(x->buf_proxy[i]->ref);
if(!buffer[i])
valid[i] = 0;
else
{
tab[i] = buffer_locksamples(buffer[i]);
if(!tab[i])
valid[i] = 0;
else
{
modified[i] = x->buf_proxy[i]->buffer_modified;
if(modified[i])
{
frames[i] = buffer_getframecount(buffer[i]);
nchans[i] = buffer_getchannelcount(buffer[i]);
x->buf_proxy[i]->nframes = frames[i];
x->buf_proxy[i]->nchans = nchans[i];
x->buf_proxy[i]->buffer_modified = false;
}
else
{
frames[i] = x->buf_proxy[i]->nframes;
nchans[i] = x->buf_proxy[i]->nchans;
}
valid[i] = (nchans[i] > 0 && frames[i] > 0);
}
}
}
t_polywave_interp interp = x->interp_type;
double p, pSamp, upperVal, lowerSamp, upperSamp, frac, a, b, c, d;
long bindx = 0;
switch (interp) {
case CUBIC:
while(n--)
{
p = *in1++;
p = CLAMP(p, 0, 1);
if(idx_connected)
{
bindx = (long)*in2++;
bindx = CLAMP(bindx, 0, numbufs-1);
}
if(valid[bindx])
{
pSamp = frames[bindx] * p;
lowerSamp = floor(pSamp);
frac = pSamp - lowerSamp;
a = (long)lowerSamp - 1 < 0 ? 0 : tab[bindx][ nchans[bindx] * ((long)lowerSamp - 1)];
b = tab[bindx][ nchans[bindx] * (long)lowerSamp];
c = (long)lowerSamp + 1 > frames[bindx] ? 0 : tab[bindx][ nchans[bindx] * ((long)lowerSamp + 1)];
d = (long)lowerSamp + 2 > frames[bindx] ? 0 : tab[bindx][ nchans[bindx] * ((long)lowerSamp + 2)];
*out++ = cubicInterpolate(a,b,c,d,frac);
}
else
*out++ = 0.0;
}
break;
case LINEAR:
while(n--)
{
p = *in1++;
p = CLAMP(p, 0, 1);
if(idx_connected)
{
bindx = (long)*in2++;
bindx = CLAMP(bindx, 0, numbufs-1);
}
if(valid[bindx])
{
pSamp = frames[bindx] * p;
lowerSamp = floor(pSamp);
upperSamp = ceil(pSamp);
upperVal = (upperSamp < frames[bindx]) ? tab[bindx][ nchans[bindx] * (long)upperSamp ] : 0.0;
*out++ = linear_interp(tab[bindx][ nchans[bindx] * (long)lowerSamp ], upperVal, pSamp - lowerSamp);
}
else
*out++ = 0.0;
}
break;
default:
case NONE:
while(n--)
{
p = *in1++;
p = CLAMP(p, 0, 1);
if(idx_connected)
{
bindx = (long)*in2++;
bindx = CLAMP(bindx, 0, numbufs-1);
}
if(valid[bindx])
{
*out++ = tab[bindx][nchans[bindx] * (long)(frames[bindx] * p)];
}
else
*out++ = 0.0;
}
break;
}
for(i=0; i<numbufs; i++)
{
if(valid[i])
buffer_unlocksamples(buffer[i]);
}
return;
}
void polywave_perform64_two(t_polywave *x, t_object *dsp64, double **ins, long numins, double **outs, long numouts, long sampleframes, long flags, void *userparam)
{
int i;
t_double *out = outs[0];
t_double *x1_in = ins[0];
t_double *x2_in = ins[1];
t_double *interp_in = ins[2];
t_double *idx1_in = ins[3];
t_double *idx2_in = ins[4];
int n = sampleframes;
if(x->numbufs == 0 || !x->w_connected[0])
{
while (n--)
*out++ = 0.;
return;
}
int *connected = x->w_connected;
long numbufs = x->numbufs;
long frames[numbufs], nchans[numbufs];
t_buffer_obj *buffer[numbufs];
t_float *tab[numbufs];
int valid[numbufs], modified[numbufs];
t_polywave_interp interp_t = x->interp_type;
// post("%d %d", x->interp_type, x->backup);
for (i=0; i<numbufs; i++) {
buffer[i] = buffer_ref_getobject(x->buf_proxy[i]->ref);
if(!buffer[i])
valid[i] = 0;
else
{
tab[i] = buffer_locksamples(buffer[i]);
if(!tab[i])
valid[i] = 0;
else
{
modified[i] = x->buf_proxy[i]->buffer_modified;
if(modified[i])
{
frames[i] = buffer_getframecount(buffer[i]);
nchans[i] = buffer_getchannelcount(buffer[i]);
x->buf_proxy[i]->nframes = frames[i];
x->buf_proxy[i]->nchans = nchans[i];
x->buf_proxy[i]->buffer_modified = false;
}
else
{
frames[i] = x->buf_proxy[i]->nframes;
nchans[i] = x->buf_proxy[i]->nchans;
}
valid[i] = (nchans[i] > 0 && frames[i] > 0);
}
}
}
double x1_p, x2_p, interp_p = 0, pSamp1, pSamp2, upperVal, lowerSamp, upperSamp, frac, a1, a2, b, c, d;
long idx1 = 0, idx2 = 0;
switch (interp_t) {
case CUBIC:
while(n--)
{
x1_p = *x1_in++;
x1_p = CLAMP(x1_p, 0, 1);
if(connected[1])
{
x2_p = *x2_in++;
x2_p = CLAMP(x2_p, 0, 1);
} else {
x2_p = x1_p;
}
if (connected[2]) {
interp_p = *interp_in++;
interp_p = CLAMP(interp_p, 0, 1);
}
if(connected[3])
{
idx1 = (long)*idx1_in++;
idx1 = CLAMP(idx1, 0, numbufs-1);
}
if(connected[4])
{
idx2 = (long)*idx2_in++;
idx2 = CLAMP(idx2, 0, numbufs-1);
}
if(valid[idx1] && valid[idx2])
{
pSamp1 = frames[idx1] * x1_p;
lowerSamp = floor(pSamp1);
frac = pSamp1 - lowerSamp;
a1 = (long)lowerSamp - 1 < 0 ? 0 : tab[idx1][ nchans[idx1] * ((long)lowerSamp - 1)];
b = tab[idx1][ nchans[idx1] * (long)lowerSamp];
c = (long)lowerSamp + 1 > frames[idx1] ? 0 : tab[idx1][ nchans[idx1] * ((long)lowerSamp + 1)];
d = (long)lowerSamp + 2 > frames[idx1] ? 0 : tab[idx1][ nchans[idx1] * ((long)lowerSamp + 2)];
pSamp1 = cubicInterpolate(a1,b,c,d,frac);
pSamp2 = frames[idx2] * x2_p;
lowerSamp = floor(pSamp2);
frac = pSamp2 - lowerSamp;
a2 = (long)lowerSamp - 1 < 0 ? 0 : tab[idx2][ nchans[idx2] * ((long)lowerSamp - 1)];
b = tab[idx2][ nchans[idx2] * (long)lowerSamp];
c = (long)lowerSamp + 1 > frames[idx2] ? 0 : tab[idx2][ nchans[idx2] * ((long)lowerSamp + 1)];
d = (long)lowerSamp + 2 > frames[idx2] ? 0 : tab[idx2][ nchans[idx2] * ((long)lowerSamp + 2)];
pSamp2 = cubicInterpolate(a2,b,c,d,frac);
*out++ = cubicInterpolate(a1,pSamp1,pSamp2,d,interp_p);
}
else
*out++ = 0.0;
}
break;
case LINEAR:
while(n--)
{
x1_p = *x1_in++;
x1_p = CLAMP(x1_p, 0, 1);
if(connected[1])
{
x2_p = *x2_in++;
x2_p = CLAMP(x2_p, 0, 1);
} else {
x2_p = x1_p;
}
if (connected[2]) {
interp_p = *interp_in++;
interp_p = CLAMP(interp_p, 0, 1);
}
if(connected[3])
{
idx1 = (long)*idx1_in++;
idx1 = CLAMP(idx1, 0, numbufs-1);
}
if(connected[4])
{
idx2 = (long)*idx2_in++;
idx2 = CLAMP(idx2, 0, numbufs-1);
}
if(valid[idx1] && valid[idx2])
{
pSamp1 = frames[idx1] * x1_p;
lowerSamp = floor(pSamp1);
upperSamp = ceil(pSamp1);
upperVal = (upperSamp < frames[idx1]) ? tab[idx1][ nchans[idx1] * (long)upperSamp ] : 0.0;
pSamp1 = linear_interp(tab[idx1][ nchans[idx1] * (long)lowerSamp ], upperVal, pSamp1 - lowerSamp);
pSamp2 = frames[idx2] * x2_p;
lowerSamp = floor(pSamp2);
upperSamp = ceil(pSamp2);
upperVal = (upperSamp < frames[idx2]) ? tab[idx2][ nchans[idx2] * (long)upperSamp ] : 0.0;
pSamp2 = linear_interp(tab[idx2][ nchans[idx2] * (long)lowerSamp ], upperVal, pSamp2 - lowerSamp);
*out++ = linear_interp(pSamp1, pSamp2, interp_p);
}
else
*out++ = 0.0;
}
break;
default:
case NONE:
while(n--)
{
x1_p = *x1_in++;
x1_p = CLAMP(x1_p, 0, 1);
if(connected[2])
{
idx1 = (long)*idx1_in++;
idx1 = CLAMP(idx1, 0, numbufs-1);
}
if(valid[idx1])
{
*out++ = tab[idx1][nchans[idx1] * (long)(frames[idx1] * x1_p)];
}
else
*out++ = 0.0;
}
break;
}
for(i=0; i<numbufs; i++)
{
if(valid[i])
buffer_unlocksamples(buffer[i]);
}
return;
}
int initialize_model_state(dist_prcp_struct *prcp,
dmy_struct dmy,
global_param_struct *global_param,
filep_struct filep,
int cellnum,
int Nveg,
int Nnodes,
int Ndist,
double surf_temp,
soil_con_struct *soil_con,
veg_con_struct *veg_con,
lake_con_struct lake_con,
char **init_STILL_STORM,
int **init_DRY_TIME)
/**********************************************************************
initialize_model_state Keith Cherkauer April 17, 2000
This routine initializes the model state (energy balance, water balance,
and snow components). If a state file is provided to the model than its
contents are checked to see if it agrees with the current simulation
set-up, if so it is used to initialize the model state. If no state
file is provided the model initializes all variables with defaults and
the user should expect to throw out the beginning of the simulation
period as model start-up.
UNITS: (m, s, kg, C, moisture in mm) unless otherwise specified
Modifications:
4-17-00 Modified from initialize_energy_bal.c and initialize_snow.c
to provide a single controlling routine for initializing the
model state.
9-00 Fixed bug where initialization of soil node temperatures
and moitures was within two vegetation loops, thus only
the first vegetation type was properly initialized. KAC
2-19-03 Modified to initialize soil and vegetation parameters for
the dry grid cell fraction, if distributed precipitation
is activated. KAC
11-18-02 Modified to initialize lake and wetland algorithms
variables. LCB
2-10-03 Fixed looping problem with initialization of soil moisture. KAC
3-12-03 Modified so that soil layer ice content is only calculated
when frozen soil is implemented and active in the current
grid cell. KAC
04-10-03 Modified to read storm parameters from model state file. KAC
04-25-03 Modified to work with vegetation type specific storm
parameters. KAC
07-May-04 Initialize soil_con->dz_node[Nnodes] to 0.0, since it is
accessed in set_node_parameters(). TJB
01-Nov-04 Added support for state files containing SPATIAL_FROST
and LAKE_MODEL state variables. TJB
2006-Apr-21 Replaced Cv (uninitialized) with lake_con.Cl[0] in
surfstor calculation. TJB
2006-Sep-23 Implemented flexible output configuration; uses the new
save_data structure to track changes in moisture storage
over each time step; this needs initialization here. TJB
2006-Oct-10 Added snow[veg][band].snow_canopy to save_data.swe. TJB
2006-Oct-16 Merged infiles and outfiles structs into filep_struct;
This included removing the unused init_snow file. TJB
2006-Nov-07 Removed LAKE_MODEL option. TJB
2007-Apr-24 Added EXP_TRANS option. JCA
2007-Apr-24 Zsum_node loaded into soil_con structure for later use
without having to recalculate. JCA
2007-Aug-09 Added features for EXCESS_ICE option. JCA
2007-Aug-21 Return value of ErrorFlag if error in
distribute_node_moisture_properties. JCA
2007-Sep-18 Check for soil moist exceeding max moist moved from
read_initial_model_state to here. JCA
2007-Oct-24 Modified initialize_lake() to return ErrorFlag. TJB
2008-Mar-01 Reinserted missing logic for QUICK_FS in calls to
distribute_node_moisture_properties() and
estimate_layer_ice_content(). TJB
2009-Feb-09 Removed dz_node from call to
distribute_node_moisture_properties. KAC via TJB
2009-Feb-09 Removed dz_node from call to find_0_degree_front. KAC via TJB
2009-Mar-15 Modified to not call estimate_layer_ice_content() if
not modeling frozen soil. KAC via TJB
2009-Mar-16 Added resid_moist to argument list of
estimate_layer_ice_content(). This allows computation
of min_liq, the minimum allowable liquid water content
in each layer as a function of temperature. TJB
2009-Jun-09 Modified to use extension of veg_lib structure to contain
bare soil information. TJB
2009-Jul-26 Added initial estimate of incoming longwave at surface
(LongUnderOut) for use in canopy snow T iteration. TJB
2009-Jul-31 Removed extra lake/wetland veg tile. TJB
2009-Sep-19 Added T fbcount to count TFALLBACK occurrences. TJB
2009-Sep-19 Made initialization of Tfoliage more accurate for snow bands. TJB
2009-Sep-28 Added initialization of energy structure. TJB
2009-Nov-15 Added check to ensure that depth of first thermal node
is <= depth of first soil layer. TJB
2009-Dec-11 Removed initialization of save_data structure, since this
is now performed by the initial call to put_data(). TJB
2009-Dec-11 Removed min_liq and options.MIN_LIQ. TJB
2010-Nov-11 Updated call to initialize_lake() to accommodate new
skip_hydro flag. TJB
2011-Mar-01 Updated calls to initialize_soil() and initialize_lake()
to accommodate new arguments. Added more detailed validation
of soil moisture. TJB
2011-Mar-05 Added validation of initial soil moisture, ice, and snow
variables to make sure they are self-consistent. TJB
2011-May-31 Removed options.GRND_FLUX. Now soil temperatures and
ground flux are always computed. TJB
2011-Jun-03 Added options.ORGANIC_FRACT. Soil properties now take
organic fraction into account. TJB
2011-Jul-05 Changed logic initializing soil temperatures so that
type of initialization depends solely on options.QUICK_FLUX;
options.Nnodes is no longer automatically reset here. TJB
2012-Jan-16 Removed LINK_DEBUG code BN
2012-Jan-28 Added stability check for case of (FROZEN_SOIL=TRUE &&
IMPLICIT=FALSE). TJB
2013-Jul-25 Fixed incorrect condition on lake initialization. TJB
2013-Jul-25 Moved computation of tmp_moist argument of
compute_runoff_and_asat() so that it would always be
initialized. TJB
2014-Jan-13 Added validation of Nnodes and dp for EXP_TRANS=TRUE. TJB
2014-Feb-09 Made non-spinup initial temperatures more consistent with
annual average air temperature and bottom boundary
temperature. TJB
**********************************************************************/
{
extern option_struct options;
extern veg_lib_struct *veg_lib;
#if QUICK_FS
extern double temps[];
#endif
char ErrStr[MAXSTRING];
char FIRST_VEG;
int i, j, ii, veg, index, dist;
int lidx;
double tmp_moist[MAX_LAYERS];
double tmp_runoff;
int dry;
int band;
#if SPATIAL_FROST
int frost_area;
#endif
int ErrorFlag;
double Cv;
double Zsum, dp;
double tmpdp, tmpadj, Bexp;
double Tair;
double tmp;
double *M;
double moist[MAX_VEG][MAX_BANDS][MAX_LAYERS];
#if SPATIAL_FROST
double ice[MAX_VEG][MAX_BANDS][MAX_LAYERS][FROST_SUBAREAS];
#else
double ice[MAX_VEG][MAX_BANDS][MAX_LAYERS];
#endif // SPATIAL_FROST
#if QUICK_FS
double Aufwc, Bufwc;
#endif
double Clake;
double mu;
double surf_swq;
double pack_swq;
double TreeAdjustFactor[MAX_BANDS];
#if EXCESS_ICE
double sum_mindepth, sum_depth_pre, sum_depth_post, tmp_mindepth;
#endif
double dt_thresh;
int tmp_lake_idx;
cell_data_struct ***cell;
energy_bal_struct **energy;
lake_var_struct *lake_var;
snow_data_struct **snow;
veg_var_struct ***veg_var;
cell = prcp->cell;
energy = prcp->energy;
lake_var = &prcp->lake_var;
snow = prcp->snow;
veg_var = prcp->veg_var;
// Initialize soil depths
dp = soil_con->dp;
FIRST_VEG = TRUE;
// increase initial soil surface temperature if air is very cold
Tair = surf_temp;
if ( surf_temp < -1. ) surf_temp = -1.;
// initialize storm parameters to start a new simulation
(*init_STILL_STORM) = (char *)malloc((Nveg+1)*sizeof(char));
(*init_DRY_TIME) = (int *)malloc((Nveg+1)*sizeof(int));
for ( veg = 0 ; veg <= Nveg ; veg++ )
(*init_DRY_TIME)[veg] = -999;
/********************************************
Initialize all snow pack variables
- some may be reset if state file present
********************************************/
initialize_snow(snow, Nveg, cellnum);
/********************************************
Initialize all soil layer variables
- some may be reset if state file present
********************************************/
initialize_soil(cell[WET], soil_con, veg_con, Nveg);
if ( options.DIST_PRCP )
initialize_soil(cell[DRY], soil_con, veg_con, Nveg);
/********************************************
Initialize all vegetation variables
- some may be reset if state file present
********************************************/
initialize_veg(veg_var[WET], veg_con, global_param, Nveg);
if ( options.DIST_PRCP )
initialize_veg(veg_var[DRY], veg_con, global_param, Nveg);
/********************************************
Initialize all lake variables
********************************************/
if ( options.LAKES ) {
tmp_lake_idx = lake_con.lake_idx;
if (tmp_lake_idx < 0) tmp_lake_idx = 0;
ErrorFlag = initialize_lake(lake_var, lake_con, soil_con, &(cell[WET][tmp_lake_idx][0]), surf_temp, 0);
if (ErrorFlag == ERROR) return(ErrorFlag);
}
/********************************************
Initialize all spatial frost variables
********************************************/
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++ ) {
if ( FROST_SUBAREAS == 1 ) soil_con->frost_fract[frost_area] = 1.;
else if (FROST_SUBAREAS == 2 ) soil_con->frost_fract[frost_area] = 0.5;
else {
soil_con->frost_fract[frost_area] = 1. / (FROST_SUBAREAS - 1);
if ( frost_area == 0 || frost_area == FROST_SUBAREAS-1 )
soil_con->frost_fract[frost_area] /= 2.;
}
}
#endif // SPATIAL_FROST
/********************************************************
Compute grid cell fractions for all subareas used in
spatial distribution of soil frost routines.
********************************************************/
#if QUICK_FS
if(options.FROZEN_SOIL) {
/***********************************************************
Prepare table of maximum unfrozen water content values
- This linearizes the equation for maximum unfrozen water
content, reducing computation time for the frozen soil
model.
***********************************************************/
for(lidx=0;lidx<options.Nlayer;lidx++) {
for(ii=0;ii<QUICK_FS_TEMPS;ii++) {
Aufwc = maximum_unfrozen_water(temps[ii], 1.0,
soil_con->bubble[lidx],
soil_con->expt[lidx]);
Bufwc = maximum_unfrozen_water(temps[ii+1], 1.0,
soil_con->bubble[lidx],
soil_con->expt[lidx]);
soil_con->ufwc_table_layer[lidx][ii][0]
= linear_interp(0., temps[ii], temps[ii+1], Aufwc, Bufwc);
soil_con->ufwc_table_layer[lidx][ii][1]
= (Bufwc - Aufwc) / (temps[ii+1] - temps[ii]);
}
}
}
#endif // QUICK_FS
/************************************************************************
CASE 1: Not using quick ground heat flux, and initial conditions files
provided
************************************************************************/
if(options.INIT_STATE) {
#if EXCESS_ICE
sum_mindepth = 0;
sum_depth_pre = 0;
for( lidx = 0; lidx < options.Nlayer; lidx++ ){
tmp_mindepth = (float)(int)(soil_con->min_depth[lidx] * 1000 + 0.5) / 1000;
sum_mindepth += tmp_mindepth;
sum_depth_pre += soil_con->depth[lidx];
}
#endif
read_initial_model_state(filep.init_state, prcp, global_param,
Nveg, options.SNOW_BAND, cellnum, soil_con,
Ndist, *init_STILL_STORM, *init_DRY_TIME, lake_con);
#if EXCESS_ICE
// calculate dynamic soil and veg properties if excess_ice is present
sum_depth_post = 0;
for( lidx = 0; lidx < options.Nlayer; lidx++ )
sum_depth_post += soil_con->depth[lidx];
if( sum_depth_post != sum_depth_pre) {
/*update soil_con properties*/
for( lidx = 0; lidx < options.Nlayer; lidx++ ) {
soil_con->bulk_dens_min[lidx] *= (1.0-soil_con->effective_porosity[lidx])*soil_con->soil_density[lidx]/soil_con->bulk_density[lidx];
if (soil_con->organic[layer] > 0)
soil_con->bulk_dens_org[lidx] *= (1.0-soil_con->effective_porosity[lidx])*soil_con->soil_density[lidx]/soil_con->bulk_density[lidx];
soil_con->bulk_density[lidx] = (1.0-soil_con->effective_porosity[lidx])*soil_con->soil_density[lidx];
soil_con->max_moist[lidx] = soil_con->depth[lidx] * soil_con->effective_porosity[lidx] * 1000.;
} //loop for each soil layer
/********update remaining soil_con properties**********/
/* update Maximum Infiltration for Upper Layers */
if(options.Nlayer==2)
soil_con->max_infil = (1.0+soil_con->b_infilt)*soil_con->max_moist[0];
else
soil_con->max_infil = (1.0+soil_con->b_infilt)*(soil_con->max_moist[0]+soil_con->max_moist[1]);
/* Soil Layer Critical and Wilting Point Moisture Contents */
for(lidx=0;lidx<options.Nlayer;lidx++) {//soil layer
soil_con->Wcr[lidx] = soil_con->Wcr_FRACT[lidx] * soil_con->max_moist[lidx];
soil_con->Wpwp[lidx] = soil_con->Wpwp_FRACT[lidx] * soil_con->max_moist[lidx];
if(soil_con->Wpwp[lidx] > soil_con->Wcr[lidx]) {
sprintf(ErrStr,"Updated wilting point moisture (%f mm) is greater than updated critical point moisture (%f mm) for layer %d.\n\tIn the soil parameter file, Wpwp_FRACT MUST be <= Wcr_FRACT.\n",
soil_con->Wpwp[lidx], soil_con->Wcr[lidx], lidx);
nrerror(ErrStr);
}
if(soil_con->Wpwp[lidx] < soil_con->resid_moist[lidx] * soil_con->depth[lidx] * 1000.) {
sprintf(ErrStr,"Updated wilting point moisture (%f mm) is less than updated residual moisture (%f mm) for layer %d.\n\tIn the soil parameter file, Wpwp_FRACT MUST be >= resid_moist / (1.0 - bulk_density/soil_density).\n",
soil_con->Wpwp[lidx], soil_con->resid_moist[lidx] * soil_con->depth[lidx] * 1000., lidx);
nrerror(ErrStr);
}
}
/* If BASEFLOW = NIJSSEN2001 then convert ARNO baseflow
parameters d1, d2, d3, and d4 to Ds, Dsmax, Ws, and c */
if(options.BASEFLOW == NIJSSEN2001) {
lidx = options.Nlayer-1;
soil_con->Dsmax = soil_con->Dsmax_orig *
pow((double)(1./(soil_con->max_moist[lidx]-soil_con->Ws_orig)), -soil_con->c) +
soil_con->Ds_orig * soil_con->max_moist[lidx];
soil_con->Ds = soil_con->Ds_orig * soil_con->Ws_orig / soil_con->Dsmax_orig;
soil_con->Ws = soil_con->Ws_orig/soil_con->max_moist[lidx];
}
/*********** update root fractions ***************/
calc_root_fractions(veg_con, soil_con);
#if VERBOSE
/* write changes to screen */
fprintf(stderr,"Soil properties initialized from state file:\n");
for(lidx=0;lidx<options.Nlayer;lidx++) {//soil layer
fprintf(stderr,"\tFor layer %d:\n",lidx+1);
fprintf(stderr,"\t\tDepth of soil layer = %.2f m.\n",soil_con->depth[lidx]);
fprintf(stderr,"\t\tEffective porosity = %.2f.\n",soil_con->effective_porosity[lidx]);
fprintf(stderr,"\t\tBulk density = %.2f kg/m^3.\n",soil_con->bulk_density[lidx]);
}
fprintf(stderr,"\tDamping depth = %.2f m.\n",soil_con->dp);
if(sum_depth_post == sum_mindepth)
fprintf(stderr,"\tExcess ice is no longer present in the soil column.\n");
#endif //VERBOSE
}//updated initial conditions due to state file
#endif //EXCESS_ICE
/******Check that soil moisture does not exceed maximum allowed************/
for ( dist = 0; dist < Ndist; dist ++ ) {
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
for( lidx = 0; lidx < options.Nlayer; lidx++ ) {
if ( cell[dist][veg][band].layer[lidx].moist > soil_con->max_moist[lidx] ) {
fprintf( stderr, "WARNING: Initial soil moisture (%f mm) exceeds maximum (%f mm) in layer %d for veg tile %d and snow band%d. Resetting to maximum.\n", cell[dist][veg][band].layer[lidx].moist, soil_con->max_moist[lidx], lidx, veg, band );
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++)
cell[dist][veg][band].layer[lidx].ice[frost_area] *= soil_con->max_moist[lidx]/cell[dist][veg][band].layer[lidx].moist;
#else
cell[dist][veg][band].layer[lidx].ice *= soil_con->max_moist[lidx]/cell[dist][veg][band].layer[lidx].moist;
#endif
cell[dist][veg][band].layer[lidx].moist = soil_con->max_moist[lidx];
}
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++) {
if (cell[dist][veg][band].layer[lidx].ice[frost_area] > cell[dist][veg][band].layer[lidx].moist)
cell[dist][veg][band].layer[lidx].ice[frost_area] = cell[dist][veg][band].layer[lidx].moist;
}
#else
if (cell[dist][veg][band].layer[lidx].ice > cell[dist][veg][band].layer[lidx].moist)
cell[dist][veg][band].layer[lidx].ice = cell[dist][veg][band].layer[lidx].moist;
#endif
tmp_moist[lidx] = cell[dist][veg][band].layer[lidx].moist;
}
compute_runoff_and_asat(soil_con, tmp_moist, 0, &(cell[dist][veg][band].asat), &tmp_runoff);
}
// Override possible bad values of soil moisture under lake coming from state file
// (ideally we wouldn't store these in the state file in the first place)
if (options.LAKES && veg == lake_con.lake_idx) {
for( lidx = 0; lidx < options.Nlayer; lidx++ ) {
lake_var->soil.layer[lidx].moist = soil_con->max_moist[lidx];
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++) {
if (lake_var->soil.layer[lidx].ice[frost_area] > lake_var->soil.layer[lidx].moist)
lake_var->soil.layer[lidx].ice[frost_area] = lake_var->soil.layer[lidx].moist;
}
#else
if (lake_var->soil.layer[lidx].ice > lake_var->soil.layer[lidx].moist)
lake_var->soil.layer[lidx].ice = lake_var->soil.layer[lidx].moist;
#endif
}
}
}
}
/****** initialize moist and ice ************/
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
for( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = cell[0][veg][band].layer[lidx].moist;
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++ )
ice[veg][band][lidx][frost_area] = cell[0][veg][band].layer[lidx].ice[frost_area];
#else
ice[veg][band][lidx] = cell[0][veg][band].layer[lidx].ice;
#endif
}
}
}
}
/******Check that snow pack terms are self-consistent************/
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
for ( band = 0 ; band < options.SNOW_BAND ; band++ ) {
if (snow[veg][band].swq > MAX_SURFACE_SWE) {
pack_swq = snow[veg][band].swq-MAX_SURFACE_SWE;
surf_swq = MAX_SURFACE_SWE;
}
else {
pack_swq = 0;
surf_swq = snow[veg][band].swq;
snow[veg][band].pack_temp = 0;
}
if (snow[veg][band].surf_water > LIQUID_WATER_CAPACITY*surf_swq) {
snow[veg][band].pack_water += snow[veg][band].surf_water - (LIQUID_WATER_CAPACITY*surf_swq);
snow[veg][band].surf_water = LIQUID_WATER_CAPACITY*surf_swq;
}
if (snow[veg][band].pack_water > LIQUID_WATER_CAPACITY*pack_swq) {
snow[veg][band].pack_water = LIQUID_WATER_CAPACITY*pack_swq;
}
}
}
}
/************************************************************************
CASE 2: Initialize soil if using quick heat flux, and no initial
soil properties file given
************************************************************************/
else if(options.QUICK_FLUX) {
Nnodes = options.Nnode;
/* Initialize soil node thicknesses */
soil_con->dz_node[0] = soil_con->depth[0];
soil_con->dz_node[1] = soil_con->depth[0];
soil_con->dz_node[2] = 2. * (dp - 1.5 * soil_con->depth[0]);
soil_con->Zsum_node[0] = 0;
soil_con->Zsum_node[1] = soil_con->depth[0];
soil_con->Zsum_node[2] = dp;
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
/* Initialize soil node temperatures */
energy[veg][band].T[0] = surf_temp;
energy[veg][band].T[1] = surf_temp;
energy[veg][band].T[2] = soil_con->avg_temp;
/* Initialize soil layer moisture and ice contents */
for ( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = cell[0][veg][band].layer[lidx].moist;
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++ )
ice[veg][band][lidx][frost_area] = 0.;
#else
ice[veg][band][lidx] = 0.;
#endif
}
}
}
}
}
/*****************************************************************
CASE 3: Initialize Energy Balance Variables if not using quick
ground heat flux, and no Initial Condition File Given
*****************************************************************/
else if(!options.QUICK_FLUX) {
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
if(!options.EXP_TRANS){
/* Initialize soil node temperatures and thicknesses
Nodes set at surface, the depth of the first layer,
twice the depth of the first layer, and at the
damping depth. Extra nodes are placed equal distance
between the damping depth and twice the depth of the
first layer. */
soil_con->dz_node[0] = soil_con->depth[0];
soil_con->dz_node[1] = soil_con->depth[0];
soil_con->dz_node[2] = soil_con->depth[0];
soil_con->Zsum_node[0] = 0;
soil_con->Zsum_node[1] = soil_con[0].depth[0];
Zsum = 2. * soil_con[0].depth[0];
soil_con->Zsum_node[2] = Zsum;
tmpdp = dp - soil_con[0].depth[0] * 2.5;
tmpadj = 3.5;
for ( index = 3; index < Nnodes-1; index++ ) {
if ( FIRST_VEG ) {
soil_con->dz_node[index] = tmpdp/(((double)Nnodes-tmpadj));
}
Zsum += (soil_con->dz_node[index]
+soil_con->dz_node[index-1])/2.;
soil_con->Zsum_node[index] = Zsum;
}
energy[veg][band].T[0] = surf_temp;
for ( index = 1; index < Nnodes; index++ ) {
energy[veg][band].T[index] = soil_con->avg_temp;
}
if ( FIRST_VEG ) {
FIRST_VEG = FALSE;
soil_con->dz_node[Nnodes-1] = (dp - Zsum
- soil_con->dz_node[Nnodes-2]
/ 2. ) * 2.;
Zsum += (soil_con->dz_node[Nnodes-2]
+soil_con->dz_node[Nnodes-1])/2.;
soil_con->Zsum_node[Nnodes-1] = Zsum;
if((int)(Zsum*1000+0.5) != (int)(dp*1000+0.5)) {
sprintf(ErrStr,"Sum of thermal node thicknesses (%f) in initialize_model_state do not equal dp (%f), check initialization procedure",Zsum,dp);
nrerror(ErrStr);
}
}
}
else{ /* exponential grid transformation, EXP_TRANS = TRUE*/
if ( FIRST_VEG ) {
/*calculate exponential function parameter */
Bexp = logf(dp+1.)/(double)(Nnodes-1); //to force Zsum=dp at bottom node
/* validate Nnodes by requiring that there be at least 3 nodes in the top 50cm */
if (Nnodes < 5*logf(dp+1.)+1) {
sprintf(ErrStr,"The number of soil thermal nodes (%d) is too small for the supplied damping depth (%f) with EXP_TRANS set to TRUE, leading to fewer than 3 nodes in the top 50 cm of the soil column. For EXP_TRANS=TRUE, Nnodes and dp must follow the relationship:\n5*ln(dp+1)<Nnodes-1\nEither set Nnodes to at least %d in the global param file or reduce damping depth to %f in the soil parameter file. Or set EXP_TRANS to FALSE in the global parameter file.",Nnodes,dp,(int)(5*logf(dp+1.))+2,exp(0.2*(Nnodes-1))+1);
nrerror(ErrStr);
}
for ( index = 0; index <= Nnodes-1; index++ )
soil_con->Zsum_node[index] = expf(Bexp*index)-1.;
if(soil_con->Zsum_node[0] > soil_con->depth[0]) {
sprintf(ErrStr,"Depth of first thermal node (%f) in initialize_model_state is greater than depth of first soil layer (%f); increase the number of nodes or decrease the thermal damping depth dp (%f)",soil_con->Zsum_node[0],soil_con->depth[0],dp);
nrerror(ErrStr);
}
}
//top node
index=0;
if ( FIRST_VEG )
soil_con->dz_node[index] = soil_con->Zsum_node[index+1]-soil_con->Zsum_node[index];
energy[veg][band].T[index] = surf_temp;
//middle nodes
for ( index = 1; index < Nnodes-1; index++ ) {
if ( FIRST_VEG ) {
soil_con->dz_node[index] = (soil_con->Zsum_node[index+1]-soil_con->Zsum_node[index])/2.+(soil_con->Zsum_node[index]-soil_con->Zsum_node[index-1])/2.;
}
// energy[veg][band].T[index] = exp_interp(soil_con->Zsum_node[index],0.,soil_con[0].dp,
// surf_temp,soil_con[0].avg_temp);
energy[veg][band].T[index] = soil_con->avg_temp;
}
//bottom node
index=Nnodes-1;
if ( FIRST_VEG )
soil_con->dz_node[index] = soil_con->Zsum_node[index]-soil_con->Zsum_node[index-1];
energy[veg][band].T[index] = soil_con->avg_temp;
} // end if !EXP_TRANS
//initialize moisture and ice for each soil layer
for ( lidx = 0; lidx < options.Nlayer; lidx++ ) {
moist[veg][band][lidx] = cell[0][veg][band].layer[lidx].moist;
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++ )
ice[veg][band][lidx][frost_area] = 0.;
#else
ice[veg][band][lidx] = 0.;
#endif
}
}
}
}
}
/*********************************
CASE 4: Unknown option
*********************************/
else {
for ( veg = 0 ; veg <= Nveg ; veg++ ) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
// Initialize soil for existing snow elevation bands
if ( soil_con->AreaFract[band] > 0. ) {
for ( index = 0; index < options.Nlayer; index++ ) {
soil_con->dz_node[index] = 1.;
}
}
}
}
}
}
/********************************************
Initialize subsidence
********************************************/
#if EXCESS_ICE
for ( lidx = 0; lidx < options.Nlayer; lidx++ )
soil_con->subsidence[lidx] = 0.0;
#endif // EXCESS_ICE
/******************************************
Initialize soil thermal node properties
******************************************/
FIRST_VEG = TRUE;
for ( veg = 0 ; veg <= Nveg ; veg++) {
// Initialize soil for existing vegetation types
Cv = veg_con[veg].Cv;
if ( Cv > 0 ) {
for( band = 0; band < options.SNOW_BAND; band++ ) {
// Initialize soil for existing snow elevation bands
if ( soil_con->AreaFract[band] > 0. ) {
/** Set soil properties for all soil nodes **/
if(FIRST_VEG) {
FIRST_VEG = FALSE;
set_node_parameters(soil_con->dz_node, soil_con->Zsum_node, soil_con->max_moist_node,
soil_con->expt_node, soil_con->bubble_node,
soil_con->alpha, soil_con->beta,
soil_con->gamma, soil_con->depth,
soil_con->max_moist, soil_con->expt,
soil_con->bubble, soil_con->quartz,
#if QUICK_FS
soil_con->ufwc_table_node,
#endif // QUICK_FS
#if EXCESS_ICE
soil_con->porosity, soil_con->effective_porosity,
soil_con->porosity_node, soil_con->effective_porosity_node,
#endif // EXCESS_ICE
Nnodes, options.Nlayer, soil_con->FS_ACTIVE);
}
/* set soil moisture properties for all soil thermal nodes */
ErrorFlag = distribute_node_moisture_properties(energy[veg][band].moist,
energy[veg][band].ice,
energy[veg][band].kappa_node,
energy[veg][band].Cs_node,
soil_con->Zsum_node,
energy[veg][band].T,
soil_con->max_moist_node,
#if QUICK_FS
soil_con->ufwc_table_node,
#else
soil_con->expt_node,
soil_con->bubble_node,
#endif // QUICK_FS
#if EXCESS_ICE
soil_con->porosity_node,
soil_con->effective_porosity_node,
#endif // EXCESS_ICE
moist[veg][band],
soil_con->depth,
soil_con->soil_dens_min,
soil_con->bulk_dens_min,
soil_con->quartz,
soil_con->soil_density,
soil_con->bulk_density,
soil_con->organic,
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
if ( ErrorFlag == ERROR ) return ( ErrorFlag );
/* Check node spacing v time step */
/* (note this is only approximate since heat capacity and conductivity can change considerably during the simulation depending on soil moisture and ice content) */
if ((options.FROZEN_SOIL && !options.QUICK_FLUX) && !options.IMPLICIT) {
dt_thresh = 0.5*energy[veg][band].Cs_node[1]/energy[veg][band].kappa_node[1]*pow((soil_con->dz_node[1]),2)/3600; // in hours
if (global_param->dt > dt_thresh) {
sprintf(ErrStr,"ERROR: You are currently running FROZEN SOIL with an explicit method (IMPLICIT is set to FALSE). For the explicit method to be stable, time step %d hours is too large for the given thermal node spacing %f m, soil heat capacity %f J/m3/K, and soil thermal conductivity %f J/m/s/K. Either set IMPLICIT to TRUE in your global parameter file (this is the recommended action), or decrease time step length to <= %f hours, or decrease the number of soil thermal nodes.",global_param->dt,soil_con->dz_node[1],energy[veg][band].Cs_node[1],energy[veg][band].kappa_node[1],dt_thresh);
nrerror(ErrStr);
}
}
/* initialize layer moistures and ice contents */
for ( dry = 0; dry < Ndist; dry++ ) {
for ( lidx = 0; lidx < options.Nlayer; lidx++ ) {
cell[dry][veg][band].layer[lidx].moist = moist[veg][band][lidx];
#if SPATIAL_FROST
for ( frost_area = 0; frost_area < FROST_SUBAREAS; frost_area++ )
cell[dry][veg][band].layer[lidx].ice[frost_area] = ice[veg][band][lidx][frost_area];
#else
cell[dry][veg][band].layer[lidx].ice = ice[veg][band][lidx];
#endif
}
if (options.QUICK_FLUX) {
ErrorFlag = estimate_layer_ice_content_quick_flux(cell[dry][veg][band].layer,
soil_con->depth, soil_con->dp,
energy[veg][band].T[0], energy[veg][band].T[1],
soil_con->avg_temp, soil_con->max_moist,
#if QUICK_FS
soil_con->ufwc_table_layer,
#else
soil_con->expt, soil_con->bubble,
#endif // QUICK_FS
#if SPATIAL_FROST
soil_con->frost_fract, soil_con->frost_slope,
#endif // SPATIAL_FROST
#if EXCESS_ICE
soil_con->porosity,
soil_con->effective_porosity,
#endif // EXCESS_ICE
soil_con->FS_ACTIVE);
}
else {
ErrorFlag = estimate_layer_ice_content(cell[dry][veg][band].layer,
soil_con->Zsum_node,
energy[veg][band].T,
soil_con->max_moist_node,
#if QUICK_FS
soil_con->ufwc_table_node,
#else
soil_con->expt_node,
soil_con->bubble_node,
#endif // QUICK_FS
soil_con->depth,
soil_con->max_moist,
#if QUICK_FS
soil_con->ufwc_table_layer,
#else
soil_con->expt,
soil_con->bubble,
#endif // QUICK_FS
#if SPATIAL_FROST
soil_con->frost_fract,
soil_con->frost_slope,
#endif // SPATIAL_FROST
#if EXCESS_ICE
soil_con->porosity,
soil_con->effective_porosity,
#endif // EXCESS_ICE
Nnodes, options.Nlayer,
soil_con->FS_ACTIVE);
}
}
/* Find freezing and thawing front depths */
if(!options.QUICK_FLUX && soil_con->FS_ACTIVE)
find_0_degree_fronts(&energy[veg][band], soil_con->Zsum_node, energy[veg][band].T, Nnodes);
}
}
}
}
// initialize miscellaneous energy balance terms
for ( veg = 0 ; veg <= Nveg ; veg++) {
for ( band = 0; band < options.SNOW_BAND; band++ ) {
/* Set fluxes to 0 */
energy[veg][band].advected_sensible = 0.0;
energy[veg][band].advection = 0.0;
energy[veg][band].AtmosError = 0.0;
energy[veg][band].AtmosLatent = 0.0;
energy[veg][band].AtmosLatentSub = 0.0;
energy[veg][band].AtmosSensible = 0.0;
energy[veg][band].canopy_advection = 0.0;
energy[veg][band].canopy_latent = 0.0;
energy[veg][band].canopy_latent_sub = 0.0;
energy[veg][band].canopy_refreeze = 0.0;
energy[veg][band].canopy_sensible = 0.0;
energy[veg][band].deltaCC = 0.0;
energy[veg][band].deltaH = 0.0;
energy[veg][band].error = 0.0;
energy[veg][band].fusion = 0.0;
energy[veg][band].grnd_flux = 0.0;
energy[veg][band].latent = 0.0;
energy[veg][band].latent_sub = 0.0;
energy[veg][band].longwave = 0.0;
energy[veg][band].LongOverIn = 0.0;
energy[veg][band].LongUnderIn = 0.0;
energy[veg][band].LongUnderOut = 0.0;
energy[veg][band].melt_energy = 0.0;
energy[veg][band].NetLongAtmos = 0.0;
energy[veg][band].NetLongOver = 0.0;
energy[veg][band].NetLongUnder = 0.0;
energy[veg][band].NetShortAtmos = 0.0;
energy[veg][band].NetShortGrnd = 0.0;
energy[veg][band].NetShortOver = 0.0;
energy[veg][band].NetShortUnder = 0.0;
energy[veg][band].out_long_canopy = 0.0;
energy[veg][band].out_long_surface = 0.0;
energy[veg][band].refreeze_energy = 0.0;
energy[veg][band].sensible = 0.0;
energy[veg][band].shortwave = 0.0;
energy[veg][band].ShortOverIn = 0.0;
energy[veg][band].ShortUnderIn = 0.0;
energy[veg][band].snow_flux = 0.0;
/* Initial estimate of LongUnderOut for use by snow_intercept() */
tmp = energy[veg][band].T[0] + KELVIN;
energy[veg][band].LongUnderOut = STEFAN_B * tmp * tmp * tmp * tmp;
energy[veg][band].Tfoliage = Tair + soil_con->Tfactor[band];
}
}
// initialize Tfallback counters
for ( veg = 0 ; veg <= Nveg ; veg++) {
for ( band = 0; band < options.SNOW_BAND; band++ ) {
energy[veg][band].Tfoliage_fbcount = 0;
energy[veg][band].Tcanopy_fbcount = 0;
energy[veg][band].Tsurf_fbcount = 0;
for ( index = 0; index < Nnodes-1; index++ ) {
energy[veg][band].T_fbcount[index] = 0;
}
}
}
// Compute treeline adjustment factors
for ( band = 0; band < options.SNOW_BAND; band++ ) {
if ( soil_con->AboveTreeLine[band] ) {
Cv = 0;
for ( veg = 0 ; veg < veg_con[0].vegetat_type_num ; veg++ ) {
if ( veg_lib[veg_con[veg].veg_class].overstory )
Cv += veg_con[veg].Cv;
}
TreeAdjustFactor[band] = 1. / ( 1. - Cv );
}
else TreeAdjustFactor[band] = 1.;
}
return(0);
}
int runoff(cell_data_struct *cell,
energy_bal_struct *energy,
soil_con_struct *soil_con,
double ppt,
double *frost_fract,
int dt,
int Nnodes,
int band,
int rec,
int iveg)
/**********************************************************************
runoff.c Keith Cherkauer May 18, 1996
This subroutine calculates infiltration and runoff from the surface,
gravity driven drainage between all soil layers, and generates
baseflow from the bottom layer..
sublayer indecies are always [layer number][sublayer number]
[layer number] is the current VIC model moisture layer
[sublayer number] is the current sublayer number where:
0 = thawed sublayer, 1 = frozen sublayer, and 2 = unfrozen sublayer.
when the model is run withoputfrozen soils, the sublayer number
is always = 2 (unfrozen).
UNITS: Ksat (mm/day)
Q12 (mm/time step)
liq, ice (mm)
inflow (mm)
runoff (mm)
Variables:
ppt incoming precipitation and snow melt
mu fraction of area that receives precipitation
inflow incoming water corrected for fractional area of precip (mu)
MODIFICATIONS:
5/22/96 Routine modified to account for spatially varying
precipitation, and it's effects on runoff. KAC
11/96 Code modified to account for extra model layers
needed for frozen soils modeling. KAC
1/9/97 Infiltration and other rate parameters modified
for time scales of less than 1 day. KAC
4-1-98 Soil moisture transport is now done on an hourly time
step, irregardless to the model time step, to prevent
numerical stabilities in the solution Dag and KAC
01-24-00 simplified handling of soil moisture for the
frozen soil algorithm. all option selection
now use the same soil moisture transport method KAC
6-8-2000 modified to handle spatially distributed soil frost KAC
06-07-03 modified so that infiltration is computed using only the
top two soil moisture layers, rather than all but the
bottom most layer. This preserves the functionality
of the original model design, but is more realistic for
handling multiple soil moisture layers
06-Sep-03 Changed calculation of dt_baseflow to go to zero when
soil liquid moisture <= residual moisture. Changed
block that handles case of total soil moisture < residual
moisture to not allow dt_baseflow to go negative. TJB
17-May-04 Changed block that handles baseflow when soil moisture
drops below residual moisture. Now, the block is only
entered if baseflow > 0 and soil moisture < residual,
and the amount of water taken out of baseflow and given
to the soil cannot exceed baseflow. In addition, error
messages are no longer printed, since it isn't an error
to be in that block. TJB
2007-Apr-04 Modified to return Error status from
distribute_node_moisture_properties GCT/KAC
2007-Apr-24 Passes soil_con->Zsum_node to distribute_node_moisture_properties. JCA
2007-Jun-13 Fixed bug arising from earlier fix to dt_baseflow
calculation. Earlier fix took residual moisture
into account in the linear part of the baseflow eqn,
but not in the non-linear part. Now we take residual
moisture into account correctly throughout the whole
equation. Also re-wrote equation in simpler form. TJB
2007-Aug-15 Changed SPATIAL_FROST if statement to enclose the correct
end-bracket for the frost_area loop. JCA
2007-Aug-09 Added features for EXCESS_ICE option. JCA
Including adding SubsidenceUpdate flag for parts
of the routine that will be used if redistributing
soil moisture after subsidence.
2007-Sep-18 Modified to correctly handle evaporation from spatially
distributed soil frost. Original version could produce
negative soil moisture in fractions with high ice content
since only total evaporation was checked versus total
liquid water content, not versus available liquid water
in each frost subsection. KAC via TJB
2007-Sep-20 Removed logic that reset resid_moist[i]. Previously,
resid_moist[i] was reset to 0 for i > 0 when
resid_moist[0] == 0. Such resetting of soil properties
was deemed unnecessary and confusing, since VIC would end
up using different residual moisture values than those
specified by the user. If a user truly wants to specify
residual moisture in all layers to be 0, the user should
set these explicitly in the soil parameter file. Also
fixed typo in fprintf() on line 289. TJB
2007-Oct-13 Fixed the checks on the lower bound of soil moisture.
Previously, the condition was
(moist[lindex]+ice[lindex]) < resid_moist[lindex]
which led to liquid soil moisture falling below residual
during winter conditions. This has been changed to
moist[lindex] < resid_moist[lindex]
to eliminate these errors and make the logic consistent
with the rest of the code. TJB
2007-Oct-13 Renamed all *moist* variables to *liq* if they only refer
to liquid soil moisture. This makes the logic much easier
to understand. TJB
2007-Oct-13 Modified the caps on Q12 and baseflow for the case of
frozen soil. Now, the lower bound on liquid soil moisture
is the maximum unfrozen component of residual moisture at
current soil temperature, i.e. liquid soil moisture may
be less than residual moisture as long as the total
(liq + ice) moisture is >= residual moisture AND the
liquid fraction of the total is appropriate for the
temperature. Without this condition, we could have an
apparent loss of liquid moisture due to conversion to ice
and the resulting adjustments of Q12 and baseflow could
pull water out of the air to bring liquid moisture up to
residual. This fix should set a reasonable lower bound
and still ensure that no extra water is condensed out
of the air simply to bring liquid water up to residual. TJB
2008-Oct-23 Added check to make sure top_moist never exceeds
top_max_moist; otherwise rounding errors could cause it
to exceed top_max_moist and produce NaN's. LCB via TJB
2009-Feb-09 Removed dz_node from call to
distribute_node_moisture_properties. KAC via TJB
2009=Feb-10 Replaced all occurrences of resid_moist with min_liq, after
min_liq was defined. This makes the use of min_liq consistent
with its documented role in the subroutine. KAC via TJB
2009-Feb-10 Removed Tlayer from selection criteria to include ice in
min_liq calculation. Soil layers can be above 0C with
ice present, as ice content is set from soil nodes. KAC via TJB
2009-Mar-16 Made min_liq an element of the layer_data_struct, so that
its value can be computed earlier in the model code, in a
more efficient manner (in initialize_soil() and
estimate_layer_ice_content()). TJB
2009-May-17 Added asat to cell_data. TJB
2009-Jun-26 Simplified argument list of runoff() by passing all cell_data
variables via a single reference to the cell data structure. TJB
2009-Dec-11 Removed min_liq and options.MIN_LIQ. Constraints on
liq[lindex] have been removed and/or replaced by
constraints on (liq[lindex]+ice[lindex]). Thus, it is
possible to freeze all of the soil moisture, as long as
total moisture > residual moisture. TJB
2010-Feb-07 Fixed bug in runoff computation for case when soil column
is completely saturated. TJB
2010-Nov-29 Moved computation of saturated area to correct place in
code for handling SPATIAL_FROST. TJB
2010-Dec-01 Added call to compute_zwt(). TJB
2011-Mar-01 Replaced compute_zwt() with wrap_compute_zwt(). Moved
computation of runoff and saturated area to a separate
function compute_runoff_and_asat(), which can be called
elsewhere. TJB
2011-Jun-03 Added options.ORGANIC_FRACT. Soil properties now take
organic fraction into account. TJB
2012-Jan-16 Removed LINK_DEBUG code BN
2013-Dec-26 Replaced LOW_RES_MOIST compile-time option with LOG_MATRIC
run-time option. TJB
2013-Dec-26 Removed EXCESS_ICE option. TJB
2013-Dec-27 Moved SPATIAL_FROST to options_struct. TJB
2013-Dec-27 Removed QUICK_FS option. TJB
2014-Mar-28 Removed DIST_PRCP option. TJB
2014-May-09 Added check on liquid soil moisture to ensure always >= 0. TJB
**********************************************************************/
{
extern option_struct options;
int firstlayer, lindex;
int i;
int last_layer[MAX_LAYERS*3];
int last_index;
int last_cnt;
int time_step;
int tmplayer;
int frost_area;
int ErrorFlag;
double A, frac;
double tmp_runoff;
double inflow;
double resid_moist[MAX_LAYERS]; // residual moisture (mm)
double org_moist[MAX_LAYERS]; // total soil moisture (liquid and frozen) at beginning of this function (mm)
double avail_liq[MAX_LAYERS][MAX_FROST_AREAS]; // liquid soil moisture available for evap/drainage (mm)
double liq[MAX_LAYERS]; // current liquid soil moisture (mm)
double ice[MAX_LAYERS]; // current frozen soil moisture (mm)
double moist[MAX_LAYERS]; // current total soil moisture (liquid and frozen) (mm)
double max_moist[MAX_LAYERS]; // maximum storable moisture (liquid and frozen) (mm)
double Ksat[MAX_LAYERS];
double Q12[MAX_LAYERS-1];
double Dsmax;
double tmp_inflow;
double tmp_moist;
double tmp_moist_for_runoff[MAX_LAYERS];
double tmp_liq;
double dt_inflow;
double dt_runoff;
double runoff[MAX_FROST_AREAS];
double tmp_dt_runoff[MAX_FROST_AREAS];
double baseflow[MAX_FROST_AREAS];
double dt_baseflow;
double rel_moist;
double evap[MAX_LAYERS][MAX_FROST_AREAS];
double sum_liq;
double evap_fraction;
double evap_sum;
double min_temp;
double max_temp;
double tmp_fract;
double Tlayer_spatial[MAX_LAYERS][MAX_FROST_AREAS];
double b[MAX_LAYERS];
layer_data_struct *layer;
layer_data_struct tmp_layer;
/** Set Residual Moisture **/
for ( i = 0; i < options.Nlayer; i++ )
resid_moist[i] = soil_con->resid_moist[i] * soil_con->depth[i] * 1000.;
/** Allocate and Set Values for Soil Sublayers **/
layer = cell->layer;
cell->runoff = 0;
cell->baseflow = 0;
cell->asat = 0;
for ( frost_area = 0; frost_area < options.Nfrost; frost_area++ )
baseflow[frost_area] = 0;
for ( lindex = 0; lindex < options.Nlayer; lindex++ ) {
evap[lindex][0] = layer[lindex].evap/(double)dt;
org_moist[lindex] = layer[lindex].moist;
layer[lindex].moist = 0;
if ( evap[lindex][0] > 0 ) { // if there is positive evaporation
sum_liq = 0;
// compute available soil moisture for each frost sub area.
for ( frost_area = 0; frost_area < options.Nfrost; frost_area++ ) {
avail_liq[lindex][frost_area] = (org_moist[lindex] - layer[lindex].ice[frost_area] - resid_moist[lindex]);
if (avail_liq[lindex][frost_area] < 0) avail_liq[lindex][frost_area] = 0;
sum_liq += avail_liq[lindex][frost_area]*frost_fract[frost_area];
}
// compute fraction of available soil moisture that is evaporated
if (sum_liq > 0) {
evap_fraction = evap[lindex][0] / sum_liq;
}
else {
evap_fraction = 1.0;
}
// distribute evaporation between frost sub areas by percentage
evap_sum = evap[lindex][0];
for ( frost_area = options.Nfrost - 1; frost_area >= 0; frost_area-- ) {
evap[lindex][frost_area] = avail_liq[lindex][frost_area] * evap_fraction;
avail_liq[lindex][frost_area] -= evap[lindex][frost_area];
evap_sum -= evap[lindex][frost_area] * frost_fract[frost_area];
}
}
else {
for ( frost_area = options.Nfrost - 1; frost_area > 0; frost_area-- )
evap[lindex][frost_area] = evap[lindex][0];
}
}
// compute temperatures of frost subareas
for ( lindex = 0; lindex < options.Nlayer; lindex++ ) {
min_temp = layer[lindex].T - soil_con->frost_slope / 2.;
max_temp = min_temp + soil_con->frost_slope;
for ( frost_area = 0; frost_area < options.Nfrost; frost_area++ ) {
if ( options.Nfrost > 1 ) {
if ( frost_area == 0 ) tmp_fract = frost_fract[0] / 2.;
else tmp_fract += (frost_fract[frost_area-1] + frost_fract[frost_area]) / 2.;
Tlayer_spatial[lindex][frost_area] = linear_interp(tmp_fract, 0, 1, min_temp, max_temp);
}
else Tlayer_spatial[lindex][frost_area] = layer[lindex].T;
}
}
for ( frost_area = 0; frost_area < options.Nfrost; frost_area++ ) {
/** ppt = amount of liquid water coming to the surface **/
inflow = ppt;
/**************************************************
Initialize Variables
**************************************************/
for ( lindex = 0; lindex < options.Nlayer; lindex++ ) {
Ksat[lindex] = soil_con->Ksat[lindex] / 24.;
b[lindex] = (soil_con->expt[lindex] - 3.) / 2.;
/** Set Layer Liquid Moisture Content **/
liq[lindex] = org_moist[lindex] - layer[lindex].ice[frost_area];
/** Set Layer Frozen Moisture Content **/
ice[lindex] = layer[lindex].ice[frost_area];
/** Set Layer Maximum Moisture Content **/
max_moist[lindex] = soil_con->max_moist[lindex];
} // initialize variables for each layer
/******************************************************
Runoff Based on Soil Moisture Level of Upper Layers
******************************************************/
for(lindex=0;lindex<options.Nlayer;lindex++) {
tmp_moist_for_runoff[lindex] = (liq[lindex] + ice[lindex]);
}
compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, inflow, &A, &(runoff[frost_area]));
// save dt_runoff based on initial runoff estimate,
// since we will modify total runoff below for the case of completely saturated soil
tmp_dt_runoff[frost_area] = runoff[frost_area] / (double) dt;
/**************************************************
Compute Flow Between Soil Layers (using an hourly time step)
**************************************************/
dt_inflow = inflow / (double) dt;
for (time_step = 0; time_step < dt; time_step++) {
inflow = dt_inflow;
last_cnt = 0;
/*************************************
Compute Drainage between Sublayers
*************************************/
for( lindex = 0; lindex < options.Nlayer-1; lindex++ ) {
/** Brooks & Corey relation for hydraulic conductivity **/
if((tmp_liq = liq[lindex] - evap[lindex][frost_area]) < resid_moist[lindex])
tmp_liq = resid_moist[lindex];
if(liq[lindex] > resid_moist[lindex]) {
Q12[lindex] = Ksat[lindex] * pow(((tmp_liq - resid_moist[lindex]) / (soil_con->max_moist[lindex] - resid_moist[lindex])), soil_con->expt[lindex]);
}
else Q12[lindex] = 0.;
last_layer[last_cnt] = lindex;
}
/**************************************************
Solve for Current Soil Layer Moisture, and
Check Versus Maximum and Minimum Moisture Contents.
**************************************************/
firstlayer = TRUE;
last_index = 0;
for ( lindex = 0; lindex < options.Nlayer - 1; lindex++ ) {
if ( lindex == 0 ) dt_runoff = tmp_dt_runoff[frost_area];
else dt_runoff = 0;
/* transport moisture for all sublayers **/
tmp_inflow = 0.;
/** Update soil layer moisture content **/
liq[lindex] = liq[lindex] + (inflow - dt_runoff) - (Q12[lindex] + evap[lindex][frost_area]);
/** Verify that soil layer moisture is less than maximum **/
if((liq[lindex]+ice[lindex]) > max_moist[lindex]) {
tmp_inflow = (liq[lindex]+ice[lindex]) - max_moist[lindex];
liq[lindex] = max_moist[lindex] - ice[lindex];
if(lindex==0) {
Q12[lindex] += tmp_inflow;
tmp_inflow = 0;
}
else {
tmplayer = lindex;
while(tmp_inflow > 0) {
tmplayer--;
if ( tmplayer < 0 ) {
/** If top layer saturated, add to runoff **/
runoff[frost_area] += tmp_inflow;
tmp_inflow = 0;
}
else {
/** else add excess soil moisture to next higher layer **/
liq[tmplayer] += tmp_inflow;
if((liq[tmplayer]+ice[tmplayer]) > max_moist[tmplayer]) {
tmp_inflow = ((liq[tmplayer] + ice[tmplayer]) - max_moist[tmplayer]);
liq[tmplayer] = max_moist[tmplayer] - ice[tmplayer];
}
else tmp_inflow=0;
}
}
} /** end trapped excess moisture **/
} /** end check if excess moisture in top layer **/
firstlayer=FALSE;
/** verify that current layer moisture is greater than minimum **/
if (liq[lindex] < 0) {
/** liquid cannot fall below 0 **/
Q12[lindex] += liq[lindex];
liq[lindex] = 0;
}
if ((liq[lindex]+ice[lindex]) < resid_moist[lindex]) {
/** moisture cannot fall below minimum **/
Q12[lindex] += (liq[lindex]+ice[lindex]) - resid_moist[lindex];
liq[lindex] = resid_moist[lindex] - ice[lindex];
}
inflow = (Q12[lindex]+tmp_inflow);
Q12[lindex] += tmp_inflow;
last_index++;
} /* end loop through soil layers */
/**************************************************
Compute Baseflow
**************************************************/
/** ARNO model for the bottom soil layer (based on bottom
soil layer moisture from previous time step) **/
lindex = options.Nlayer-1;
Dsmax = soil_con->Dsmax / 24.;
/** Compute relative moisture **/
rel_moist = (liq[lindex]-resid_moist[lindex]) / (soil_con->max_moist[lindex]-resid_moist[lindex]);
/** Compute baseflow as function of relative moisture **/
frac = Dsmax * soil_con->Ds / soil_con->Ws;
dt_baseflow = frac * rel_moist;
if (rel_moist > soil_con->Ws) {
frac = (rel_moist - soil_con->Ws) / (1 - soil_con->Ws);
dt_baseflow += Dsmax * (1 - soil_con->Ds / soil_con->Ws) * pow(frac,soil_con->c);
}
/** Make sure baseflow isn't negative **/
if(dt_baseflow < 0) dt_baseflow = 0;
/** Extract baseflow from the bottom soil layer **/
liq[lindex] += Q12[lindex-1] - (evap[lindex][frost_area] + dt_baseflow);
/** Check Lower Sub-Layer Moistures **/
tmp_moist = 0;
/* If soil moisture has gone below minimum, take water out
* of baseflow and add back to soil to make up the difference
* Note: this may lead to negative baseflow, in which case we will
* reduce evap to make up for it */
if((liq[lindex]+ice[lindex]) < resid_moist[lindex]) {
dt_baseflow += (liq[lindex]+ice[lindex]) - resid_moist[lindex];
liq[lindex] = resid_moist[lindex] - ice[lindex];
}
if((liq[lindex]+ice[lindex]) > max_moist[lindex]) {
/* soil moisture above maximum */
tmp_moist = ((liq[lindex]+ice[lindex]) - max_moist[lindex]);
liq[lindex] = max_moist[lindex] - ice[lindex];
tmplayer = lindex;
while(tmp_moist > 0) {
tmplayer--;
if(tmplayer<0) {
/** If top layer saturated, add to runoff **/
runoff[frost_area] += tmp_moist;
tmp_moist = 0;
}
else {
/** else if sublayer exists, add excess soil moisture **/
liq[tmplayer] += tmp_moist ;
if ( ( liq[tmplayer] + ice[tmplayer]) > max_moist[tmplayer] ) {
tmp_moist = ((liq[tmplayer] + ice[tmplayer]) - max_moist[tmplayer]);
liq[tmplayer] = max_moist[tmplayer] - ice[tmplayer];
}
else tmp_moist=0;
}
}
}
baseflow[frost_area] += dt_baseflow;
} /* end of hourly time step loop */
/** If negative baseflow, reduce evap accordingly **/
if ( baseflow[frost_area] < 0 ) {
layer[lindex].evap += baseflow[frost_area];
baseflow[frost_area] = 0;
}
/** Recompute Asat based on final moisture level of upper layers **/
for(lindex=0;lindex<options.Nlayer;lindex++) {
tmp_moist_for_runoff[lindex] = (liq[lindex] + ice[lindex]);
}
compute_runoff_and_asat(soil_con, tmp_moist_for_runoff, 0, &A, &tmp_runoff);
/** Store tile-wide values **/
for ( lindex = 0; lindex < options.Nlayer; lindex++ )
layer[lindex].moist += ((liq[lindex] + ice[lindex]) * frost_fract[frost_area]);
cell->asat += A * frost_fract[frost_area];
cell->runoff += runoff[frost_area] * frost_fract[frost_area];
cell->baseflow += baseflow[frost_area] * frost_fract[frost_area];
}
/** Compute water table depth **/
wrap_compute_zwt(soil_con, cell);
/** Recompute Thermal Parameters Based on New Moisture Distribution **/
if(options.FULL_ENERGY || options.FROZEN_SOIL) {
for(lindex=0;lindex<options.Nlayer;lindex++) {
tmp_layer = cell->layer[lindex];
moist[lindex] = tmp_layer.moist;
}
ErrorFlag = distribute_node_moisture_properties(energy->moist, energy->ice,
energy->kappa_node, energy->Cs_node,
soil_con->Zsum_node, energy->T,
soil_con->max_moist_node,
soil_con->expt_node,
soil_con->bubble_node,
moist, soil_con->depth,
soil_con->soil_dens_min,
soil_con->bulk_dens_min,
soil_con->quartz,
soil_con->soil_density,
soil_con->bulk_density,
soil_con->organic, Nnodes,
options.Nlayer, soil_con->FS_ACTIVE);
if ( ErrorFlag == ERROR ) return (ERROR);
}
return (0);
}
// int scatdb(float f, float t, int nshape, float dmax, float *cabs, float *csca, float *cbsc, float *g, float *p, float *re, int *is_loaded) {
int scatdb(float f, float t, int nshape, float dmax, float *cabs, float *csca, float *cbsc, float *g, float *p, float *re, int *is_loaded, char scat_db_dir[180]) { //scat_db_dir added! (Max, 16.8.11)
/*char scat_db_dir[180]={"."};*/ //removed because of scat_db_dir! (Max, 16.8.11)
const char scat_db_fn[]={"scatdb/scat_db2.dda"};
FILE *fp;
static float fs[NFREQ],ts[NTEMP],szs[NSIZE][NSHAP],abss[NFREQ][NTEMP][NSHAP][NSIZE],scas[NFREQ][NTEMP][NSHAP][NSIZE],
bscs[NFREQ][NTEMP][NSHAP][NSIZE],gs[NFREQ][NTEMP][NSHAP][NSIZE],reff[NSIZE][NSHAP],pqs[NFREQ][NTEMP][NSHAP][NSIZE][NQ];
static int shs[NSHAP],mf,mt,msh,msz[NSHAP];
int iret=0,it1=-1,it2=-1,if1=-1,if2=-1,ir1=-1,ir2=-1,big=TRUE;
float x1,x2,y1,y2,a1,b1,c1,d1;
int i,j,k,m,n;
char *db_dir, wk[180];
if(*is_loaded != TRUE) {
/* if((db_dir=getenv("SCATDB_DATA"))) //removed because of scat_db_dir! (Max, 16.8.11)
strcpy(scat_db_dir,db_dir);*/ //removed because of scat_db_dir! (Max, 16.8.11)
sprintf(wk,"%s/%s",scat_db_dir,scat_db_fn);
if(!(fp=fopen(wk,"rb"))) {
fprintf(stderr,"Cannot find scat_db2.dda file. %s\n",wk);
return(iret=2000);
}
if(little_endian() == TRUE) big = FALSE;
fread(&msh,4,1,fp);
if(big) reverse(&msh,4);
fread(&mf,4,1,fp);
if(big) reverse(&mf,4);
fread(&mt,4,1,fp);
if(big) reverse(&mt,4);
for(i=0;i<msh;i++) {
fread(&shs[i],4,1,fp);
if(big) reverse(&shs[i],4);
fread(&msz[i],4,1,fp);
if(big) reverse(&msz[i],4);
for(j=0;j<msz[i];j++) {
fread(&szs[j][shs[i]],4,1,fp);
if(big) reverse(&szs[j][shs[i]],4);
fread(&reff[j][shs[i]],4,1,fp);
if(big) reverse(&reff[j][shs[i]],4);
for(m=0;m<mf;m++) {
fread(&fs[m],4,1,fp);
if(big) reverse(&fs[m],4);
for(n=0;n<mt;n++) {
fread(&ts[n],4,1,fp);
if(big) reverse(&ts[n],4);
fread(&abss[m][n][shs[i]][j],4,1,fp);
if(big) reverse(&abss[m][n][shs[i]][j],4);
fread(&scas[m][n][shs[i]][j],4,1,fp);
if(big) reverse(&scas[m][n][shs[i]][j],4);
fread(&bscs[m][n][shs[i]][j],4,1,fp);
if(big) reverse(&bscs[m][n][shs[i]][j],4);
fread(&gs[m][n][shs[i]][j],4,1,fp);
if(big) reverse(&gs[m][n][shs[i]][j],4);
for(k=0;k<NQ;k++) {
fread(&pqs[m][n][shs[i]][j][k],4,1,fp);
if(big) reverse(&pqs[m][n][shs[i]][j][k],4);
}
}
}
}
}
fclose(fp);
*is_loaded = TRUE;
}
if((nshape<0) || (nshape>msh-1)) return(iret=1000);
for(i=0;i<mf-1;i++)
if((f>=fs[i]) && (f<=fs[i+1])) {
if1=i;
if2=i+1;
break;
}
if(if1 == -1) {
if(f<fs[0]) {if1=0;if2=1;iret += 2;}
else {if1=mf-2;if2=mf-1;iret += 1;}
}
for(i=0;i<mt-1;i++)
if((t<=ts[i]) && (t>=ts[i+1])) {
it1=i;
it2=i+1;
break;
}
if(it1 == -1) {
if(t>ts[0]) {it1=0;it2=1;iret += 10;}
else {it1=mt-2;it2=mt-1;iret += 20;}
}
for(i=0;i<msz[nshape]-1;i++)
if((dmax>=szs[i][nshape]) && (dmax<=szs[i+1][nshape])) {
ir1=i;
ir2=i+1;
break;
}
if(ir1 == -1) {
if(dmax<szs[0][nshape]) {ir1=0;ir2=1;iret += 200;}
else {ir1=msz[nshape]-2;ir2=msz[nshape]-1;iret += 100;}
}
/* sphere equavalent radius */
x1=szs[ir1][nshape];y1=reff[ir1][nshape];x2=szs[ir2][nshape];y2=reff[ir2][nshape];
*re=linear_interp(dmax,x1,x2,y1,y2);
/* absorption */
x1=fs[if1]; x2=fs[if2];
y1=abss[if1][it1][nshape][ir1]; y2=abss[if2][it1][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=abss[if1][it1][nshape][ir2]; y2=abss[if2][it1][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
c1=linear_interp(dmax,x1,x2,y1,y2);
x1=fs[if1]; x2=fs[if2];
y1=abss[if1][it2][nshape][ir1]; y2=abss[if2][it2][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=abss[if1][it2][nshape][ir2]; y2=abss[if2][it2][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
d1=linear_interp(dmax,x1,x2,y1,y2);
x1=ts[it1]; x2=ts[it2]; y1=c1; y2=d1;
*cabs=linear_interp(t,x1,x2,y1,y2);
/* scattering */
x1=fs[if1]; x2=fs[if2];
y1=scas[if1][it1][nshape][ir1]; y2=scas[if2][it1][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=scas[if1][it1][nshape][ir2]; y2=scas[if2][it1][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
c1=linear_interp(dmax,x1,x2,y1,y2);
x1=fs[if1]; x2=fs[if2];
y1=scas[if1][it2][nshape][ir1]; y2=scas[if2][it2][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=scas[if1][it2][nshape][ir2]; y2=scas[if2][it2][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
d1=linear_interp(dmax,x1,x2,y1,y2);
x1=ts[it1]; x2=ts[it2]; y1=c1; y2=d1;
*csca=linear_interp(t,x1,x2,y1,y2);
/* backscattering */
x1=fs[if1]; x2=fs[if2];
y1=bscs[if1][it1][nshape][ir1]; y2=bscs[if2][it1][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=bscs[if1][it1][nshape][ir2]; y2=bscs[if2][it1][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
c1=linear_interp(dmax,x1,x2,y1,y2);
x1=fs[if1]; x2=fs[if2];
y1=bscs[if1][it2][nshape][ir1]; y2=bscs[if2][it2][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=bscs[if1][it2][nshape][ir2]; y2=bscs[if2][it2][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
d1=linear_interp(dmax,x1,x2,y1,y2);
x1=ts[it1]; x2=ts[it2]; y1=c1; y2=d1;
*cbsc=linear_interp(t,x1,x2,y1,y2);
/* asymmetry parameter */
x1=fs[if1]; x2=fs[if2];
y1=gs[if1][it1][nshape][ir1]; y2=gs[if2][it1][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=gs[if1][it1][nshape][ir2]; y2=gs[if2][it1][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
c1=linear_interp(dmax,x1,x2,y1,y2);
x1=fs[if1]; x2=fs[if2];
y1=gs[if1][it2][nshape][ir1]; y2=gs[if2][it2][nshape][ir1];
a1=linear_interp(f,x1,x2,y1,y2);
y1=gs[if1][it2][nshape][ir2]; y2=gs[if2][it2][nshape][ir2];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
d1=linear_interp(dmax,x1,x2,y1,y2);
x1=ts[it1]; x2=ts[it2]; y1=c1; y2=d1;
*g=linear_interp(t,x1,x2,y1,y2);
/* phase function */
for (i=0;i<NQ;i++) {
x1=fs[if1]; x2=fs[if2];
y1=pqs[if1][it1][nshape][ir1][i]; y2=pqs[if2][it1][nshape][ir1][i];
a1=linear_interp(f,x1,x2,y1,y2);
y1=pqs[if1][it1][nshape][ir2][i]; y2=pqs[if2][it1][nshape][ir2][i];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
c1=linear_interp(dmax,x1,x2,y1,y2);
x1=fs[if1]; x2=fs[if2];
y1=pqs[if1][it2][nshape][ir1][i]; y2=pqs[if2][it2][nshape][ir1][i];
a1=linear_interp(f,x1,x2,y1,y2);
y1=pqs[if1][it2][nshape][ir2][i]; y2=pqs[if2][it2][nshape][ir2][i];
b1=linear_interp(f,x1,x2,y1,y2);
x1=szs[ir1][nshape]; x2=szs[ir2][nshape]; y1=a1; y2=b1;
d1=linear_interp(dmax,x1,x2,y1,y2);
x1=ts[it1]; x2=ts[it2]; y1=c1; y2=d1;
p[i]=linear_interp(t,x1,x2,y1,y2);
}
return iret;
}
void calc_root_fractions(veg_con_struct *veg_con,
soil_con_struct *soil_con)
/**********************************************************************
calc_root_fraction.c Keith Cherkauer September 24, 1998
This routine computes the fraction of roots in each soil layer based
on the root zone distribution defined in the vegetation parameter
file. Roots are assumed to be linearly distributed within each
root zone.
**********************************************************************/
{
extern option_struct options;
char ErrStr[MAXSTRING];
int Nveg;
int veg;
int layer;
int zone;
int i;
float sum_depth;
float sum_fract;
float dum;
double Zstep;
double Zsum;
double Lstep;
double Lsum;
double Zmin_fract;
double Zmin_depth;
double Zmax;
Nveg = veg_con[0].vegetat_type_num;
for(veg=0; veg<Nveg; veg++) {
sum_depth = 0;
sum_fract = 0;
layer = 0;
Lstep = soil_con->depth[layer];
Lsum = Lstep;
Zsum = 0;
zone = 0;
while(zone<options.ROOT_ZONES) {
Zstep = (double)veg_con[veg].zone_depth[zone];
if((Zsum + Zstep) <= Lsum && Zsum >= Lsum - Lstep) {
/** CASE 1: Root Zone Completely in Soil Layer **/
sum_fract += veg_con[veg].zone_fract[zone];
}
else {
/** CASE 2: Root Zone Partially in Soil Layer **/
if(Zsum < Lsum - Lstep) {
/** Root zone starts in previous soil layer **/
Zmin_depth = Lsum - Lstep;
Zmin_fract = linear_interp(Zmin_depth,Zsum,Zsum+Zstep,0,
veg_con[veg].zone_fract[zone]);
}
else {
/** Root zone starts in current soil layer **/
Zmin_depth = Zsum;
Zmin_fract = 0.;
}
if(Zsum + Zstep <= Lsum) {
/** Root zone ends in current layer **/
Zmax = Zsum + Zstep;
}
else {
/** Root zone extends beyond bottom of current layer **/
Zmax = Lsum;
}
sum_fract += linear_interp(Zmax,Zsum,Zsum+Zstep,0,
veg_con[veg].zone_fract[zone]) - Zmin_fract;
}
/** Update Root Zone and Soil Layer **/
if(Zsum + Zstep < Lsum) {
Zsum += Zstep;
zone ++;
}
else if(Zsum + Zstep == Lsum) {
Zsum += Zstep;
zone ++;
if(layer<options.Nlayer) {
veg_con[veg].root[layer] = sum_fract;
sum_fract = 0.;
}
layer++;
if(layer<options.Nlayer) {
Lstep = soil_con->depth[layer];
Lsum += Lstep;
}
else if(layer==options.Nlayer) {
Lstep = Zsum + Zstep - Lsum;
if(zone<options.ROOT_ZONES-1) {
for(i=zone+1; i<options.ROOT_ZONES; i++) {
Lstep += veg_con[veg].zone_depth[i];
}
}
Lsum += Lstep;
}
}
else if(Zsum + Zstep > Lsum) {
if(layer<options.Nlayer) {
veg_con[veg].root[layer] = sum_fract;
sum_fract = 0.;
}
layer++;
if(layer<options.Nlayer) {
Lstep = soil_con->depth[layer];
Lsum += Lstep;
}
else if(layer==options.Nlayer) {
Lstep = Zsum + Zstep - Lsum;
if(zone<options.ROOT_ZONES-1) {
for(i=zone+1; i<options.ROOT_ZONES; i++) {
Lstep += veg_con[veg].zone_depth[i];
}
}
Lsum += Lstep;
}
}
}
if(sum_fract > 0 && layer >= options.Nlayer) {
veg_con[veg].root[options.Nlayer-1] += sum_fract;
}
else if(sum_fract > 0) {
veg_con[veg].root[layer] += sum_fract;
}
dum=0.;
for (layer=0; layer<options.Nlayer; layer++) {
if(veg_con[veg].root[layer] < 1.e-4) veg_con[veg].root[layer] = 0.;
dum += veg_con[veg].root[layer];
}
if(dum == 0.0) {
sprintf(ErrStr,"Root fractions sum equals zero: %f , Vege Class: %d\n",
dum, veg_con[veg].veg_class);
nrerror(ErrStr);
}
for (layer=0; layer<options.Nlayer; layer++) {
veg_con[veg].root[layer] /= dum;
}
}
}
void calc_root_fractions(std::vector<HRU>& hruList,
soil_con_struct *soil_con,
const ProgramState* state)
/**********************************************************************
calc_root_fraction.c Keith Cherkauer September 24, 1998
This routine computes the fraction of roots in each soil layer based
on the root zone distribution defined in the vegetation parameter
file. Roots are assumed to be linearly distributed within each
root zone.
**********************************************************************/
{
char ErrStr[MAXSTRING];
int Nhrus;
int veg;
int layer;
int zone;
int i;
float sum_depth;
float sum_fract;
float dum;
double Zstep;
double Zsum;
double Lstep;
double Lsum;
double Zmin_fract;
double Zmin_depth;
double Zmax;
Nhrus = hruList.size();
for(std::vector<HRU>::iterator hru = hruList.begin(); hru != hruList.end(); ++hru) {
if (hru->isArtificialBareSoil) continue; // Skip added bare soil HRUs (zone_fract and zone_depth have not been allocated for these)
sum_depth = 0;
sum_fract = 0;
layer = 0;
Lstep = soil_con->depth[layer];
Lsum = Lstep;
Zsum = 0;
zone = 0;
while(zone<state->options.ROOT_ZONES) {
Zstep = (double)hru->veg_con.zone_depth[zone];
if((Zsum + Zstep) <= Lsum && Zsum >= Lsum - Lstep) {
/** CASE 1: Root Zone Completely in Soil Layer **/
sum_fract += hru->veg_con.zone_fract[zone];
}
else {
/** CASE 2: Root Zone Partially in Soil Layer **/
if(Zsum < Lsum - Lstep) {
/** Root zone starts in previous soil layer **/
Zmin_depth = Lsum - Lstep;
Zmin_fract = linear_interp(Zmin_depth,Zsum,Zsum+Zstep,0,
hru->veg_con.zone_fract[zone]);
}
else {
/** Root zone starts in current soil layer **/
Zmin_depth = Zsum;
Zmin_fract = 0.;
}
if(Zsum + Zstep <= Lsum) {
/** Root zone ends in current layer **/
Zmax = Zsum + Zstep;
}
else {
/** Root zone extends beyond bottom of current layer **/
Zmax = Lsum;
}
sum_fract += linear_interp(Zmax, Zsum, Zsum + Zstep, 0,
hru->veg_con.zone_fract[zone]) - Zmin_fract;
}
/** Update Root Zone and Soil Layer **/
if(Zsum + Zstep < Lsum) {
Zsum += Zstep;
zone ++;
}
else if(Zsum + Zstep == Lsum) {
Zsum += Zstep;
zone ++;
if(layer<state->options.Nlayer) {
hru->veg_con.root[layer] = sum_fract;
sum_fract = 0.;
}
layer++;
if(layer<state->options.Nlayer) {
Lstep = soil_con->depth[layer];
Lsum += Lstep;
}
else if(layer==state->options.Nlayer) {
Lstep = Zsum + Zstep - Lsum;
if(zone<state->options.ROOT_ZONES-1) {
for(i=zone+1;i<state->options.ROOT_ZONES;i++) {
Lstep += hru->veg_con.zone_depth[i];
}
}
Lsum += Lstep;
}
}
else if(Zsum + Zstep > Lsum) {
if(layer<state->options.Nlayer) {
hru->veg_con.root[layer] = sum_fract;
sum_fract = 0.;
}
layer++;
if(layer<state->options.Nlayer) {
Lstep = soil_con->depth[layer];
Lsum += Lstep;
}
else if(layer==state->options.Nlayer) {
Lstep = Zsum + Zstep - Lsum;
if(zone<state->options.ROOT_ZONES-1) {
for(i=zone+1;i<state->options.ROOT_ZONES;i++) {
Lstep += hru->veg_con.zone_depth[i];
}
}
Lsum += Lstep;
}
}
}
if(sum_fract > 0 && layer >= state->options.Nlayer) {
hru->veg_con.root[state->options.Nlayer-1] += sum_fract;
}
else if(sum_fract > 0) {
hru->veg_con.root[layer] += sum_fract;
}
dum=0.;
for (layer=0;layer<state->options.Nlayer;layer++) {
if(hru->veg_con.root[layer] < 1.e-4) hru->veg_con.root[layer] = 0.;
dum += hru->veg_con.root[layer];
}
if(dum == 0.0){
sprintf(ErrStr,"Root fractions sum equals zero: %f , Vege Class: %d\n",
dum, hru->veg_con.vegClass);
nrerror(ErrStr);
}
for (layer=0;layer<state->options.Nlayer;layer++) {
hru->veg_con.root[layer] /= dum;
}
}
}
