/* This function establishes the list of all stations that will actually
be used for processing. I creates an associative array of MWstation
objects keyed by the station name. Note it is important to realize
the structure this function creates is NOT completely filled in, but
every element is at least initialized. (see above). The NULL pointers
are especially dangerous if not filled in.
The main element of the MWstation structure that this function fills in
is the weights vector. This vector is an array of weights used for
forming the stack in a given frequency band. That is, weight[i] is
the weight given traces for this station in wavelet band i.
arguments:
pf = input pf object to be parsed
nbands = number of frequency bands to use in processing = length
of weights vector created in s->weights
The weights array is created cautiously using nbands. The input line
is parsed and if there are insufficient weights listed in the input
a diagnostic will be issued and the undefined weights set to 1.0.
If there are more numbers listed than required the list will be silently
truncated.
History:
Created summer 1999
Modified march 2000
Added code for stations with bad timing.
*/
Arr *create_station_objects(Pf *pf, int nbands)
{
int i,j,k;
Arr *a;
Tbl *t;
MWstation *s;
char *sta;
char *line,*word;
char *white=" \t";
t = pfget_tbl(pf,"station_weights");
if(t == NULL) elog_die(0,"station_weights table not in parameter file\n");
a = newarr(0);
for(i=0;i<maxtbl(t);i++)
{
line = gettbl(t,i);
sta = strtok(line,white);
s = (MWstation *)malloc(sizeof(MWstation));
if(s==NULL)
elog_die(0,"Cannot malloc MWstation structure for station %s\n",sta);
initialize_MWstation(s,nbands);
allot(double *,s->weights,nbands);
s->sta = strdup(sta);
for(j=0;j<nbands;j++)
{
word = strtok(NULL,white);
if(word == NULL)
{
elog_notify(0,"error in station_weights parameter inputfor station %s\nExpected list of %d weights, found only %d\n",
sta,nbands, j);
if(j==0)
{
elog_notify(0,"No weights defined in any band for station %s\nSetting all weights to 1.0\n",
sta);
for(k=0;k<nbands;++k)s->weights[k]=1.0;
}
else
{
elog_notify(0,"Setting weights for station %s above band %d to %lf\n",
sta,j-1,s->weights[j-1]);
for(k=j;k<nbands;++k)
s->weights[k]=s->weights[j-1];
}
break;
}
s->weights[j] = atof(word);
}
/* we set the clock_is_bad variable false here and depend
upon the genloc bad clock definitions to set a station as
being always bad with this flag */
s->clock_is_bad = 0;
setarr(a,s->sta,s);
}
return(a);
}
void save_run_parameters(Dbptr db,Pf *pf)
{
char *dir,*dfile;
char filename[512];
char *vm,*vm3d;
int ierr;
dir = pfget_string(pf,"pmelrun_archive_directory");
if(dir==NULL)elog_die(0,"Parameter pmelrun_archive_directory not in parameter file\n");
if(makedir(dir))
elog_die(0,"makedir failed on directory %s\n",dir);
dfile = pfget_string(pf,"pmel_run_name");
vm = pfget_string(pf,"travel_time_model");
vm3d=pfget_string(pf,"3Dreference_model");
if( (vm==NULL) || (vm3d==NULL) )
elog_die(0,"Missing required velocity model definitions\nCheck parameters travel_time model and 3Dreference_model\n");
db = dblookup(db,0,"pmelruns",0,0);
ierr=dbaddv(db,0,"pmelrun",dfile,
"vmodel",vm,
"vmodel3d",vm3d,
"dir",dir,
"dfile",dfile,0);
if(ierr < 0) elog_die(0,
"dbaddv error on pmelrun table\nVerify schema extensions for dbpmel and that the pmel_run_name parameter is unique\n");
strcpy(filename,dir);
strcat(filename,"/");
strcat(filename,dfile);
if(pfwrite(filename,pf))
elog_die(0,"pfwrite error for file %s\n",filename);
}
Arr *build_stachan_list(Pf *pf, int *nchan,int verbose)
{
char sta[10], chan[10];
char *key;
Arr *a;
int i;
Tbl *t;
char *line;
int *channel_number; /* value stored in arr */
if(verbose)
elog_notify(0,"Station Channel_code Channel_number\n");
a = newarr(0);
t = pfget_tbl(pf,"channels");
if(t==NULL) elog_die(0,"Parameter file error: no channels table\n");
for(i=0;i<maxtbl(t);++i)
{
line = gettbl(t,i);
sscanf(line,"%s %s",sta,chan);
key = make_key(sta,chan);
channel_number = (int *) malloc(sizeof(int));
if(channel_number == NULL)
elog_die(0,"malloc error for channel_number\n");
*channel_number = i;
setarr(a,key,(void *)channel_number);
if(verbose)
elog_notify(0,"%s %s %d\n",sta,chan,(*channel_number)+1);
free(key);
}
*nchan = maxtbl(t);
freetbl(t,free);
return(a);
}
RT_HTTPD rt_http_from_lld(RT_LLD lld /* typeless low level data */)
{
if (!lld)
elog_die(FATAL, "passed NULL low level descriptor");
if ( (((RT_HTTPD)lld)->magic != RT_HTTP_LLD_MAGIC) &&
(((RT_HTTPD)lld)->magic != RT_HTTPS_LLD_MAGIC) )
elog_die(FATAL, "magic type mismatch: we were given "
"%s (%s) but can handle only %s (%s) or %s (%d)",
((RT_HTTPD)lld)->prefix,
((RT_HTTPD)lld)->description,
rt_http_prefix(), rt_http_description(),
rt_https_prefix(), rt_https_description() );
return (RT_HTTPD) lld;
}
Dbptr join_tables(Dbptr db, Pf *pf, Arr *tables)
{
char *table_name;
int *ilogic;
Tbl *t;
Dbptr dbj;
long int nrec;
int i;
int ntables=0;
/* This is an exact copy of above, but it is duplicated because
this function could get stolen by another future program
because it is pretty general */
t = pfget_tbl(pf,"join_tables");
if(t == NULL)
{
elog_die(0,"No list of tables to be joined\n");
}
for(i=0;i<maxtbl(t);++i)
{
table_name = gettbl(t,i);
ilogic = (int *)getarr(tables,table_name);
if(ilogic == NULL)
{
elog_die(0,"Table %s was not handled previously by check_tables.\nProgramming logic error\n",
table_name);
}
else if(*ilogic)
{
if(ntables == 0)
dbj = dblookup(db,0,table_name,0,0);
else
dbj=dbjoin(dbj,dblookup(db,0,table_name,0,0),
NULL,NULL,0,NULL,0);
++ntables;
dbquery(dbj,dbRECORD_COUNT,&nrec);
if(nrec == 0)
{
elog_complain(0,
"join_tables error\njoined database has 0 length after joining table %s\n",
table_name);
dbj.record = dbINVALID;
return(dbj);
}
}
}
return(dbj);
}
/* This is a companion routine to load_station_table for array beam code
tables. At the moment it is essentially identical to the load_station_table
function, but changes may eventually occur in the beam table that will
make them diverge so I have produced to seperate functions */
Arr *load_array_table(Pf *pf)
{
Arr *a;
Tbl *t;
int i;
char *value;
Seismic_Array *s;
double elev_datum;
a = newarr(0);
elev_datum = pfget_double_wdef(pf,"elevation_datum",0.0);
t = pfget_tbl(pf,"seismic_arrays");
for(i=0;i<maxtbl(t);++i)
{
s = (Seismic_Array *) malloc(sizeof(Seismic_Array));
if(s == NULL) elog_die(1,"load_array_table: Cannot malloc Seismic_Array structure entry\n");
value = gettbl(t,i);
if(sscanf(value,"%s %lf %lf %lf",s->name,
&(s->lat),&(s->lon),&(s->elev)) != 4)
elog_complain(1,"Warning(load_array_table): \
Read error in array tbl read from parameter file\n\
The following line of the array table was skipped\n%s\n",
value);
else
{
s->elev -= elev_datum;
setarr(a,s->name,s);
}
}
return(a);
}
/*This function adds a single row to the origerr table for this event.
arguments:
orid - orid assign to this solution
h - Hypocenter object for this solution
dbo - output db
This version doesn't set much of this large table. Eventually, it
needs to include all the error terms, but that function is not
written yet.
Author: Gary L. Pavlis
Written: February 1997
*/
void save_origerr(long orid, Hypocenter h, double **C, Dbptr dbo)
{
double sdobs;
double lddate;
/* Intentionally ignored: smajax,sminax,strike,sdepth,stime,
conf,commid */
dbo = dblookup(dbo,0,"origerr",0,0);
/* Bad news here is that we can't save the more useful
statistics that this program calculates. css3.0 only allows
sdobs = sswr/ndgf */
sdobs = h.rms_raw;
lddate = std_now();
if(dbaddv(dbo,0,
"orid",orid,
"sxx",C[0][0],
"syy",C[1][1],
"szz",C[2][2],
"stt",C[3][3],
"sxy",C[0][1],
"sxz",C[0][2],
"syz",C[1][2],
"stx",C[0][3],
"sty",C[1][3],
"stz",C[2][3],
"sdobs",sdobs,
"lddate",lddate,
NULL) == dbINVALID)
{
elog_die(1,"save_origerr: dbaddv error writing origerr record for orid %ld\n",
orid);
}
}
Hypocenter db_load_initial(Dbptr dbv,long row)
{
Hypocenter h;
dbv.record = row;
if(dbgetv(dbv, 0,
"origin.lat", &(h.lat),
"origin.lon", &(h.lon),
"origin.depth",&(h.z),
"origin.time", &(h.time),
NULL) == dbINVALID)
elog_die(1,"relocate: dbgetv error fetching previous location data\nFailure at line %ld of database view\n",row);
/* This initializes parts of the hypocenter stucture that define
this as an initial location. */
h.dz = 0.0;
h.dx = 0.0;
h.dy = 0.0;
h.dt = 0.0;
h.rms_raw = -1.0;
h.rms_weighted = -1.0;
h.interquartile = -1.0;
h.number_data = 0;
h.degrees_of_freedom = 0;
h.lat0 = h.lat;
h.lon0=h.lon;
h.z0 = h.z;
h.t0 = h.time;
return(h);
}
/* This small function returns an associative array of pointers to
doubles keyed by station names that are the arrival times read from
the database. Because we are dealing with this db bundle pointer
this is simpler than manipulating the db directly
Author: G Pavlis
*/
Arr *get_arrivals(Dbptr dbbundle)
{
int is, ie;
Arr *a;
double time,*t;
char sta[20];
dbget_range(dbbundle,&is,&ie);
a = newarr(0);
for(dbbundle.record=is;dbbundle.record<ie;++dbbundle.record)
{
if(dbgetv(dbbundle,0,
"sta",sta,
"arrival.time", &time,0) == dbINVALID)
{
elog_complain(0,"dbgetv error reading arrival information from row %d\n",
dbbundle.record);
continue;
}
/* the idea here is to skip this step if an arrival is
already set. This often because only every third trace
or a three-component set yields a unique station name */
if(getarr(a,sta) == NULL)
{
t=malloc(sizeof(double));
if(t==NULL)elog_die(0,"get_arrivals malloc failure for simple double\n");
*t = time;
setarr(a,sta,(void *)t);
}
}
return(a);
}
int load_surface_velocity(Pf *pf, Arr *a)
{
int nset;
Tbl *t;
char sta[10];
double vp,vs;
char *line;
MWstation *s;
int i;
t = pfget_tbl(pf,"surface_velocities");
if(t == NULL) elog_die(0,"surface_velocities table missing from parameter file\n");
for(i=0,nset=0;i<maxtbl(t);i++)
{
line = gettbl(t,i);
if((sscanf(line,"%s %lf %lf",sta,&vp,&vs)) != 3)
{
elog_notify(0,"Syntax error reading line from surface_velocity table\nOffending line->%s\n",
line);
continue;
}
s = (MWstation *)getarr(a,sta);
if(s == NULL)
{
elog_notify(0,"Station %s listed in surface_velocity table not found in master table\n",
sta);
continue;
}
s->vp0 = vp;
s->vs0 = vs;
++nset;
}
return(nset);
}
/* This routine computes the pure pseudoinverse from the svd returned
by svdcmp (U*S*V^T) so Agi = V*S^-1*U^T. The algorithm used is a
little overly tricky using an internally allocated work vector to
make the routine nondestructive to the input matrices. This computes
the "pure" pseudoinverse by setting the svd cutoff value based on
float epsilon (from float.h).
Note input U is mxn, s is an n vector, V is nxn, and the output
Agi is nxm.
Function returns the number of singular values actually used to
compute Agi.
Author: Gary L. Pavlis
*/
int pseudoinverse(float **U, float *s, float **V, int m, int n, float **Agi)
{
int i,j, k; /* counters*/
float *work; /* work space */
float smax;
float sinv;
double sv_cutoff;
int nsv_used;
#ifndef SUNPERF
int one=1;
#endif
if((work=(float *)calloc(n,sizeof(float))) == NULL)
elog_die(1,"Pseudoinverse computation: cannot alloc work array of length %d\n",
n);
/* first find the larges singular value, then just zero
all those smaller than the cutoff determined as the ratio
wrt to largest singular value */
smax = 0.0;
for(i=0;i<n;++i)
if(s[i] > smax) smax = s[i];
sv_cutoff = (double)smax*FLT_EPSILON;
/* This is a copy operation */
for(i=0;i<m;++i)
for(j=0;j<n;++j) Agi[j][i] = U[i][j];
/* this works because of C storage order, but is strange.
It is the multiply by S^-1 */
for(j=0,nsv_used=0;j<n;++j)
{
if( (double)s[j] > sv_cutoff)
{
sinv = 1.0/s[j];
++nsv_used;
}
else
sinv = 0.0;
#ifdef SUNPERF
sscal(m,sinv,Agi[j],1);
#else
sscal_(&m,&sinv,Agi[j],&one);
#endif
}
/* multiply by V using a column work vector*/
for(j=0;j<m;++j)
{
for(k=0;k<n;++k) work[k] = Agi[k][j];
for(i=0;i<n;++i)
#ifdef SUNPERF
Agi[i][j] = sdot(n,work,1,V[i],1);
#else
Agi[i][j] = sdot_(&n,work,&one,V[i],&one);
#endif
}
free(work);
return(nsv_used);
}
int main(int argc, char **argv) {
int r, seq1, size1;
CF_VALS cf;
RT_LLD lld1;
time_t time1;
ITREE *chain;
ROUTE_BUF *rtbuf;
cf = cf_create();
http_init();
rt_http_init(cf, 1);
/* test 1: is it there? */
r = rt_http_access(TURL1, NULL, TURL1, ROUTE_READOK);
if (r)
elog_die(FATAL, "[1] shouldn't have read access to http %s",
TURL1);
r = rt_http_access(TURL1, NULL, TURL1, ROUTE_WRITEOK);
if (r)
elog_die(FATAL, "[1] shouldn't have write access to http %s",
TURL1);
/* test 2: open for read only should not create http */
lld1 = rt_http_open(TURL1, "blah", NULL, 0, TURL1);
if (!lld1)
elog_die(FATAL, "[2] no open http descriptor");
/* test 3: read an http location */
chain = rt_http_read(lld1, 0, 0);
if (itree_n(chain) != 1)
elog_die(FATAL, "[3] wrong number of buffers: %d",
itree_n(chain));
itree_first(chain);
rtbuf = itree_get(chain);
if (!rtbuf)
elog_die(FATAL, "[3] no buffer");
if (!rtbuf->buffer)
elog_die(FATAL, "[3] NULL buffer");
if (rtbuf->buflen != strlen(rtbuf->buffer))
elog_die(FATAL, "[3] buffer length mismatch %d != %d",
rtbuf->buflen, strlen(rtbuf->buffer));
route_free_routebuf(chain);
/* test 4: tell test */
r = rt_http_tell(lld1, &seq1, &size1, &time1);
if (r)
elog_die(FATAL, "[4] http tell should always fail");
rt_http_close(lld1);
cf_destroy(cf);
rt_http_fini();
return 0;
}
/* Does what is says and performs a consistency check on the
gathers passed via the gathers vector (length nwavelets).
Causes the program to die if the number of station in a gather
is not the same for all wavelets. This should never really
happen and chaos will result if it does so we kill the program
under this condition. This may be only needed for debugging, but
the effort in the check is so small it can probably be left
in forever.
*/
void check_gather_consistency(MWgather **gathers,int nwavelets)
{
int i;
for(i=1;i<nwavelets;++i)
{
if(gathers[i]->nsta != gathers[i-1]->nsta)
elog_die(0,"Mismatch in station count for wavelets in a single frequency band. Wavelet %d gather has %d stations while wavelet %d has %d\nCannot continue -- exiting\n",
i,gathers[i]->nsta,i-1,gathers[i-1]->nsta);
}
}
/* This routine looks for a Tbl in the parameter space that
defines a set of auxiliary tables that are to be used. It
cautiously checks to see if that table is defined in the
schema and is nonempty. It sets logical variables in associative
array it returns that define if the table is "ok". This is serious
overkill added to make the code for expandable in the future.
At the moment the only table that would be used is "shot".
It would, however, be easy to add similar auxiliary tables for
segy constructs like statics, mute definition, etc. In that
case there probably should be a more general mechanism than this
but I'm more or less laying out a useful functionality here rather
than doing it in a completely general way.
*/
Arr *check_tables(Dbptr db, Pf *pf)
{
char *table;
int *ilogic;
int i;
Tbl *t;
Dbptr dbtmp;
int table_ok;
long int nrec;
Arr *a;
a = newarr(0);
t = pfget_tbl(pf,"join_tables");
if(t == NULL)
{
elog_die(0,"No list of tables to be joined\n");
}
for(i=0;i<maxtbl(t);++i)
{
/* This series of conditionals is safe: It certifies
a table (a) is defined in this schema and (b) is
not empty. */
table = (char *)gettbl(t,i);
dbtmp = dblookup(db,0,table,0,0);
if(dbtmp.table == dbINVALID)
table_ok = 0;
else
table_ok = 1;
if(table_ok)
{
dbquery(dbtmp,dbRECORD_COUNT,&nrec);
if(nrec > 0)
table_ok = 1;
else
table_ok = 0;
}
ilogic = (int *) malloc(sizeof(int));
if(ilogic == NULL) elog_die(0,"malloc error\n");
*ilogic = table_ok;
setarr(a,table,ilogic);
}
return(a);
}
MWbasis *load_multiwavelets_pf(Pf *pf,int *nwavelets)
{
int i,j,k;
char *line;
double f0,fw;
int nsamples;
Tbl *w;
MWbasis *mw;
int nrows;
nsamples = pfget_int(pf,"nsamples");
*nwavelets = pfget_int(pf,"nwavelets");
f0 = pfget_double(pf,"f0");
fw = pfget_double(pf,"fw");
w = pfget_tbl(pf,"wavelets");
nrows = maxtbl(w);
if(nrows != (nsamples*(*nwavelets)))
elog_die(0,"Size mismatch in wavelet parameter file\nExpected %d from %d wavelets each %d long\nFound %d instead\n",
nsamples*(*nwavelets),*nwavelets,nsamples,nrows);
mw = (MWbasis *)calloc(*nwavelets, sizeof(MWbasis));
if(mw == NULL)
elog_die(0,"Cannot alloc %d multiwavelet structures\n",*nwavelets);
for(i=0,k=0;i<(*nwavelets);++i)
{
mw[i].r = calloc(nsamples,sizeof(float));
mw[i].i = calloc(nsamples,sizeof(float));
if((mw[i].r == NULL) || (mw[i].i == NULL) )
elog_die(0,"Cannot alloc %d samples for complex wavelet %d\n",
nsamples,i);
mw[i].n = nsamples;
mw[i].f0 = f0;
mw[i].fw = fw;
for(j=0;j<nsamples;j++,k++)
{
line = gettbl(w,k);
if(sscanf(line,"%g%g",&(mw[i].r[j]),&(mw[i].i[j])) != 2)
elog_die(0,"Error reading wavelets from parameter file on line %d of wavelet tbl\n",
k);
}
}
return(mw);
}
/* Changed to int from void by JN in order to return evid. */
long save_event(Dbptr dbi, long is, long ie, long orid, Dbptr dbo)
{
/* these are variables in dbi copied to dbo */
long evid;
char evname[16];
/*altered in output by this program */
long prefor;
char auth[20];
double lddate;
/* intentionally ignored: commid */
dbo = dblookup(dbo,0,"event",0,0);
dbi.record = is;
if( dbgetv(dbi,0,
"event.evid",&evid,
"event.evname",evname,
NULL) == dbINVALID)
{
elog_die(1,"save_event: dbgetv error reading event fields of input view at record %ld\n",
is);
}
prefor = orid;
my_username(auth);
lddate = std_now();
if(dbaddv(dbo,0,
"evid",evid,
"evname",evname,
"prefor",prefor,
"auth",auth,
"lddate",lddate,
NULL ) == dbINVALID)
{
elog_die(1,"save_event: dbaddv error writing event record for orid %ld\n",
orid);
}
/* Added by JN */
return(evid);
}
int save_origin(int nass, int evid, Dbptr master_db, Dbptr dbtmp,
Hypocenter h,Location_options o, int orb)
{
int ndef;
char dtype[2];
char algorithm[16]="ggnloc";
char auth[16]="orbgenloc";
int grn, srn;
int orid; /* orid returned */
orid = dbnextid(master_db,"orid");
if(orid < 0 )
elog_die(1,"save_origin: dbnextid failure asking for new orid\n");
if(o.fix[2])
{
ndef = h.degrees_of_freedom + 3;
strcpy(dtype,"r");
}
else
{
ndef = h.degrees_of_freedom + 4;
strcpy(dtype,"f");
}
grn = grnumber(h.lat, h.lon) ;
srn = srnumber ( grn ) ;
dbtmp = dblookup(dbtmp,0,"origin",0,0);
dbtmp.record = dbSCRATCH;
if((dbputv(dbtmp,0,
"lat",h.lat,
"lon",h.lon,
"depth",h.z,
"time",h.time,
"orid",orid,
"evid",evid,
"nass",nass,
"grn", grn,
"srn", srn,
"dtype",dtype,
"ndef",ndef,
"algorithm",algorithm,
"auth",auth,0))
== dbINVALID)
{
elog_complain(0,"dbputv error while building origin record for orid %d\nNo results saved\n",
orid);
}
else
{
if(save_dbrecord(dbtmp,orb))
elog_complain(0,"Errors saving orid %d\n",orid);
}
return(orid);
}
/* This is the function actually called to build and fill the multiwavelet station objects.
It basically calls all three functions defined above in the correct sequence. This
was an intentional modularization done to simply code maintenance by separating out some
parts linked to different input objects (i.e. pfs versus dbs).
The function returns an assembled Arr containing pointers to MWstation objects keyed
by the station name.
Arguments:
db - Database pointer to css3.0 database with a site table
pf - parameter object previously loaded
time - epoch time of start of this data set.
The "time" variable is needed due to a peculiarity of how site is keyed in css3.0.
(see the load_station_geometry function comments above for details.)
Author: G. Pavlis
Written: March 1999
*/
Arr *build_station_objects(Dbptr db, Pf *pf, double time)
{
int nsta_pf,nsta; /* nsta_pf is the number of stations defined in the
parameter file descriptions while nsta
is used for comparison from each function */
int nbands; /* number of frequency bands (needed to define weight vectors */
Arr *a;
char *refsta;
MWstation *s;
nbands = pfget_int(pf,"number_frequency_bands");
a = create_station_objects(pf,nbands);
nsta_pf = cntarr(a);
nsta = load_surface_velocity(pf, a);
if(nsta != nsta_pf)
elog_complain(0,"Surface velocity defined for only %d of %d stations\n",
nsta,nsta_pf);
nsta = load_station_geometry(db,a,time);
if(nsta<=0)
elog_die(0,"load_station_geometry failed to match any stations in parameter file with database site table\n");
if(nsta != nsta_pf)
elog_complain(0,"Missing entries in site table\nMatched only %d of %d defined in the parameter file\n",
nsta,nsta_pf);
/* This is an extra sanity check. We require refsta to be in the
site table or all hell will break loose. */
refsta = get_refsta(a);
s = (MWstation *)getarr(a,refsta);
if(s == NULL) elog_die(0,"Station site table error: reference station %s must appear in site table\n",
refsta);
free(refsta);
nsta = load_initial_statics(pf, a);
elog_log(0,"Set initial statics on %d stations\n",nsta);
return(a);
}
/* Simple little function to define the 3D reference model
used to compute bias components of solution. It simply
uses the same mechanism used in dbgenloc to access a set of
standard models.
*/
Arr *parse_3D_phase(Pf *pf)
{
Arr *a;
Pf *pf3d;
char *vmodel;
vmodel = pfget_string(pf,"3Dreference_model");
if(pfload("GENLOC_MODELS","tables/genloc",vmodel,&pf3d) != 0)
elog_die(0,"pfload failed on 3Dreference model %s\n",vmodel);
a = parse_phase_parameter_file(pf3d);
pffree(pf3d);
return(a);
}
char *format_hypo(Hypocenter *h)
{
char *s;
s = malloc(512);
if(s == NULL) elog_die(1,"malloc error for hypocenter output tabulation\n");
sprintf(s,"%lg %lg %lg %lg %lg %lg %lg %lg %lg %lg %lg %lg %lg %lg %d %d",
h->lat0,h->lon0,h->z0,h->t0,
h->lat,h->lon,h->z,h->time,
h->dx,h->dy,h->dz,
h->rms_raw, h->rms_weighted, h->interquartile,
h->number_data,h->degrees_of_freedom);
return(s);
}
int main(int argc1, char *argv[])
{
route_init(NULL, 0);
route_register(&rt_filea_method);
route_register(&rt_fileov_method);
route_register(&rt_stdin_method);
route_register(&rt_stdout_method);
route_register(&rt_stderr_method);
route_register(&rt_rs_method);
if ( ! elog_init(1, "cascade test", NULL))
elog_die(FATAL, "didn't initialise elog\n");
out = route_open("stdout", NULL, NULL, 0);
err = route_open("stderr", NULL, NULL, 0);
rs_init();
/* run cascade with all the possible modes */
test_cascade(CASCADE_AVG, "avg",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_AVGSING, RES_AVGSINGKEY, RES_AVGMULT, RES_AVGMULTKEY);
test_cascade(CASCADE_MIN, "min",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_MINSING, RES_MINSINGKEY, RES_MINMULT, RES_MINMULTKEY);
test_cascade(CASCADE_MAX, "max",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_MAXSING, RES_MAXSINGKEY, RES_MAXMULT, RES_MAXMULTKEY);
test_cascade(CASCADE_SUM, "sum",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_SUMSING, RES_SUMSINGKEY, RES_SUMMULT, RES_SUMMULTKEY);
test_cascade(CASCADE_FIRST, "first",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_FIRSTSING, RES_FIRSTSINGKEY, RES_FIRSTMULT,
RES_FIRSTMULTKEY);
test_cascade(CASCADE_LAST, "last",
TAB_SING, TAB_SINGINFO, TAB_SINGINFOKEY,
TAB_MULT, TAB_MULTINFO, TAB_MULTINFOKEY,
RES_LASTSING, RES_LASTSINGKEY, RES_LASTMULT,
RES_LASTMULTKEY);
rs_fini();
elog_fini();
route_close(err);
route_close(out);
route_fini();
printf("tests finished successfully\n");
exit(0);
}
/* trap needed because wfdisc and site are required tables. */
void check_for_required_tables(Arr *tabarray)
{
int *test;
int need_to_die=0;
test = (int *)getarr(tabarray,"site");
if( (test == NULL) || ((*test) == 0) )
{
elog_complain(0,"Cannot find required table site in db\n");
++need_to_die;
}
test = (int *)getarr(tabarray,"wfdisc");
if( (test == NULL) || ((*test) == 0) )
{
elog_complain(0,"Cannot find required table wfdisc in db\n");
++need_to_die;
}
if(need_to_die) elog_die(0,"Cannot proceed without required tables\n");
}
/* This small functions scans the gridlist tbl to get the maximum
and minimum gridid values. These are used to subset the working view
automatically to reduce the size of the working view (found to be
excessive otherwise .
gmin and gmax are returned as the maximum and minimum grid id
Author: Gary Pavlis
Written: July 2001
*/
void get_gridid_range(Tbl *gridlist,int *gmin,int *gmax)
{
int gidmin,gidmax;
int gridid;
int i;
if(maxtbl(gridlist)<=0) elog_die(0,"Empty grid id list\nProbable usage error\n");
gidmin = (int)gettbl(gridlist,0);
gidmax = gidmin;
for(i=1;i<maxtbl(gridlist);++i)
{
gridid = (int)gettbl(gridlist,i);
gidmin = MIN(gidmin,gridid);
gidmax = MAX(gidmax,gridid);
}
*gmin = gidmin;
*gmax = gidmax;
}
/* This is the translation routine similar to dbload_arrival_table and load_arrival_table
in libgenloc.
Arguments:
hyp - input structure
stations - associative array of station structures
arrphase - associate array of phase handles.
Function returns tbl of Arrival objects used by genloc routines.
Author: G Pavlis
written: january 30, 1998
*/
Tbl *orbhypo_to_genloc(ORB_Hypocenter *hyp, Arr *arrphase, Arr *stations)
{
Arrival *a;
Tbl *t;
int i;
t = newtbl(0);
for(i=0;i<hyp->nass;++i)
{
a = (Arrival *) malloc(sizeof(Arrival));
if(a == NULL)
elog_die(1,"orbhypo_to_genloc cannot malloc Arrival structure\n");
a->sta = (Station *) getarr(stations,hyp->assocs[i].sta);
if(a->sta == NULL)
{
elog_complain(1,"Cannot find coordinates for station %s\n%s phase arrival for this station skipped\n",
hyp->assocs[i].sta, hyp->assocs[i].iphase);
free(a);
continue;
}
a->arid = hyp->assocs[i].arid;
a->time = hyp->assocs[i].time;
a->phase = (Phase_handle *) getarr(arrphase,
hyp->assocs[i].iphase);
if(a->phase == NULL)
{
if ( strcmp(hyp->assocs[i].iphase, "D") != 0 ) {
elog_complain(1,"Don't know how to handle phase '%s'"
" -- Arrival at %s at time %lf skipped\n",
hyp->assocs[i].iphase,hyp->assocs[i].sta,
hyp->assocs[i].time);
}
free(a);
continue;
}
/* the current real-time system has no uncertainty
estimate on the picks so we always use the default */
a->deltat = (double)a->phase->deltat0;
pushtbl(t,a);
}
return(t);
}
/*
* Main function
*/
main(int argc, char *argv[]) {
char *buf;
iiab_start("", argc, argv, "", NULL);
plinps_init();
plinps_collect();
if (argc > 1)
buf = table_outtable(plinps_tab);
else
buf = table_print(plinps_tab);
if (buf)
puts(buf);
else
elog_die(FATAL, "plinps", 0, "no output produced");
nfree(buf);
table_destroy(plinps_tab);
plinps_fini();
iiab_stop();
exit(0);
}
int pseudo_inv_solver(double *U,
double *Vt,
double *s,
int m,
int n,
double *b,
double maxcon,
double *x)
{
double sv_cutoff;
double *work;
int nsvused;
int i, j;
work = (double *)calloc(n,sizeof(double));
if(work == NULL) elog_die(0,"pseudoinverse solver cannot alloc array of %d doubles\n",
n);
/*dgesvd returns singular values in descending order so
finding the largest is trivial. We use this to establish
the sv cutuff */
sv_cutoff = s[0]/maxcon;
/* multiply by S-1 * UT */
nsvused = 0;
for(j=0;j<n;++j)
{
if(s[j]<sv_cutoff) break;
work[j] = ddot(m,(U+j*m),1,b,1);
work[j] /= s[j];
++nsvused;
}
for(i=0;i<n;++i) x[i]=0.0;
/* This is the right form because of Vt */
for(j=0;j<nsvused;++j)
{
daxpy(n,work[j],(Vt+j),n,x,1);
}
free(work);
return(nsvused);
}
/*
* Turn a normal running process into a detached daemon!!
* Running this routine will fork the process into a different pid
* parented by init, become part of a new session or process group,
* change the default umask for created files and block off
* tty signals.
* It does not close file descriptors or redirect them.
*/
void iiab_daemonise()
{
int i;
if (getppid() == 1)
return; /* already a daemon */
i = fork();
if (i < 0)
elog_die(FATAL, "unable to fork"); /* fork error */
if (i > 0) {
iiab_stop();
_exit(0); /* parent */
}
/* Child process (the novice daemon) continues.
* Become a session and process group leader */
setsid();
/* fork again to allow the session group leader to die. The child
* is thus prevented from being a session group leader and acquiring
* a controlling terminal by mistake */
if (fork() > 0) {
_exit(0); /* pg leader dies */
};
/* move to '/' so we don't hold any unnecessary directories.
* This would be harmful in the non-daemon invocation */
chdir("/");
#if 0
for (i = getdtablesize(); i >= 0; --i)
close(i); /* close all fds */
i = open("/dev/null", O_RDWR); /* open stdio on /dev/null */
dup(i);
dup(i);
#endif
umask(022); /* security esp root */
/*sig_blocktty();*/
}
/* Creation routine for an SCMatrix structure used internally
as the working internal object of pmel. It defines static
sizes and indices that define the columns of the working matrix.
It then allocs memory for the working vectors of station correction
(path anomalies) that are the major outputs of pmel. The initial
working S matrix is created, but it's size is set to 1 row. This
assumes that later on this space will be realloced to match variable
data size for different event groups that are processed. That is
the number of data in a group is variable, but the station list and
phase list that define the column structure of S are static through
a single run of pmel.
Arguments:
stalist - Associative array of Station structures keyed by
station name. This is used to build the internal
station column indexing array.
arrp - Associate array of phase handles keyed by phase
name.
Always returns a pointer to a valid SCMatrix structure (object).
If any problems happen this function will call die. This would
normally be memory alloc problems, but it could also happen if
the stalist or arrp arrays are foobarred.
Note the algorithm assumes the list of phase handles is all inclusive
and will create a matrix large enough to deal with every phase it
finds listed there.
Author: GAry Pavlis
Written: October 2000
*/
SCMatrix *create_SCMatrix(Arr *stalist, Arr *arrp)
{
SCMatrix *s;
Tbl *tkeys;
char *key;
int i;
int *phase_col;
allot(SCMatrix *,s,1);
s->nsta = cntarr(stalist);
s->nphases = cntarr(arrp);
s->ncol = (s->nsta)*(s->nphases);
s->sta_index = create_sta_index(stalist);
if((s->ncol)<=0)
elog_die(0,"create_SCMatrix: illegal matrix request\nNumber stations = %d and number of phases = %ld yielding %d matrix columns\n",
s->nsta,cntarr(arrp),s->ncol);
/* We set the initial number of rows to 1 and depend on
a realloc late to make the S workspace larger. */
s->nrow = 1;
allot(double *,s->S,(s->nrow)*(s->ncol));
allot(double *,s->scref,s->ncol);
allot(double *,s->sc,s->ncol);
allot(double *,s->scbias,s->ncol);
allot(double *,s->scdata,s->ncol);
tkeys = keysarr(arrp);
s->phase_index = newarr(0);
for(i=0;i<maxtbl(tkeys);++i)
{
key = gettbl(tkeys,i);
allot(int *,phase_col,1);
*phase_col = i*(s->nsta);
setarr(s->phase_index,key,phase_col);
}
freetbl(tkeys,0);
return(s);
}
/* Edits the array of phase handles to keep only phases
named in the keeplist Tbl of phase names strings. This
is complicated by the fact that keeplist is a simple
list. The algorithm used converts the keeplist to a
temporary associative array then passes through the
array of phase handles calling the free routine on
phases not found in the keeplist.
Author: G Pavlis
Written: August 2001
*/
void edit_phase_handle(Arr *a,Tbl *keeplist)
{
Tbl *akeys;
Arr *akeeper;
int dummy; /* used purely as a placeholder in akeeper*/
char *phase;
int i,n;
Phase_handle *ph;
n = maxtbl(keeplist);
if(n<=0)
elog_die(0,"List of phases to keep is empty.\n\
Check phases_to_keep parameter setting\n");
akeeper = newarr(0);
for(i=0; i<maxtbl(keeplist); ++i)
{
phase = (char *)gettbl(keeplist,i);
setarr(akeeper,phase,&dummy);
ph = (Phase_handle *)getarr(a,phase);
if(ph==NULL)elog_die(0,
"Don't know how to handle required phase %s\n",
phase);
}
akeys = keysarr(a);
for(i=0; i<maxtbl(akeys); ++i)
{
phase = gettbl(akeys,i);
if(getarr(akeeper,phase) == NULL)
{
ph = (Phase_handle *)getarr(a,phase);
free_phase_handle(ph);
delarr(a,phase);
}
}
freearr(akeeper,0);
freetbl(akeys,0);
}
int
main (int argc, char **argv)
{
int c,
verbose = 0,
errflg = 0;
char *dbinname=malloc(1024);
char *dboutname=malloc(1024);
Point *poly;
double lat,lon;
char *auth=strdup("regions2polygon");
char *ptype= strdup("rp");
char *dir=strdup(".");
char *dfile=strdup("polygons");
int ftype=polyFLOAT;
char *name;
int nregions, nvertices;
Tbl *sortkeys, *groupkeys;
Dbptr dbin,dbout,dbi,dbo,dbg,dbb;
int i,from,to,nv;
int vertex;
elog_init ( argc, argv ) ;
while ((c = getopt (argc, argv, "vV")) != -1) {
switch (c) {
case 'v':
verbose++ ;
break;
case 'V':
usage ();
break;
case '?':
errflg++;
break ;
}
}
if ((errflg) || argc < 3)
usage ();
dbinname = argv[optind++];
dboutname= argv[optind++];
if (dbopen(dbinname,"r",&dbin)) {
elog_die(1,"cannot open database %s",dbinname);
}
dbi=dblookup(dbin,0,"regions",0,0);
sortkeys=newtbl(2);
pushtbl(sortkeys,"regname");
pushtbl(sortkeys,"vertex");
groupkeys=newtbl(1);
pushtbl(groupkeys,"regname");
dbi=dbsort(dbi,sortkeys,0,"regions.sorted");
dbg=dbgroup(dbi,groupkeys,0,0);
dbquery(dbg,dbRECORD_COUNT,&nregions);
if (nregions <1) {
elog_die(0,"table regions seems to be empty (or not present)");
}
if (verbose) elog_notify(0,"creating database descriptor %s",dboutname);
if (dbcreate(dboutname,"polygon1.2",0,0,0)) {
elog_die(1,"cannot create database %s",dboutname);
}
dbopen(dboutname,"r+",&dbout);
dbo=dblookup(dbout,0,"polygon",0,0);
for (i=0; i< nregions; i++) {
dbg.record=i;
dbgetv(dbg,0,"regname",name,"bundle",&dbb,0);
dbget_range(dbb,&from,&to);
nvertices= to - from;
if (verbose) elog_notify(0,"%s (%i nvertices)",name,nvertices);
poly=malloc(2 * nvertices * sizeof(double));
nv=0;
for (dbi.record=from; dbi.record<to; dbi.record++) {
dbgetv(dbi,0,
"regname",name,
"vertex",&vertex,
"lat",&lat,"lon",&lon,
0);
poly[nv].lat=lat;
poly[nv].lon=lon;
nv++;
}
writePolygonData(dbo,poly,nv,name,1,0,ptype,auth,dir,dfile,ftype);
free(poly);
}
/*
*/
return 0;
}
