int
add_latencies ( Arr * networks )
{
char * net;
char * sta;
char * statime;
Arr * stations;
Arr * sinfo;
Arr * network;
Tbl * stas;
Tbl * nets;
Pf * oldval;
int numstas;
int numnets;
int i, j;
int min = MAXINT;
int max = 0;
nets = keysarr( networks );
numnets = maxtbl( nets );
for ( i = 0; i < numnets; i++ )
{
net = gettbl( nets, i );
network = getpf( networks, net );
stations = getpf( network, STALIST );
stas = keysarr( stations );
numstas = maxtbl( stas );
for ( j = 0, min=MAXINT, max=0; j < numstas; j++ )
{
sta = gettbl( stas, j );
sinfo = getpf( stations, sta );
statime = get_station_field( sinfo, LATENCY );
if ( statime && ( atoi( statime ) < min ) )
min = atoi( statime );
if ( statime && ( atoi( statime ) > max ) )
max = atoi( statime );
}
freetbl( stas, 0 );
oldval = setarr( network, MINNETLATENCY,
create_pf( itoa(min), PFSTRING ) );
if ( oldval ) recurse_free_pf( oldval );
oldval = setarr( network, MAXNETLATENCY,
create_pf( itoa(max), PFSTRING ) );
if ( oldval ) recurse_free_pf( oldval );
}
freetbl( nets, 0 );
return 1;
}
/* companion to the above, but this version will copy entries in
*in to *o. Errors are issued only if *o does not contain an entry
for the same key as *in. If *o is null the dup function above
is called and the function returns immediately after returning
from it.
*/
void copy_arrival_array(Arr *in,Arr **o)
{
Tbl *t;
double *value,*copy;
char *key;
int i;
if((*o) == NULL)
{
*o = newarr(0);
dup_arrival_array(in,o);
}
else
{
t = keysarr(in);
for(i=0;i<maxtbl(t);++i)
{
key = gettbl(t,i);
value = (double *)getarr(in,key);
copy = (double *)getarr(*o,key);
if(copy == NULL)
{
setarr(*o,key,value);
}
else
{
*copy = *value;
}
}
freetbl(t,0);
}
}
/* This function is used to exactly duplicate the arrival array of doubles from
i to o. If *o is not a null pointer it is assumed the arr already
exists and freearr is called to clear it's contents before
calling setarr to copy contents.*/
void dup_arrival_array(Arr *in,Arr **o)
{
Tbl *t;
double *value,*copy;
char *key;
int i;
if((*o) == NULL)
*o = newarr(0);
else
{
freearr(*o,free);
*o=newarr(0);
}
t = keysarr(in);
for(i=0;i<maxtbl(t);++i)
{
key = gettbl(t,i);
value = (double *)getarr(in,key);
allot(double *,copy,1);
*copy = *value;
setarr(*o,key,copy);
}
freetbl(t,0);
}
void MWcheck_timing(Arr *a,Arr *arrsta,Arr *bcarr)
{
Tbl *stakeys;
char *name;
int i;
stakeys = keysarr(a);
for(i=0;i<maxtbl(stakeys);++i)
{
Bad_Clock *bc;
MWstation *sta;
double *atime;
name=gettbl(stakeys,i);
bc=(Bad_Clock *)getarr(bcarr,name);
sta=(MWstation *)getarr(arrsta,name);
if(sta==NULL)
elog_complain(0,"MWcheck_timing: no match in station table for arrival at station %s\n",name);
else
{
if(bc==NULL)
sta->clock_is_bad=0;
else
{
atime = (double *)getarr(a,name);
if(clock_is_bad(bc->badtimes,*atime))
sta->clock_is_bad=1;
else
sta->clock_is_bad=0;
}
}
}
}
static int
dbrows2orb(Dbptr db, int orb, char *prefix)
{
Packet *pkt;
char srcname[ORBSRCNAME_SIZE];
double time;
char *packet;
int nbytes, packetsize = 0;
Dbptr tmpdb;
long t, nrecords, r, ntables;
Arr *records = NULL;
Tbl *tables = NULL, *static_tables;
char *thistablename;
Stbl *stbl;
char *s;
dbuntangle(db, &records);
tables = keysarr(records);
ntables = maxtbl(tables);
if (ntables > 0)
pkt = newPkt();
if (prefix)
strncpy(pkt->parts.src_net, prefix, PKT_TYPESIZE);
pkt->pkttype = suffix2pkttype("db");
for (t = 0; t < ntables; t++) {
thistablename = gettbl(tables, t);
tmpdb = dblookup(db, 0, thistablename, 0, 0);
stbl = (Stbl *) getarr(records, thistablename);
nrecords = maxstbl(stbl);
if (nrecords > 0) {
for (r = 0; r < nrecords; r++) {
tmpdb.record = (long) getstbl(stbl, r);
pkt->db = tmpdb;
if (stuffPkt(pkt, srcname, &time, &packet, &nbytes, &packetsize) < 0) {
elog_complain(0, "stuffPkt fails for pf packet");
return (-1);
}
if (orbput(orb, srcname, time, packet, nbytes) < 0) {
elog_complain(0, "Couldn't send packet to orb\n");
return (-1);
}
}
}
}
freetbl(tables, 0);
dbfree_untangle(records);
freePkt(pkt);
if (verbose) {
elog_notify(0, "%s: %d patcket(s) sent with sourcename: %s\n", s = strtime(now()), nrecords, srcname);
free(s);
}
return (0);
}
static PyObject *
pf2PyObject( Pf *pf )
{
PyObject *obj;
Pf *pfvalue;
Tbl *keys;
char *key;
int ivalue;
switch( pf->type ) {
case PFSTRING:
obj = string2PyObject( pfexpand( pf ) );
break;
case PFTBL:
obj = PyTuple_New( pfmaxtbl( pf ) );
for( ivalue = 0; ivalue < pfmaxtbl( pf ); ivalue++ ) {
pfvalue = (Pf *) gettbl( pf->value.tbl, ivalue );
PyTuple_SetItem( obj, ivalue, pf2PyObject( pfvalue ) );
}
break;
case PFFILE:
case PFARR:
keys = keysarr( pf->value.arr );
obj = PyDict_New();
for( ivalue = 0; ivalue < maxtbl( keys ); ivalue++ ) {
key = gettbl( keys, ivalue );
pfvalue = (Pf *) getarr( pf->value.arr, key );
PyDict_SetItem( obj, Py_BuildValue( "s", key ), pf2PyObject( pfvalue ) );
}
break;
case PFINVALID:
default:
obj = (PyObject *) NULL;
break;
}
return obj;
}
int
sinfo_update ( Arr * sold, Arr * snew )
{
int i;
int n1, n2;
int numfields;
char * field;
char * value;
char * newval;
char * oldval;
int newp, oldp;
Tbl * fields;
fields = keysarr( getpf( snew, FIELDS ) );
numfields = maxtbl( fields );
for ( i = 0; i < numfields; i++ )
{
field = (char*) poptbl( fields );
value = get_station_field( snew, field );
oldval = get_station_field( sold, field );
if ( strcmp( field, LATENCY ) == 0 )
{
newp = atoi( getpf( snew, LATENCY_ORDER ) );
oldp = atoi( getpf( sold, LATENCY_ORDER ) );
if ( ( !oldp && newp ) || ( newp < oldp ) )
{
set_station_field( sold, field, strdup(value) );
setarr( sold, LATENCY_ORDER, create_pf( itoa(newp), PFSTRING ) );
}
else if ( ( ( newp == oldp ) || ( !newp && !oldp ) ) &&
( atoi( value ) < atoi( oldval ) ) )
{
set_station_field( sold, field, strdup(value) );
setarr( sold, LATENCY_ORDER, create_pf( itoa(newp), PFSTRING ) );
}
}
else
/* If this is a channels value, we want to merge the values */
if ( strcmp( field, NUMCHANS ) == 0 )
{
(!value)? (n1 = 0): (n1 = atoi( value ));
(!oldval)? (n2 = 0): (n2 = atoi( oldval ));
set_station_field( sold, field, itoa( n1 + n2 ) );
}
else
if ( value != NULL )
set_station_field( sold, field, strdup(value) );
}
freetbl( fields, 0 );
return 1;
}
char *get_refsta(Arr *s)
{
char *ref;
MWstation *station;
char *key;
Tbl *t;
t = keysarr(s);
key = gettbl(t,0);
station = (MWstation *) getarr(s,key);
ref = strdup(station->refsta);
freetbl(t,0);
return(ref);
}
/* Creates an associative array of column index positions using
pattern from associative array of Station structures keyed by sta name.
The order will be controlled by what keysarr gives. Note we use
pointers to int to store column indexes because getarr from this
array signals a error with a NULL. If we used an int I can't see
how we could tell this from 0, which is a valid column index and
will, in fact, always be in the resultant.
Arguments:
sa - associative array of Station * that are counted to
produce output indices.
Returns an associative array keyed by station names that hold
indices to column positions. These are basically count order
from sa input.
Author: G Pavlis
Written: October 2000
*/
Arr *create_sta_index(Arr *sa)
{
int *cindex;
int i;
Arr *aout;
Tbl *keys;
char *sta;
aout = newarr(0);
keys = keysarr(sa);
for(i=0;i<maxtbl(keys);++i)
{
sta = gettbl(keys,i);
allot(int *,cindex,1);
*cindex = i;
setarr(aout,sta,cindex);
}
return(aout);
}
int
clrarr( Arr * arr, void (*free_value )() )
{
Tbl * tbl;
char * key;
void * oldval;
int size;
int i;
tbl = keysarr( arr );
size = maxtbl( tbl );
for ( i = 0; i < size; i++ )
{
key = poptbl( tbl );
oldval = delarr( arr, key );
if ( oldval ) free_value( oldval );
}
freetbl( tbl, 0 );
return 1;
}
/* 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);
}
/* Recursively removes pf instances from the pf object and returns the
* objects' contents in an entirely new structure so that no memory is reused.
* Requires the caller have some knowledge about the structure of the data. */
void *
pf_collapse( Pf * pf )
{
Arr * currarr;
Tbl * currtbl;
char * key;
void * value;
int i;
int size;
if ( pf == NULL ) return NULL;
switch( pf->type )
{
case PFARR: currtbl = keysarr( pf->value.arr );
size = maxtbl( currtbl );
/* currarr = newarr( pf->value.arr->rb_comp ); */
currarr = newarr( strcmp );
for ( i = 0; i < size; i++ )
{
key = poptbl( currtbl );
value = pf_collapse( getarr( pf->value.arr, key ) );
setarr( currarr, key, value );
}
freetbl( currtbl, 0 );
return currarr;
case PFTBL: size = maxtbl( pf->value.tbl );
currtbl = newtbl( size );
for ( i = 0; i < size; i++ )
settbl( currtbl, i,
pf_collapse( gettbl( pf->value.tbl, i ) ) );
return currtbl;
default: return strdup( pf->value.s );
}
}
/* To avoid having station corrections on top of other station corrections
we need to make sure the station correction portion of each phase
handle is cleared. This is done with a simple freearr on the station
correction associative array.
Arguments:
pha - associative array of phase handle keyed by phase name.
Author: Gary Pavlis
Written: October 2000
*/
void clear_station_corrections(Arr *pha)
{
int i;
Phase_handle *p;
Tbl *keys;
char *phase;
keys = keysarr(pha);
for(i=0;i<maxtbl(keys);++i)
{
phase = gettbl(keys,i);
p = (Phase_handle *)getarr(pha,phase);
if(cntarr(p->time_station_corrections)>0)
{
elog_notify(0,"Clearing time station correction for phase %s\nConsider editing your parameter file for this program\n",
phase);
freearr(p->time_station_corrections,free);
p->time_station_corrections=newarr(0);
}
}
freetbl(keys,0);
}
/* This function computes theoretical arrival times and a slowness vector
(at the reference station for an array) based on a model and method
defined in a parameter file and using the generic travel time interface
of datascope/antelope.
Arguments:
///inputs////
stations - Associative array of MWstation objects used in
multiwavelet programs
refsta - name of reference station to use. The slowness
vector is computed based on a source location accessed
through the db pointer (see below) and the location of
the reference station. If the refsta is not found in
the stations array the first element of the sorted list
of stations will be used in an attempt to recover. For
most arrays this would be a minor error.
phase - name of seismic phase to compute theoretical times and
slowness vector for.
db - This db pointer MUST point to a single row of a db view with
the origin table joined as part of the view. The hypocenter
information is read with dbgetv passing this db pointer
directly.
pf - parameter space pointer. We search for model and method
fields from pf to get the interface right.
///outputs///
times - associative array keyed by station name of theoretical
arrival times (stored as double * s). If there are
problems computing any travel times they will be absent
from this array. When this array is used, be aware you
can't assume all the times are filled.
slow - theoretical slowness vector. If the slowness vector
calculation fails this is set to 0 and the refsta field
is set to "BAD". This allows the use of the slowness
vector without errors in a less than ideal way. The
BAD condition should be trapped.
Return codes:
0 = normal return, no problems
> 0 = count of travel time failures
< 0 = nothing was computed. Both slowness and times should be
assumed invalid.
Author: Gary Pavlis
Written: December 2000
*/
static Hook *hook=0; /*Used by ttcalc */
int MWget_model_tt_slow(Arr *stations,
char *refsta,
char *phase,
Dbptr db,
Pf *pf,
Arr **times,
MWSlowness_vector *slow)
{
Tbl *t; /* used to hold keys with keysarr */
char *key; /* key returned from Tbl *t */
int i;
MWstation *s, *s0;
char *model;
char *method;
TTGeometry geometry;
TTTime *atime;
TTSlow *u0,*u;
Tbl *treturn=NULL,*ureturn=NULL;
int error_count=0;
double *twork;
s0 = (MWstation *)getarr(stations,refsta);
if(s0 == NULL) elog_complain(0,"MWget_model_tt_slow: cannot find reference station %s\nWill arbitarily pick first station found as refererence for computing model based time and slowness\n",refsta);
if(dbgetv(db,0,"origin.lat",&(geometry.source.lat),
"origin.lon",&(geometry.source.lon),
"origin.depth",&(geometry.source.z),
"origin.time",&(geometry.source.time),0) == dbINVALID)
{
elog_complain(0,"MWget_model_tt_slow: dbgetv error reading origin data\nCannot compute theoretical arrival times and slowness\n");
return(-1);
}
model = pfget_string(pf,"TTmodel");
method = pfget_string(pf,"TTmethod");
if( (model == NULL) || (method == NULL) )
{
elog_complain(0,"MWget_model_tt_slow: TTmodel or TTmethod missing from parameter file\nCannot compute theoretical travel times and slowness vector\n");
return(-1);
}
t = keysarr(stations);
if(maxtbl(t)<=0)
{
elog_complain(0,"MWget_model_tt_slow: no data to process\n");
return(-1);
}
/* recover from reference station error */
if(s0==NULL)
{
key = gettbl(t,0);
elog_log(0,"Setting reference station to %s for travel time computation\n",
key);
}
/* We now compute the slowness vector estimated for the reference
station location at 0 elevation. */
strcpy(geometry.receiver.name,s0->sta);
geometry.receiver.lat = s0->lat;
geometry.receiver.lon = s0->lon;
geometry.receiver.z = 0.0;
if(slow->refsta == NULL) slow->refsta = strdup(refsta);
if(ucalc(method,model,phase,0,&geometry,&ureturn,&hook))
{
elog_complain(0,"MWget_model_tt_slow: slowness vector calculation failed for reference station %s\nSetting model slowness vector to zero and attempting to continue.\n",
s0->sta);
slow->ux = 0.0;
slow->uy = 0.0;
}
else
{
u0 = (TTSlow *)gettbl(ureturn,0);
slow->ux = u0->ux;
slow->uy = u0->uy;
}
/* If the output times array is not empty we have to free it up
and start fresh. Otherwise we will have a memory leak or access
old values stored there. This probably should be handled
externally, but better to be redundant.*/
if(*times != NULL) freearr(*times,free);
*times = newarr(0);
/* Look through the station list */
for(i=0;i<maxtbl(t);i++)
{
double estatic;
key = gettbl(t,i);
s = (MWstation *)getarr(stations,key);
strcpy(geometry.receiver.name,s->sta);
geometry.receiver.lat = s->lat;
geometry.receiver.lon = s->lon;
geometry.receiver.z = 0.0;
if(ttcalc(method,model,phase,0,&geometry,&treturn,&hook))
{
elog_complain(0,"MWget_model_tt_slow: Travel time computation failed computing travel time for station %s\nCannot compute residuals\n",
s->sta);
++error_count;
}
else
{
atime = (TTTime *)gettbl(treturn,0);
estatic = compute_elevation_static(s,*slow,0.0,phase);
allot(double *,twork,1);
*twork = geometry.source.time
+ (atime->value) + estatic;
setarr(*times,key,twork);
}
}
freetbl(ureturn,0);
freetbl(treturn,0);
return(error_count);
}
int
main( int argc, char **argv )
{
int c;
int errflag = 0;
int orb;
int stop = 0;
long nrecs;
char *match = ".*/pf/st";
char *from = 0;
char *statefile = 0;
char *pfname = "orb2rrdc";
char *orbname;
char *dbcache;
char *rrdtool;
char command[STRSZ];
char net[STRSZ];
char sta[STRSZ];
char rrdvar[STRSZ];
char key[STRSZ];
char path[FILENAME_MAX];
Dbptr db;
Dbptr dbt;
Pf *pf;
char *Default_network;
Tbl *dlslines;
Arr *Dls_vars_dsparams;
Arr *Dls_vars_rras;
Tbl *Dls_vars_keys;
char *line;
char *dls_var;
char *dsparams;
Tbl *rras;
int i;
int j;
OrbreapThr *ort;
int pktid;
char srcname[ORBSRCNAME_SIZE];
double time = 0;
char *packet = 0;
int nbytes = 0;
int bufsize = 0;
Packet *pkt = 0;
int rc;
char *s;
Pf *dlspf;
Tbl *dlspfkeys;
char *element;
Tbl *parts;
double val;
Pf *pfval = 0;
elog_init( argc, argv );
while( ( c = getopt( argc, argv, "vVd:s:p:m:f:" ) ) != -1 ) {
switch( c ) {
case 'd':
CacheDaemon = optarg;
break;
case 'f':
from = optarg;
break;
case 'm':
match = optarg;
break;
case 'p':
pfname = optarg;
break;
case 's':
statefile = optarg;
break;
case 'v':
Verbose++;
break;
case 'V':
VeryVerbose++;
Verbose++;
break;
default:
elog_complain( 0, "Unknown option '%c'\n", c );
errflag++;
break;
}
}
if( errflag || argc - optind != 2 ) {
usage();
}
if( Verbose ) {
elog_notify( 0, "Starting at %s (%s $Revision$ $Date$)\n",
zepoch2str( str2epoch( "now" ), "%D %T %Z", "" ),
Program_Name );
}
orbname = argv[optind++];
dbcache = argv[optind++];
pfread( pfname, &pf );
rrdtool = pfget_string( pf, "rrdtool" );
if( rrdtool == NULL || ! strcmp( rrdtool, "" ) ) {
elog_die( 0, "Error: no rrdtool executable name specified in parameter file\n" );
} else if( ( rrdtool[0] == '/' && ! is_present( rrdtool ) ) || ( rrdtool[0] != '/' && ! datafile( "PATH", rrdtool ) ) ) {
elog_die( 0, "Error: can't find rrdtool executable by name of '%s' (check PATH environment "
"variable, or absolute path name if given)\n", rrdtool );
} else if( rrdtool[0] == '/' ) {
sprintf( command, "%s -", rrdtool );
} else {
sprintf( command, "rrdtool -" );
}
Suppress_egrep = pfget_string( pf, "suppress_egrep" );
if( Suppress_egrep != NULL && strcmp( Suppress_egrep, "" ) ) {
if( ! datafile( "PATH", "egrep" ) ) {
elog_complain( 0, "Ignoring suppress_egrep parameter: can't find egrep on path\n" );
} else {
sprintf( command, "%s 2>&1 | egrep -v '%s'", command, Suppress_egrep );
}
}
if( VeryVerbose ) {
elog_notify( 0, "Executing command: %s\n", command );
}
Rrdfp = popen( command, "w" );
if( Rrdfp == (FILE *) NULL ) {
elog_die( 0, "Failed to open socket to rrdtool command\n" );
}
orb = orbopen( orbname, "r&" );
if( orb < 0 ) {
elog_die( 0, "Failed to open orb '%s' for reading. Bye.\n", orbname );
}
orbselect( orb, match );
if( from != NULL && statefile == NULL ) {
pktid = orbposition( orb, from );
if( Verbose ) {
elog_notify( 0, "Positioned to packet %d\n", pktid );
}
} else if( from != NULL ) {
elog_complain( 0, "Ignoring -f in favor of existing state file\n" );
}
if( statefile != NULL ) {
stop = 0;
exhume( statefile, &stop, 15, 0 );
orbresurrect( orb, &pktid, &time );
if( Verbose ) {
elog_notify( 0, "Resurrecting state to pktid %d, time %s\n",
pktid, s = strtime( time ) );
free( s );
}
orbseek( orb, pktid );
}
dbopen( dbcache, "r+", &db );
if( db.database < 0 ) {
elog_die( 0, "Failed to open cache database '%s'. Bye.\n", dbcache );
} else {
db = dblookup( db, "", "rrdcache", "", "" );
if( db.table < 0 ) {
elog_die( 0, "Failed to lookup 'rrdcache' table in '%s'. Bye.\n", dbcache );
}
}
dbcrunch( db );
dbt = dbsubset( db, "endtime == NULL", NULL );
Rrd_files = newarr( 0 );
dbquery( dbt, dbRECORD_COUNT, &nrecs );
for( dbt.record = 0; dbt.record < nrecs; dbt.record++ ) {
dbgetv( dbt, 0, "net", &net, "sta", &sta, "rrdvar", &rrdvar, NULL );
dbfilename( dbt, (char *) &path );
sprintf( key, "%s:%s:%s", net, sta, rrdvar );
if( ! is_present( path ) ) {
elog_complain( 0, "WARNING: rrd file '%s', listed in database, does not exist. "
"Removing database entry.\n", path );
dbmark( dbt );
} else {
setarr( Rrd_files, key, strdup( path ) );
if( VeryVerbose ) {
elog_notify( 0, "Re-using rrd file '%s' for '%s'\n", path, key );
}
}
}
Rrdfile_pattern = pfget_string( pf, "rrdfile_pattern" );
Status_stepsize_sec = pfget_double( pf, "status_stepsize_sec" );
Default_network = pfget_string( pf, "default_network" );
dlslines = pfget_tbl( pf, "dls_vars" );
Dls_vars_dsparams = newarr( 0 );
Dls_vars_rras = newarr( 0 );
for( i = 0; i < maxtbl( dlslines ); i++ ) {
line = gettbl( dlslines, i );
strtr( line, "\t", " " );
rras = split( line, ' ' );
dls_var = shifttbl( rras );
dsparams = shifttbl( rras );
setarr( Dls_vars_dsparams, dls_var, dsparams );
setarr( Dls_vars_rras, dls_var, rras );
}
ort = orbreapthr_new( orb, -1., 0 );
for( ; stop == 0; ) {
orbreapthr_get( ort, &pktid, srcname, &time, &packet, &nbytes, &bufsize );
if( statefile ) {
rc = bury();
if( rc < 0 ) {
elog_complain( 0, "Unexpected failure of bury command! "
"(are there two orb2rrdc's running with the same state"
"file?)\n" );
clear_register( 1 );
}
}
rc = unstuffPkt( srcname, time, packet, nbytes, &pkt );
if( rc == Pkt_pf ) {
if( VeryVerbose ) {
/* Parameter files generally too big for elog */
fprintf( stderr, "Received a parameter-file '%s' at %s\n%s\n\n",
srcname,
s = strtime( time ),
pf2string( pkt->pf ) );
free( s );
} else if( Verbose ) {
elog_notify( 0, "Received a parameter-file '%s' at %s\n",
srcname, s = strtime( time ) );
free( s );
}
pfmorph( pkt->pf );
if( VeryVerbose ) {
fprintf( stderr, "Morphed parameter-file '%s' to interpret 'opt':\n%s\n\n",
srcname,
pf2string( pkt->pf ) );
}
pfget( pkt->pf, "dls", (void **) &dlspf );
dlspfkeys = pfkeys( dlspf );
Dls_vars_keys = keysarr( Dls_vars_dsparams );
for( i = 0; i < maxtbl( dlspfkeys ); i++ ) {
element = gettbl( dlspfkeys, i );
if( strcontains( element, "_", 0, 0, 0 ) ) {
parts = split( (s = strdup( element )), '_' );
sprintf( net, "%s", (char *) gettbl( parts, 0 ) );
sprintf( sta, "%s", (char *) gettbl( parts, 1 ) );
free( s );
freetbl( parts, 0 );
} else {
sprintf( net, "%s", Default_network );
sprintf( sta, "%s", element );
}
for( j = 0; j < maxtbl( Dls_vars_keys ); j++ ) {
dls_var = gettbl( Dls_vars_keys, j );
sprintf( key, "%s{%s}", element, dls_var );
if( pfresolve( dlspf, key, 0, &pfval ) < 0 ) {
elog_complain( 0, "Unable to extract variable '%s' "
"(not present or wrong type) from element '%s' "
"in packet from '%s', timestamped '%s'; Skipping\n",
key, element, srcname, s = strtime( time ) );
free( s );
pfval = 0;
continue;
} else if( pfval != (Pf *) NULL &&
pfval->value.s != (char *) NULL &&
! strcmp( pfval->value.s, "-" ) ) {
if( VeryVerbose ) {
elog_notify( 0, "Non-floating point value '-' in variable '%s', "
"in packet from '%s', timestamped '%s'; Skipping data point\n",
key, srcname, s = strtime( time ) );
free( s );
}
continue;
} else {
val = pfget_double( dlspf, key );
}
archive_dlsvar( db, net, sta, dls_var,
(char *) getarr( Dls_vars_dsparams, dls_var ),
(Tbl *) getarr( Dls_vars_rras, dls_var ),
time, val );
}
}
freetbl( dlspfkeys, 0 );
freetbl( Dls_vars_keys, 0 );
} else if( rc == Pkt_stash ) {
; /* Do nothing */
} else {
if( Verbose ) {
elog_notify( 0, "Received a packet that's not a parameter file "
"(type '%d' from unstuffPkt); skipping\n", rc );
}
}
}
}
void save_assoc(Tbl *ta, Tbl *tu,
int orid, char *vmodel, Hypocenter hypo,
Dbptr db, int orb)
{
double delta;
double seaz;
double esaz;
double azres;
double slores;
Arr *u_arr;
char key_arid[20];
Tbl *udregs;
int i,n;
double ux, uy, azimuth;
double duphi;
Arrival *a;
Slowness_vector *u;
/* We build an associative array keyed to arid for
all the slowness vector measurements.
Then in the loop below we can efficiently find any
slowness vectors associated with the same arid as
an Arrival. The overhead in this is significant, but
it makes it completely general and open ended. */
n = maxtbl(tu);
u_arr = newarr(0);
for(i=0;i<n;i++)
{
Slowness_vector *utmp;
utmp = (Slowness_vector *)gettbl(tu,i);
sprintf(key_arid,"%d",utmp->arid);
setarr(u_arr,key_arid,utmp);
}
db = dblookup(db,0,"assoc",0,0);
db.record = dbSCRATCH;
n=maxtbl(ta);
for(i=0;i<n;i++)
{
a=(Arrival*)gettbl(ta,i);
dist(rad(hypo.lat),rad(hypo.lon),
rad(a->sta->lat),rad(a->sta->lon),&delta,&esaz);
dist(rad(a->sta->lat),rad(a->sta->lon),
rad(hypo.lat),rad(hypo.lon),&delta,&seaz);
sprintf(key_arid,"%d",a->arid);
u = (Slowness_vector *) getarr(u_arr,key_arid);
if(u == NULL)
{
if(dbputv(db,0,
"orid",orid,
"arid",a->arid,
"sta",a->sta->name,
"phase",a->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timeres",(double)a->res.raw_residual,
"timedef","d",
"vmodel",vmodel,
"wgt",(double)a->res.residual_weight,
0)<0)
{
elog_complain(0,
"Can't add assoc record for station %s arid = %d orid = %d to working db scratch record\nRecord skipped and not saved anywhere\n",
a->sta->name,a->arid,orid);
continue;
}
}
else
{
slores = deg2km(sqrt(sqr(u->xres.raw_residual)
+ sqr(u->yres.raw_residual)));
azimuth = atan2 ( u->uy, u->ux ) ;
duphi = (u->ux*cos(azimuth)
- u->uy*sin(azimuth))
/ sqrt(sqr(u->ux)+ sqr(u->uy)) ;
azres = deg(duphi);
if(dbputv(db,"assoc",
"orid",orid,
"arid",a->arid,
"sta",a->sta->name,
"phase",a->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timeres",(double)a->res.raw_residual,
"timedef","d",
"vmodel",vmodel,
"slores",slores,
"slodef","d",
"azres",azres,
"azdef","d",
"wgt",(double)a->res.residual_weight,
0)<0)
{
elog_complain(0,
"Can't add assoc record for station %s arid = %d orid = %d to working db scratch record\nRecord skipped and not saved anywhere\n",
a->sta->name,a->arid,orid);
delarr(u_arr,key_arid);
continue;
}
/* We delete this entry from u_arr, then we
can scan below for the dregs easily */
delarr(u_arr,key_arid);
}
if(save_dbrecord(db,orb))
elog_complain(0,"Error saving assoc record for arid %d\n",
a->arid);
}
/* Since it is possible that slowness vectors can be measured
with no arrival time, we need to take care of that possibility.
We do that by checking for dregs in u_arr not removed with
delarr calls above */
udregs = keysarr(u_arr);
n = maxtbl(udregs);
for(i=0;i<n;i++)
{
char *key;
key = gettbl(udregs,i);
u = (Slowness_vector *) getarr(u_arr,key);
dist(rad(hypo.lat),rad(hypo.lon),
rad(u->array->lat),rad(u->array->lon),&delta,&esaz);
dist(rad(u->array->lat),rad(u->array->lon),
rad(hypo.lat),rad(hypo.lon),&delta,&seaz);
slores = deg2km(sqrt(sqr(u->xres.raw_residual)
+ sqr(u->yres.raw_residual)));
azimuth = atan2 ( u->uy, u->ux ) ;
duphi = (u->ux*cos(azimuth)
- u->uy*sin(azimuth))
/ sqrt(sqr(u->ux)+ sqr(u->uy)) ;
azres = deg(duphi);
/* The residual weight extraction from the ux component is
not ideal here because it could be wrong. It is unavoidable
due to polar-cartesian conversion */
if(dbputv(db,"assoc",
"orid",orid,
"arid",u->arid,
"sta",u->array->name,
"phase",u->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timedef","n",
"vmodel",vmodel,
"slores",slores,
"slodef","d",
"azres",azres,
"azdef","d",
"wgt",(double)u->xres.residual_weight,
0)<0)
{
elog_complain(0,"Can't add assoc record for array slowness vector with %s arid = %d and orid = %d to working db scratch record\nNothing saved\n",
u->array->name,u->arid,orid);
continue;
}
if(save_dbrecord(db,orb))
elog_complain(0,"Error saving assoc record for arid %d\n",
u->arid);
}
/* We must not use regular free here, or later we could try
to free the same area twice. That is, u_tmp contains keyed
version of the pointers stored in tu. This releases only
the Arr structures, but leaves the pointers to be freed
later. I've never seen a better example of the need for
a decent garbage collection system. */
freetbl(udregs,free_nothing);
freearr(u_arr,free_nothing);
}
save_ms ( Dbptr dborig ) {
Dbptr db;
Event *event;
Tbl *AllMs;
double sum, unc;
char auth[64], net[16], sta[16];
char magtype[8];
char *str, orig_str[16];
int numms, total;
int smags, nmags;
int i;
int arid, orid, evid, msid, magid;
AllMs = keysarr( AllEv );
numms = maxtbl( AllMs );
if( numms <= 0 ) {
complain (0, "Ther are no MS found for current orid.\n");
return 0 ;
}
unc = 0.0; sum=0.0; total=0;
for( i = 0; i < numms; i++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
sum += event->ms;
total ++;
}
sum /= total;
if( total > 1 ) {
for( i = 0; i < numms; i++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
unc += (event->ms-sum) * (event->ms-sum);
}
unc /= (total-1);
unc = sqrt(unc);
} else unc = -1.0;
/* Fill netmag table */
db = dblookup (dborig, 0, "netmag", 0, 0);
dbquery (db, dbRECORD_COUNT, &nmags);
magid = -1;
for ( db.record = 0; db.record < nmags; db.record++) {
dbgetv (db, 0,
"net", net,
"orid", &orid,
"magtype", magtype, 0);
sprintf( orig_str, "%d\0", orid);
if( !regexec( &orig_match, orig_str, (size_t) 0, NULL, 0 ) &&
/*!regexec( &net_match, net, (size_t) 0, NULL, 0 ) && */
orid == event->orid &&
!strcmp(magtype, "ms")) break;
}
if ( db.record < nmags) {
dbgetv (db, 0, "magid", &magid, 0);
dbputv (db, 0,
"magid", magid,
"evid", event->evid,
"magtype", "ms",
"nsta", total,
"magnitude", sum,
"uncertainty", unc,
"auth", "dbms", 0);
} else if ( sum > 0) {
magid = dbnextid (db, "magid");
db.field = dbALL;
db.record = dbSCRATCH;
dbputv (db, 0,
"net", event->net,
"orid", event->orid,
"evid", event->evid,
"magid", magid,
"magtype", "ms",
"nsta", total,
"magnitude", sum,
"uncertainty", unc,
"auth", "dbms", 0);
dbadd (db, 0);
}
msid = magid;
/* Fill origin table with MS */
if( !regexec( &orig_match, orig_str, (size_t) 0, NULL, 0 ) &&
!regexec( &auth_match, event->auth, (size_t) 0, NULL, 0 ) ) {
db = dball;
db.record = Crnt_record;
dbputv (db, 0, "ms", sum, "msid", msid, 0);
}
/* Fill MS into stamag table */
db = dball;
db = dblookup (db, 0, "stamag", 0, 0);
dbquery (db, dbRECORD_COUNT, &smags);
for( i = 0; i < numms; i ++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
for (db.record=0; db.record<smags; db.record++) {
dbgetv (db, 0, "sta", sta, "magid", &magid, 0);
if (magid == msid && !strcmp(event->sta, sta)) break;
}
if (db.record<smags) {
dbputv (db, 0,
"arid", event->arid,
"orid", event->orid,
"evid", event->evid,
"phase", event->phase,
"magtype", "ms",
"magnitude", event->ms,
"auth", "dbms", 0);
} else if (event->ms > 0) {
db.field = dbALL;
db.record = dbSCRATCH;
dbputv (db, 0,
"sta", event->sta,
"arid", event->arid,
"orid", event->orid,
"evid", event->evid,
"phase", event->phase,
"magid", msid,
"magtype", "ms",
"magnitude", event->ms,
"auth", "dbms", 0);
dbadd (db, 0);
}
free(event);
delarr( AllEv, str);
}
freetbl( AllMs, 0 );
return (1);
}
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);
}
/* This function computes a covariance estimate for slowness
vector estimates computed by mwap. It is very specialized
in that it contains hard wired 3 dimensions for the number
of unknowns in this problem. This estimate is not at all the same
as that proposed in Bear and Pavlis (1997). They used variations in
estimates made in semblance/slowness space. Here we use the estimated
uncertainties in the static estimates as estimates of the data covariance
that is scaled by the inverse of the slowness estimation matrix to
produce a covariance estimate for the slowness vector.
This routine is confused greatly by being forced to use FORTRAN
indexing to mesh with sunperf. This leads to some very messy
indexing in a somewhat tricky algorithm I use to compute the
covariance with the SVD components.
Arguments:
stations - associative array of station objects
statics - associative array of MWstatic objects
c - 3x3 covariance estimate (result) in order of
ux, uy, dt
Normal return is 0. Postive returns mean a nonfatal problem
occurred that will be posted to elog. The routine dies only
from malloc errors.
Author: G Pavlis
Written: March 2000
Modified: March 2002
Removed the sample interval floor on the error. Previously this
function did not allow the error for a single station to drop
below the one sample lever. This was done to be conservative
but the new algorithm seems capable of resolving subsample
timing. Hence, I removed this feature.
*/
int compute_slowness_covariance(Arr *stations,Arr *statics,
double *c)
{
double *A;
double vt[9];
double svalue[3];
double work[9];
double *Cd1_2; /* holds vector of diagonal elements of
data covariance to 1/2 power (useful for scaling)*/
int nsta; /* number of stations = rows in A */
int nsta_used; /*actual value when problems happen */
MWstatic *mws;
MWstation *s;
Tbl *t; /* tbl of keys used to parse statics arr */
char *sta;
int i,j,ii;
int errcount=0;
int info;
for(i=0;i<9;++i) c[i] = 0.0;
t = keysarr(statics);
nsta = maxtbl(t);
allot(double *,A,3*nsta);
allot(double *,Cd1_2,nsta);
for(i=0,ii=0;i<nsta;++i)
{
sta = gettbl(t,i);
mws = (MWstatic *)getarr(statics,sta);
s = (MWstation *)getarr(stations,sta);
if(s==NULL)
{
elog_notify(0,"Station %s has a computed MWstatic but is not in station table\nStation array may be corrupted\n",sta);
++errcount;
}
else
{
A[ii] = s->deast;
A[ii+nsta] = s->dnorth;
A[ii+2*nsta] = 1.0;
Cd1_2[ii] = (mws->sigma_t);
++ii;
}
}
nsta_used = ii;
dgesvd('o','a',nsta,3,A,nsta_used,svalue,NULL,nsta,vt,3,&info);
/* Now we just compute covariance as C=A+(Cd)(A+)T
A+ = VS+UT. We first replace A by U*S+ */
for(i=0;i<3;++i)
{
dscal(nsta_used,1.0/svalue[i],A+i*nsta,1);
}
/* Another devious trick -- row scaling by Cd1_2 elements
forms proto form of V [ S+UT]Cd[US+T] VT */
for(i=0;i<nsta_used;++i) dscal(3,Cd1_2[i],A+i,nsta);
/* Now compute the term in brackets above = [ S+UT]Cd[US+T] */
for(i=0;i<3;++i)
{
for(j=0;j<3;++j)
c[i+3*j] = ddot(nsta_used,A+i,1,A+j,1);
}
/* Now we have to complete the products with V and VT.
First VT */
for(i=0;i<3;++i)
for(j=0;j<3;++j)
work[i+3*j] = ddot(3,c+i,3,vt+j*3,1);
/* then V */
for(i=0;i<3;++i)
for(j=0;j<3;++j)
c[i+3*j] = ddot(3,vt+i*3,1,work+j*3,1);
free(A);
free(Cd1_2);
return(errcount);
}
int
set_sinfo_limits( Arr * sinfo, orbinfo * oi, char * pkttype )
{
int i, j;
int size, size2;
int numalerts;
Arr * alert_ranges;
Arr* ranges;
Arr * oldval;
Pf * newfieldlist;
Arr * field;
Pf * thresholds;
Pf * thresh;
double high;
double low;
double * val;
Tbl* levels;
Tbl* byfield;
Tbl* fields;
char* level;
char * name;
int priority = 0;
/* Find the alert thresholds applicable to this packet type. If packet
type not mentioned by name, use the default values. */
if ( !( ranges = getarr( oi->alert_ranges, pkttype) ) )
if ( !( ranges = getarr( oi->alert_ranges, "all") ) ) return 0;
thresholds = pfnew( PFARR );
thresholds->value.arr = newarr( strcmp );
oldval = setarr( sinfo, THRESHOLD, thresholds );
/* if ( oldval ) freearr( oldval, recurse_free_pf ); */
/* First grab the list of alert levels for this packet type. */
levels = keysarr( ranges );
numalerts = maxtbl( levels );
for ( i =0; i < numalerts; i++ )
{
level = poptbl( levels );
byfield = (Tbl*) getarr( ranges, level );
newfieldlist = create_pf ( newarr( strcmp ), PFARR );
setarr( thresholds->value.arr, level, newfieldlist );
priority = get_priority( level, oi );
/* Next, get the thresholds for this current alert level. */
size = maxtbl( byfield );
for ( j = 0; j < size; j++ )
{
/* From this, examine each field. */
field = (Arr*) gettbl( byfield, j );
thresh = create_pf( newarr( strcmp ), PFARR );
setarr ( thresh->value.arr, HIGH,
create_pf( strdup( getarr( field, HIGH ) ), PFSTRING) );
setarr ( thresh->value.arr, LOW,
create_pf( strdup( getarr( field, LOW ) ), PFSTRING) );
setarr ( thresh->value.arr, PRIORITY,
create_pf( itoa( priority ), PFSTRING));
name = getarr( field, NAME );
if ( name == NULL )
continue;
oldval = setarr( newfieldlist->value.arr, name, thresh );
if ( oldval ) free( oldval );
}
}
freetbl( levels, 0 );
return 1;
}
void initpf( char *pf )
{
double epoch, sec;
Pf *Param;
Tbl *Inputs;
Arr *pfarr;
DIR *dirp;
struct dirent *direntp;
char *istr;
char *path, exten[132], name[132], *pfile;
int getone = 0;
int yr, day, hr, min;
int i, n, ninputs;
if( (pfile = (char *) malloc(256)) == NULL)
elog_die( 1, "initpf(): malloc error\n");
/* Get today's time */
if( pf == NULL ) {
epoch = now();
e2h(epoch, &yr, &day, &hr, &min, &sec);
/* Get List of Parameter Files */
if( (path = getenv("DASPF_PATH") ) == NULL || (int) strlen(path) <= 0 ) {
DASPF = "pkt";
} else {
sprintf( pfile, "%04d%03d%02d%02d\0", yr, day, hr, min);
dirp = opendir(path);
if(dirp == NULL)
elog_die(1, "initIP():Can't open %s directory.\n", path);
pfarr = newarr( 0 );
while ( (direntp = readdir(dirp)) != NULL ) {
istr = direntp->d_name;
fexten( istr, exten);
if( strncmp( exten, "pf", strlen("pf")) == 0)
setarr( pfarr, direntp->d_name, "Y" );
}
/* Get the most recent PF name */
Inputs = keysarr( pfarr );
ninputs = maxtbl( Inputs );
for( i = 0; i < ninputs; i++ ) {
istr = ( char *) gettbl( Inputs, i );
if( strcmp( istr, pfile ) == 0 ) {
sprintf( pfile, "%s/%s\0", path, istr);
getone = 1;
break;
}
else if( strcmp( istr, pfile ) > 0 ) {
if( i == 0 )
istr = ( char *) gettbl( Inputs, (0));
else
istr = ( char *) gettbl( Inputs, (i -1));
strncpy( name, istr, strlen(istr));
name[strlen(istr)-strlen(".pf")] = '\0';
for(n = 0; n < (int) strlen(name); n++)
if(!isdigit(name[n])) break;
if( n == (int) strlen(name))
sprintf( pfile, "%s/%s\0",path, istr);
else
sprintf( pfile, "pkt.pf" );
getone = 1;
break;
}
} /* end for */
if( !getone ) {
istr = ( char *) gettbl( Inputs, (ninputs -1));
sprintf( pfile, "%s/%s\0",path, istr);
}
/* Read configuration file */
pfile[strlen(pfile)-strlen(".pf")] = '\0';
DASPF = pfile;
freearr( pfarr, 0 );
closedir( dirp );
}
} else {
/* Read configuration file */
fexten( pf, exten);
if( strncmp( exten, "pf", strlen("pf")) == 0)
pf[strlen(pf) - strlen(".pf")] = '\0';
DASPF = pf;
}
}
/*This is an important function that sets the set of base station corrections
used as the bias term in pmel. These base station corrections are computed
as the difference between travel times computed by a 3D calculator
(This program actually has no concept of this directly. It just uses
the 3D model as a reference.) and a reference model (presumably generally
a 1D model like iasp91, but it could itself be 3D really). Note
that if the 3D model has any station corrections set they will be applied.
For the reference model (1D) the station corrections are set by this
function. This allows testing or application with a global set of station
corrections used as the 3D equivalent, but allowing the results to be
space variable when used with dbpmel. i.e. you can, if desired, use
the same travel time calculator for the 1D and 3D case, but if
station corrections are defined for the 3D handle they will be used
as a global bias term. Similarly, if this same process is done with
no station corrections one can produce a "unbiased estimate" meaning
the bias term is always forced to 0 everywhere. Experience has shown
that although this might be conceptually appealing it generally is a
bad idea unless the reference model is very good to start with.
Arguments:
pha - associative array of phase handles for 1D reference model
calculator (station correction of these handles are set here).
pha3D - same as pha, but for the 3D (bias) model calculator
sa - associative array of Station objects with station location
information (keyed by sta name).
hc - hypocentroid location.
Returns:
0 - normal, aok
> 0 - count of failures in computing travel times
< 0 - total failure
*/
int initialize_station_corrections(Arr *pha,Arr *pha3D, Arr *sa,Hypocenter *hc)
{
int i,j;
Phase_handle *p,*p3D;
Tbl *keys;
char *phase;
Station *s;
Tbl *stakeys;
char *sta;
int nsc_fail=0;
Ray_Endpoints x;
Travel_Time_Function_Output t,t3D;
double *sc,*sc3D;
keys = keysarr(pha);
stakeys = keysarr(sa);
x.slat = hc->lat;
x.slon = hc->lon;
x.sz = hc->z;
for(i=0;i<maxtbl(keys);++i)
{
phase = gettbl(keys,i);
p = (Phase_handle *)getarr(pha,phase);
p3D = (Phase_handle *)getarr(pha3D,phase);
if(pha3D == NULL)
{
elog_notify(0,"No handle for 3d (bias correction) for phase %s\nBias contribution set to 0 for this phase\n",
phase);
nsc_fail += cntarr(sa);
/* Emptying the arr is a simple way to create
the equivalent of all 0s*/
if(cntarr(p->time_station_corrections)>0)
{
freearr(p->time_station_corrections,free);
p->time_station_corrections=newarr(0);
}
continue;
}
for(j=0;j<maxtbl(stakeys);++j)
{
sta = gettbl(stakeys,j);
s = (Station *)getarr(sa,sta);
x.sta = s->name;
x.rlat = s->lat;
x.rlon = s->lon;
x.rz = -(s->elev);
/* Get a pointer to hold the new station correction.
If it doesn't exist yet, create it and enter it into
the associative array. Note because these are direct
pointers we don't have set the entry in the arr below*/
sc = (double *)getarr(p->time_station_corrections,sta);
if(sc == NULL)
{
allot(double *,sc,1);
setarr(p->time_station_corrections,sta,sc);
}
t3D = p3D->ttcalc(x,phase,RESIDUALS_ONLY);
t = p->ttcalc(x,phase,RESIDUALS_ONLY);
if( (t.time == TIME_INVALID)
|| (t3D.time == TIME_INVALID) )
{
elog_notify(0,"Travel time failure for phase %s computing reference corrections for station %s\nCorrection set to 0.0\n",
phase,sta);
*sc = 0.0;
++nsc_fail;
}
else
{
*sc = t3D.time - t.time;
sc3D = (double *)
getarr(p3D->time_station_corrections,sta);
if(sc3D != NULL)
*sc += *sc3D;
}
}
}