int full_energy(int gridcell,
int rec,
atmos_data_struct *atmos,
all_vars_struct *all_vars,
dmy_struct *dmy,
global_param_struct *gp,
lake_con_struct *lake_con,
soil_con_struct *soil_con,
veg_con_struct *veg_con,
veg_hist_struct **veg_hist)
/**********************************************************************
full_energy Keith Cherkauer January 8, 1997
This subroutine controls the model core, it solves both the energy
and water balance models, as well as frozen soils.
modifications:
07-98 restructured to fix problems with distributed precipitation,
and to add the ability to solve the snow model at different
elevation bands within a single grid cell. KAC
01-19-00 modified to work with the new atmosphere data structure
implemented when the radiation forcing routines were
updated. Also modified to use the new simplified
soil moisture storage for the frozen soil algorithm. KAC
12-01-00 modified to include the lakes and wetlands algorithm. KAC
11-18-02 Modified to handle blowing snow. Also added debugging
output for lake model. LCB
05-27-03 Updated passing of veg_con parameters for blowing snow
to surface_fluxes. Original did not account for the fact
that veg_con is not allocated for veg = Nveg (bare soil)
case. This eliminates a memory error. KAC
28-Sep-04 Added aero_resist_used to store the aerodynamic resistance
used in flux calculations. TJB
2006-Sep-23 Implemented flexible output configuration; now computation
of soil wetness and root zone soil moisture happens here. TJB
2006-Nov-07 Removed LAKE_MODEL option. TJB
2007-Apr-04 Modified to handle grid cell errors by returning to the
main subroutine, rather than ending the simulation. GCT/KAC
2007-May-01 Added case of SPATIAL_FROST = TRUE in modifications
from 2006-Sep-23. GCT
2007-Aug-10 Added features for EXCESS_ICE option.
Including calculating subsidence for each layer and
updating soil depth, effective porosity,
bulk density, and soil moisture and fluxes by calling
runoff function if subsidence occurs. JCA
2007-Sep-07 No longer resets ice content to previous time-step ice content if
subsidence has occurred. JCA
2007-Sep-19 Added MAX_SUBSIDENCE parameter to EXCESS_ICE option. JCA
2007-Sep-19 Fixed bug in subsidence calculation. JCA
2007-Nov-06 Added veg_con to parameter list of lakemain(). Replaced
lake.fraci with lake.areai. LCB via TJB
2008-Jan-23 Changed ice0 from a scalar to an array. Previously,
when options.SNOW_BAND > 1, the value of ice0 computed
for earlier bands was always overwritten by the value
of ice0 computed for the final band (even if the final
band had 0 area). JS via TJB
2008-May-05 Changed moist from a scalar to an array (moist0). Previously,
when options.SNOW_BAND > 1, the value of moist computed
for earlier bands was always overwritten by the value
of moist computed for the final band (even if the final
band had 0 area). KAC via TJB
2009-Jan-16 Modified aero_resist_used and Ra_used to become arrays of
two elements (surface and overstory); added
options.AERO_RESIST_CANSNOW. TJB
2009-May-17 Added asat to cell_data. TJB
2009-Jun-09 Modified to use extension of veg_lib structure to contain
bare soil information. TJB
2009-Jun-09 Modified to compute aero_resist for all potential evap
landcover types. TJB
2009-Jun-09 Cell_data structure now only stores final aero_resist
values (called "aero_resist"). Preliminary uncorrected
aerodynamic resistances for current vegetation and various
reference land cover types for use in potential evap
calculations is stored in temporary array aero_resist. 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-Jul-22 Fixed error in assignment of cell.aero_resist. TJB
2009-Jul-31 Wetland portion of lake/wetland tile is now processed in
full_energy() instead of wetland_energy(). Lake funcions are
now called directly from full_energy instead of lakemain(). TJB
2009-Sep-28 Moved lake_snow and lake_energy into lake_var structure.
Removed calls to initialize_prcp and update_prcp. TJB
2009-Sep-30 Miscellaneous fixes for lake model. TJB
2009-Oct-05 Miscellaneous fixes for lake model, including updating/
rescaling of lake and wetland storages and fluxes to account
for changes in lake area. TJB
2009-Nov-09 Changed definition of lake->sarea to include ice extent; other
changes to handle case when lake fraction goes to 0. LCB via TJB
2010-Mar-31 Added runoff_in. TJB
2010-Sep-24 Changed atmos.runoff_in to atmos.channel_in. Added
lake_var.channel_in to store it. TJB
2010-Nov-02 Changed units of lake_var moisture fluxes to volume (m3). TJB
2010-Nov-26 Changed argument list of water_balance(). TJB
2011-May-31 Prepare_full_energy() is now always called. TJB
2011-Jun-03 Added options.ORGANIC_FRACT. Soil properties now take
organic fraction into account. TJB
2012-Jan-01 Modified condition for determining whether to simulate lakes
to check whether lake_idx >= 0. TJB
2012-Jan-16 Removed LINK_DEBUG code BN
2012-Aug-28 Added accumulation of rain and snow over lake to grid cell
totals. TJB
2013-Jul-25 Added photosynthesis terms. TJB
2013-Jul-25 Added soil carbon terms. TJB
2013-Dec-26 Removed EXCESS_ICE option. TJB
2013-Dec-27 Removed (unused) SPATIAL_FROST code. TJB
2014-Mar-28 Removed DIST_PRCP option. TJB
2014-Apr-25 Added non-climatological veg params. TJB
2014-Apr-25 Added partial vegcover fraction. TJB
**********************************************************************/
{
extern veg_lib_struct *veg_lib;
extern option_struct options;
char overstory;
int i, j, p;
int lidx;
int iveg;
int Nveg;
int veg_class;
int band;
int Nbands;
int ErrorFlag;
double out_prec[2*MAX_BANDS];
double out_rain[2*MAX_BANDS];
double out_snow[2*MAX_BANDS];
double out_short=0;
double dp;
double ice0[MAX_BANDS];
double moist0[MAX_BANDS];
double surf_atten;
double Tend_surf;
double Tend_grnd;
double wind_h;
double height;
double displacement[3];
double roughness[3];
double ref_height[3];
double **aero_resist;
double Cv;
double Le;
double Melt[2*MAX_BANDS];
double bare_albedo;
double snow_inflow[MAX_BANDS];
double rainonly;
double sum_runoff;
double sum_baseflow;
double tmp_wind[3];
double gauge_correction[2];
float lag_one;
float sigma_slope;
float fetch;
int pet_veg_class;
double lakefrac;
double fraci;
double wetland_runoff;
double wetland_baseflow;
double oldsnow;
double snowprec;
double rainprec;
int cidx;
lake_var_struct *lake_var;
cell_data_struct **cell;
veg_var_struct **veg_var;
energy_bal_struct **energy;
snow_data_struct **snow;
/* Allocate aero_resist array */
aero_resist = (double**)calloc(N_PET_TYPES+1,sizeof(double*));
for (p=0; p<N_PET_TYPES+1; p++) {
aero_resist[p] = (double*)calloc(3,sizeof(double));
}
/* set local pointers */
cell = all_vars->cell;
energy = all_vars->energy;
lake_var = &all_vars->lake_var;
snow = all_vars->snow;
veg_var = all_vars->veg_var;
Nbands = options.SNOW_BAND;
/* Set number of vegetation types */
Nveg = veg_con[0].vegetat_type_num;
/** Set Damping Depth **/
dp = soil_con->dp;
/* Compute gauge undercatch correction factors
- this assumes that the gauge is free of vegetation effects, so gauge
correction is constant for the entire grid cell */
if( options.CORRPREC && atmos->prec[NR] > 0 )
correct_precip(gauge_correction, atmos->wind[NR], gp->wind_h,
soil_con->rough, soil_con->snow_rough);
else {
gauge_correction[0] = 1;
gauge_correction[1] = 1;
}
atmos->out_prec = 0;
atmos->out_rain = 0;
atmos->out_snow = 0;
/* Assign current veg albedo and LAI */
if (rec >= 0) {
// Loop over vegetated tiles
for(iveg = 0; iveg < Nveg; iveg++){
veg_class = veg_con[iveg].veg_class;
if (veg_hist[rec][iveg].vegcover[0] < MIN_VEGCOVER)
veg_hist[rec][iveg].vegcover[0] = MIN_VEGCOVER;
for ( band = 0; band < Nbands; band++ ) {
veg_var[iveg][band].vegcover = veg_hist[rec][iveg].vegcover[0];
veg_var[iveg][band].albedo = veg_hist[rec][iveg].albedo[0];
veg_var[iveg][band].LAI = veg_hist[rec][iveg].LAI[0];
// Convert LAI from global to local
veg_var[iveg][band].LAI /= veg_var[iveg][band].vegcover;
veg_var[iveg][band].Wdew /= veg_var[iveg][band].vegcover;
veg_var[iveg][band].Wdmax = veg_var[iveg][band].LAI*LAI_WATER_FACTOR;
snow[iveg][band].snow_canopy /= veg_var[iveg][band].vegcover;
}
}
}
/**************************************************
Solve Energy and/or Water Balance for Each
Vegetation Type
**************************************************/
for(iveg = 0; iveg <= Nveg; iveg++){
/** Solve Veg Type only if Coverage Greater than 0% **/
if (veg_con[iveg].Cv > 0.0) {
Cv = veg_con[iveg].Cv;
Nbands = options.SNOW_BAND;
/** Lake-specific processing **/
if (veg_con[iveg].LAKE) {
/* Update areai to equal new ice area from previous time step. */
lake_var->areai = lake_var->new_ice_area;
/* Compute lake fraction and ice-covered fraction */
if (lake_var->areai < 0) lake_var->areai = 0;
if (lake_var->sarea > 0) {
fraci = lake_var->areai/lake_var->sarea;
if(fraci > 1.0) fraci = 1.0;
}
else
fraci = 0.0;
lakefrac = lake_var->sarea/lake_con->basin[0];
Nbands = 1;
Cv *= (1-lakefrac);
if (Cv == 0)
continue;
}
/**************************************************
Initialize Model Parameters
**************************************************/
for(band = 0; band < Nbands; band++) {
if(soil_con->AreaFract[band] > 0) {
/* Initialize energy balance variables */
energy[iveg][band].shortwave = 0;
energy[iveg][band].longwave = 0.;
/* Initialize snow variables */
snow[iveg][band].vapor_flux = 0.;
snow[iveg][band].canopy_vapor_flux = 0.;
snow_inflow[band] = 0.;
Melt[band*2] = 0.;
}
}
/* Initialize precipitation storage */
for ( j = 0; j < 2*MAX_BANDS; j++ ) {
out_prec[j] = 0;
out_rain[j] = 0;
out_snow[j] = 0;
}
/** Define vegetation class number **/
veg_class = veg_con[iveg].veg_class;
/** Initialize other veg vars **/
if (iveg < Nveg) {
for(band=0; band<Nbands; band++) {
veg_var[iveg][band].rc = HUGE_RESIST;
}
}
/** Assign wind_h **/
/** Note: this is ignored below **/
wind_h = veg_lib[veg_class].wind_h;
/** Compute Surface Attenuation due to Vegetation Coverage **/
surf_atten = (1-veg_var[iveg][0].vegcover)*1.0
+ veg_var[iveg][0].vegcover
* exp(-veg_lib[veg_class].rad_atten * veg_var[iveg][0].LAI);
/* Initialize soil thermal properties for the top two layers */
prepare_full_energy(iveg, Nveg, options.Nnode, all_vars, soil_con, moist0, ice0);
/** Compute Bare (free of snow) Albedo **/
if (iveg!=Nveg){
bare_albedo = veg_var[iveg][0].albedo;
}
else {
bare_albedo = BARE_SOIL_ALBEDO;
}
/*************************************
Compute the aerodynamic resistance
for current veg cover and various
types of potential evap
*************************************/
/* Loop over types of potential evap, plus current veg */
/* Current veg will be last */
for (p=0; p<N_PET_TYPES+1; p++) {
/* Initialize wind speeds */
tmp_wind[0] = atmos->wind[NR];
tmp_wind[1] = -999.;
tmp_wind[2] = -999.;
/* Set surface descriptive variables */
if (p < N_PET_TYPES_NON_NAT) {
pet_veg_class = veg_lib[0].NVegLibTypes+p;
}
else {
pet_veg_class = veg_class;
}
displacement[0] = veg_lib[pet_veg_class].displacement[dmy[rec].month-1];
roughness[0] = veg_lib[pet_veg_class].roughness[dmy[rec].month-1];
overstory = veg_lib[pet_veg_class].overstory;
if (p >= N_PET_TYPES_NON_NAT)
if ( roughness[0] == 0 ) roughness[0] = soil_con->rough;
/* Estimate vegetation height */
height = calc_veg_height(displacement[0]);
/* Estimate reference height */
if(displacement[0] < wind_h)
ref_height[0] = wind_h;
else
ref_height[0] = displacement[0] + wind_h + roughness[0];
/* Compute aerodynamic resistance over various surface types */
/* Do this not only for current veg but also all types of PET */
ErrorFlag = CalcAerodynamic(overstory, height,
veg_lib[pet_veg_class].trunk_ratio,
soil_con->snow_rough, soil_con->rough,
veg_lib[pet_veg_class].wind_atten,
aero_resist[p], tmp_wind,
displacement, ref_height,
roughness);
if ( ErrorFlag == ERROR ) return ( ERROR );
}
/* Initialize final aerodynamic resistance values */
for ( band = 0; band < Nbands; band++ ) {
if( soil_con->AreaFract[band] > 0 ) {
cell[iveg][band].aero_resist[0] = aero_resist[N_PET_TYPES][0];
cell[iveg][band].aero_resist[1] = aero_resist[N_PET_TYPES][1];
}
}
/******************************
Compute nitrogen scaling factors and initialize other veg vars
******************************/
if (options.CARBON && iveg < Nveg) {
for(band=0; band<Nbands; band++) {
for (cidx=0; cidx<options.Ncanopy; cidx++) {
veg_var[iveg][band].rsLayer[cidx] = HUGE_RESIST;
}
veg_var[iveg][band].aPAR = 0;
if (dmy->hour == 0) {
calc_Nscale_factors(veg_lib[veg_class].NscaleFlag,
veg_con[iveg].CanopLayerBnd,
veg_lib[veg_class].LAI[dmy[rec].month-1],
soil_con->lat,
soil_con->lng,
soil_con->time_zone_lng,
dmy[rec],
veg_var[iveg][band].NscaleFactor);
}
if (dmy[rec].month == 1 && dmy[rec].day == 1) {
veg_var[iveg][band].AnnualNPPPrev = veg_var[iveg][band].AnnualNPP;
veg_var[iveg][band].AnnualNPP = 0;
}
}
}
/******************************
Solve ground surface fluxes
******************************/
for ( band = 0; band < Nbands; band++ ) {
if( soil_con->AreaFract[band] > 0 ) {
lag_one = veg_con[iveg].lag_one;
sigma_slope = veg_con[iveg].sigma_slope;
fetch = veg_con[iveg].fetch;
/* Initialize pot_evap */
for (p=0; p<N_PET_TYPES; p++)
cell[iveg][band].pot_evap[p] = 0;
ErrorFlag = surface_fluxes(overstory, bare_albedo, height, ice0[band], moist0[band],
surf_atten, &(Melt[band*2]), &Le,
aero_resist,
displacement, gauge_correction,
&out_prec[band*2],
&out_rain[band*2], &out_snow[band*2],
ref_height, roughness,
&snow_inflow[band],
tmp_wind, veg_con[iveg].root, Nbands,
options.Nlayer, Nveg, band, dp, iveg, rec, veg_class,
atmos, dmy, &(energy[iveg][band]), gp,
&(cell[iveg][band]),
&(snow[iveg][band]),
soil_con, &(veg_var[iveg][band]),
lag_one, sigma_slope, fetch, veg_con[iveg].CanopLayerBnd);
if ( ErrorFlag == ERROR ) return ( ERROR );
atmos->out_prec += out_prec[band*2] * Cv * soil_con->AreaFract[band];
atmos->out_rain += out_rain[band*2] * Cv * soil_con->AreaFract[band];
atmos->out_snow += out_snow[band*2] * Cv * soil_con->AreaFract[band];
/********************************************************
Compute soil wetness and root zone soil moisture
********************************************************/
cell[iveg][band].rootmoist = 0;
cell[iveg][band].wetness = 0;
for(lidx=0;lidx<options.Nlayer;lidx++) {
if (veg_con->root[lidx] > 0) {
cell[iveg][band].rootmoist += cell[iveg][band].layer[lidx].moist;
}
cell[iveg][band].wetness += (cell[iveg][band].layer[lidx].moist - soil_con->Wpwp[lidx])/(soil_con->porosity[lidx]*soil_con->depth[lidx]*1000 - soil_con->Wpwp[lidx]);
}
cell[iveg][band].wetness /= options.Nlayer;
} /** End non-zero area band **/
} /** End Loop Through Elevation Bands **/
} /** end non-zero area veg tile **/
} /** end of vegetation loop **/
/* Convert LAI back to global */
if (rec >= 0) {
for(iveg = 0; iveg < Nveg; iveg++){
for ( band = 0; band < Nbands; band++ ) {
veg_var[iveg][band].LAI *= veg_var[iveg][band].vegcover;
veg_var[iveg][band].Wdmax *= veg_var[iveg][band].vegcover;
}
}
}
for (p=0; p<N_PET_TYPES+1; p++) {
free((char *)aero_resist[p]);
}
free((char *)aero_resist);
/****************************
Run Lake Model
****************************/
/** Compute total runoff and baseflow for all vegetation types
within each snowband. **/
if ( options.LAKES && lake_con->lake_idx >= 0 ) {
wetland_runoff = wetland_baseflow = 0;
sum_runoff = sum_baseflow = 0;
// Loop through all vegetation tiles
for ( iveg = 0; iveg <= Nveg; iveg++ ) {
/** Solve Veg Tile only if Coverage Greater than 0% **/
if (veg_con[iveg].Cv > 0.) {
Cv = veg_con[iveg].Cv;
Nbands = options.SNOW_BAND;
if (veg_con[iveg].LAKE) {
Cv *= (1-lakefrac);
Nbands = 1;
}
// Loop through snow elevation bands
for ( band = 0; band < Nbands; band++ ) {
if ( soil_con->AreaFract[band] > 0 ) {
if (veg_con[iveg].LAKE) {
wetland_runoff += ( cell[iveg][band].runoff
* Cv * soil_con->AreaFract[band] );
wetland_baseflow += ( cell[iveg][band].baseflow
* Cv * soil_con->AreaFract[band] );
cell[iveg][band].runoff = 0;
cell[iveg][band].baseflow = 0;
}
else {
sum_runoff += ( cell[iveg][band].runoff
* Cv * soil_con->AreaFract[band] );
sum_baseflow += ( cell[iveg][band].baseflow
* Cv * soil_con->AreaFract[band] );
cell[iveg][band].runoff *= (1-lake_con->rpercent);
cell[iveg][band].baseflow *= (1-lake_con->rpercent);
}
}
}
}
}
/** Run lake model **/
iveg = lake_con->lake_idx;
band = 0;
lake_var->runoff_in = (sum_runoff * lake_con->rpercent + wetland_runoff)*soil_con->cell_area*0.001; // m3
lake_var->baseflow_in = (sum_baseflow * lake_con->rpercent + wetland_baseflow)*soil_con->cell_area*0.001; // m3
lake_var->channel_in = atmos->channel_in[NR]*soil_con->cell_area*0.001; // m3
lake_var->prec = atmos->prec[NR]*lake_var->sarea*0.001; // m3
rainonly = calc_rainonly(atmos->air_temp[NR], atmos->prec[NR],
gp->MAX_SNOW_TEMP, gp->MIN_RAIN_TEMP);
if ( (int)rainonly == ERROR ) {
return( ERROR );
}
/**********************************************************************
Solve the energy budget for the lake.
**********************************************************************/
oldsnow = lake_var->snow.swq;
snowprec = gauge_correction[SNOW] * (atmos->prec[NR] - rainonly);
rainprec = gauge_correction[SNOW] * rainonly;
atmos->out_prec += (snowprec + rainprec) * lake_con->Cl[0] * lakefrac;
atmos->out_rain += rainprec * lake_con->Cl[0] * lakefrac;
atmos->out_snow += snowprec * lake_con->Cl[0] * lakefrac;
ErrorFlag = solve_lake(snowprec, rainprec, atmos->air_temp[NR],
atmos->wind[NR], atmos->vp[NR] / 1000.,
atmos->shortwave[NR], atmos->longwave[NR],
atmos->vpd[NR] / 1000.,
atmos->pressure[NR] / 1000.,
atmos->density[NR], lake_var, *lake_con,
*soil_con, gp->dt, rec, gp->wind_h, dmy[rec], fraci);
if ( ErrorFlag == ERROR ) return (ERROR);
/**********************************************************************
Solve the water budget for the lake.
**********************************************************************/
ErrorFlag = water_balance(lake_var, *lake_con, gp->dt, all_vars, rec, iveg, band, lakefrac, *soil_con, *veg_con);
if ( ErrorFlag == ERROR ) return (ERROR);
} // end if (options.LAKES && lake_con->lake_idx >= 0)
return (0);
}
void full_energy(int rec,
atmos_data_struct *atmos,
soil_con_struct *soil_con,
veg_con_struct *veg_con,
dist_prcp_struct *prcp,
dmy_struct *dmy,
global_param_struct *gp,
int gridcell,
char NEWCELL)
/**********************************************************************
full_energy Keith Cherkauer January 8, 1997
This subroutine controls the model core, it solves both the energy
and water balance models, as well as frozen soils.
modifications:
07-98 restructured to fix problems with distributed precipitation,
and to add the ability to solve the snow model at different
elevation bands within a single grid cell. KAC
01-19-00 modified to work with the new atmosphere data structure
implemented when the radiation forcing routines were
updated. Also modified to use the new simplified
soil moisture storage for the frozen soil algorithm. KAC
28-Sep-04 Added aero_resist_used to store the aerodynamic resistance
actually used in flux calculations. TJB
2006-Sep-14 Added computation of soil wetness and root zone soil
moisture, as part of ALMA-compliant input/output. TJB
2007-Oct-22 Changed ice0 from a scalar to an array. Previously,
when options.SNOW_BAND > 1, the value of ice0 computed
for earlier bands was always overwritten by the value
of ice0 computed for the final band (even if the final
band had 0 area). JS via TJB
**********************************************************************/
{
extern veg_lib_struct *veg_lib;
extern option_struct options;
#if LINK_DEBUG
extern debug_struct debug;
#endif
char overstory;
char SOLVE_SURF_ENERGY;
int i, j, k;
int lidx;
int Ndist;
int dist;
int iveg;
int Nveg;
int veg_class;
int band;
int Nbands;
int hour;
double out_prec[2*MAX_BANDS];
double out_rain[2*MAX_BANDS];
double out_snow[2*MAX_BANDS];
double tmp_surf_temp;
double last_T1;
double out_short=0;
double inshort;
double inlong;
double dp;
double ice0[MAX_BANDS];
double moist;
double surf_atten;
double Tsurf;
double Tgrnd;
double Tend_surf;
double Tend_grnd;
double rainfall[2];
double wind_h;
double height;
double displacement;
double roughness;
double ref_height;
double Cv;
double Le;
double Ls;
double Evap;
double Melt[2*MAX_BANDS];
double bare_albedo;
double snow_inflow[MAX_BANDS];
double step_rad;
double step_net_short;
double tmp_aero_resist;
double tmp_throughfall[2][MAX_BANDS];
double tmp_wind[3];
double tmp_melt[MAX_BANDS*2];
double tmp_vapor_flux[MAX_BANDS];
double tmp_canopy_vapor_flux[MAX_BANDS];
double tmp_canopyevap[2][MAX_BANDS];
double tmp_snow_energy;
double tmp_Wdew[2];
double tmp_mu;
double tmp_layerevap[2][MAX_BANDS][MAX_LAYERS];
double tmp_Tmin;
double tmp_total_moist_wet;
double tmp_total_moist_dry;
double gauge_correction[2];
layer_data_struct *tmp_layer[2];
veg_var_struct tmp_veg_var[2];
cell_data_struct ***cell;
veg_var_struct ***veg_var;
energy_bal_struct **energy;
energy_bal_struct *ptr_energy;
snow_data_struct **snow;
snow_data_struct *tmp_snow;
veg_var_struct *tmp_veg[2];
veg_var_struct *wet_veg_var;
veg_var_struct *dry_veg_var;
veg_var_struct empty_veg_var;
/* set local pointers */
cell = prcp->cell;
veg_var = prcp->veg_var;
snow = prcp->snow;
energy = prcp->energy;
/* set variables for distributed precipitation */
if(options.DIST_PRCP)
Ndist = 2;
else
Ndist = 1;
Nbands = options.SNOW_BAND;
/* Set number of vegetation types */
Nveg = veg_con[0].vegetat_type_num;
/** Set Damping Depth **/
dp = soil_con->dp;
/* allocate memory for temporary storage structures */
if(options.FULL_ENERGY || options.FROZEN_SOIL) {
for(i=0; i<2; i++) {
tmp_layer[i] = (layer_data_struct *)calloc((options.Nlayer),
sizeof(layer_data_struct));
}
}
/* Compute gauge undercatch correction factors
- this assumes that the gauge is free of vegetation effects, so gauge
correction is constant for the entire grid cell */
if( options.CORRPREC && atmos->prec[NR] > 0 )
correct_precip(gauge_correction, atmos->wind[NR], gp->wind_h,
soil_con->rough, soil_con->snow_rough);
else {
gauge_correction[0] = 1;
gauge_correction[1] = 1;
}
atmos->out_prec = 0;
atmos->out_rain = 0;
atmos->out_snow = 0;
/**************************************************
Solve Energy and/or Water Balance for Each
Vegetation Type
**************************************************/
for(iveg = 0; iveg <= Nveg; iveg++){
/** Solve Veg Type only if Coverage Greater than 0% **/
if ((iveg < Nveg && veg_con[iveg].Cv > 0.) ||
(iveg == Nveg && veg_con[0].Cv_sum < 1.)) {
if ( iveg < Nveg ) Cv = veg_con[iveg].Cv;
else Cv = 1. - veg_con[0].Cv_sum;
/**************************************************
Initialize Model Parameters
**************************************************/
/* Initialize energy balance variables */
for(band = 0; band < Nbands; band++) {
if(soil_con->AreaFract[band] > 0) {
energy[iveg][band].shortwave = 0;
energy[iveg][band].longwave = 0.;
}
}
/* Initialize snow variables */
for(band=0; band<Nbands; band++) {
if(soil_con->AreaFract[band] > 0) {
snow[iveg][band].vapor_flux = 0.;
snow[iveg][band].canopy_vapor_flux = 0.;
snow_inflow[band] = 0.;
Melt[band*2] = 0.;
}
}
/* Initialize precipitation storage */
for ( j = 0; j < 2*MAX_BANDS; j++ ) {
out_prec[j] = 0;
out_rain[j] = 0;
out_snow[j] = 0;
}
/** Define vegetation class number **/
if (iveg < Nveg)
veg_class = veg_con[iveg].veg_class;
else
veg_class = 0;
if ( iveg < Nveg ) wind_h = veg_lib[veg_class].wind_h;
else wind_h = gp->wind_h;
/** Compute Surface Attenuation due to Vegetation Coverage **/
if(iveg < Nveg)
surf_atten = exp(-veg_lib[veg_class].rad_atten
* veg_lib[veg_class].LAI[dmy[rec].month-1]);
else
surf_atten = 1.;
/* Initialize soil thermal properties for the top two layers */
if(options.FULL_ENERGY || options.FROZEN_SOIL) {
prepare_full_energy(iveg, Nveg, options.Nnode, prcp,
soil_con, &moist, ice0);
}
/** Compute Bare Soil (free of snow) Albedo **/
if(iveg != Nveg)
bare_albedo = veg_lib[veg_class].albedo[dmy[rec].month-1];
else
bare_albedo = BARE_SOIL_ALBEDO;
/*************************************
Compute the aerodynamic resistance
*************************************/
/* Set surface descriptive variables */
overstory = FALSE;
if(iveg < Nveg) {
displacement = veg_lib[veg_class].displacement[dmy[rec].month-1];
roughness = veg_lib[veg_class].roughness[dmy[rec].month-1];
overstory = veg_lib[veg_class].overstory;
}
if(iveg == Nveg || roughness == 0) {
displacement = 0.;
roughness = soil_con->rough;
overstory = FALSE;
}
/* Initialize wind speeds */
tmp_wind[0] = atmos->wind[NR];
tmp_wind[1] = -999.;
tmp_wind[2] = -999.;
/* Estimate vegetation height */
height = calc_veg_height(displacement);
/* Estimate reference height */
if(displacement < wind_h)
ref_height = wind_h;
else
ref_height = displacement + wind_h + roughness;
/* Compute aerodynamic resistance over various surface types */
CalcAerodynamic(overstory, iveg, Nveg, veg_lib[veg_class].wind_atten,
height, soil_con->rough, soil_con->snow_rough,
&displacement, &roughness, &ref_height,
veg_lib[veg_class].trunk_ratio,
tmp_wind, cell[WET][iveg][0].aero_resist);
/**************************************************
Store Water Balance Terms for Debugging
**************************************************/
#if LINK_DEBUG
if(debug.DEBUG || debug.PRT_MOIST || debug.PRT_BALANCE) {
/** Compute current total moisture for water balance check **/
store_moisture_for_debug(iveg, Nveg, prcp->mu, cell,
veg_var, snow, soil_con);
if(debug.PRT_BALANCE) {
for(j=0; j<Ndist; j++) {
for(band=0; band<Nbands; band++) {
if(soil_con->AreaFract[band] > 0) {
for(i=0; i<options.Nlayer+3; i++) {
debug.inflow[j][band][i] = 0;
debug.outflow[j][band][i] = 0;
}
}
}
}
}
}
#endif
/******************************
Solve ground surface fluxes
******************************/
for ( band = 0; band < Nbands; band++ ) {
if( soil_con->AreaFract[band] > 0 ) {
if ( iveg < Nveg ) {
wet_veg_var = &(veg_var[WET][iveg][band]);
dry_veg_var = &(veg_var[DRY][iveg][band]);
}
else {
wet_veg_var = &(empty_veg_var);
dry_veg_var = &(empty_veg_var);
}
surface_fluxes(overstory, rec, band, veg_class, iveg, Nveg, Ndist,
Nbands, options.Nlayer, dp, prcp->mu[iveg], ice0[band],
moist, surf_atten, height, displacement, roughness,
ref_height, bare_albedo,
cell[WET][iveg][0].aero_resist, &(cell[WET][iveg][0].aero_resist_used),
&(cell[WET][iveg][band].baseflow),
&(cell[DRY][iveg][band].baseflow),
&(cell[WET][iveg][band].runoff),
&(cell[DRY][iveg][band].runoff), &out_prec[band*2],
&out_rain[band*2], &out_snow[band*2],
tmp_wind, &Le, &Ls, &(Melt[band*2]),
&(cell[WET][iveg][band].inflow),
&(cell[DRY][iveg][band].inflow),
&snow_inflow[band], gauge_correction,
veg_con[iveg].root, atmos, soil_con, dmy, gp,
&(energy[iveg][band]), &(snow[iveg][band]),
cell[WET][iveg][band].layer,
cell[DRY][iveg][band].layer,
wet_veg_var, dry_veg_var);
atmos->out_prec += out_prec[band*2] * Cv * soil_con->AreaFract[band];
atmos->out_rain += out_rain[band*2] * Cv * soil_con->AreaFract[band];
atmos->out_snow += out_snow[band*2] * Cv * soil_con->AreaFract[band];
/********************************************************
Compute soil wetness and root zone soil moisture
********************************************************/
cell[WET][iveg][band].rootmoist = 0;
cell[DRY][iveg][band].rootmoist = 0;
cell[WET][iveg][band].wetness = 0;
cell[DRY][iveg][band].wetness = 0;
for(lidx=0;lidx<options.Nlayer;lidx++) {
tmp_total_moist_wet = cell[WET][iveg][band].layer[lidx].moist + cell[WET][iveg][band].layer[lidx].ice;
tmp_total_moist_dry = cell[DRY][iveg][band].layer[lidx].moist + cell[DRY][iveg][band].layer[lidx].ice;
if (veg_con->root[lidx] > 0) {
cell[WET][iveg][band].rootmoist += tmp_total_moist_wet;
cell[DRY][iveg][band].rootmoist += tmp_total_moist_dry;
}
cell[WET][iveg][band].wetness += (tmp_total_moist_wet - soil_con->Wpwp[lidx])/(soil_con->porosity[lidx]*soil_con->depth[lidx]*1000 - soil_con->Wpwp[lidx]);
cell[DRY][iveg][band].wetness += (tmp_total_moist_dry - soil_con->Wpwp[lidx])/(soil_con->porosity[lidx]*soil_con->depth[lidx]*1000 - soil_con->Wpwp[lidx]);
}
cell[WET][iveg][band].wetness /= options.Nlayer;
cell[DRY][iveg][band].wetness /= options.Nlayer;
} /** End Loop Through Elevation Bands **/
} /** End Full Energy Balance Model **/
/****************************
Controls Debugging Output
****************************/
#if LINK_DEBUG
for(j = 0; j < Ndist; j++) {
if(iveg < Nveg)
tmp_veg[j] = veg_var[j][iveg];
else
tmp_veg[j] = NULL;
}
ptr_energy = energy[iveg];
tmp_snow = snow[iveg];
for(j = 0; j < Ndist; j++) {
if(j == 0)
tmp_mu = prcp->mu[iveg];
else
tmp_mu = 1. - prcp->mu[iveg];
/** for debugging water balance: [0] = vegetation,
[1] = ground snow, [2..Nlayer+1] = soil layers **/
if(debug.PRT_BALANCE) {
for(band = 0; band < Nbands; band++) {
if(soil_con->AreaFract[band] > 0) {
debug.inflow[j][band][options.Nlayer+2]
+= out_prec[j+band*2] * soil_con->Pfactor[band];
debug.inflow[j][band][0] = 0.;
debug.inflow[j][band][1] = 0.;
debug.outflow[j][band][0] = 0.;
debug.outflow[j][band][1] = 0.;
if(iveg < Nveg) {
/** Vegetation Present **/
debug.inflow[j][band][0] += out_prec[j+band*2] * soil_con->Pfactor[band];
debug.outflow[j][band][0]
+= veg_var[j][iveg][band].throughfall;
}
if(j == 0)
debug.inflow[j][band][1] += snow_inflow[band];
debug.outflow[j][band][1] += Melt[band*2+j];
}
} /** End loop through elevation bands **/
}
if(iveg != Nveg) {
write_debug(atmos, soil_con, cell[j][iveg], ptr_energy,
tmp_snow, tmp_veg[j], &(dmy[rec]), gp, out_short,
tmp_mu, Nveg, iveg, rec, gridcell, j, NEWCELL);
}
else {
write_debug(atmos, soil_con, cell[j][iveg], ptr_energy, tmp_snow,
tmp_veg[j], &(dmy[rec]), gp, out_short, tmp_mu, Nveg,
iveg, rec, gridcell, j, NEWCELL);
}
}
#endif
} /** end current vegetation type **/
} /** end of vegetation loop **/
/** END Temperature and Moisture Profile Debugging Output **/
if(options.FULL_ENERGY || options.FROZEN_SOIL) {
for(j = 0; j < 2; j++) {
free ((char *)tmp_layer[j]);
}
}
}