/* Modified Dec. 2006: added two new Tbls for resid and slowness to
compute residuals only=tapro and tupro. */
int
load_observations ( Pf *pf, Dbptr db, Arr *arr_phase,
Arr **stationsp, Arr **arraysp, Tbl **tap, Tbl **tup ,
Tbl **tapro, Tbl **tupro)
{
Station *station ;
Seismic_Array *array ;
Arrival *a ;
Tbl *ta, *tu ,*taro, *turo;
Dbptr dbarr, dbsite ;
static Hook *hook = 0 ;
static Tbl *matching ;
Tbl *arrival_tbl ;
Arr *stations ;
Arr *arrays ;
int i, narr ;
char sta[32], iphase[32], timedef[16], azdef[16], slodef[16] ;
double time, deltim, azimuth, delaz, slow, delslo ;
int arid ;
Phase_handle *phase ;
Slowness_vector *u ;
int nobs = 0 ;
if ( *stationsp == 0 ) {
*stationsp = newarr(0) ;
*arraysp = newarr(0) ;
}
stations = *stationsp ;
arrays = *arraysp ;
ta = *tap = newtbl(0) ;
tu = *tup = newtbl(0) ;
taro = *tapro = newtbl(0) ;
turo = *tupro = newtbl(0) ;
dbarr = dblookup ( db, 0, "arrival", 0, "dbSCRATCH" ) ;
dbsite = dblookup ( db, 0, "site", 0, 0 ) ;
arrival_tbl = pfget_tbl(pf, "arrival_table");
narr = maxtbl(arrival_tbl);
for (i = 0; i < narr; i++) {
sscanf(gettbl(arrival_tbl, i),
"%d %s %s %lf %lf %s %lf %lf %s %lf %lf %s",
&arid,
sta,
iphase,
&time,
&deltim,
timedef,
&azimuth,
&delaz,
azdef,
&slow,
&delslo,
slodef
);
if ( (station = getarr ( stations, sta ) ) == 0 ) {
dbputv ( dbarr, 0, "sta", sta, "time", time, NULL ) ;
dbmatches ( dbarr, dbsite, 0, 0, &hook, &matching ) ;
if ( maxtbl(matching) < 1 ) {
char *t ;
complain ( 0, "No site table record for %s at time %s\n",
sta, t=strtime(time));
free(t) ;
continue ;
}
dbsite.record = (long) gettbl(matching, 0) ;
freetbl(matching,0) ;
allot ( Station *, station, 1 ) ;
allot ( Seismic_Array *, array, 1 ) ;
dbgetv ( dbsite, 0,
"sta", station->name, "lat", &station->lat, "lon", &station->lon, "elev", &station->elev, NULL ) ;
dbgetv ( dbsite, 0,
"sta", array->name, "lat", &array->lat, "lon", &array->lon, "elev", &array->elev, NULL ) ;
setarr (stations, sta, station ) ;
setarr (arrays, sta, array ) ;
} else {
int load_station_geometry(Dbptr db, Arr *a, double time)
{
Dbptr dbs;
int i,j,nset;
Tbl *t;
char *key;
int yrday;
Dbptr dbscr;
static Hook *hook=NULL;
Tbl *match_tbl;
MWstation *s;
int ondate,offdate;
char refsta[10]; /*This is used as input buffer that
is duped to store in each s object*/
char refsta0[10]; /* Used for comparison to guarantee there
is no change in refsta */
yrday = yearday(time);
t = keysarr(a);
db = dblookup(db,0,"site",0,0);
dbs = dblookup(db,0,"site",0,0);
dbs.record = dbSCRATCH;
dbaddnull(dbs);
for(i=0,nset=0;i<maxtbl(t);i++)
{
int nmatch;
key = gettbl(t,i);
s = (MWstation *)getarr(a,key);
dbputv(dbs,0,"sta",s->sta,0);
nmatch = dbmatches(dbs,db,0,0,&hook,&match_tbl);
if(nmatch == dbINVALID)
elog_die(0,"dbmatches error looking for entries for station %s\n",s->sta);
else if(nmatch < 1)
{
elog_notify(0,"load_station_geometry: cannot find station %s in site table -- deleted from geometry list\n",
s->sta);
delarr(a,s->sta);
free_MWstation(s);
}
else
{
/* when when there is only one match, we just use it, otherwise
we have to search for the correct entry based on ondate/offdate */
if(nmatch == 1)
{
db.record = (int )gettbl(match_tbl,0);
}
else
{
for(j=0;j<maxtbl(match_tbl);j++)
{
db.record = (int)gettbl(match_tbl,j);
if(dbgetv(db,0,"ondate",&ondate,
"offdate",&offdate,0)
== dbINVALID)
{
elog_notify(0,"load_station_geometry: dbgetv error while searching for ondate/offdate match for station %s\nBlundering on\n",
s->sta);
continue;
}
if((yrday >= ondate) && (yrday <= offdate)) break;
}
}
/* note if the date match fails,we still end up here
using the last record in the db */
freetbl(match_tbl,0);
if(dbgetv(db,0,
"lat",&(s->lat),
"lon",&(s->lon),
"elev",&(s->elev),
"dnorth",&(s->dnorth),
"deast",&(s->deast),
"refsta",refsta,
0) == dbINVALID)
{
elog_notify(0,"load_station_geometry: dbgetv error reading record %d for station %s in site table\nStation deleted from list\n",
db.record,s->sta);
delarr(a,s->sta);
free_MWstation(s);
}
else
{
if(nset==0) strcpy(refsta0,refsta);
s->refsta = strdup(refsta0);
if(!strcmp(s->sta,refsta0))
{
if(((s->dnorth)!=0.0)
|| ((s->deast)!=0.0))
elog_die(0,"load_station_geometry: reference station in site table must have dnorth and deast set to 0.0\nFound refstat = %s with (dnorth,deast)=(%lf,%lf)\n",
s->sta,s->dnorth,
s->deast);
++nset;
}
else
/* This deletes stations != refsta with dnorth
and deast not set properly. */
{
if(((s->dnorth)==0.0) && ((s->deast)==0.0))
{
elog_notify(0,"load_station_geometry: unset dnorth and deast entries for station %s\nStation deleted from list\n",
s->sta);
delarr(a,s->sta);
free_MWstation(s);
}
else if(strcmp(refsta0,refsta))
elog_die(0,"load_station_geometry: reference station change not allowed.\nAll stations to be processed must have a common refsta in site table\n");
else
++nset;
}
}
}
}
return(nset);
}
static int
write_cal2 (Dbptr db, double time, double endtime, double *calperp)
{
static Dbptr dbx = INVALID_DBPTR;
static double null_endtime = 0.0;
Dbptr dbcalibration;
long nmatches;
char sta[MAX_STA_SIZE],
chan[MAX_CHAN_SIZE],
units[16],
instype[16];
double calib,
calper=0;
long j;
int errors = 0;
Tbl *tbl;
static Hook *hook = 0;
char *ontime,
*offtime;
char *aux = "";
char *s,
*t;
char segtype;
double samprate;
if (dbx.database == dbINVALID) {
dbx = dblookup (db, 0, "wfdisc", 0, 0);
dbx.record = dbNULL;
dbgetv (dbx, 0, "endtime", &null_endtime, NULL);
dbx.record = dbSCRATCH;
}
dbgetv (db, 0, "sta", sta, "chan", chan, NULL);
dbputv (dbx, 0, "sta", sta, "chan", chan, "time", time, "endtime", endtime, NULL);
errors += get_instype (dbx, instype, &samprate);
dbcalibration = dblookup (db, 0, "calibration", 0, 0);
nmatches = dbmatches (dbx, dbcalibration, 0, 0, &hook, &tbl);
switch (nmatches) {
case dbINVALID:
case 0:
dbgetv (db, 0, "sta", sta, "chan", chan, "time", &time, NULL);
complain (0, "no matches in calibration table for %s:%s @ %s",
sta, chan, s = strydtime (time));
free (s);
break;
default:
dbgetv (db, 0, "sta", sta, "chan", chan, "time", &time, NULL);
complain (0, "too many matches (%ld) in calibration table for %s:%s @ %s - %s",
nmatches, sta, chan, s = strydtime (time), t = strydtime (endtime));
free (s);
free (t);
errors++;
/* FALLTHRU */
case 1:
dbcalibration.record = (long) gettbl (tbl, 0);
dbgetv (dbcalibration, 0,
"sta", sta,
"chan", chan,
"calib", &calib,
"calper", &calper,
"units", units,
NULL);
*calperp = calper;
for (j = 0; j < strlen (units); j++) {
units[j] = tolower (units[j]);
}
s = getarr (Segtype, units);
if (s == 0) {
segtype = 'D';
} else {
segtype = *s;
}
switch (segtype) {
case 'A':
calib *= SQR (calper / (2 * M_PI));
break;
case 'V':
calib *= calper / (2 * M_PI);
break;
default:
break;
}
ontime = epoch2str (time, "%Y/%m/%d %H:%M");
if (endtime == null_endtime) {
offtime = strdup ("");
} else {
offtime = epoch2str (endtime, "%Y/%m/%d %H:%M");
}
fprintf (stdout, "\nCAL2 %-5.5s %-3.3s %4.4s %-6.6s %15.8e %7.3f %11.5f %s %s\n",
sta, chan, aux, instype, calib, calper, samprate, ontime, offtime);
free (ontime);
free (offtime);
break;
}
freetbl (tbl, 0);
return errors;
}
static int
autodrm_response (Dbptr db)
{
Dbptr dbstage;
static Hook *hook = 0;
char sta[MAX_STA_SIZE],
chan[MAX_CHAN_SIZE];
double time,
endtime;
long stageid;
char *s;
Response *response;
Response_group *group;
char iunits[96],
ounits[96];
char gtype[100];
long i,
j;
Paz *paz;
Fir *fir;
Fap *fap;
Fap2 *fap2;
FILE *file;
double samprate,
gnom,
gcalib;
double calper=0.0;
long decifac;
char dir[100],
dfile[100];
char filename[STRSZ];
long nmatches;
int errors = 0;
Tbl *tbl,
*stbl;
double mintime=0,
maxtime=0;
char segtype;
static Tbl *keys1 = 0,
*keys2 = 0;
if (keys1 == 0) {
keys1 = strtbl ("sta", "chan", "time", NULL);
keys2 = strtbl ("sta", "chan", "time::endtime", NULL);
}
dbstage = dblookup (db, 0, "stage", 0, 0);
nmatches = dbmatches (db, dbstage, &keys1, &keys2, &hook, &tbl);
switch (nmatches) {
case dbINVALID:
case 0:
dbgetv (db, 0, "sta", sta, "chan", chan, "time", &time, NULL);
complain (0, "Can't match record for %s:%s @ %s in stage table",
sta, chan, s = strydtime (time));
free (s);
errors++;
break;
default:
stbl = newtbl (maxtbl (tbl));
for (i = 0; i < nmatches; i++) {
dbstage.record = (long) gettbl (tbl, i);
dbgetv (dbstage, 0,
"stageid", &stageid,
"time", &time,
"endtime", &endtime,
NULL);
if (i == 0) {
mintime = time;
maxtime = endtime;
} else {
mintime = MAX (time, mintime);
maxtime = MIN (endtime, maxtime);
}
settbl (stbl, stageid - 1, (char *) i);
}
if (maxtbl (tbl) != maxtbl (stbl)) {
dbgetv (db, 0, "sta", sta, "chan", chan, "time", &time, NULL);
complain (0, "stageid numbers for %s:%s @ %s don't add up.",
sta, chan, s = strydtime (time));
free (s);
errors++;
} else {
errors += write_cal2 (db, mintime, maxtime, &calper);
for (i = 0; i < nmatches; i++) {
j = (long) gettbl (stbl, i);
dbstage.record = (long) gettbl (tbl, j);
dbgetv (dbstage, 0,
"sta", sta,
"chan", chan,
"time", &time,
"endtime", &endtime,
"stageid", &stageid,
"decifac", &decifac,
"samprate", &samprate,
"gnom", &gnom,
"gcalib", &gcalib,
"dir", dir,
"dfile", dfile,
"gtype", gtype,
"iunits", iunits,
"ounits", ounits,
NULL);
if (gcalib > 0.0) {
gnom *= gcalib;
} else if (gcalib < 0.0) {
complain (0, "gcalib = %10.3f < 0. is invalid for %s:%s @ %s.\n",
gcalib, sta, chan, s = strydtime (time));
free (s);
errors++;
}
if (*dir != '-' || *dfile != '-') {
long mark;
dbextfile (dbstage, "stage", filename);
mark = elog_mark ();
elog_log (0, "response file is '%s'", filename);
if ((file = fopen (filename, "r")) == 0
|| read_response (file, &response) < 0) {
register_error (0,
"Can't read response file %s for %s_%s @ %s",
filename, sta, chan, s = strydtime (time));
free (s);
fclose (file);
errors++;
} else {
fclose (file);
if (response->ngroups > 1) {
register_error (0,
"stage response file %s has %d stages, not 1",
filename, response->ngroups);
errors++;
} else {
group = response->groups;
switch (group->id) {
case PAZ:
/* The normalization frequency chosen in the
* response file may not necessarily be the
* same as the one chosen by calibration
* table for insertion into the seed volumes.
* Consequently, we have to adjust the
* specified gnom to be correct for the seed
* normalization frequency. Since the gain
* is
*
* G(f) = gnom_db * A_response_file * P(f) =
* gnom_seed * A_seed * P(f)
*
* We have
*
* gnom_seed = gnom_db * A_response_file /
* A_seed
*
* gnom_db is just the gnom from the stage
* table. A_response_file is the
* normalization from the response file, left
* in the stage structure. Below, we
* calculate A_seed by setting
* A_response_file to 1.0.
*
*/
paz = (Paz *) group->pvt;
for (j = 0; j < strlen (iunits); j++) {
iunits[j] = tolower (iunits[j]);
}
s = getarr (Segtype, iunits);
if (s == 0) {
segtype = 'D';
} else {
segtype = *s;
}
adwrite_paz (stageid, 0, gnom, segtype, ounits, paz);
break;
case IIR:
paz = (Paz *) group->pvt;
for (j = 0; j < strlen (iunits); j++) {
iunits[j] = tolower (iunits[j]);
}
s = getarr (Segtype, iunits);
if (s == 0) {
segtype = 'D';
} else {
segtype = *s;
}
adwrite_paz (stageid, 1, gnom, segtype, ounits, paz);
break;
case FIR:
fir = (Fir *) group->pvt;
errors += adwrite_fir (stageid, gnom, fir);
break;
case FAP:
fap = (Fap *) group->pvt;
errors += adwrite_fap (stageid, ounits, fap);
break;
case FAP2:
fap2 = (Fap2 *) group->pvt;
errors += adwrite_fap2 (stageid, ounits, fap2);
break;
default:
complain (0, "Unknown filter type %d in response file %s\n",
group->id, filename);
errors++;
break;
}
}
}
elog_flush (mark, 0);
} else {
char *desc = "";
if (gcalib > 0.0) {
gnom *= gcalib;
} else if (gcalib < 0.0) {
complain (0, "gcalib = %10.3f < 0. is an invalid value.\n", gcalib);
errors++;
}
if (strcmp (gtype, "digitizer") == 0
/* following hack for psd2db */
|| strcmp (gtype, "sensor") == 0) {
fprintf (stdout, "DIG2 %2ld %15.8e %11.5f %s\n",
stageid, gnom, samprate, desc);
} else if (strcmp (gtype, "amplifier") == 0) {
/* no corners */
fprintf (stdout, "GEN2 %2ld %c %15.8e %7.3f 0 %s\n",
stageid, *ounits, gnom, calper, desc);
} else {
complain (0, "Unrecognized gtype='%s' for %s:%s @ %s",
gtype, sta, chan, s = strydtime (time));
free (s);
errors++;
}
}
}
}
freetbl (stbl, 0);
break;
}
freetbl (tbl, 0);
return errors;
}
int dbpmel_save_results(Dbptr db,
int nevents,
long *evid,
Hypocenter *h,
Tbl **ta,
Location_options o,
Pf *pf)
#endif
{
Dbptr dbe,dbo,dba,dboe;
Dbptr dbes,dbos,dbas;
Dbptr dbs; /* subset view created by dblist2subset */
Tbl *opat,*aspat,*aspat2;
Tbl *matches=NULL,*match2; /* output list of matching records */
/* Dan Q advises it is wise to have a separate hook for each
table passed through dbmatches */
Hook *hooke=NULL,*hooko=NULL,*hooka=NULL,*hooka2=NULL;
long prefor;
int i,j;
char *auth;
Arrival *a;
long orid;
int nmatch;
double **C;
float emodel[4];
char *alg=(char *)strdup("dbpmel");
/* A collection of variables from assoc that have to be
copied. Earlier algorithm using dbget raw on a subset
view failed so I have to copy by this mechanism */
double belief;
char timedef[2],slodef[2],azdef[2];
double azres,slores,emares;
Tbl *utbl;
/* This is needed as a stub for the predicted_error function.
Because we don't support slowness vector data in pmel this
has to be an empty (NOT NULL) tbl list */
utbl=newtbl(0);
/* All of these are used repeatedly so we do one lookup at the
top */
dbe = dblookup(db,0,"event",0,0);
dbo = dblookup(db,0,"origin",0,0);
dba = dblookup(db,0,"assoc",0,0);
dboe = dblookup(db,0,"origerr",0,0);
dbes = dblookup(db,0,"event",0,0);
dbos = dblookup(db,0,"origin",0,0);
dbas = dblookup(db,0,"assoc",0,0);
dbes.record = dbSCRATCH;
dbos.record = dbSCRATCH;
dbas.record = dbSCRATCH;
opat = strtbl("orid",NULL );
aspat = strtbl("orid",NULL );
aspat2 = strtbl("arid","orid","sta",NULL );
auth = pfget_string(pf,"author");
C = dmatrix(0,3,0,3);
/* outer loop over nevents */
for(i=0;i<nevents;++i)
{
double conf;
char *modtype;
int model;
double smajax,sminax,strike,sdepth,stime;
int rc;
/* Save nothing for events marked no use */
if(h[i].used==0) continue;
/* Start with event table to get prefor */
dbputv(dbes,0,"evid",evid[i],NULL );
dbe.record = dbALL;
if(dbmatches(dbes,dbe,0,0,&hooke,&matches)!=1)
elog_complain(0,"WARNING: multiple records in event table have evid=%ld.\nThis is a serious database problem that should be corrected. Using first one found in table\n",
evid[i]);
dbe.record = (long)gettbl(matches,0);
/* this is excessively paranoid, but better safe than sorry*/
if(dbe.record<0)
{
elog_complain(0,"dbmatches invalid record %ld\nSkip saving evid %ld\n",
dbe.record,evid[i]);
continue;
}
dbgetv(dbe,0,"prefor",&prefor,NULL );
freetbl(matches,0);
matches=NULL;
dbputv(dbos,0,"orid",prefor,NULL );
dbo.record = dbALL;
nmatch=dbmatches(dbos,dbo,&opat,&opat,&hooko,&matches);
if(nmatch>1)
elog_complain(0,"WARNING: multiple records in origin table match orid=%ld.\nThis is a serious database problem that should be corrected. Using first one found in table\n",
prefor);
else if(nmatch<=0)
{
elog_complain(0,"Cannot find matching origin\
record for orid %ld prefor of event %ld\n",
prefor,evid[i]);
}
dbo.record = (long)gettbl(matches,0);
if(dbget(dbo,0)==dbINVALID)
{
elog_complain(0,"dbget error on origin table for orid %ld\nData for evid %ld will not be saved\n",
prefor,evid[i]);
continue;
}
freetbl(matches,0);
matches=NULL;
/* origerr code cloned from dbgenloc */
conf = pfget_double(pf,"confidence");
modtype = pfget_string(pf,"ellipse_type");
if(modtype == NULL)
{
elog_complain(0,"parameter ellipse_type not defined--default to chi_square");
model = CHI_SQUARE;
}
else if( strcmp( modtype, "chi_square" ) == 0 )
{
model = CHI_SQUARE;
}
else if( strcmp( modtype, "F_dist" ) == 0 )
{
model = F_DIST;
}
else
{
elog_complain(0, "parameter ellipse_type %s incorrect (must be F_dist or chi_square)--default to chi_square", modtype );
model = CHI_SQUARE;
}
predicted_errors(h[i],ta[i],utbl,o,C,emodel);
rc = project_covariance( C, model, &conf,
h[i].rms_weighted, h[i].degrees_of_freedom,
&smajax, &sminax, &strike, &sdepth, &stime );
if( rc != 0 )
{
elog_complain(0, "project_covariance failed." );
smajax = -1;
sminax = -1;
strike = -1;
sdepth = -1;
stime = -1;
conf = 0.;
}
orid = dbnextid(dbo,"orid");
if(dbaddv(dboe,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", h[i].rms_raw,
"smajax", smajax,
"sminax", sminax,
"strike", strike,
"sdepth", sdepth,
"stime", stime,
"conf", conf,
NULL ) < 0 )
{
elog_complain(0,"Problem adding origerr record for evid %ld\n",
evid[i]);
}
/* This edits the scratch record and adds it to the end
of the origin table */
dbputv(dbos,0,"orid",orid,
"lat",h[i].lat,
"lon",h[i].lon,
"depth",h[i].z,
"time",h[i].time,
"algorithm",alg,
"auth",auth,NULL );
/*
printf("Added to origin table: %8d %9.4lf %9.4lf %9.4lf"
" %17.5lf %-15s %-15s\n", orid, h[i].lat,
h[i].lon, h[i].z, h[i].time, alg, auth);
*/
if(dbadd(dbo,0)==dbINVALID)
elog_complain(0,"dbadd error for origin table\
for new orid %ld of evid %ld\n",
orid,evid[i]);
/* The assoc tables is much more complex. Rather than
do a row for row match against each arrival in ta, I
use a staged reduction. Than is I first match the full
assoc table against orid=prefor only to get a full list
of records for that event. We then run matches against
the smaller table for sta/phase in the arrival list.
Untested but from previous experience with dbmatches on
large tables I'm fairly sure this is a necessary
complication to keep this from be very slow*/
dbputv(dbas,0,"orid",prefor,NULL );
dba.record = dbALL;
nmatch=dbmatches(dbas,dba,&aspat,&aspat,&hooka,&matches);
if(nmatch<=0)
{
elog_complain(0,"No assoc records for orid %ld\
found\nFail to create new assoc records for orid %ld\n",
prefor,orid);
freetbl(matches,0);
continue;
}
