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;
}
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;
}
int
add_network ( Arr * networks, char * net )
{
Arr * network;
Arr * oldnet;
if ( get_stations( networks, net ) ) return 0;
network = newarr( strcmp );
setarr( networks, net, create_pf( network, PFARR ) );
setarr( network, STALIST, create_pf( newarr( strcmp ), PFARR) );
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);
}
}
int
add_station ( Arr * networks, char * net, char * sta, Arr * sinfo )
{
Arr * stations;
Arr * sold;
char * latency;
if ( networks == NULL )
networks = newarr( strcmp );
if ( sold = get_station( networks, net, sta ) )
{
sinfo_update( sold, sinfo );
clrarr( sinfo, pffree );
}
else
{
if ( get_stations( networks, net ) == NULL )
add_network( networks, net );
if ( !(stations = get_stations( networks, net ) ) ) return 0;
setarr( stations, sta, create_pf( sinfo, PFARR ) );
}
return 1;
}
/* 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);
}
StachanCalib *
get_StachanCalib( char *site_id, char *channel_identifier )
{
char key_specific[STRSZ];
char key_default[STRSZ];
StachanCalib *scc;
sprintf( key_specific, "%s:%s", site_id, channel_identifier );
sprintf( key_default, "%s:%s", "default", channel_identifier );
scc = (StachanCalib *) getarr( Stachan_calibs, key_specific );
if( scc == (StachanCalib *) NULL ) {
if( VeryVerbose ) {
elog_notify( 0, "Couldn't find customized "
"offsets for %s:%s; "
"using defaults.\n",
site_id, channel_identifier );
}
scc = (StachanCalib *) getarr( Stachan_calibs, key_default );
scc = dup_StachanCalib( scc );
setarr( Stachan_calibs, key_specific, (void *) scc );
}
return scc;
}
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);
}
/* 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 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);
}
/* 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);
}
static Orb_relic *
new_Orb_relic( int orbfd ) {
Orb_relic *or;
allot( Orb_relic *, or, 1 );
or->orbfd = orbfd;
or->orbname = NULL;
or->orb_start = PYTHONORB_NULL_PKTTIME;
or->pkttime = PYTHONORB_NULL_PKTTIME;
or->pktid = -1;
sprintf( or->orbfd_str, "%d", or->orbfd );
orbresurrect4perl( orbfd, &or->orbname, &or->orb_start );
or->pktid_relicname = strconcat( or->orbname, "{last_pktid}", 0 );
or->pkttime_relicname = strconcat( or->orbname, "{last_pkttime}", 0 );
if( Orb_relics == (Arr *) NULL ) {
Orb_relics = newarr( 0 );
}
setarr( Orb_relics, or->orbfd_str, (void *) or );
return or;
}
/* This function creates an associative array keyed by an integer
event id from a parameter file based descriptor &Tbl like this example:
pmel_calibration_events &Tbl{
10 xyz
11 xyzt
}
where 10 and 11 are event ids and the string defines coordinates to fix.
Author: Gary Pavlis
*/
Arr *load_calibration_events(Pf *pf)
{
Tbl *t;
int evid;
char *evidstr;
char fix[5],*line;
char *fptr;
Arr *a;
int i;
a = newarr(0);
t = pfget_tbl(pf,"pmel_calibration_events");
if(t==NULL)
{
elog_complain(0,
"pmel_calibration_events Tbl not in parameter file\nAssuming no calibration events exist\n");
}
else
{
for(i=0;i<maxtbl(t);++i)
{
line = (char *)gettbl(t,i);
sscanf(line,"%d%s",&evid,fix);
evidstr = make_evid_key(evid);
fptr=strdup(fix);
setarr(a,evidstr,fptr);
free(evidstr);
}
}
return(a);
}
void init( )
{
Pf *Param;
Tbl *Site;
DAS *das;
struct Site site;
char *istr;
char dasid[6];
int pkttype;
int ntrec, i, j;
int nsite;
int *num = 0;
if(pfread( pfile, &Param) != 0)
die(0, "Can't read parameter file\n");
/* Get Input & Network tables */
Site = pfget_tbl(Param, "Site");
nsite = maxtbl(Site);
if( nsite <= 0 )
die( 0, "init(): parameter file is not complete.\n");
Dases = newarr( 0 );
Dasid = newarr( 0 );
for( i = 0; i < nsite; i++ ) {
istr = (char *) gettbl(Site, i);
sscanf(istr, STE_SCS, STE_RVL(&site));
if( !strcmp(site.up, "Y") ) {
sprintf( dasid, "%d\0", site.sid );
if( ( das = ( DAS *) getarr( Dases, dasid ) ) == NULL ) {
das = new_das( site.sid, site.name );
setarr(Dases, (char *) &dasid[0], (char *) das );
}
if( (num = ( int *) getarr( Dasid, site.name ) ) == NULL ) {
allot( int *, num, 1 );
*num = site.sid;
setarr(Dasid, (char *) site.name, (char *) num );
}
}
int
set_fullnetname( Arr * networks, char * net, char * name )
{
Arr * network = get_network( networks, net );
Pf * oldval;
oldval = setarr( network, FULLNET, create_pf( name, PFSTRING ) );
if ( oldval ) recurse_free_pf( oldval );
return 1;
}
int
set_station_field( Arr * sinfo, char * name, char * value )
{
Pf * oldval;
Pf * pf;
if ( !sinfo || !name || !value ) return 0;
pf = create_pf ( value , PFSTRING );
oldval = setarr( getpf( sinfo, FIELDS ), name, pf );
/* if ( oldval ) recurse_free_pf( oldval ); */
return 1;
}
int parse_pscl_IP (
uchar_t *packet,
ushort_t pkttype )
{
int nsamp, yr, day, hr, min, sec, msec;
ushort_t newtype;
PktPar pack;
char stime[64], key[64];
struct PsclPreHdr pkt;
int dasid;
/* Get parameters for current datatype */
newtype = PSCLIP;
if( !get_packet( newtype, &pack) ) return -1;
dasid = bcd2hex( &packet[4] , 4 );
Par.staid = dasid;
Par.chan = -1;
Par.packet = pack;
Par.hdrtype = ( int )decode( pack.hdrtype );
memcpy( (char *) &pkt, packet, sizeof( struct PsclPreHdr ));
yr = bcd2hex( pkt.year , 2 );
sprintf( (char *) &stime[0], "%02x%02x%02x%02x%02x%02x\0",
pkt.bcdtime[0], pkt.bcdtime[1], pkt.bcdtime[2],
pkt.bcdtime[3], pkt.bcdtime[4], pkt.bcdtime[5]);
sscanf( (char *) &stime[0], "%3d%2d%2d%2d%3d",
&day, &hr, &min, &sec, &msec);
if( yr < 50 )
sprintf( (char *) &stime[0], "20%02d%03d:%02d:%02d:%02d.%03d\0",
yr, day, hr, min, sec, msec);
else
sprintf( (char *) &stime[0], "19%02d%03d:%02d:%02d:%02d.%03d\0",
yr, day, hr, min, sec, msec);
Par.time = str2epoch( (char *) &stime[0] );
sprintf( &Par.packet.pkttype[0], "PSCLIP\0");
sprintf( (char *) &key[0], "%d", newtype );
setarr( RawPkts, (char *) &key[0], (char *) &Par.raw);
return (int) pkttype;
}
static int
report_nonroutable( char *address )
{
if( Nonroutable == (Arr *) NULL ) {
Nonroutable = newarr( 0 );
}
if( getarr( Nonroutable, address ) == NULL ) {
setarr( Nonroutable, address, 0x1 );
return 1;
} else {
return 0;
}
}
/* 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);
}
/* 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);
}
/* this is a parallel routine to dbload_station_table. In fact, the
code is identical except it returns an associative array of
Seismic_Array pointers rather than pointers to Station structures.
This is consistent with CSS3.0 perspective that any station is a
candidate for making slowness measurements, even though that is
rarely the case in practice. It makes this table larger than
necessary, but simplifies a lot of things and makes this code
of more general use.
Author: Gary L. Pavlis
Written: January 1997
*/
Arr *dbload_array_table(Dbptr db,int row_start,int row_end,Pf *pf)
{
Arr *a;
Seismic_Array *s;
char *prog="dbform_station_table";
/* Values set by dbgetv from row of view */
double lat, lon, elev;
char staname[12];
char laststa[12];
double elev_datum;
a = newarr(0);
elev_datum = pfget_double_wdef(pf,"elevation_datum",0.0);
for(db.record=row_start;db.record<row_end;++db.record)
{
if((dbgetv( db, 0,
"sta",staname,
"lat",&lat,
"lon",&lon,
"elev",&elev,
NULL )) == dbINVALID) die(1,"%s: dbgetv error\n",prog);
if(db.record == row_start) strcpy(laststa,staname);
if( (db.record == row_start) || strcmp(staname,laststa))
{
s = (Seismic_Array *) malloc(sizeof(Seismic_Array));
if(s == NULL)
die(1,"%s: Cannot malloc Seismic_Array structure\n",
prog);
strcpy(laststa,staname);
strcpy(s->name,staname);
s->lat = lat;
s->lon = lon;
elev -= elev_datum;
s->elev = elev;
setarr(a,s->name,s);
}
}
return(a);
}
/* 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);
}
int ttlvz_init(char *phase, Pf *pf)
{
Tbl *t;
Vmodel *mod;
if(ttlvz_models == NULL) ttlvz_models = newarr(0);
mod = (Vmodel *)malloc(sizeof(Vmodel));
if(mod == NULL) die(1,"ttlvz_init: cannot malloc Vmodel structure for phase %s\n",phase);
t = pfget_tbl(pf,"velocity_model");
if(t == NULL)
{
elog_complain(0,
"ttlvz_init: no velocity model data found for phase %s\n",
phase);
return(1);
}
ttlvz_parse_vmodel(t,&(mod->velocity),&(mod->ztop),&(mod->nlayers));
setarr(ttlvz_models,phase,mod);
return(0);
}
/* 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);
}
StaStatus *
add_StaStatus( char *sta )
{
StaStatus *ss;
if( ! strcmp( sta, "default" ) ) {
return (StaStatus *) NULL;
}
mutex_lock( &Sta_statuses_mutex );
if( ( ss = (StaStatus *) getarr( Sta_statuses, sta ) ) == (StaStatus *) NULL ) {
ss = new_StaStatus();
setarr( Sta_statuses, sta, (void *) ss );
}
mutex_unlock( &Sta_statuses_mutex );
return ss;
}
int ATM_cggrid_register( CGGrid *cgg )
{
char *key;
allot( char *, key, STRSZ );
sprintf( key, "%x", (unsigned long) cgg );
if( ATM_CGGrid_Registry == (Arr *) NULL )
{
ATM_CGGrid_Registry = newarr( 0 );
}
if( getarr( ATM_CGGrid_Registry, key ) != NULL )
{
mexWarnMsgTxt( "cggrid is already registered" );
free( key );
return 1;
}
setarr( ATM_CGGrid_Registry, key, (void *) 0x1 );
return 1;
}
/* 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 );
}
}
void save_assoc(Dbptr dbi, long is, long ie, long orid, char *vmodel,
Tbl *residual,Hypocenter h, Dbptr dbo)
{
/* These fields are copied from input assoc table */
long arid;
char sta[8];
char phase[10];
double belief;
/* These fields are set here */
double delta;
double seaz;
double esaz;
double timeres;
double azres;
double slores;
double lddate;
double wgt;
char timedef[2],slodef[2], azdef[2];
/* intentionally ignored: emares, commid */
/* passed through arg list; orid*/
/* We use this to produce a keyed arr list of the residual
list passed into here as a Tbl */
Arr *residual_array;
long i;
char key[40];
double r, w, reswt,uxresid, uyresid;
double stalat, stalon;
double ux, uy, azimuth;
double u,phi; /* polar form of measured slowness vector */
double duphi;
dbo = dblookup(dbo,0,"assoc",0,0);
lddate = std_now();
/* We build an associate array for the residual tbl keying
each entry with a sta/phase/type key where type is
set in ggnloc as time, ux, or uy. This complication is
needed to sort out array residuals. */
residual_array = newarr(0);
for(i=0;i<maxtbl(residual);++i)
{
char *s;
char keysta[10], keyphase[10], keytype[5];
s = (char *)gettbl(residual,i);
sscanf(s,"%s %s %s",keysta,keyphase,keytype);
/* handle S-P case by having the same residual mapped
to each half of - phase pair */
if(strchr(keyphase,'-'))
{
char *phase1,*phase2;
/* algorithm to split phase names cloned from dbgenloc */
phase1 = strdup(keyphase);
phase2= strchr(phase1,'-');
*phase2 = '\0';
++phase2;
sprintf(key,"%s %s %s",keysta,phase1,keytype);
setarr(residual_array,key,s);
sprintf(key,"%s %s %s",keysta,phase2,keytype);
setarr(residual_array,key,s);
free(phase1);
}
else
{
/* normal phases are one to one */
sprintf(key,"%s %s %s",keysta,keyphase,keytype);
setarr(residual_array,key,s);
}
}
for(dbi.record=is;dbi.record < ie;++dbi.record)
{
char *time_residual_record;
char *ux_residual_record,*uy_residual_record;
if( dbgetv(dbi,0,
"assoc.arid",&arid,
"assoc.sta",sta,
"assoc.phase",phase,
"assoc.belief",&belief,
NULL) == dbINVALID)
{
elog_die(1,"save_assoc: dbgetv error reading assoc fields of input view at record %ld\n",
dbi.record);
}
if( dbgetv(dbi,0,
"site.lat",&stalat,
"site.lon",&stalon,
NULL) == dbINVALID)
{
elog_die(1,"save_assoc: dbgetv error reading site fields of input view at record %ld\n",
dbi.record);
}
/* Find the time residual record for this arrival */
sprintf(key,"%s %s time",sta,phase);
time_residual_record = (char *)getarr(residual_array,key);
if(time_residual_record == NULL)
{
elog_complain(1,"save_assoc: getarr mismatch for key %s\nCannot set residual\n",key);
timeres = TIMENULL;
wgt = 0.0;
strcpy(timedef,"n");
}
else
{
/* Changed by JN to avoid gcc warning */
/* sscanf(time_residual_record,"%*s%*s%*s%*lg%lg%lg%lg", */
sscanf(time_residual_record,"%*s%*s%*s%*g%lg%lg%lg",
&r,&w,&reswt);
timeres = r;
wgt = w*reswt;
strcpy(timedef,"d");
}
sprintf(key,"%s %s ux",sta,phase);
ux_residual_record = (char *)getarr(residual_array,key);
sprintf(key,"%s %s uy",sta,phase);
uy_residual_record = (char *)getarr(residual_array,key);
/* Corrected by JN
if( (ux_residual_record == NULL)
|| (ux_residual_record == NULL))
*/
if( (ux_residual_record == NULL)
|| (uy_residual_record == NULL))
{
/* This trick is not documented. By setting
the record filed to dbNULL, and then calling dbgetv
each of the fields will be set to their NULL value */
dbo.record = dbNULL;
dbgetv(dbo,0,"azres",&azres,"slores",&slores,NULL );
strcpy(azdef,"n");
strcpy(slodef,"n");
}
else
{
/* This gets nasty because we have to convert to polar
coordinates from ux, uy components */
sscanf(ux_residual_record,"%*s%*s%*s%*g%lg",&uxresid);
sscanf(uy_residual_record,"%*s%*s%*s%*g%lg",&uyresid);
/* We fetch the measured slowness vector to convert */
if( dbgetv(dbi,0,
"arrival.slow",&u,
"arrival.azimuth",&phi,
NULL) == dbINVALID)
{
elog_die(1,"save_assoc: dbgetv error reading arrival fields of input view at record %ld\n",
dbi.record);
}
/* css stores slowness in s/deg, but we use
s/km internally here so we have to convert */
slores = sqrt(uxresid*uxresid+uyresid*uyresid);
slores *= KMPERDEG;
/* this is the azimuth term */
u /= KMPERDEG;
duphi = ux*cos(rad(azimuth)) - uy*sin(rad(azimuth));
duphi /= u;
azres = deg(duphi);
strcpy(azdef,"d");
strcpy(slodef,"d");
}
dist(rad(h.lat),rad(h.lon),rad(stalat),rad(stalon),
&delta,&esaz);
dist(rad(stalat),rad(stalon),rad(h.lat),rad(h.lon),
&delta,&seaz);
delta = deg(delta);
seaz = deg(seaz);
esaz = deg(esaz);
if(dbaddv(dbo,0,
"arid",arid,
"orid",orid,
"sta",sta,
"phase",phase,
"belief",belief,
"delta",delta,
"seaz",seaz,
"esaz",esaz,
"timeres",timeres,
"timedef",timedef,
"azres",azres,
"azdef",azdef,
"slores",slores,
"slodef",slodef,
"wgt",wgt,
"vmodel",vmodel,
"lddate",lddate,
NULL ) == dbINVALID)
{
elog_die(1,"save_assoc: dbaddv error writing assoc record for arid %ld\n",
arid);
}
}
freearr(residual_array,0);
}
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 );
}
}
}
}
static void
archive_dlsvar( Dbptr db, char *net, char *sta, char *dls_var, char *dsparams, Tbl *rras, double time, double val )
{
char key[STRSZ];
char *rrd;
double start_time;
Dbptr dbt;
char datasource[STRSZ];
char command[STRSZ];
char cacheopt[FILENAME_MAX];
/* Disable response printing for now (see below)
char response[STRSZ];
char *resp_ptr;
*/
int i;
sprintf( key, "%s:%s:%s", net, sta, dls_var );
rrd = getarr( Rrd_files, key );
/* rrdtool in server-mode apparently does not write files until a request occurs to switch to the next
file, so the test below doesn't work right. Trust the database to report existing files:
if( rrd == NULL || ! is_present( rrd ) ) {
*/
if( rrd == NULL ) {
start_time = time - Status_stepsize_sec;
dbt = db;
dbt.record = dbaddnull( db );
dbputv( dbt, 0, "net", net,
"sta", sta,
"rrdvar", dls_var,
"time", start_time,
NULL );
trwfname( dbt, Rrdfile_pattern, &rrd );
sprintf( datasource, "DS:%s:%s", dls_var, dsparams );
if( Verbose ) {
elog_notify( 0, "Creating rrdfile %s\n", rrd );
}
sprintf( command, "create %s -b %d -s %f %s",
rrd, (int) floor( start_time ), Status_stepsize_sec, datasource );
for( i = 0; i < maxtbl( rras ); i++ ) {
strcat( command, " " );
strcat( command, (char *) gettbl( rras, i ) );
}
if( VeryVerbose ) {
elog_notify( 0, "Issuing rrdtool command: '%s'\n", command );
}
fprintf( Rrdfp, "%s\n", command );
/* Disable response printing for now since popen() bi-directional pipes
are not supported across all platforms:
if( VeryVerbose ) {
resp_ptr = getaline( Rrdfp, response, STRSZ );
if( resp_ptr == (char *) NULL ) {
elog_notify( 0, "%s\n", "(null)" );
} else {
elog_notify( 0, "%s\n", resp_ptr );
}
}
*/
setarr( Rrd_files, key, strdup( rrd ) );
}
if( VeryVerbose ) {
elog_notify( 0, "Recording time '%f' value '%f' from '%s:%s:%s' in '%s'\n",
time, val, net, sta, dls_var, rrd );
}
if( CacheDaemon == NULL ) {
sprintf( cacheopt, "%s", "" );
} else {
sprintf( cacheopt, "--daemon=%s", CacheDaemon );
}
sprintf( command, "update %s %s %d:%f", cacheopt, rrd, (int) floor( time ), val );
if( VeryVerbose ) {
elog_notify( 0, "Issuing rrdtool command: '%s'\n", command );
}
fprintf( Rrdfp, "%s\n", command );
/* Disable response printing for now since popen() bi-directional pipes
are not supported across all platforms:
if( VeryVerbose ) {
resp_ptr = getaline( Rrdfp, response, STRSZ );
if( resp_ptr == (char *) NULL ) {
elog_notify( 0, "%s\n", "(null)" );
} else {
elog_notify( 0, "%s\n", resp_ptr );
}
}
*/
}