void do_cd (void)
{ header *hd;
char name[256];
char *s;
scan_space();
if (*next==';' || *next==',' || *next==0)
{ s=cd("");
output1("%s\n",s);
return;
}
if (*next=='(')
{ hd=scan_value();
if (error) return;
if (hd->type!=s_string)
{ output("String value expected!\n");
error=1; return;
}
strcpy(name,stringof(hd));
}
else
{ scan_namemax(name,256);
}
if (error) return;
s=cd(name);
if (*next!=';') output1("%s\n",s);
if (*next==',' || *next==';') next++;
}
bool script_preprocessor::scan_directive_and_value(const wchar_t *& p, const wchar_t * pend)
{
m_directive_buffer.force_reset();
if (*p == '@')
{
++p;
const wchar_t * pdirective_begin = 0;
const wchar_t * pdirective_end = 0;
if (isalpha(*p))
{
pdirective_begin = p;
++p;
while (isalnum(*p) || *p == '_' || *p == '-' || *p == '.')
++p;
// We may get a directive now
pdirective_end = p;
// Scan value
if (scan_value(p, pend))
{
// We may get a value now, set the directive
m_directive_buffer.set_size(pdirective_end - pdirective_begin + 1);
pfc::__unsafe__memcpy_t(m_directive_buffer.get_ptr(), pdirective_begin, pdirective_end - pdirective_begin);
m_directive_buffer[pdirective_end - pdirective_begin] = 0;
}
}
}
return (m_directive_buffer.get_size() > 0 && m_value_buffer.get_size() > 0);
}
/*
* Old enum signatures would cover a single name/value only:
*
* enum_sig = id name value
* | id
*/
EnumSig *Parser::parse_old_enum_sig() {
size_t id = read_uint();
EnumSigState *sig = lookup(enums, id);
if (!sig) {
/* parse the signature */
sig = new EnumSigState;
sig->id = id;
sig->num_values = 1;
EnumValue *values = new EnumValue[sig->num_values];
values->name = read_string();
values->value = read_sint();
sig->values = values;
sig->offset = file->currentOffset();
enums[id] = sig;
} else if (file->currentOffset() < sig->offset) {
/* skip over the signature */
skip_string(); /*name*/
scan_value();
}
assert(sig);
return sig;
}
void load_file (void)
/***** load_file
interpret a file.
*****/
{ char filename[256];
char oldline[1024],fn[256],*oldnext;
int oldbooktype=booktype,pn;
header *hd;
FILE *oldinfile;
if (udfon)
{ output("Cannot load a file in a function!\n");
error=221; return;
}
scan_space();
if (*next=='(')
{ hd=scan_value();
if (error) return;
if (hd->type!=s_string)
{ output("String value expected!\n");
error=1; return;
}
strcpy(filename,stringof(hd));
}
else
{ scan_namemax(filename,256);
}
if (error) return;
oldinfile=infile;
pn=-1;
retry :
if (pn>=0)
{ strcpy(fn,path[pn]);
strcat(fn,PATH_DELIM_STR);
strcat(fn,filename);
}
else strcpy(fn,filename);
infile=fopen(fn,"r");
if (!infile)
{ strcat(fn,EXTENSION);
infile=fopen(fn,"r");
pn++;
if (!infile)
{ if (pn>=npath)
{ output1("Could not open %s!\n",filename);
error=53; infile=oldinfile; return;
}
else goto retry;
}
}
strcpy(oldline,input_line); oldnext=next;
*input_line=0; next=input_line;
booktype=0;
while (!error && infile && !quit) command();
booktype=oldbooktype;
if (infile) fclose(infile);
infile=oldinfile;
strcpy(input_line,oldline); next=oldnext;
}
void load_book (void)
/***** load_book
interpret a notebook file.
*****/
{ header *hd;
char name[256];
char oldline[1024],fn[256],*oldnext;
int oldbooktype=booktype;
FILE *oldinfile;
if (udfon)
{ output("Cannot load a notebook in a function!\n");
error=221; return;
}
scan_space();
if (*next=='(')
{ hd=scan_value();
if (error) return;
if (hd->type!=s_string)
{ output("String value expected!\n");
error=1; return;
}
strcpy(name,stringof(hd));
}
else
{ scan_namemax(name,256);
}
if (error) return;
oldinfile=infile;
infile=fopen(name,"r");
if (!infile)
{ strcpy(fn,name);
strcat(fn,BOOKEXTENSION);
infile=fopen(fn,"r");
if (!infile)
{ output1("Could not open %s!\n",stringof(name));
error=53; infile=oldinfile; return;
}
}
strcpy(oldline,input_line); oldnext=next;
*input_line=0; next=input_line;
booktype=1;
while (!error && infile && !quit)
{ startglobal=startlocal; endglobal=endlocal;
command();
}
booktype=oldbooktype;
if (infile) fclose(infile);
infile=oldinfile;
strcpy(input_line,oldline); next=oldnext;
}
void do_postscript (void)
{ header *file;
scan_space();
file=scan_value();
if (error || file->type!=s_string)
{ output("Postscript needs a filename!\n");
error=201; return;
}
FILE *metafile=fopen(stringof(file),"w");
if (!metafile)
{ output1("Could not open %s.\n",stringof(file));
}
dump_postscript(metafile);
fclose(metafile);
}
void do_exec (void)
{ header *name;
char *s;
name=scan_value(); if (error) return;
if (name->type!=s_string)
{ output("Cannot execute a number or matrix!\n");
error=130; return;
}
s=stringof(name);
while (*s && !isspace(*s)) s++;
if (*s) *s++=0;
if (execute(stringof(name),s))
{ output("Execution failed or program returned a failure!\n");
error=131;
}
}
void do_remove (void)
{ header *hd;
char name[256];
if (*next=='(')
{ hd=scan_value();
if (error) return;
if (hd->type!=s_string)
{ output("String value expected!\n");
error=1; return;
}
strcpy(name,stringof(hd));
}
else
{ scan_namemax(name,256);
}
if (error) return;
remove(name);
}
void do_dump (void)
{ header *file;
if (outfile)
{ if (fclose(outfile))
{ output("Error while closing dumpfile.\n");
}
outfile=0;
}
scan_space();
if (*next==';' || *next==',' || *next==0)
{ if (*next) next++; return; }
file=scan_value();
if (error || file->type!=s_string)
{ output("Dump needs a filename!\n");
error=201; return;
}
outfile=fopen(stringof(file),"a");
if (!outfile)
{ output1("Could not open %s.\n",stringof(file));
}
}
void do_dir (void)
{ header *file;
char *s;
scan_space();
if (*next==';' || *next==',' || *next==0)
{ file=new_string("*.*",5,"");
}
else file=scan_value();
if (error || file->type!=s_string)
{ output("Dir needs a string!\n");
error=201; return;
}
s=dir(stringof(file));
if (!s || !*s) return;
output1("%s\n",s);
while (1)
{ s=dir(0);
if (!s || !*s) break;
output1("%s\n",s);
}
if (*next==',' || *next==';') next++;
}
void do_path (void)
{ header *ppath;
char s[256],*p,*q;
int i;
scan_space();
if (*next==';' || *next==',' || *next==0)
{ out :
for (i=0; i<npath; i++)
{ output1("%s;",path[i]);
}
output("\n");
return;
}
ppath=scan_value();
if (error || ppath->type!=s_string)
{ output("Path needs a string!\n");
error=201; return;
}
p=stringof(ppath);
for (i=0; i<npath; i++) free(path[i]);
npath=0;
while (*p)
{ q=s;
while (*p && *p!=';') *q++=*p++;
if (q>s && *(q-1)==PATH_DELIM_CHAR) q--;
*q=0;
if (*p==';') p++;
path[npath]=(char *)malloc(strlen(s)+1);
strcpy(path[npath],s);
npath++;
}
if (npath==0)
{ path[0]=(char *)malloc(5);
strcpy(path[0],".");
}
if (*next!=';') goto out;
}
void Parser::scan_array(void) {
size_t len = read_uint();
for (size_t i = 0; i < len; ++i) {
scan_value();
}
}
int epc_init(file init, epconst_struct* epc)
{
int ok = 1;
double t1,t2,t3,t4,r1;
file temp;
char key1[] = "EPC_FILE";
char key2[] = "ECOPHYS";
char keyword[80];
/********************************************************************
** **
** Begin reading initialization file block starting with keyword: **
** EPC_FILES **
** **
********************************************************************/
/* scan for the EPC file keyword, exit if not next */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword for control data\n");
ok=0;
}
if (ok && strcmp(keyword, key1))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in file %s\n",key1,init.name);
ok=0;
}
/* open file */
if (ok && scan_open(init,&temp,'r'))
{
bgc_printf(BV_ERROR, "Error opening epconst file, epc_init()\n");
ok=0;
}
/* first scan epc keyword to ensure proper *.init format */
if (ok && scan_value(temp, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, epc_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key2))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key2,init.name);
ok=0;
}
/* begin reading constants from *.init */
if (ok && scan_value(temp, &epc->woody, 'i'))
{
bgc_printf(BV_ERROR, "Error reading woody/non-woody flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->evergreen, 'i'))
{
bgc_printf(BV_ERROR, "Error reading evergreen/deciduous flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->c3_flag, 'i'))
{
bgc_printf(BV_ERROR, "Error reading C3/C4 flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->phenology_flag, 'i'))
{
bgc_printf(BV_ERROR, "Error reading phenology flag, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->onday, 'i'))
{
bgc_printf(BV_ERROR, "Error reading onday, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->offday, 'i'))
{
bgc_printf(BV_ERROR, "Error reading offday, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->transfer_pdays, 'd'))
{
bgc_printf(BV_ERROR, "Error reading transfer_pdays, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->litfall_pdays, 'd'))
{
bgc_printf(BV_ERROR, "Error reading litfall_pdays, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaf_turnover, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf turnover, epc_init()\n");
ok=0;
}
/* force leaf turnover fraction to 1.0 if deciduous */
if (!epc->evergreen)
{
epc->leaf_turnover = 1.0;
}
epc->froot_turnover = epc->leaf_turnover;
if (ok && scan_value(temp, &epc->livewood_turnover, 'd'))
{
bgc_printf(BV_ERROR, "Error reading livewood turnover, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading whole-plant mortality, epc_init()\n");
ok=0;
}
epc->daily_mortality_turnover = t1/365;
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading fire mortality, epc_init()\n");
ok=0;
}
epc->daily_fire_turnover = t1/365;
if (ok && scan_value(temp, &epc->alloc_frootc_leafc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot C:leaf C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_newstemc_newleafc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new stemC:new leaf C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_newlivewoodc_newwoodc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new livewood C:new wood C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_crootc_stemc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading croot C:stem C, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->alloc_prop_curgrowth, 'd'))
{
bgc_printf(BV_ERROR, "Error reading new growth:storage growth, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaf_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading average leaf C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->leaflitr_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter C:N, epc_init()\n");
ok=0;
}
/* test for leaflitter C:N > leaf C:N */
if (epc->leaflitr_cn < epc->leaf_cn)
{
bgc_printf(BV_ERROR, "Error: leaf litter C:N must be >= leaf C:N\n");
bgc_printf(BV_ERROR, "change the values in ECOPHYS block of initialization file\n");
ok=0;
}
if (ok && scan_value(temp, &epc->froot_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial fine root C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->livewood_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial livewood C:N, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->deadwood_cn, 'd'))
{
bgc_printf(BV_ERROR, "Error reading initial deadwood C:N, epc_init()\n");
ok=0;
}
/* test for deadwood C:N > livewood C:N */
if (epc->deadwood_cn < epc->livewood_cn)
{
bgc_printf(BV_ERROR, "Error: livewood C:N must be >= deadwood C:N\n");
bgc_printf(BV_ERROR, "change the values in ECOPHYS block of initialization file\n");
ok=0;
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter labile proportion, epc_init()\n");
ok=0;
}
epc->leaflitr_flab = t1;
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter cellulose proportion, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t3, 'd'))
{
bgc_printf(BV_ERROR, "Error reading leaf litter lignin proportion, epc_init()\n");
ok=0;
}
epc->leaflitr_flig = t3;
/* test for litter fractions sum to 1.0 */
if ( ok && (fabs(t1+t2+t3-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "leaf litter proportions of labile, cellulose, and lignin\n");
bgc_printf(BV_ERROR, "must sum to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t3/t2;
if (r1 <= 0.45)
{
epc->leaflitr_fscel = 0.0;
epc->leaflitr_fucel = t2;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->leaflitr_fscel = t4*t2;
epc->leaflitr_fucel = (1.0 - t4)*t2;
}
else
{
epc->leaflitr_fscel = 0.8*t2;
epc->leaflitr_fucel = 0.2*t2;
}
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter labile proportion, epc_init()\n");
ok=0;
}
epc->frootlitr_flab = t1;
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter cellulose proportion, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t3, 'd'))
{
bgc_printf(BV_ERROR, "Error reading froot litter lignin proportion, epc_init()\n");
ok=0;
}
epc->frootlitr_flig = t3;
/* test for litter fractions sum to 1.0 */
if ( ok && (fabs(t1+t2+t3-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "froot litter proportions of labile, cellulose, and lignin\n");
bgc_printf(BV_ERROR, "must sum to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t3/t2;
if (r1 <= 0.45)
{
epc->frootlitr_fscel = 0.0;
epc->frootlitr_fucel = t2;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->frootlitr_fscel = t4*t2;
epc->frootlitr_fucel = (1.0 - t4)*t2;
}
else
{
epc->frootlitr_fscel = 0.8*t2;
epc->frootlitr_fucel = 0.2*t2;
}
}
if (ok && scan_value(temp, &t1, 'd'))
{
bgc_printf(BV_ERROR, "Error reading dead wood %% cellulose, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &t2, 'd'))
{
bgc_printf(BV_ERROR, "Error reading dead wood %% lignin, epc_init()\n");
ok=0;
}
epc->deadwood_flig = t2;
/* test for litter fractions sum to 1.0 */
if (ok && (fabs(t1+t2-1.0) > FLT_COND_TOL) )
{
bgc_printf(BV_ERROR, "Error:\n");
bgc_printf(BV_ERROR, "deadwood proportions of cellulose and lignin must sum\n");
bgc_printf(BV_ERROR, "to 1.0. Check initialization file and try again.\n");
ok=0;
}
/* calculate shielded and unshielded cellulose fraction */
if (ok)
{
r1 = t2/t1;
if (r1 <= 0.45)
{
epc->deadwood_fscel = 0.0;
epc->deadwood_fucel = t1;
}
else if (r1 > 0.45 && r1 < 0.7)
{
t4 = (r1 - 0.45)*3.2;
epc->deadwood_fscel = t4*t1;
epc->deadwood_fucel = (1.0 - t4)*t1;
}
else
{
epc->deadwood_fscel = 0.8*t1;
epc->deadwood_fucel = 0.2*t1;
}
}
if (ok && scan_value(temp, &epc->int_coef, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy water int coef, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->ext_coef, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy light ext coef, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->lai_ratio, 'd'))
{
bgc_printf(BV_ERROR, "Error reading all to projected LA ratio, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->avg_proj_sla, 'd'))
{
bgc_printf(BV_ERROR, "Error reading canopy average projected specific leaf area, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->sla_ratio, 'd'))
{
bgc_printf(BV_ERROR, "Error reading shaded to sunlit SLA ratio, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->flnr, 'd'))
{
bgc_printf(BV_ERROR, "Error reading Rubisco N fraction, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_smax, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_smax, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_c, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_c, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->gl_bl, 'd'))
{
bgc_printf(BV_ERROR, "Error reading gl_bl, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->psi_open, 'd'))
{
bgc_printf(BV_ERROR, "Error reading psi_close, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->psi_close, 'd'))
{
bgc_printf(BV_ERROR, "Error reading psi_sat, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->vpd_open, 'd'))
{
bgc_printf(BV_ERROR, "Error reading vpd_max, epc_init()\n");
ok=0;
}
if (ok && scan_value(temp, &epc->vpd_close, 'd'))
{
bgc_printf(BV_ERROR, "Error reading vpd_min, epc_init()\n");
ok=0;
}
fclose(temp.ptr);
return (!ok);
}
int scc_init(file init, climchange_struct* scc)
{
int ok = 1;
char key1[] = "CLIM_CHANGE";
char keyword[80];
/********************************************************************
** **
** Begin reading initialization file block starting with keyword: **
** CLIM_CHANGE **
** **
********************************************************************/
/* scan for the climate change block keyword, exit if not next */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, scc_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key1))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key1,init.name);
ok=0;
}
/* begin reading climate change data */
if (ok && scan_value(init, &scc->s_tmax, 'd'))
{
bgc_printf(BV_ERROR, "Error reading scalar for tmax, scc_init()\n");
ok=0;
}
if (ok && scan_value(init, &scc->s_tmin, 'd'))
{
bgc_printf(BV_ERROR, "Error reading scalar for tmin, scc_init()\n");
ok=0;
}
if (ok && scan_value(init, &scc->s_prcp, 'd'))
{
bgc_printf(BV_ERROR, "Error reading scalar for prcp, scc_init()\n");
ok=0;
}
if (ok && scan_value(init, &scc->s_vpd, 'd'))
{
bgc_printf(BV_ERROR, "Error reading scalar for vpd, scc_init()\n");
ok=0;
}
if (ok && scan_value(init, &scc->s_swavgfd, 'd'))
{
bgc_printf(BV_ERROR, "Error reading scalar for swavgfd, scc_init()\n");
ok=0;
}
/* some error checking on scalar climate change values */
if (scc->s_prcp < 0.0)
{
bgc_printf(BV_ERROR, "Error in scc_init(): prcp scalar must be positive\n");
ok=0;
}
if (scc->s_vpd < 0.0)
{
bgc_printf(BV_ERROR, "Error in scc_init(): vpd scalar must be positive\n");
ok=0;
}
if (scc->s_swavgfd < 0.0)
{
bgc_printf(BV_ERROR, "Error in scc_init(): swavgfd scalar must be positive\n");
ok=0;
}
return (!ok);
}
int sitec_init(file init, siteconst_struct* sitec)
{
/* reads the site physical constants from *.init */
int ok=1;
char key[] = "SITE";
char keyword[80];
double sand,silt,clay; /* percent sand, silt, and clay */
/* first scan keyword to ensure proper *.init format */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, sitec_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key,init.name);
ok=0;
}
/* begin reading constants from *.init */
if (ok && scan_value(init, &sitec->soil_depth, 'd'))
{
bgc_printf(BV_ERROR, "Error reading soil depth, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sand, 'd'))
{
bgc_printf(BV_ERROR, "Error reading percent sand, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &silt, 'd'))
{
bgc_printf(BV_ERROR, "Error reading percent clay, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &clay, 'd'))
{
bgc_printf(BV_ERROR, "Error reading percent clay, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->elev, 'd'))
{
bgc_printf(BV_ERROR, "Error reading elevation, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->lat, 'd'))
{
bgc_printf(BV_ERROR, "Error reading site latitude, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->sw_alb, 'd'))
{
bgc_printf(BV_ERROR, "Error reading shortwave albedo, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->ndep, 'd'))
{
bgc_printf(BV_ERROR, "Error reading N deposition, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->nfix, 'd'))
{
bgc_printf(BV_ERROR, "Error reading N fixation, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->obs_alpha, 'd'))
{
bgc_printf(BV_ERROR, "Error reading alpha, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->obs_beta, 'd'))
{
bgc_printf(BV_ERROR, "Error reading beta, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->obs_theta_s, 'd'))
{
bgc_printf(BV_ERROR, "Error reading theta_s, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->obs_theta_r, 'd'))
{
bgc_printf(BV_ERROR, "Error reading theta_r, sitec_init()\n");
ok=0;
}
if (ok && scan_value(init, &sitec->obs_fc, 'd'))
{
bgc_printf(BV_ERROR, "Error reading field capacity, sitec_init()\n");
ok=0;
}
/* calculate the soil pressure-volume coefficients from texture data */
/* Uses the multivariate regressions from Cosby et al., 1984 */
/* first check that the percentages add to 100.0 */
if (ok && fabs(sand+silt+clay-100) > FLT_COND_TOL)
{
bgc_printf(BV_ERROR, "Error: %%sand + %%silt + %%clay MUST EQUAL 100%%\n");
bgc_printf(BV_ERROR, "Check values in initialization file.\n");
ok=0;
}
if (ok)
{
sitec->soil_b = -(3.10 + 0.157*clay - 0.003*sand);
sitec->vwc_sat = (50.5 - 0.142*sand - 0.037*clay)/100.0;
sitec->psi_sat = -(exp((1.54 - 0.0095*sand + 0.0063*silt)*log(10.0))*9.8e-5);
sitec->vwc_fc = sitec->vwc_sat*pow((-0.015/sitec->psi_sat),1.0/sitec->soil_b);
/* define maximum soilwater content, for outflow calculation
converts volumetric water content (m3/m3) --> (kg/m2) */
sitec->soilw_fc = sitec->soil_depth * sitec->vwc_fc * 1000.0;
sitec->soilw_sat = sitec->soil_depth * sitec->vwc_sat * 1000.0;
}
return (!ok);
}
void do_assignment (header *var)
/***** do_assignment
assign a value to a variable.
*****/
{ header *variable[8],*rightside[8],*rs,*v,*mark;
int rscount,varcount,i,j;
ULONG offset,oldoffset,dif;
char *oldendlocal;
scan_space();
if (*next=='=')
{ next++;
nosubmref=1; rs=scan_value(); nosubmref=0;
if (error) return;
varcount=0;
/* count the variables, that get assigned something */
while (var<rs)
{ if (var->type!=s_reference && var->type!=s_submatrix
&& var->type!=s_csubmatrix && var->type!=s_isubmatrix)
{ output("Cannot assign to value!\n");
error=210;
}
variable[varcount]=var; var=nextof(var); varcount++;
if (varcount>=8)
{ output("To many commas!\n"); error=100; return;
}
}
/* count and note the values, that are assigned to the
variables */
rscount=0;
while (rs<(header *)newram)
{ rightside[rscount]=rs;
rs=nextof(rs); rscount++;
if (rscount>=8)
{ output("To many commas!\n"); error=101; return;
}
}
/* cannot assign 2 values to 3 variables , e.g. */
if (rscount>1 && rscount<varcount)
{ output("Illegal multiple assignment!\n"); error=102; return;
}
oldendlocal=endlocal;
offset=0;
/* do all the assignments */
if (varcount==1) var=assign(variable[0],rightside[0]);
else
for (i=0; i<varcount; i++)
{ oldoffset=offset;
/* assign a variable */
var=assign(addsize(variable[i],offset),
addsize(rightside[(rscount>1)?i:0],offset));
if (error) return;
offset=endlocal-oldendlocal;
if (oldoffset!=offset) /* size of var. changed */
{ v=addsize(variable[i],offset);
if (v->type==s_reference) mark=referenceof(v);
else mark=submrefof(v);
/* now shift all references of the var.s */
if (mark) /* not a new variable */
for (j=i+1; j<varcount; j++)
{ v=addsize(variable[j],offset);
dif=offset-oldoffset;
if (v->type==s_reference && referenceof(v)>mark)
referenceof(v)=addsize(referenceof(v),dif);
else if (submrefof(v)>mark)
submrefof(v)=addsize(submrefof(v),dif);
}
}
}
}
else /* just an expression which is a variable */
{ var=getvalue(var);
}
if (error) return;
if (*next!=';') give_out(var);
if (*next==',' || *next==';') next++;
}
void Parser::scan_repr() {
scan_value();
scan_value();
}
void Parser::scan_struct() {
StructSig *sig = parse_struct_sig();
for (size_t i = 0; i < sig->num_members; ++i) {
scan_value();
}
}
int co2_init(file init, co2control_struct* co2, int simyears)
{
int ok = 1;
int i;
char key1[] = "CO2_CONTROL";
char keyword[80];
char junk[80];
file temp;
int reccount = 0;
/********************************************************************
** **
** Begin reading initialization file block starting with keyword: **
** CO2_CONTROL **
** **
********************************************************************/
/* scan for the climate change block keyword, exit if not next */
if (ok && scan_value(init, keyword, 's'))
{
bgc_printf(BV_ERROR, "Error reading keyword, co2_init()\n");
ok=0;
}
if (ok && strcmp(keyword,key1))
{
bgc_printf(BV_ERROR, "Expecting keyword --> %s in %s\n",key1,init.name);
ok=0;
}
/* begin reading co2 control information */
if (ok && scan_value(init, &co2->varco2, 'i'))
{
bgc_printf(BV_ERROR, "Error reading variable CO2 flag: co2_init()\n");
ok=0;
}
if (ok && scan_value(init, &co2->co2ppm, 'd'))
{
bgc_printf(BV_ERROR, "Error reading constant CO2 value: co2_init()\n");
ok=0;
}
/* if using variable CO2 file, open it, otherwise
discard the next line of the ini file */
if (ok && co2->varco2)
{
if (scan_open(init,&temp,'r'))
{
bgc_printf(BV_ERROR, "Error opening annual CO2 file\n");
ok=0;
}
/* Find the number of lines in the file*/
/* Then use that number to malloc the appropriate arrays */
while(fscanf(temp.ptr,"%*lf%*lf") != EOF)
{
reccount++;
}
rewind(temp.ptr);
/* Store the total number of CO2 records found in the co2vals variable */
co2->co2vals = reccount;
bgc_printf(BV_DIAG,"Found: %i CO2 records in co2_init()\n",reccount);
/* allocate space for the annual CO2 array */
if (ok && !(co2->co2ppm_array = (double*) malloc(reccount *
sizeof(double))))
{
bgc_printf(BV_ERROR, "Error allocating for annual CO2 array, co2_init()\n");
ok=0;
}
if (ok && !(co2->co2year_array = (int*) malloc(reccount *
sizeof(int))))
{
bgc_printf(BV_ERROR, "Error allocating for annual CO2 year array, co2_init()\n");
ok=0;
}
/* read year and co2 concentration for each simyear */
for (i=0 ; ok && i<reccount ; i++)
{
if (fscanf(temp.ptr,"%i%lf",
&(co2->co2year_array[i]),&(co2->co2ppm_array[i]))==EOF)
{
bgc_printf(BV_ERROR, "Error reading annual CO2 array, ctrl_init()\n");
bgc_printf(BV_ERROR, "Note: file must contain a pair of values for each\n");
bgc_printf(BV_ERROR, "simyear: year and CO2.\n");
ok=0;
}
/* printf("CO2 value read: %i %lf\n",co2->co2year_array[i],co2->co2ppm_array[i]); */
if (co2->co2ppm_array[i] < 0.0)
{
bgc_printf(BV_ERROR, "Error in co2_init(): co2 (ppm) must be positive\n");
ok=0;
}
}
fclose(temp.ptr);
}
else
{
if (scan_value(init, junk, 's'))
{
bgc_printf(BV_ERROR, "Error scanning annual co2 filename\n");
ok=0;
}
}
if (co2->co2ppm < 0.0)
{
bgc_printf(BV_ERROR, "Error in co2_init(): co2 (ppm) must be positive\n");
ok=0;
}
return (!ok);
}
// time64_scanf("%Y-%M-%D %h:%m:%s.%S", "2013-01-31 13:52:01.123")
static int time64_scanf(struct tm64* tm64, const char* format, const char* src)
{
const char* p;
int asterisk;
int width;
for(p=format; p && *p && src && *src; ++p)
{
if('%' != *p)
{
++src;
continue;
}
++p; // skip '%'
// The field is scanned but not stored
asterisk = 0;
if('*' == *p)
{
asterisk = 1;
++p;
}
// width
for(width=0; '0'<=*p && '9'>=*p; ++p)
{
width = width*10 + (*p - '0');
}
// type
switch(*p)
{
case 'Y': // year
src = scan_value(asterisk, width, &tm64->year, src);
tm64->year -= 1900;
break;
case 'M': // month
src = scan_value(asterisk, width, &tm64->month, src);
tm64->month -= 1;
break;
case 'D': // day
src = scan_value(asterisk, width, &tm64->day, src);
break;
case 'h': // hour
src = scan_value(asterisk, width, &tm64->hour, src);
break;
case 'm': // minute
src = scan_value(asterisk, width, &tm64->minute, src);
break;
case 's': // second
src = scan_value(asterisk, width, &tm64->second, src);
break;
case 'S': // millisecond
src = scan_value(asterisk, width, &tm64->millisecond, src);
break;
case 'y': // 2012 -> 12
src = scan_value(asterisk, width, &tm64->year, src);
tm64->year = (2000 + tm64->year) - 1900;
break;
default:
assert(0);
}
}
return 0;
}
