int main(int argc, char *argv[])
/**********************************************************************
vicNl.c Dag Lohmann January 1996
This program controls file I/O and variable initialization as well as
being the primary driver for the model.
For details about variables, input files and subroutines check:
http://ce.washington.edu/~hydro/Lettenmaier/Models/VIC/VIC_home.html
UNITS: unless otherwise marked:
all water balance components are in mm
all energy balance components are in mks
depths, and lengths are in m
modifications:
1997-98 Model was updated from simple 2 layer water balance to
an extension of the full energy and water balance 3 layer
model. KAC
02-27-01 added controls for lake model KAC
11-18-02 Updated storage of lake water for water balance
calculations. LCB
03-12-03 Modifed to add AboveTreeLine to soil_con_struct so that
the model can make use of the computed treeline. KAC
04-10-03 Modified to initialize storm parameters using the state
file. KAC
04-10-03 Modified to start the model by skipping records until the
state file date is found. This replaces the previous method
of modifying the global file start date, which can change
the interpolation of atmospheric forcing data. KAC
04-15-03 Modified to store wet and dry fractions when intializing
water balance storage. This accounts for changes in model
state initialization, which now stores wet and dry fractions
rather than just averagedvalues. KAC
29-Oct-03 Modified the version display banner to print the version
string defined in global.h. TJB
01-Nov-04 Updated arglist for make_dist_prcp(), as part of fix for
QUICK_FLUX state file compatibility. TJB
02-Nov-04 Updated arglist for read_lakeparam(), as part of fix for
lake fraction readjustment. TJB
2005-Apr-13 OUTPUT_FORCE option now calls close_files(). TJB
2006-Sep-23 Implemented flexible output configuration; uses the new
out_data, out_data_files, and save_data structures. TJB
2006-Oct-16 Merged infiles and outfiles structs into filep_struct;
This included merging builtnames into filenames. TJB
2006-Nov-07 Removed LAKE_MODEL option. TJB
2006-Nov-07 Changed statefile to init_state in call to
check_state_file(). TJB
2007-Jan-15 Added PRT_HEADER option; added call to
write_header(). TJB
2007-Apr-04 Added option to continue run after a cell fails. GCT/KAC
2007-Apr-21 Added calls to free_dmy(), free_out_data_files(),
free_out_data(), and free_veglib(). Added closing of
all parameter files. TJB
2007-Aug-21 Return ErrorFlag from initialize_model_state. JCA
2007-Sep-14 Excluded calls to free_veglib() and closing of parameter
files other than the soil param file for the case
when OUTPUT_FORCE=TRUE. TJB
2007-Nov-06 Moved computation of cell_area from read_lakeparam() to
read_soilparam() and read_soilparam_arc(). TJB
2008-May-05 Added prcp fraction (mu) to initial water storage
computation. This solves water balance errors for the
case where DIST_PRCP is TRUE. TJB
2009-Jan-16 Added soil_con.avgJulyAirTemp to argument list of
initialize_atmos(). TJB
2009-Jun-09 Modified to use extension of veg_lib structure to contain
bare soil information. TJB
2009-Jul-07 Added soil_con.BandElev[] to read_snowband() arg list. TJB
2009-Jul-31 Replaced references to N+1st veg tile with references
to index of lake/wetland tile. TJB
2009-Sep-28 Replaced initial water/energy storage computations and
calls to calc_water_balance_error/calc_energy_balance_error
with an initial call to put_data. Modified the call to
read_snowband(). TJB
2009-Dec-11 Removed save_data structure from argument list of
initialize_model_state(). TJB
2010-Mar-31 Added cell_area to initialize_atmos(). TJB
2010-Apr-28 Removed individual soil_con variables from argument list
of initialize_atmos() and replaced with *soil_con. TJB
2010-Nov-10 Added closing of state files. TJB
2011-Jan-04 Made read_soilparam_arc() a sub-function of
read_soilparam(). TJB
2012-Jan-16 Removed LINK_DEBUG code BN
**********************************************************************/
{
extern veg_lib_struct *veg_lib;
extern option_struct options;
extern Error_struct Error;
extern global_param_struct global_param;
/** Variable Declarations **/
char NEWCELL;
char LASTREC;
char MODEL_DONE;
char RUN_MODEL;
char *init_STILL_STORM;
char ErrStr[MAXSTRING];
int rec, i, j;
int veg;
int dist;
int band;
int Ndist;
int Nveg_type;
int cellnum;
int index;
int *init_DRY_TIME;
int Ncells;
int cell_cnt;
int startrec;
int ErrorFlag;
float mu;
double storage;
double veg_fract;
double band_fract;
double Clake;
dmy_struct *dmy;
atmos_data_struct *atmos;
veg_con_struct *veg_con;
soil_con_struct soil_con;
dist_prcp_struct prcp; /* stores information about distributed
precipitation */
filenames_struct filenames;
filep_struct filep;
lake_con_struct lake_con;
out_data_file_struct *out_data_files;
out_data_struct *out_data;
save_data_struct save_data;
/** Read Model Options **/
initialize_global();
filenames = cmd_proc(argc, argv);
#if VERBOSE
display_current_settings(DISP_VERSION,(filenames_struct*)NULL,(global_param_struct*)NULL);
#endif
/** Read Global Control File **/
filep.globalparam = open_file(filenames.global,"r");
global_param = get_global_param(&filenames, filep.globalparam);
/** Set up output data structures **/
out_data = create_output_list();
out_data_files = set_output_defaults(out_data);
fclose(filep.globalparam);
filep.globalparam = open_file(filenames.global,"r");
parse_output_info(&filenames, filep.globalparam, &out_data_files, out_data);
/** Check and Open Files **/
check_files(&filep, &filenames);
#if !OUTPUT_FORCE
/** Read Vegetation Library File **/
veg_lib = read_veglib(filep.veglib,&Nveg_type);
#endif // !OUTPUT_FORCE
/** Initialize Parameters **/
if(options.DIST_PRCP) Ndist = 2;
else Ndist = 1;
cellnum = -1;
/** Make Date Data Structure **/
dmy = make_dmy(&global_param);
/** allocate memory for the atmos_data_struct **/
alloc_atmos(global_param.nrecs, &atmos);
/** Initial state **/
startrec = 0;
#if !OUTPUT_FORCE
if ( options.INIT_STATE )
filep.init_state = check_state_file(filenames.init_state, dmy,
&global_param, options.Nlayer,
options.Nnode, &startrec);
/** open state file if model state is to be saved **/
if ( options.SAVE_STATE && strcmp( filenames.statefile, "NONE" ) != 0 )
filep.statefile = open_state_file(&global_param, filenames, options.Nlayer,
options.Nnode);
else filep.statefile = NULL;
#endif // !OUTPUT_FORCE
/************************************
Run Model for all Active Grid Cells
************************************/
MODEL_DONE = FALSE;
cell_cnt=0;
while(!MODEL_DONE) {
soil_con = read_soilparam(filep.soilparam, filenames.soil_dir, &cell_cnt, &RUN_MODEL, &MODEL_DONE);
if(RUN_MODEL) {
#if QUICK_FS
/** Allocate Unfrozen Water Content Table **/
if(options.FROZEN_SOIL) {
for(i=0;i<MAX_LAYERS;i++) {
soil_con.ufwc_table_layer[i] = (double **)malloc((QUICK_FS_TEMPS+1)*sizeof(double *));
for(j=0;j<QUICK_FS_TEMPS+1;j++)
soil_con.ufwc_table_layer[i][j] = (double *)malloc(2*sizeof(double));
}
for(i=0;i<MAX_NODES;i++) {
soil_con.ufwc_table_node[i] = (double **)malloc((QUICK_FS_TEMPS+1)*sizeof(double *));
for(j=0;j<QUICK_FS_TEMPS+1;j++)
soil_con.ufwc_table_node[i][j] = (double *)malloc(2*sizeof(double));
}
}
#endif /* QUICK_FS */
NEWCELL=TRUE;
cellnum++;
#if !OUTPUT_FORCE
/** Read Grid Cell Vegetation Parameters **/
veg_con = read_vegparam(filep.vegparam, soil_con.gridcel,
Nveg_type);
calc_root_fractions(veg_con, &soil_con);
if ( options.LAKES )
lake_con = read_lakeparam(filep.lakeparam, soil_con, veg_con);
#endif // !OUTPUT_FORCE
/** Build Gridded Filenames, and Open **/
make_in_and_outfiles(&filep, &filenames, &soil_con, out_data_files);
if (options.PRT_HEADER) {
/** Write output file headers **/
write_header(out_data_files, out_data, dmy, global_param);
}
#if !OUTPUT_FORCE
/** Read Elevation Band Data if Used **/
read_snowband(filep.snowband, &soil_con);
/** Make Precipitation Distribution Control Structure **/
prcp = make_dist_prcp(veg_con[0].vegetat_type_num);
#endif // !OUTPUT_FORCE
/**************************************************
Initialize Meteological Forcing Values That
Have not Been Specifically Set
**************************************************/
#if VERBOSE
fprintf(stderr,"Initializing Forcing Data\n");
#endif /* VERBOSE */
initialize_atmos(atmos, dmy, filep.forcing,
#if OUTPUT_FORCE
&soil_con, out_data_files, out_data);
#else /* OUTPUT_FORCE */
&soil_con);
#endif /* OUTPUT_FORCE */
#if !OUTPUT_FORCE
/**************************************************
Initialize Energy Balance and Snow Variables
**************************************************/
#if VERBOSE
fprintf(stderr,"Model State Initialization\n");
#endif /* VERBOSE */
ErrorFlag = initialize_model_state(&prcp, dmy[0], &global_param, filep,
soil_con.gridcel, veg_con[0].vegetat_type_num,
options.Nnode, Ndist,
atmos[0].air_temp[NR],
&soil_con, veg_con, lake_con,
&init_STILL_STORM, &init_DRY_TIME);
if ( ErrorFlag == ERROR ) {
if ( options.CONTINUEONERROR == TRUE ) {
// Handle grid cell solution error
fprintf(stderr, "ERROR: Grid cell %i failed in record %i so the simulation has not finished. An incomplete output file has been generated, check your inputs before rerunning the simulation.\n", soil_con.gridcel, rec);
break;
} else {
// Else exit program on cell solution error as in previous versions
sprintf(ErrStr, "ERROR: Grid cell %i failed in record %i so the simulation has ended. Check your inputs before rerunning the simulation.\n", soil_con.gridcel, rec);
vicerror(ErrStr);
}
}
#if VERBOSE
fprintf(stderr,"Running Model\n");
#endif /* VERBOSE */
/** Update Error Handling Structure **/
Error.filep = filep;
Error.out_data_files = out_data_files;
/** Initialize the storage terms in the water and energy balances **/
/** Sending a negative record number (-global_param.nrecs) to dist_prec() will accomplish this **/
ErrorFlag = dist_prec(&atmos[0], &prcp, &soil_con, veg_con,
&lake_con, dmy, &global_param, &filep, out_data_files,
out_data, &save_data, -global_param.nrecs, cellnum,
NEWCELL, LASTREC, init_STILL_STORM, init_DRY_TIME);
/******************************************
Run Model in Grid Cell for all Time Steps
******************************************/
for ( rec = startrec ; rec < global_param.nrecs; rec++ ) {
if ( rec == global_param.nrecs - 1 ) LASTREC = TRUE;
else LASTREC = FALSE;
ErrorFlag = dist_prec(&atmos[rec], &prcp, &soil_con, veg_con,
&lake_con, dmy, &global_param, &filep,
out_data_files, out_data, &save_data, rec, cellnum,
NEWCELL, LASTREC, init_STILL_STORM, init_DRY_TIME);
if ( ErrorFlag == ERROR ) {
if ( options.CONTINUEONERROR == TRUE ) {
// Handle grid cell solution error
fprintf(stderr, "ERROR: Grid cell %i failed in record %i so the simulation has not finished. An incomplete output file has been generated, check your inputs before rerunning the simulation.\n", soil_con.gridcel, rec);
break;
} else {
// Else exit program on cell solution error as in previous versions
sprintf(ErrStr, "ERROR: Grid cell %i failed in record %i so the simulation has ended. Check your inputs before rerunning the simulation.\n", soil_con.gridcel, rec);
vicerror(ErrStr);
}
}
NEWCELL=FALSE;
for ( veg = 0; veg <= veg_con[0].vegetat_type_num; veg++ )
init_DRY_TIME[veg] = -999;
} /* End Rec Loop */
#endif /* !OUTPUT_FORCE */
close_files(&filep,out_data_files,&filenames);
#if !OUTPUT_FORCE
#if QUICK_FS
if(options.FROZEN_SOIL) {
for(i=0;i<MAX_LAYERS;i++) {
for(j=0;j<6;j++)
free((char *)soil_con.ufwc_table_layer[i][j]);
free((char *)soil_con.ufwc_table_layer[i]);
}
for(i=0;i<MAX_NODES;i++) {
for(j=0;j<6;j++)
free((char *)soil_con.ufwc_table_node[i][j]);
free((char *)soil_con.ufwc_table_node[i]);
}
}
#endif /* QUICK_FS */
free_dist_prcp(&prcp,veg_con[0].vegetat_type_num);
free_vegcon(&veg_con);
free((char *)soil_con.AreaFract);
free((char *)soil_con.BandElev);
free((char *)soil_con.Tfactor);
free((char *)soil_con.Pfactor);
free((char *)soil_con.AboveTreeLine);
free((char*)init_STILL_STORM);
free((char*)init_DRY_TIME);
#endif /* !OUTPUT_FORCE */
} /* End Run Model Condition */
} /* End Grid Loop */
/** cleanup **/
free_atmos(global_param.nrecs, &atmos);
free_dmy(&dmy);
free_out_data_files(&out_data_files);
free_out_data(&out_data);
#if !OUTPUT_FORCE
free_veglib(&veg_lib);
#endif /* !OUTPUT_FORCE */
fclose(filep.soilparam);
#if !OUTPUT_FORCE
fclose(filep.vegparam);
fclose(filep.veglib);
if (options.SNOW_BAND>1)
fclose(filep.snowband);
if (options.LAKES)
fclose(filep.lakeparam);
if ( options.INIT_STATE )
fclose(filep.init_state);
if ( options.SAVE_STATE && strcmp( filenames.statefile, "NONE" ) != 0 )
fclose(filep.statefile);
#endif /* !OUTPUT_FORCE */
return EXIT_SUCCESS;
} /* End Main Program */
local void makeking(dyn * b, int n, real w0, bool n_flag, bool u_flag, int test)
// Create a King model, and optionally initialize an N-body system
// with total mass = n, core radius = 1.
{
int i, iz, j, jcore, jhalf;
real dz, z, rho0;
real rhalf, zmcore;
int nprof;
real v20;
if (w0 > 16) err_exit("makeking: must specify w0 < 16");
initialize_global();
// Compute the cluster density/velocity/potential profile
poisson(rr, NM, w0, nprof, v20);
if (test == 1)
dump_model_and_exit(nprof);
// Determine statistics and characteristic scales of the King model.
rho0 = 1 / zm[nprof]; // Central density for total mass = 1
// Unit of velocity = sig, where rc^2 = 9 sig^2 / (4 pi G rho0)
real sig = sqrt(four3pi * rho0 / 3); // This 3 was v20 in the f77 version...
// v20 is central vel. disp. / sig^2
// Scale the zm array to unit total mass.
for (i = 0; i <= nprof; i++)
zm[i] = zm[i] / zm[nprof];
// Index the mass distribution, and determine the core mass and
// the half-mass radius.
// By construction, rr[indx[j]] and rr[indx[j+1]] bracket the
// radius containing a fraction j / NINDX of the total mass.
indx[0] = 0;
indx[NINDX] = nprof;
dz = 1.0/NINDX;
z = dz;
iz = 1;
for (j = 1; j <= nprof - 1; j++) {
if (rr[j] < 1) jcore = j;
if (zm[j] < 0.5) jhalf = j;
if (zm[j] > z) {
indx[iz] = j - 1;
z = z + dz;
iz = iz + 1;
}
}
zmcore = zm[jcore] + (zm[jcore+1] - zm[jcore]) * (1 - rr[jcore])
/ (rr[jcore+1] - rr[jcore]);
rhalf = rr[jhalf] + (rr[jhalf+1] - rr[jhalf])
* (0.5 - zm[jhalf])
/ (zm[jhalf+1] - zm[jhalf]);
// Compute the kinetic and potential energies, and determine the
// virial radius and ratio.
real kin = 0, pot =0;
for (i = 1; i <= nprof; i++) {
kin += (zm[i] - zm[i-1]) * (v2[i-1] + v2[i]);
pot -= (zm[i] - zm[i-1]) * (zm[i] + zm[i-1]) / (rr[i-1] + rr[i]);
}
kin *= 0.25*sig*sig*v20;
real rvirial = -0.5/pot;
cerr << endl << "King model";
cerr << "\n w0 = " << w0 << " beta = " << beta << " nprof =" << nprof
<< " V20/sig2 = " << v20
<< " Mc/M = " << zmcore << endl
<< " Rt/Rc = " << rr[nprof] << " (c = " << log10(rr[nprof])
<< ") Rh/Rc = " << rhalf
<< " Rvir/Rc = " << rvirial // << " -T/U = " << -kin/pot
<< endl
<< " Rc/Rvir = " << 1/rvirial
<< " Rh/Rvir = " << rhalf/rvirial
<< " Rt/Rvir = " << rr[nprof]/rvirial
<< "\n\n";
if (test == 2) {
// Scaling factors are for Mtotal = 1, Rvir = 1:
dump_model_and_exit(nprof, rho0, 1/rvirial);
}
if (b == NULL || n < 1) return;
// Initialize the N-body system.
sprintf(tmp_string,
" King model, w0 = %.2f, Rt/Rc = %.3f, Rh/Rc = %.3f, Mc/M = %.3f",
w0, rr[nprof], rhalf, zmcore);
b->log_comment(tmp_string);
// Write essential model information to root dyn story.
putrq(b->get_log_story(), "initial_mass", 1.0);
// putrq(b->get_log_story(), "initial_rvirial", 0.25/kin); // assumes a lot!
// -- too much...
putrq(b->get_log_story(), "initial_rtidal_over_rvirial",
rr[nprof] / (0.25/kin));
// Assign positions and velocities. Note that it may actually
// be preferable to do this in layers instead.
for_all_daughters(dyn, b, bi) {
if (test == 3) {
// Test: For a pure King model, getvel should generate a
// distribution of velocities with maximum speed
// sqrt(-2*p) and <v^2> = v2*v20, where p and v2
// are the scaled potential and mean-square
// velocity at any given radius.
real nsum = 10000;
for (int zone = 0; zone < 0.95*nprof; zone += nprof/15) {
real v2sum = 0;
real v2max = 0;
for (int jj = 0; jj < nsum; jj++) {
setvel(bi, psi[zone]);
real vsq = bi->get_vel()*bi->get_vel();
v2sum += vsq;
v2max = Starlab::max(v2max, vsq);
}
cerr << "zone " << zone << " r = " << rr[zone]
<< " v2max = " << v2max<< " ?= " << -2*psi[zone]
<< " v2mean = " << v2sum/nsum << " ?= " << v2[zone]*v20
<< endl;
}
exit(0);
}
if (n_flag)
bi->set_mass(1.0/n);
real pot;
setpos(bi, pot);
setvel(bi, pot);
// Unit of length = rc.
// Unit of velocity = sig.
bi->scale_vel(sig);
}
// System is in virial equilibrium in a consistent set of units
// with G, core radius, and total mass = 1.
// Convenient to have the "unscaled" system (-u on the command line)
// be as close to standard units as possible, so rescale here to force
// the virial radius to 1. (Steve, 9/04)
real xfac = 1/rvirial;
real vfac = 1/sqrt(xfac);
for_all_daughters(dyn, b, bi) {
bi->set_pos(xfac*bi->get_pos());
bi->set_vel(vfac*bi->get_vel());
}
