int
main (int argc, char **argv)
{
int c,
errflg = 0;
char *in,
*out;
int orbin,
orbout;
double maxpkts = VERY_LARGE_NUMBER ;
int quit;
char *pktmatch = strdup(".*/pf/evtinfo"),
*reject = 0;
int nmatch;
int specified_after = 0;
double after = 0.0,
until = VERY_LARGE_NUMBER ;
double start_time,
end_time,
delta_t ;
double totpkts = 0,
totbytes = 0;
Flags flags;
static int last_pktid = -1;
static double last_pkttime = 0.0;
char *statefile = 0;
double last_burial = 0.0;
double decent_interval = 300.0;
int mode = PKT_NOSAMPLES;
int rcode;
char srcname[ORBSRCNAME_SIZE];
double pkttime = 0.0 ;
int pktid;
int nbytes;
char *packet = 0;
int packetsz = 0;
Packet *unstuffed = 0;
Pf *pf;
Tbl *tbl;
Arr *arr;
char *arrkey;
char *pffilename;
Tbl *channels;
char *net;
char *sta;
char *chan;
char netstachan[ORBSRCNAME_SIZE];
Srcname parts;
double maxtime,mintime,starttime,triggertime,duration,min_g,max_g,snr;
char *datalogger;
int evtfilesize,channelno,maxcts,mincts;
char *errors,*evtfilename,*ft,*filter,*srcid;
char *line;
int i;
Pf *pfnew;
Dbptr db;
int put_tests=0;
char *chanmatch=0;
Hook *hook=0;
char *tdummy=0;
char *match=malloc(100);
memset (&flags, 0, sizeof (flags));
elog_init (argc, argv);
elog_notify (0, "%s $Revision: 1.5 $ $Date: 2005/05/10 07:34:43 $\n",
Program_Name);
while ((c = getopt (argc, argv, "m:n:r:S:c:tvV")) != -1) {
switch (c) {
case 'm':
match = optarg;
sprintf(pktmatch,"%s/pf/evtinfo",match);
break;
case 'c':
chanmatch = optarg;
break;
case 't':
put_tests = 1;
break;
case 'n':
maxpkts = atoi (optarg);
break;
case 'r':
reject = optarg;
break;
case 'S':
statefile = optarg;
break;
case 'v':
flags.verbose++;
break;
case 'V':
flags.verbose++;
flags.verbose++;
break;
case '?':
errflg++;
}
}
if (errflg || argc - optind < 2 || argc - optind > 4)
usage ();
in = argv[optind++];
out = argv[optind++];
if (argc > optind) {
after = str2epoch (argv[optind++]);
specified_after = 1;
if (argc > optind) {
until = str2epoch (argv[optind++]);
if (until < after) {
until += after ;
}
}
}
if ((orbin = orbopen (in, "r&")) < 0)
die (0, "Can't open input '%s'\n", in);
if (statefile != 0) {
char *s;
if (exhume (statefile, &quit, RT_MAX_DIE_SECS, 0) != 0) {
elog_notify (0, "read old state file\n");
}
if (orbresurrect (orbin, &last_pktid, &last_pkttime) == 0) {
elog_notify (0, "resurrection successful: repositioned to pktid #%d @ %s\n",
last_pktid, s = strtime (last_pkttime));
free (s);
} else {
complain (0, "resurrection unsuccessful\n");
}
}
if ((orbout = orbopen (out, "w&")) < 0) {
die (0, "Can't open output '%s'\n", out);
}
if (pktmatch) {
nmatch = orbselect (orbin, pktmatch);
}
if (nmatch < 0) {
die (1, "select '%s' returned %d\n", pktmatch, nmatch);
}
if (reject) {
nmatch = orbreject (orbin, reject);
}
if (nmatch < 0) {
elog_die (1, "reject '%s' returned %d\n", reject, nmatch);
} else {
if (flags.verbose) {
elog_notify (1,"%d sources selected\n", nmatch);
}
}
if (specified_after) {
pktid = orbafter (orbin, after);
if (pktid < 0) {
char *s;
elog_complain (1, "seek to %s failed\n", s = strtime (after));
free (s);
pktid = forbtell (orbin);
elog_complain (1,"pktid is still #%d\n", pktid);
} else {
if (flags.verbose) elog_notify (1,"new starting pktid is #%d\n", pktid);
}
}
start_time = now ();
db = dbtmp("rt1.0");
while (!quit && pkttime < until && totpkts < maxpkts) {
rcode = orbreap (orbin,
&pktid, srcname, &pkttime, &packet, &nbytes, &packetsz);
switch (rcode) {
case 0:
totpkts++;
totbytes += nbytes;
if (flags.verbose>2) {
showPkt (pktid, srcname, pkttime, packet, nbytes, stdout, mode);
}
if (statefile != 0
&& last_pkttime - last_burial > decent_interval) {
bury ();
last_burial = pkttime;
}
if ((unstuffPkt (srcname, pkttime, packet, nbytes, &unstuffed))==Pkt_pf) {
pf = unstuffed->pf;
tbl= pfkeys(pf);
arrkey= gettbl(tbl,0);
pfget(pf,arrkey,&pfnew);
datalogger= pfget_string(pfnew,"datalogger");
duration= pfget_double(pfnew,"duration");
errors= pfget_string(pfnew,"errors");
evtfilename= pfget_string(pfnew,"evtfilename");
evtfilesize= pfget_int(pfnew,"evtfilesize");
ft= pfget_string(pfnew,"ft");
starttime= pfget_double(pfnew,"time");
triggertime= pfget_double(pfnew,"triggertime");
channels=pfget_tbl(pfnew,"channels");
if (strcasecmp(ft,"no")==0 || put_tests == 1) {
for (i=0; i<maxtbl(channels);i++) {
line=gettbl(channels,i);
sscanf(line,"%s %d %lf %d %lf %lf %d %lf",
netstachan,&channelno,&maxtime,&maxcts,&max_g,&mintime,&mincts,&min_g);
split_srcname(netstachan,&parts);
strcpy(parts.src_suffix,"GENC");
join_srcname(&parts,netstachan);
if (flags.verbose>1) printf("%s,%s\n", netstachan,tdummy=strtime(triggertime));
if (chanmatch == 0 ||
strmatches(parts.src_chan,chanmatch,&hook)) {
if (flags.verbose) elog_notify(1,"putting detev for %s,%s\n", netstachan,tdummy=strtime(triggertime));
db=dblookup(db,0,"detev",0,"dbSCRATCH");
dbputv(db,0,"sta",parts.src_sta,"chan",parts.src_chan,
"filter",K2_FILTER,
"time", triggertime,
"tron", starttime - triggertime,
"troff", starttime - triggertime + duration,
"iphase","K2",
"snr",(max_g * 1000.0 - min_g * 1000.0)/2.0,
0);
db2orbpkt(db,orbout);
} else {
if (flags.verbose>1) elog_notify(1,"ignoring %s,%s\n", netstachan,tdummy=strtime(triggertime));
}
}
}
}
last_pktid = pktid;
last_pkttime = pkttime;
}
}
if (statefile != 0)
bury ();
end_time = now ();
delta_t = end_time - start_time;
if (flags.verbose>1) {
if (totpkts > 0) {
elog_notify (1,"\n%.0f %.2f byte packets (%.1f kbytes) in %.3f seconds\n\t%10.3f kbytes/s\n\t%10.3f kbaud\n\t%10.3f pkts/s\n",
totpkts, totbytes / totpkts, totbytes / 1024,
delta_t,
totbytes / delta_t / 1024,
totbytes / delta_t / 1024 * 8,
totpkts / delta_t);
} else {
elog_notify (1,"\nno packets read\n");
}
}
if (orbclose (orbin)) {
elog_complain (1, "error closing read orb\n");
}
if (orbclose (orbout)) {
elog_complain (1, "error closing write orb\n");
}
return 0;
}
/* Implements error ellipses from input covariance matrix assuming
particular error model defined by "model".
(inputs)
C - 4x4 covariance matrix in order x,y,z,t. If depth is fixed it is assumd
all the z terms have been zeroed. Use of an eigenvector routine
assures it will still be stable and algorithms used should still
all be stable.
model - error model (CHI_SQUARE or F_DIST defined in location.h)
conf - confidence level (this function will complain if not 0.683 or 0.9
and round to closest) Must be 0<conf<1.0 This value is altered
to one of these values if necessary.
rms - residual norm used to scale error ellipse in F distribution model
(ignored with chisquare model)
dgf - number of degrees of freedom (enters only in F_DIST case, ignored
for chi-square error model)
(outputs)
smajax, sminax, strike - horizontal error ellipse as defined in css3.0
sdepth, stime - depth and time error attributes in css3.0
Normal return is 0. Returns -1 if computation totally fails. Calling
function should trap this condition results are all set 0 in that
situation.
Written: November 2000
Authors: G Pavlis and Kent Lindquist
*/
int project_covariance(double **C, int model, double *conf, double rms, int dgf,
double *smajax, double *sminax, double *strike,
double *sdepth, double *stime)
{
int i ;
double cwork[16]; /* covariance subset work space in FORTRAN order*/
/* These are chisquare critical values. First index is critical
level and second is degrees of freedom. e.g.
chisq_crit[1][2] is 90% level for 3 dgf*/
double chisq_crit[2][3]={{1.001284,2.297707,3.529159},
{2.705543, 4.60517, 6.251389}};
double evals[4];
double vwork[16];
int info,ecount=0;
int iconf;
if((*conf<=0.0) || (*conf>=1.0))
{
elog_complain(0,"project_confidence passed illegal confidence level. Default to 68.3 percent\n");
iconf = 0;
}
if(fabs(*conf-0.683)<0.001)
iconf = 0;
else if(fabs(*conf-0.9)<0.001)
iconf = 1;
else
{
elog_complain(0,"Confidence level %f not implemented--default to 68%%\n",*conf);
iconf = 0;
}
/* first compute the horizontal error ellipse, unscaled.
This uses the packed storage mode of lapack */
cwork[0] = C[0][0];
cwork[1] = C[1][0];
cwork[2] = C[1][1];
/* this is CLAPACK/sunperf routine to compute eigenvalues and
eigenvectors for a positive definite matrix */
dspev('v','l',2,cwork,evals,vwork,2,&info);
if(info<0)
{
elog_complain(0,"dspev illegal value\n");
return(-1);
}
else if(info>0)
{
elog_notify(0,"dspev convergence failure. Error ellipse esults may be unreliable\n");
++ecount;
}
/* dspev returns eigenvalues in ascending order of size */
switch(model)
{
case(F_DIST):
elog_complain(0,"F distribution not yet implemented--default to chi-square\n");
case(CHI_SQUARE):
default:
*smajax = chisq_crit[iconf][1]*sqrt(evals[1]); /*2 dgf */
*sminax = chisq_crit[iconf][1]*sqrt(evals[0]);
*strike= 90.0 - deg(atan2(vwork[3],vwork[2]));
/* phase-wrap so the principal value of the arctangent
maps to the valid range of the CSS origerr.strike field */
if( *strike < 0 ) *strike += 360.;
}
/* Now we have to do the full covariance to properly compute
the depth and time uncertainties*/
cwork[0] = C[0][0];
cwork[1] = C[1][0];
cwork[2] = C[2][0];
cwork[3] = C[3][0];
cwork[4] = C[1][1];
cwork[5] = C[2][1];
cwork[6] = C[3][1];
cwork[7] = C[2][2];
cwork[8] = C[3][2];
cwork[9] = C[3][3];
dspev('v','l',4,cwork,evals,vwork,4,&info);
if(info<0)
{
elog_complain(0,"dspev illegal value\n");
return(-1);
}
else if(info>0)
{
elog_notify(0,"dspev convergence failure. Error ellipse esults may be unreliable\n");
++ecount;
}
/* We scale each eigenvector by the eigenvalue and find
the largest z and t components to compute errors in z and t*/
for(i=0;i<4;++i)dscal(4,sqrt(evals[i]),vwork+4*i,1);
i = idamax(4,vwork+2,4);
/* Note sunperf implementation of blas returns an index based
from 0 ala C while the FORTRAN version uses 1. Dangerous
inconsistency to watch out for. */
/* This is the sunperf version
*sdepth = fabs(vwork[2+i*4]);
This is the correct version for perf which returns 1-4 */
*sdepth =fabs(vwork[2+(i-1)*4]);
i = idamax(4,vwork+3,4);
/* other old sunperf version
*stime = fabs(vwork[3+i*4]); */
*stime = fabs(vwork[3+(i-1)*4]);
switch(model)
{
case(F_DIST):
case(CHI_SQUARE):
default:
*sdepth *= chisq_crit[iconf][0];
*stime *= chisq_crit[iconf][0];
}
return(ecount);
}
int
main (int argc, char **argv)
{
int c,
verbose = 0,
errflg = 0;
char *dbinname=malloc(1024);
char *dboutname=malloc(1024);
Point *poly;
double lat,lon;
char *subset_expr=NULL;
char *name=malloc(100);
long nregions, nvertices;
Tbl *sortkeys;
Dbptr dbin,dbout,dbi,dbo,dbs;
long i,from,to,nv;
long vertex;
elog_init ( argc, argv ) ;
while ((c = getopt (argc, argv, "s:vV")) != -1) {
switch (c) {
case 's':
subset_expr=optarg;
break;
case 'v':
verbose++ ;
break;
case 'V':
usage ();
break;
case '?':
errflg++;
break ;
}
}
if ((errflg) || argc < 3)
usage ();
dbinname = argv[optind++];
dboutname= argv[optind++];
if (dbopen(dbinname,"r",&dbin)) {
elog_die(1,"cannot open database %s",dbinname);
}
dbi=dblookup(dbin,0,"polygon",0,0);
if (subset_expr) {
dbi=dbsubset(dbi,subset_expr,NULL);
}
sortkeys=newtbl(1);
pushtbl(sortkeys,"pname");
dbs=dbsort(dbi,sortkeys,0,"sorted");
dbquery(dbs,dbRECORD_COUNT,&nregions);
if (nregions <1) {
elog_die(0,"table regions seems to be empty (or not present)");
}
if (verbose) elog_notify(0,"creating database descriptor %s",dboutname);
if (dbcreate(dboutname,"places1.2",0,0,0)) {
elog_die(1,"cannot create database %s",dboutname);
}
dbopen(dboutname,"r+",&dbout);
dbo=dblookup(dbout,0,"regions",0,0);
for (i=0; i< nregions; i++) {
dbs.record=i;
dbgetv(dbs,0,"pname",name,NULL );
nvertices=readPolygon(dbs,&poly);
for (nv=0;nv < nvertices;nv++) {
lat=poly[nv].lat;
lon=poly[nv].lon;
dbaddv(dbo,0,
"regname",name,
"vertex",nv,
"lat",lat,"lon",lon,
NULL );
}
free(poly);
}
dbclose(dbo);
/*
*/
return 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 );
}
}
}
}
int main(int argc, char **argv)
{
SegyReel reel;
SegyHead *header;
char *dbin;
char *outfile;
FILE *fp;
Pf *pf;
Arr *channels; /* channel order list */
Arr *table_list; /* array of valid tables */
int nchan;
char *stest;
float **traces;
char reel1[3200];
Dbptr db, trdb, dbj;
Dbptr trdbss;
int nsamp0;
double time0, endtime0, samprate0;
long int nsamp;
double samprate;
int i,j;
char stime[30],etime[30];
char s[128];
double tlength;
double phi, theta;
char *newchan_standard[3]={"X1","X2","X3"};
char *trsubset="chan=~/X./";
char *newchan[3]={"R","T","Z"};
Tbl *sortkeys=newtbl(0);
char sta[10],chan[10];
double lat, lon, elev, dnorth, deast, edepth;
char refsta[10];
int total_traces=0;
char *time_str;
long int evid,shotid=1;
int rotate=0;
long int ntraces;
int ichan;
int map_to_cdp; /* logical switch to output data like cdp stacked data */
char *fmt="%Y %j %H %M %S %s";
char *pfname;
int Verbose=0;
/* New features added 2009 */
/* this is a boolean. If true (nonzero) it is assumed stdin will
contain four numbers: time,lat, lon, elev. If false, only the
time field is read and remainder of any input on each line is dropped.*/
int input_source_coordinates;
/* scale factor for source coordinates. Needed because segy uses
an int to store source coordinates. Sensible choices are
3600 for arc seconds and 10000 for a pseudodecimal. Note this
parameter is ignored unless input_source_coordinates is true.*/
int coordScale;
/* If true use passcal 32 bit extension num_samps as record length.
SEGY standard uses a 16 bit entry that easily overflows with large
shots at long offset. In this ase assume the 16 bit quantity is
meaningless. */
int use_32bit_nsamp;
/* This is switched on by argument switch. When set to a nonzero
(default) the reel headers are written. When 0 `
the reel heades will not be written -- used by seismic unix
r
and passcal*/
int write_reel_headers=1;
char *substr=NULL;
if(argc < 3) usage();
dbin = argv[1];
outfile = argv[2];
pfname = NULL;
for(i=3;i<argc;++i)
{
if(!strcmp(argv[i],"-pf"))
{
++i;
pfname = argv[i];
}
else if(!strcmp(argv[i],"-SU"))
{
write_reel_headers=0;
}
else if(!strcmp(argv[i],"-v"))
{
Verbose=1;
}
else if(!strcmp(argv[i],"-ss"))
{
++i;
substr=argv[i];
}
else
{
usage();
}
}
if(pfname == NULL) pfname = strdup("db2segy");
elog_init(argc, argv);
if(pfread(pfname,&pf))
elog_die(0,"pfread error for pf file %s.pf\n",argv[0]);
/* rotation parameters */
rotate=pfget_boolean(pf,"rotate");
if(rotate)
{
phi = pfget_double(pf,"phi");
theta = pfget_double(pf,"theta");
}
/* This function creates the channel order list keyed by
station channel names */
channels = build_stachan_list(pf,&nchan,Verbose);
map_to_cdp = pfget_boolean(pf,"map_to_cdp");
if(map_to_cdp && Verbose)
fprintf(stdout,"Casting data as CDP stacked section\n");
if(dbopen(dbin,"r",&db) == dbINVALID)
{
fprintf(stderr,"Cannot open db %s\n", dbin);
usage();
}
/* We grab the sample rate and trace length (in seconds) and
use this to define global sample rates for the data.
segy REQUIRES fixed length records and sample rates, so
irregular sample rates will cause this program to die.
One could add a decimate/interpolate function, but this
is not currently implemented */
samprate0 = pfget_double(pf,"sample_rate");
tlength = pfget_double(pf,"trace_length");
nsamp0 = (int)(tlength*samprate0);
use_32bit_nsamp=pfget_boolean(pf,"use_32bit_nsamp");
/* nsamp in segy is a 16 bit field. Handling depends on
setting of use_32bit_nsamp boolean */
if(nsamp0 > 32767)
{
if(use_32bit_nsamp)
{
elog_notify(0,"Warning: segy ues a 16 bit entity to store number of samples\nThat field is garbage. Using the 32 bit extension field.\n");
}
else
{
elog_complain(0,
"Warning: segy uses a 16 bit entity to store number of samples\nRequested %d samples per trace. Trucated to 32767\n",nsamp0);
nsamp0 = 32767;
}
}
input_source_coordinates=pfget_boolean(pf,"input_source_coordinates");
if(input_source_coordinates)
{
coordScale=pfget_int(pf,"coordinate_scale_factor");
}
else
{
coordScale=1;
}
/* boolean. When nonzero set coordinates as geographic arc seconds values */
int use_geo_coordinates=pfget_boolean(pf,"use_geo_coordinates");
/* check list of tables defined in pf. Return array of
logicals that define which tables are valid and join
tables. */
table_list = check_tables(db,pf);
check_for_required_tables(table_list);
dbj = join_tables(db,pf,table_list);
if(dbj.record == dbINVALID) elog_die(0,"dbjoin error\n");
if(substr!=NULL) dbj=dbsubset(dbj,substr,0);
long int ndbrows;
dbquery(dbj,dbRECORD_COUNT,&ndbrows);
if(ndbrows<=0)
{
fprintf(stderr,"Working database view is empty\n");
if(substr!=NULL) fprintf(stderr,"Subset condtion =%s a likely problem\n",
substr);
usage();
}
fp = fopen(outfile,"w");
if(fp == NULL)
{
fprintf(stderr,"Cannot open output file %s\n",outfile);
usage();
}
/* These are needed for sort below */
pushtbl(sortkeys,"sta");
pushtbl(sortkeys,"chan");
/*The reel1 header in true blue segy is ebcdic. We are goingto
just fill it with nulls and hope for the best */
for(i=0;i<3200;i++) reel1[i] = '\0';
/* Just blindly write this turkey. Bad form, but tough*/
if(write_reel_headers) fwrite(reel1,1,3200,fp);
/* memory allocation for trace data. This is a large matrix
that is cleared for each event. This model works because of
segy's fixed length format. This routine is a descendent of
numerical recipes routine found in libgenloc. This is not
the most efficient way to do this, but it simplifies the
algorithm a lot. */
traces = matrix(0,nchan,0,nsamp0);
if(traces == NULL)
elog_die(0,"Cannot alloc trace data matrix work space of size %d by %d\n",
nchan, nsamp0);
header = (SegyHead *)calloc((size_t)nchan,sizeof(SegyHead));
if(header == NULL)
elog_die(0,"Cannot alloc memory for %d segy header workspace\n",nchan);
if(write_reel_headers)
{
/* now fill in the binary reel header and write it */
reel.kjob = 1;
reel.kline = 1;
reel.kreel = 1;
reel.kntr = (int16_t)nchan;
reel.knaux = 0;
reel.sr = (int16_t)(1000000.0/samprate0);
reel.kfldsr = reel.sr;
reel.knsamp = (int16_t)nsamp0;
reel.kfsamp = (int16_t)nsamp0;
reel.dsfc=5; /* This is ieee floats*/
reel.kmfold = 0;
if(map_to_cdp)
reel.ksort = 2;
else
reel.ksort = 1;
reel.kunits = 1; /* This sets units to always be meters */
for(i=0;i<344;++i)reel.unused2[i]='\0';
if(fwrite((void *)(&reel),sizeof(SegyReel),1,fp) != 1)
{
fprintf(stderr,"Write error for binary reel header\n");
exit(-2);
}
}
/* Now we enter a loop over stdin reading start times.
Program will blindly ask for data from each start time to
time+tlength. The trace buffer will be initialized to
zeros at the top of the loop always. If nothing is found
only zeros will be written to output.
*/
while((stest=fgets(s,80,stdin)) != NULL)
{
double slat,slon,selev; /* Used when reading source location*/
if(Verbose)
fprintf(stdout,"Processing: %s\n",s);
for(i=0;i<nchan;++i)
{
initialize_header(&(header[i]));
header[i].lineSeq = total_traces + i + 1;
header[i].reelSeq = header[i].lineSeq;
if(map_to_cdp)
{
header[i].cdpEns = i + 1;
header[i].traceInEnsemble = 1; /* 1 trace per cdp faked */
}
else
{
header[i].channel_number = i + 1;
}
header[i].event_number = shotid;
header[i].energySourcePt=shotid;
for(j=0;j<nsamp0;++j) traces[i][j] = (Trsample)0.0;
}
if(input_source_coordinates)
{
char stmp[40];
sscanf(s,"%s%ld%lf%lf%lf",stmp,&shotid,&slon,&slat,&selev);
time0=str2epoch(stmp);
}
else
{
time0 = str2epoch(s);
}
endtime0 = time0 + tlength;
sprintf(stime,"%20.4f",time0);
sprintf(etime,"%20.4f",endtime0);
trdb.database = -1;
if(trload_css(dbj,stime,etime,&trdb,0, 0) < 0)
{
if(Verbose)
{
fprintf(stdout,"trload_css failed for shotid=%ld",shotid);
fprintf(stdout," No data in time range %s to %s\n",
strtime(time0),strtime(endtime0) );
fprintf(stdout,"No data written for this shotid block.");
fprintf(stdout," Handle this carefully in geometry definitions.\n");
}
continue;
}
/* This does gap processing */
repair_gaps(trdb);
trapply_calib(trdb);
if(rotate)
{
if(rotate_to_standard(trdb,newchan_standard))
elog_notify(0,"Data loss in rotate_to_standard for event %s to %s\n",
stime, etime);
/* This is need to prevent collisions of channel
names */
trdbss = dbsubset(trdb,trsubset,0);
if(trrotate(trdbss,phi,theta,newchan))
elog_notify(0,"Data loss in trrotate for event %s to %s\n",
stime, etime);
}
if(Verbose)
fprintf(stdout,"Station chan_name chan_number seq_number shotid evid\n");
trdb = dbsort(trdb,sortkeys,0,0);
dbquery(trdb,dbRECORD_COUNT,&ntraces);
if(Verbose) fprintf(stdout,"Read %ld traces for event at time%s\n",
ntraces,strtime(time0));
for(trdb.record=0;trdb.record<ntraces;++trdb.record)
{
Trsample *trdata;
if(dbgetv(trdb,0,
"evid",&evid,
"sta",sta,
"chan",chan,
"nsamp", &nsamp,
"samprate",&samprate,
"data",&trdata,
"lat", &lat,
"lon", &lon,
"elev",&elev,
"refsta",refsta,
"dnorth",&dnorth,
"deast",&deast,
"edepth",&edepth,
NULL) == dbINVALID)
{
elog_complain(0," dbgetv error reading record %ld\nTrace will be skipped for station %s and channel %s\n",
trdb.record,sta,chan);
continue;
}
/* Allow 1 percent samprate error before killing */
double fsrskew=fabs((samprate-samprate0)/samprate0);
double frskewcut=0.01;
if(fsrskew>frskewcut)
{
elog_complain(0,"%s:%s sample rate %f is significantly different from base sample rate of %f\nTrace skipped -- segy requires fixed sample rates\n",
sta,chan,samprate,samprate0);
continue;
}
if(nsamp > nsamp0)
{
elog_complain(0,"%s:%s trace has extra samples=%ld\nTruncated to length %d\n",
sta, chan, nsamp, nsamp0);
nsamp = nsamp0;
}
else if(nsamp < nsamp0)
{
elog_complain(0,"%s:%s trace is shorter than expected %d samples\nZero padded after sample %ld\n",
sta, chan, nsamp0, nsamp);
}
ichan = get_channel_index(channels,sta,chan);
if(ichan > nchan) elog_die(0,"Channel index %d outside limit of %d\nCannot continue\n",
ichan, nchan);
if(ichan >= 0)
{
if(Verbose)
fprintf(stdout,"%s:%s\t%-d\t%-d\t%-ld\t%-ld\n",
sta,chan,ichan+1,
header[ichan].reelSeq,
shotid, evid);
header[ichan].traceID = 1;
for(j=0;j<nsamp;++j)
traces[ichan][j] = (float)trdata[j];
/* header fields coming from trace table */
header[ichan].samp_rate = (int32_t)
(1000000.0/samprate0);
if(!use_geo_coordinates && ( coordScale==1))
{
header[ichan].recLongOrX = (int32_t)(deast*1000.0);
header[ichan].recLatOrY = (int32_t)(dnorth*1000.0);
}
else
{
/* Note negative here. This is a oddity
of segy that - means divide by this to
get actual. Always make this negative in case
user inputs a negative number. */
header[ichan].coordScale=-abs(coordScale);
/* Force 2 = geographic coordinates. Standard says when this is
so units are arc seconds, hence we multiply deg by 3600*coordScale */
if(use_geo_coordinates)
{
header[ichan].coordUnits=2;
header[ichan].recLongOrX
=(int32_t)(lon*3600.0*(double)coordScale);
header[ichan].recLatOrY
=(int32_t)(lat*3600.0*(double)coordScale);
}
else
{
header[ichan].recLongOrX
=(int32_t)(lon*(double)coordScale);
header[ichan].recLatOrY
=(int32_t)(lat*(double)coordScale);
}
}
header[ichan].recElevation = (int32_t)(elev*1000.0);
header[ichan].deltaSample = (int16_t)
(1000000.0/samprate0);
header[ichan].sampleLength = (int16_t)nsamp0;
header[ichan].num_samps = (int32_t)nsamp0;
/* This cracks the time fields */
time_str = epoch2str(time0,fmt);
sscanf(time_str,"%hd %hd %hd %hd %hd %hd",
&header[ichan].year,
&header[ichan].day,
&header[ichan].hour,
&header[ichan].minute,
&header[ichan].second,
&header[ichan].m_secs);
/* These are PASSCAL extensions, but we'll
go ahead and set them anyway.*/
header[ichan].trigyear = header[ichan].year;
header[ichan].trigday = header[ichan].day;
header[ichan].trighour = header[ichan].hour;
header[ichan].trigminute = header[ichan].minute;
header[ichan].trigsecond = header[ichan].second;
free(time_str);
if(input_source_coordinates)
{
if(use_geo_coordinates)
{
slat*=3600.0;
slon*=3600.0;
}
header[ichan].sourceLongOrX
=(int32_t)(slon*(double)coordScale);
header[ichan].sourceLatOrY
=(int32_t)(slat*(double)coordScale);
header[ichan].sourceSurfaceElevation
=(int32_t)selev;
/* No easy way to specify both elev and depth*/
header[ichan].sourceDepth=0;
}
else if(map_to_cdp)
{
/* When faking CDP data we make this look
like a zero offset, single fold data set */
header[ichan].sourceLongOrX = header[ichan].recLongOrX;
header[ichan].sourceLatOrY = header[ichan].recLatOrY;
header[ichan].sourceSurfaceElevation = header[ichan].recElevation;
header[ichan].sourceDepth = 0;
header[ichan].sourceToRecDist = 0;
}
else
{
/* This is the mechanism for adding other
information with added tables. The one
table currently supported is a "shot" table
that holds shot coordinates. If other tables
were added new functions could be added with
a similar calling sequence. This procedure
silently does nothing if a shot table is not
present.*/
set_shot_variable(db,table_list,
evid,&header[ichan]);
}
}
else
{
if(Verbose)
fprintf(stdout,"Station %s and channel %s skipped\n",
sta,chan);
}
}
/* Now we write the data */
for(i=0;i<nchan;++i)
{
if(fwrite((void *)(&(header[i])),sizeof(SegyHead),1,fp) != 1)
elog_die(0,"Write error on header for trace %d\n",total_traces+i);
if(fwrite((void *)traces[i],sizeof(float),
(size_t)nsamp0,fp) != nsamp0)
elog_die(0,"Write error while writing data for trace %d\n",
total_traces+i);
}
total_traces += nchan;
trdestroy(&trdb);
if(!input_source_coordinates) ++shotid;
}
return 0 ;
}
int read_dec_files (Tbl *decdef, int *dec_fac, Tbl **decimators)
{
int i, j, n;
Response *rsp;
char string[512];
FILE *file;
FIR_decimation *decptr;
Response *resp;
resp = (Response *) new_response ();
if(*decimators == NULL) *decimators = newtbl(0);
if (resp == NULL) {
elog_die(0, "read_dec_files: Malloc error on decimation response structure.\n");
return (0);
}
for (i=0,(*dec_fac)=1; i<maxtbl(decdef); i++) {
int ok;
char *decfile;
decfile = gettbl(decdef,i);
if(!strcmp(decfile,"none") )
{
*dec_fac = 1.0;
decptr = (FIR_decimation *) malloc(sizeof(FIR_decimation));
if(decptr == NULL)
{
elog_notify(0,"Cannot malloc decimation structure for stage %d\n",
i);
return(0);
}
decptr->decfac = 1.0;
decptr->ncoefs = 0;
decptr->coefs=NULL;
pushtbl(*decimators,decptr);
return(2);
}
file = fopen(decfile, "r");
if (file == NULL) {
elog_notify(0, "read_dec_files: Unable to open response stage file '%s'.\n",
decfile);
return (0);
}
if (read_response (file, &rsp)) {
elog_clear_register(1);
elog_notify(0, "read_dec_files: read_response() error on stage file '%s'.\n",
decfile);
return (0);
}
fclose (file);
get_response_nstages (rsp, &n);
for (j=0,ok=0; j<n; j++) {
int dec_factor, nnum, nden;
double srate;
get_response_stage_type (rsp, j, string);
if (strcmp(string, "fir")) continue;
get_response_stage_fir_ncoefs (rsp, j, &srate, &dec_factor, &nnum, &nden);
if (nden > 1) {
elog_notify(0, "read_dec_files: Dont know how to do IIR filters (%s).\n",
decfile);
return (0);
}
if (nnum < 1) {
elog_notify(0, "read_dec_files: No numerator terms (%s).\n",
decfile);
return (0);
}
ok=1;
(*dec_fac) *= dec_factor;
}
if (!ok) {
elog_notify(0, "read_dec_files: no fir stage on file '%s'.\n",
decfile);
return (0);
}
for (j=0; j<n; j++) {
Response_group *gpi;
get_response_stage_type (rsp, j, string);
if (strcmp(string, "fir")) continue;
gpi = rsp->groups + j;
if (copy_response_group (gpi, (resp), -1) < 0) {
elog_notify(0, "read_dec_files: copy_response_group() error.\n");
return (0);
}
}
free_response (rsp);
}
get_response_nstages ((resp), &n);
for (i=0; i<n; i++) {
Response_group *gpi;
int dec_factor, nnum, nden;
double srate;
double *coefsi, *coefs_err;
double *coefdi, *coefd_err;
decptr = (FIR_decimation *) malloc(sizeof(FIR_decimation));
if(decptr == NULL)
{
elog_notify(0,"Cannot malloc decimation structure for stage %d\n",
i);
return(0);
}
gpi = (resp)->groups + i;
get_response_stage_fir_ncoefs ((resp), i, &srate, &dec_factor, &nnum, &nden);
get_response_stage_fir_coefs ((resp), i, &nnum, &coefsi, &coefs_err,
&nden, &coefdi, &coefd_err);
for (j=0; j<nnum/2; j++) if (coefsi[j] != coefsi[nnum-j-1]) break;
if (j < nnum/2) {
elog_notify(0, "read_dec_files: Can only do symetrical FIR filters.\n");
return (0);
}
decptr->ncoefs = nnum;
decptr->decfac = dec_factor;
decptr->coefs = calloc(nnum,sizeof(float));
if((decptr->coefs) == NULL)
elog_die(0,"read_dec_files: can't alloc filter coef array of length %d\n",nnum);
for(j=0; j<nnum; j++) decptr->coefs[j] = coefsi[j];
pushtbl(*decimators,decptr);
}
return (1);
}
void compute_location(Location_options o,
RTlocate_Options rtopts,
Arr *stations, Arr *arrays, Arr *phases,
Pf *pf,
Dbptr master_db, Dbptr dbtmp, ORB_Hypocenter hyp, int orbout)
{
Tbl *ta,*tu; /* Arrival and slowness tables respectively */
Hypocenter h0;
int ret_code;
Tbl *converge_history,*reason_converged,*residual;
Hypocenter *hypo;
int niterations;
char *vmodel;
int i;
char *s;
int orid;
Point origin;
double delta, seaz;
double **C;
float *emodel;
int nass;
initialize_hypocenter(&h0);
/* It is inefficient to reread these from the parameter
space on each entry, but preferable to a burdensome
argument list */
origin.lat = pfget_double(pf,"center_latitude");
origin.lon = pfget_double(pf,"center_longitude");
origin.z = 0.0;
/* This routine translates hyp structure to return tbl
of arrival object pointers */
ta = orbhypo_to_genloc(&hyp,phases,stations);
/* this is a pure place holder */
tu = newtbl(0);
vmodel = pfget_string(pf,"velocity_model_name");
/* By default we use the location transmitted by orbassoc.
This can be overriden in the parameter file by using the
other options allowed in genloc*/
s=pfget_string(pf,"initial_location_method");
h0.lat = hyp.lat;
h0.lon = hyp.lon;
h0.z = hyp.depth;
h0.time = hyp.time;
/* this strange logic is to allow this parameter to be defaulted.
If the "initial_location_method" is not defined, or set
to "manual", we use the location given by orbassoc. Otherwise
we utilize genlocs suite of initial locate options. */
if(s != NULL)
if(strcmp(s,"manual"))
h0 = initial_locate(ta, tu, o, pf);
/* Now compute distance from origin, and process only if
the event falls in the specified range */
dist(rad(origin.lat),rad(origin.lon),rad(h0.lat),rad(h0.lon),
&delta,&seaz);
delta = deg(delta);
/* this is the distance sifting test to ignore things outside
specified distance range */
if( ((delta>=rtopts.minimum_distance)
&& (delta <= rtopts.maximum_distance)) )
{
/* Location with Generic Gauss_Newton code */
orid = -1;
nass = maxtbl(ta);
ret_code = ggnloc(h0,ta,tu,o,
&converge_history,&reason_converged,&residual);
if(ret_code < 0)
{
elog_notify (0,"ggnloc failed to produce a solution for evid %d\n",hyp.evid);
}
else
{
if(ret_code > 0)
elog_notify(0,"Warning: %d travel time calculator failures in ggnloc\nSolution ok for evid %d\n",
ret_code,hyp.evid);
C = dmatrix(0,3,0,3);
emodel = (float *) calloc(4,sizeof(float));
if((emodel == NULL) || (*C == NULL) )
elog_die(0,"Malloc error for error arrays\n");
niterations = maxtbl(converge_history);
hypo = (Hypocenter *)gettbl(converge_history,
niterations-1);
predicted_errors(*hypo, ta, tu, o, C, emodel);
orid = save_origin(nass,hyp.evid,master_db,
dbtmp,*hypo,o,orbout);
save_origerr(orid,*hypo,C,dbtmp,orbout);
save_assoc(ta, tu, orid, vmodel,
*hypo, dbtmp,orbout);
elog_notify(0,"orid %d converged in %d iterations\n",
orid,niterations);
elog_notify(0,"Reason(s) for convergence: \n");
for(i=0;i<maxtbl(reason_converged);++i)
elog_notify(0,"%s",gettbl(reason_converged,i));
elog_notify(0,"\n");
s=format_hypo(hypo);
elog_notify(0,"%s\n",s);
free(emodel);
free_matrix((char **)C,0,3,0);
free(s);
}
write_to_logfile(rtopts, orid, hyp.evid,
pf, converge_history, reason_converged,residual);
if(maxtbl(converge_history)>0)freetbl(converge_history,free);
if(maxtbl(reason_converged)>0)freetbl(reason_converged,free);
if(maxtbl(residual)>0)freetbl(residual,free);
}
destroy_data_tables(ta, tu);
return;
}
int
main(int argc, char **argv)
{
int verbose = 0;
char *dbname = malloc(STRSZ);
char *datafilename = malloc(STRSZ);
char *name = malloc(STRSZ);
char *line = malloc(STRSZ);
char str1[20], str2[20], *str3 = malloc(1024);
int level = 0;
int closed = 0, close = 0;
int maxpoints = 5000;
Point *poly = malloc(maxpoints * sizeof(double));
double lat, lon;
long npoints;
char *auth = malloc(STRSZ);
char ptype[STRSZ];
char *dir = malloc(STRSZ), *dfile = malloc(STRSZ), *tname = malloc(STRSZ),
numstr[10];
int ftype = polyFLOAT;
Dbptr db;
FILE *fh;
int putit;
int polycounter = 0;
elog_init(argc, argv);
my_username(auth);
strcat(auth, ":gmt");
strcpy(name, "-");
strcpy(dir, "-");
strcpy(dfile, "gmt.bin");
strcpy(ptype, "-");
for (argc--, argv++; argc > 0; argc--, argv++) {
if (!strcmp(*argv, "-auth")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -auth argument.\n");
usage();
exit(1);
}
auth = *argv;
} else if (!strcmp(*argv, "-dir")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -dir argument.\n");
usage();
exit(1);
}
dir = *argv;
} else if (!strcmp(*argv, "-dfile")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -dfile argument.\n");
usage();
exit(1);
}
dfile = *argv;
} else if (!strcmp(*argv, "-pname")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -pname argument.\n");
usage();
exit(1);
}
name = *argv;
} else if (!strcmp(*argv, "-ptype")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -ptype argument.\n");
usage();
exit(1);
}
strncpy(ptype, *argv, 2);
} else if (!strcmp(*argv, "-level")) {
argc--;
argv++;
if (argc < 3) {
elog_complain(0, "Need -level argument.\n");
usage();
exit(1);
}
level = atoi(*argv);
} else if (!strcmp(*argv, "-close_polygons")) {
close = 1;
} else if (!strcmp(*argv, "-v")) {
verbose++;
} else if (**argv != '-') {
break;
} else {
elog_complain(0, "unrecognized argument '%s'\n", *argv);
usage();
exit(1);
}
}
if (argc < 2) {
elog_complain(0, "Need datfile and db arguments.\n");
usage();
exit(1);
}
datafilename = *argv;
argc--;
argv++;
dbname = *argv;
if (access(datafilename, 4)) {
elog_die(0, "datafile %s should be READABLE!\n", datafilename);
}
if (dbcreate(dbname, "polygon1.2", 0, 0, 0)) {
elog_die(1, "can't create database %s\n", dbname);
}
if (!strcmp(name, "-")) {
strcpy(name, datafilename);
}
dbopen(dbname, "r+", &db);
db = dblookup(db, 0, "polygon", 0, 0);
fh = fopen(datafilename, "r");
putit = 0;
npoints = 0;
polycounter = 0;
while (fgets(line, 80, fh) != 0) {
if (line[0] == '>') {
if (putit) {
strcpy(tname, name);
if (polycounter > 0) {
sprintf(numstr, ".%d", polycounter);
tname = strcat(tname, numstr);
}
if (verbose) {
elog_notify(0, "%s: (%ld points n file %s/%s)\n", tname, npoints, dir, dfile);
}
if (npoints > 2 && (close || (
(poly[0].lat == poly[npoints - 1].lat) &&
(poly[0].lon == poly[npoints - 1].lon)))) {
closed = 1;
}
writePolygonData(db, poly, npoints, tname, closed, level, ptype, auth, dir, dfile, ftype);
closed = 0;
polycounter++;
}
strtrim(line);
npoints = 0;
putit = 1;
} else {
sscanf(line, "%s %s %s", str1, str2, str3);
lon = atof(str1);
lat = atof(str2);
if (npoints > maxpoints - 2) {
maxpoints += 5000;
poly = realloc(poly, maxpoints);
}
poly[npoints].lat = lat;
poly[npoints].lon = lon;
npoints++;
}
}
if (npoints > 0) {
strcpy(tname, name);
if (polycounter > 0) {
sprintf(numstr, ".%d", polycounter);
strcat(tname, numstr);
}
if (verbose) {
elog_notify(0, "%s: (%ld points n file %s/%s)\n", tname, npoints, dir, dfile);
}
if (npoints > 2 && (close || (
(poly[0].lat == poly[npoints - 1].lat) &&
(poly[0].lon == poly[npoints - 1].lon)))) {
closed = 1;
}
writePolygonData(db, poly, npoints, tname, closed, level, ptype, auth, dir, dfile, ftype);
closed = 0;
}
fclose(fh);
elog_print(0, 0);
return 0;
}
int svdcmp (float **A, int m, int n, float *s, float **V)
{
float *afort, *vfort; /*Vector format work spaces */
int i;
int info=0;
#ifndef SUNPERF
int one=1;
float *swork;
int ldwork;
#endif
/*Alloc work spaces and copy from numerical recipes matrix
form to the form sunperf wants */
afort = (float *) calloc(m*MAX(m,n),sizeof(float));
vfort = (float *) calloc(n*n,sizeof(float));
if( (afort == NULL) || (vfort == NULL))
die(0,"svdcmp could not alloc work arrays\n");
#ifdef SUNPERF
for(i=0;i<m;++i)
scopy(n,A[i],1,(afort+i),m);
#else
for(i=0;i<m;++i)
scopy_(&n,A[i],&one,(afort+i),&m);
#endif
/* old rule: always initialize things like this */
for(i=0;i<n*n;++i) vfort[i] = 0.0;
#ifdef SUNPERF
sgesvd('o','s',m,n,afort,m,s,NULL,m,vfort,n,&info);
#else
ldwork = 12+2*n; /* This is slightly larger than the minimum
required for safety. Space required is never
large by modern standards */
swork = calloc(ldwork,sizeof(float));
if(n == NULL) die(0,"Cannot alloc work space for SVD routine\n");
sgesvd_("o","s",&m,&n,afort,&m,s,NULL,&m,vfort,&n,
swork, &ldwork,
&info);
free(swork);
#endif
if(info!=0)
{
if(info > 0)
elog_notify(0,"Convergence failure in svd routine\n");
else
elog_notify(0,"Illegal value for argument %d passed to sgesvd\nNo solution possible\n",
-info);
free(afort);
free(vfort);
return(info);
}
#ifdef SUNPERF
/* note we do return something even when convergence failed.
Must handle negative return as junk is returned then. */
for(i=0;i<m;++i)
scopy(n,(afort+i),m,A[i],1);
/* Note this copies V transpose in vfort to V in the matrix V.
Tricky BLAS code I know*/
for(i=0;i<n;++i)
scopy(n,(vfort+i*n),1,V[i],1);
#else
for(i=0;i<m;++i)
scopy_(&n,(afort+i),&m,A[i],&one);
for(i=0;i<n;++i)
scopy_(&n,(vfort+i*n),&one,V[i],&one);
#endif
free(afort);
free(vfort);
return(0);
}
/* This function creates the mwslow table output of mwap.
This table hold slowness vector estimates.
arguments:
phase - name of seismic phase
u - estimated slowness vector
t0 - start time at reference station
twin - length of analysis time window relative to t0
array - array name to use in table for station key field
evid - css3.0 evid of parent data
bankid - defines unique multiwavelet bank (could be
extracted from traces of gather, but it is
so deep in indirection it gets ridiculous)
fc - center frequency (in Hz) of this wavelet bank.
fwin - bandwidth (in Hz) of this wavelet
C - 3x3 covariance matrix estimate for this slowness vector
(ux,uy, t order assumed )
cohtype - type of coherence measure used (mapped in multiwavelet.h)
peakcm - value of coherence measure for this fc and evid.
db - output database
Returns 0 if dbaddv was successful, -1 if dbaddv fails.
Author: G Pavlis
Written: March 2000
*/
int MWdb_save_slowness_vector(char *phase,
MWSlowness_vector *u,
double t0,
double twin,
char *array,
int evid,
int bankid,
double fc,
double fwin,
double *C,
int nsta,
int ncomp,
int cohtype,
double peakcm,
Dbptr db)
{
double slo, azimuth, cxx, cyy, cxy;
char cmeasure[2];
slo = hypot(u->ux,u->uy);
azimuth = atan2(u->ux,u->uy);
azimuth = deg(azimuth);
db = dblookup(db,0,"mwslow",0,0);
switch(cohtype)
{
case(USE_COHERENCE):
strcpy(cmeasure,"c");
break;
case(USE_SEMBLANCE):
default:
strcpy(cmeasure,"s");
}
if( dbaddv(db,0,"sta",array,
"evid",evid,
"bankid",bankid,
"phase", phase,
"fc",fc,
"fwin",fwin,
"time",t0,
"twin",twin,
"slo",slo,
"azimuth",azimuth,
"cxx",C[0],
"cyy",C[4],
"cxy",C[1],
"nsta",nsta,
"ncomp",ncomp,
"cohtype",cmeasure,
"cohmeas",peakcm,
"algorithm","mwap",0) < 0)
{
elog_notify(0,
"dbaddv error for mwslow table on evid %d fc=%lf\n",
evid,fc);
return(-1);
}
else
return(0);
}
/* This function saves particle motion parameter estimates to a extension
table called mwpm. Individual station estimates and an array average
estimate are all saved in the same table. they can be sorted out through
the key field pmtype set to "ss" for single station and "aa" for array average.
Arguments:
array - array name used as tag on the array average row
evid - css3.0 event id
bankid - multiwavelet bank id tag
phase - seismic phase name as in css3.0
fc - center frequency of band in hz.
t0 - start time at reference station for particle motion analysis
twin - length of analysis time window relative to t0
g - MWgather structure for this band. The routine loops through
the list defined by this complicated structure.
moveout - moveout vector. Elements of moveout are a parallel array
to g->sta and related quanties in the gather structure.
pmarr - particle motion structures array indexed by station name
pmerrarr - particle motion error structure array indexed by station name
pmavg - particle motion ellipse parameters for array average
pmaerr - error parameters associated with pmavg
db - output database
Author: G Pavlis
Written: march 2000
*/
int MWdb_save_pm(
char *array,
int evid,
int bankid,
char *phase,
double fc,
double t0,
double twin,
MWgather *g,
double *moveout,
Arr *pmarr,
Arr *pmerrarr,
Particle_Motion_Ellipse *pmavg,
Particle_Motion_Error *pmaerr,
Dbptr db)
{
char *sta;
int i;
Particle_Motion_Ellipse *pm;
Particle_Motion_Error *pmerr;
int errcount=0;
double time;
int nsta;
Spherical_Coordinate scoor;
double majaz, majema, minaz, minema;
db = dblookup(db,0,"mwpm",0,0);
nsta = g->nsta;
/* We look through the whole gather quietly skipping entries
flagged bad with a null pointer */
for(i=0;i<nsta;++i)
{
pm = (Particle_Motion_Ellipse *)getarr(pmarr,g->sta[i]->sta);
pmerr = (Particle_Motion_Error *)getarr(pmerrarr,g->sta[i]->sta);
/* Silently skip null entries because autoediting makes
this happen often. We could trap the condition where
one of these pointers is null and the other is not, but
this should not happen so I skip it.*/
if( (pm != NULL) && (pmerr != NULL) )
{
/* We have to correct the start time for moveout.
This asssumes the moveout vector has the current
best estimate */
time = t0 + moveout[i];
/* The pm structure stores the major and minor axes
as unit vectors. It is more compact and more
intuitive to store these quantities in spherical coord
form (az and ema) in the database so we have to convert
them. NOte also all angles are stored internally
in radians and need to be converted to degrees with
the deg for external consumption. */
scoor = unit_vector_to_spherical(pm->major);
/* Note azimuth in geographical coordinates is
not the same as the phi angle in spherical coordinates
used here. It is 90 - phi */
majaz = 90.0 - deg(scoor.phi);
majema = deg(scoor.theta);
scoor = unit_vector_to_spherical(pm->minor);
minaz = 90.0 - deg(scoor.phi);
minema = deg(scoor.theta);
if( dbaddv(db,0,
"sta",g->sta[i]->sta,
"bankid",bankid,
"fc",fc,
"phase",phase,
"evid",evid,
"time",time,
"twin",twin,
"pmtype","ss",
"majoraz",majaz,
"majorema",majema,
"minoraz",minaz,
"minorema",minema,
"rect",pm->rectilinearity,
"errmajaz",deg(pmerr->dphi_major),
"errmajema",deg(pmerr->dtheta_major),
"errminaz",deg(pmerr->dphi_minor),
"errminema",deg(pmerr->dtheta_minor),
"errrect",pmerr->delta_rect,
"majndgf",pmerr->ndgf_major,
"minndgf",pmerr->ndgf_minor,
"rectndgf",pmerr->ndgf_rect,
"algorithm","mwap",0) < 0)
{
elog_notify(0,"dbaddv error in mwpm table for station %s\n",sta);
++errcount;
}
}
}
/* now we add a row for the array average. This is flagged only
by the pmtype field. */
scoor = unit_vector_to_spherical(pmavg->major);
majaz = 90.0 - deg(scoor.phi);
majema = deg(scoor.theta);
scoor = unit_vector_to_spherical(pmavg->minor);
minaz = 90.0 - deg(scoor.phi);
minema = deg(scoor.theta);
if( dbaddv(db,0,
"sta",array,
"bankid",bankid,
"fc",fc,
"phase",phase,
"evid",evid,
"time",time,
"twin",twin,
"pmtype","aa",
"majoraz",majaz,
"majorema",majema,
"minoraz",minaz,
"minorema",minema,
"rect",pmavg->rectilinearity,
"errmajaz",deg(pmaerr->dphi_major),
"errmajema",deg(pmaerr->dtheta_major),
"errminaz",deg(pmaerr->dphi_minor),
"errminema",deg(pmaerr->dtheta_minor),
"errrect",pmaerr->delta_rect,
"majndgf",pmaerr->ndgf_major,
"minndgf",pmaerr->ndgf_minor,
"rectndgf",pmaerr->ndgf_rect,
"algorithm","mwap",0) < 0)
{
elog_notify(0,"dbaddv error saving array average particle motion parameters in mwpm table for evid %d\n",
evid);
++errcount;
}
return(errcount);
}
int MWdb_save_statics(
int evid,
int bankid,
char *phase,
double fc,
double t0,
double twin,
double refelev,
MWgather *g,
double *moveout,
Arr *statics,
Arr *stations,
Arr *snrarr,
Arr *arrivals,
Arr *model_times,
Dbptr db)
{
char *sta;
int i;
MWstatic *mws;
MWstation *s;
Signal_to_Noise *snr;
int errcount=0;
double time;
int nsta;
Dbptr dbt, dba, dbsnr;
double ampdb, aerrdb;
double *atime,*modtime,resid;
int ierr;
dbt = dblookup(db,0,"mwtstatic",0,0);
dba = dblookup(db,0,"mwastatic",0,0);
dbsnr = dblookup(db,0,"mwsnr",0,0);
nsta = g->nsta;
for(i=0;i<nsta;++i)
{
/* We keep all snr estimates that can be found in the snarr
array. Station with low signal to noise ratio are automatically
deleted in processing so it is useful to record this fact in
the database in the mwsnr table. Note we silently skip stations
not found in the array for snr */
sta = g->sta[i]->sta;
snr = (Signal_to_Noise *)getarr(snrarr,sta);
if(snr != NULL)
{
/* negative snr values are used to flag null entries
that are still processed. We don't want these store
here though so we skip them.*/
if (((snr->ratio_z) > 0.0)
&& ((snr->ratio_n) > 0.0)
&& ((snr->ratio_e) > 0.0)
&& ((snr->ratio_3c) > 0.0) )
{
if( dbaddv(dbsnr,0,
"sta",sta,
"fc",fc,
"bankid",bankid,
"phase",phase,
"evid",evid,
"nstime",snr->nstime,
"netime",snr->netime,
"sstime",snr->sstime,
"setime",snr->setime,
"snrz",snr->ratio_z,
"snrn",snr->ratio_n,
"snre",snr->ratio_e,
"snr3c",snr->ratio_3c,
"algorithm","mwap",0) < 0)
{
elog_notify(0,"mwtstatic dbaddv error for station %s\n",sta);
++errcount;
}
}
}
mws = (MWstatic *)getarr(statics,sta);
/* Again we silently skip stations without an entry in
this array because they can auto-edited in processing
so this is not an error. */
if(mws != NULL)
{
s = (MWstation *)getarr(stations,sta);
if(s == NULL)
{
elog_complain(0,"MWdb_save_time_statics cannot find entry for station %s\nThis should NOT happen--program may have ovewritten itself!\n",
sta);
continue;
}
/* We have to correct the start time for moveout.
This asssumes the moveout vector has the current
best estimate */
time = t0 + moveout[i];
/* We store the residual relative to a model time.
There may be a more elegant way to skip saving resid
in the conditional below with dbNULL, but I couldn't
figure out that process. */
atime = (double *)getarr(arrivals,sta);
modtime = (double *)getarr(model_times,sta);
if((atime==NULL) || (modtime == NULL) )
{
ierr = dbaddv(dbt,0,
"sta",sta,
"fc",fc,
"bankid",bankid,
"phase",phase,
"evid",evid,
"time",time,
"twin",twin,
"wgt",s->current_weight_base,
"estatic",s->elevation_static,
"pwstatic",s->plane_wave_static,
"rstatic",s->residual_static,
"errstatic",mws->sigma_t,
"ndgf",mws->ndgf,
"datum",refelev,
"algorithm","mwap",0);
}
else
{
resid = (*atime) - (*modtime);
ierr = dbaddv(dbt,0,
"sta",sta,
"fc",fc,
"bankid",bankid,
"phase",phase,
"evid",evid,
"time",time,
"twin",twin,
"wgt",s->current_weight_base,
"estatic",s->elevation_static,
"pwstatic",s->plane_wave_static,
"rstatic",s->residual_static,
"errstatic",mws->sigma_t,
"ndgf",mws->ndgf,
"datum",refelev,
"timeres",resid,
"algorithm","mwap",0);
}
if(ierr<0)
{
elog_notify(0,"mwtstatic dbaddv error for station %s\n",sta);
++errcount;
}
/* zero weight stations will have a static
time shift computed, but the amplitude will
be meaningless. Thus, we skip stations with
a zero weight */
if((s->current_weight_base)>0.0)
{
/* output amplitude statics are converted to db */
ampdb = 20.0*(mws->log10amp);
aerrdb = 20.0*(mws->sigma_log10amp);
if( dbaddv(dba,0,
"sta",sta,
"ampcomp",AMPCOMP,
"fc",fc,
"bankid",bankid,
"phase",phase,
"evid",evid,
"time",time,
"twin",twin,
"wgt",s->current_weight_base,
"ndgf",mws->ndgf,
"ampstatic",ampdb,
"erramp",aerrdb,
"algorithm","mwap",0) < 0)
{
elog_notify(0,"mwtstatic dbaddv error for station %s\n",sta);
++errcount;
}
}
}
}
return(errcount);
}
int
main (int argc, char **argv)
{
int c ;
char *liss_server ;
int timeout = 10;
int verbose = 0 ;
int defaultport = 4000 ;
unsigned char *seed ;
int fd = -1 ;
Bns *bns=0 ;
elog_init (argc, argv);
announce(0,0) ;
while ((c = getopt (argc, argv, "v")) != -1) {
switch (c) {
case 'v':
verbose++ ;
break;
default:
usage ();
}
}
if (argc - optind < 1)
usage ();
allot(unsigned char *, seed, SIZE) ;
for(;optind < argc;optind++) {
liss_server = argv[optind] ;
elog_notify(0, "opening %s\n", liss_server) ;
fd = open_socket ( liss_server, defaultport ) ;
if ( fd < 0 ) {
elog_complain ( 1, "Can't open liss server %s", liss_server ) ;
} else {
int out ;
bns = bnsnew(fd, 8192) ;
bnsuse_sockio(bns) ;
bnstimeout ( bns, timeout*1000 ) ;
bnsclr(bns) ;
bns->fd = fd ;
elog_notify(0, "reading %d bytes from %s\n", SIZE, liss_server) ;
if ( bnsget(bns, seed, BYTES, SIZE ) == 0 ) {
out = open(liss_server, O_WRONLY | O_CREAT, 0664 ) ;
if ( out == 0 ) {
elog_die (0, "Can't open %s to write", liss_server) ;
}
elog_notify(0, "writing %d bytes from %s\n", SIZE, liss_server) ;
if ( write(out, seed, SIZE) != SIZE ) {
elog_complain(0, "failed to write %d bytes to %s", SIZE, liss_server) ;
}
if ( close(out) != 0 ) {
elog_complain(0, "failed to close %s", liss_server) ;
}
} else {
elog_complain(0, "Failed to read data from %s", liss_server) ;
}
if ( bnsclose(bns) != 0 ) {
elog_complain(0, "failed to close bns #%d for %s", fd, liss_server) ;
}
}
}
return 0 ;
}
/* 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);
}
/* This function is used to check a list of pf names to verify they
are in the parameter space. It is useful for any program that uses
parameter files that cracks the pf space anywhere except up front.
That is, the pf space is a convenient place to store all the run time
parameters of any program and is a convenient way to pass a large
control structure. However, because flow can be complex it is possible
to have parameters that are only accessed deep within a program and
in these situations it is desirable to run a check at program initialization
to verify the required parameters will be there when required.
Normally a string variable will not cause pfget to die, but it will
here if it is listed as required
Parameters to be checked are grouped by type. Each numerical fields
can contain an optional range check. This is not allowed for strings.
Code below only checks int, double, boolean, and string variables. Because of
the complexity of Tbl and Arrs I thought this not worth messing with.
Furthermore, it is not unusual to have an empty Tbl list or Arr that
the program should handle correctly.
Function will die on the first occurence of a problem parameter.
It is void because it only returns if everything checks out.
Author: Gary L. Pavlis
*/
void check_required_pf(Pf *pf)
{
Tbl *t,*testtbl;
Pf *pf_required;
char *key;
int i,j,nitems;
int itest, ilowcheck, ihighcheck;
double dtest, dlowcheck, dhighcheck;
int bool;
char *line;
char *ctest;
char name[50];
/* This cracks the "required" &Arr dies if it isn't present
at all. This assumes you wouldn't call this routine if you
weren't serious about checking */
if(pfget(pf,"require",(void **)&pf_required) != PFARR)
die(0,"Arr of required parameters (require &Arr) missing from parameter space\nMust be present to execute this program\n");
t=pfkeys(pf_required);
for(i=0;i<maxtbl(t);++i)
{
key = gettbl(t,i);
if(!strcmp(key,"int"))
{
testtbl = pfget_tbl(pf_required,"int");
for(j=0;j<maxtbl(testtbl);++j)
{
line = gettbl(testtbl,i);
nitems = sscanf(line,"%s%d%d",name,&ilowcheck,
&ihighcheck);
itest = pfget_int(pf,name);
if(nitems == 3)
{
if( (itest < ilowcheck)
|| (itest > ihighcheck) ) die(0,
"Parameter %s has value %d which is outside required range of %d to %d\n",
name,itest,ilowcheck,ihighcheck);
}
}
}
else if(!strcmp(key,"double"))
{
testtbl = pfget_tbl(pf_required,"double");
for(j=0;j<maxtbl(testtbl);++j)
{
line = gettbl(testtbl,i);
nitems = sscanf(line,"%s%lg%lg",name,&dlowcheck,
&dhighcheck);
dtest = pfget_double(pf,name);
if(nitems == 3)
{
if( (dtest < dlowcheck)
|| (dtest > dhighcheck) ) die(0,
"Parameter %s has value %lg which is outside required range of %lg to %lg\n",
name,dtest,dlowcheck,dhighcheck);
}
}
}
else if(!strcmp(key,"boolean"))
{
testtbl = pfget_tbl(pf_required,"boolean");
for(j=0;j<maxtbl(testtbl);++j)
{
line = gettbl(testtbl,i);
itest = pfget_boolean(pf,line);
}
}
else if(!strcmp(key,"string"))
{
testtbl=pfget_tbl(pf_required,"string");
for(j=0;j<maxtbl(testtbl);++j)
{
line = gettbl(testtbl,i);
ctest = pfget_string(pf,line);
if(ctest == NULL)
die(0,"Missing required string variable = %s\n",
line);
}
}
else
{
elog_notify(0,"Unknown required type name = %s\nRequired parameters under this heading will not be checked\n",
key);
}
}
freetbl(t,0);
}
/* this is a blas like function analogous to scopy, dcopy, etc
for a matrix of pointers to Particle_Motion_Vector objects. I could
have made this a general matrix function, I suppose, but I decided that
would be a bit opaque, and would promote on of C's most evil features.
The pointers are blindly copied and it assumed the output vector
bounds are not violated.
Arguments:
n - number of elements in input and output vectors]
x - input vector of pointers
incx - storage increment of x ala blas
y - output vector
incy - storage increment of y ala blas.
Written: February 2000
Author: G Pavlis
*/
void pmvector_copy(int n, Particle_Motion_Ellipse *x, int incx,
Particle_Motion_Ellipse *y, int incy)
{
int i,ix,iy;
for(i=0,ix=0,iy=0;i<n;++i,ix+=incx,iy+=incy)
{
y[iy] = x[ix];
}
}
#define PM_MINSCALE_MAJOR 0.2 /* This needs to be pretty large compared to
good data because if the errors get much
larger than this the results are trash anyway */
#define PM_MINSCALE_MINOR 1.0 /* Minor axis can easily be totally random.
Nearly always happens for pure linear pm.
This essentially turns off robust weighting */
void pmvector_average(Particle_Motion_Ellipse *pmv, int n,
Particle_Motion_Ellipse *pmavg, Particle_Motion_Error *pmerr)
{
int i,j,ii;
double *v; /* work space used to store coordinates passed
to m-estimator routine */
double avg[3];
double *weight;
double nrm_major, nrm_minor;
Spherical_Coordinate scoor;
double U[9]; /* transformation matrix*/
double work[3];
double *workn;
double dotprod;
double sumsq,sumwt;
int ndgf;
MW_scalar_statistics stats;
double nrmtest;
allot(double *,v,3*n);
allot(double *,weight,n);
allot(double *,workn,n);
for(i=0,ii=0;i<n;++i,ii+=3)
{
/* This could be done with the blas, but it would
be more obscure and no faster */
v[ii] = pmv[i].major[0];
v[ii+1] = pmv[i].major[1];
v[ii+2] = pmv[i].major[2];
}
/* We use relative scaling here because the pm vectors are
not normalized. We could use absolute scaling if we normalized
them above. This is a modification that might actually give
better results. */
M_estimator_double_n_vector(v,3,n,
IQ_SCALE_RELATIVE,PM_MINSCALE_MAJOR,avg,weight);
nrm_major = dnrm2(3,avg,1);
for(i=0;i<3;++i)
{
/* Needed to avoid random NaN */
if(nrm_major<FLT_EPSILON)
pmavg->major[i] = avg[i];
else
pmavg->major[i] = avg[i]/nrm_major;
}
/* Error estimates are computed completely differently here from
that described in Bear and Pavlis (1999). Rather than use a
jackknife on individual angles, here I've chosen to use a simple
standard deviation measure using weighted residuals. The residuals,
however, are computed from total angular separation computed using
a dot product. This allows us to avoid wraparound errors that
are inevitable with angles.
First step is to compute a vector of angle residuals. */
for(i=0,ii=0;i<n;++i,ii+=3)
{
dotprod = ddot(3,v+ii,1,pmavg->major,1);
dotprod /= dnrm2(3,v+ii,1);
workn[i] = acos(dotprod);
}
/* weighted mean formula for error */
for(i=0,sumwt=0.0,sumsq=0.0;i<n;++i)
{
sumsq += workn[i]*workn[i]*weight[i]*weight[i];
sumwt += weight[i];
}
ndgf = nint(sumwt) - 3;
if(ndgf<1)
{
elog_notify(0,"pmvector_average: sum of weights = %lf in major axis average implies degrees of freedom less than 1\nUsing 1 degree of freedom\n",sumwt);
ndgf = 1;
}
pmerr->ndgf_major = ndgf;
pmerr->dtheta_major = sqrt(sumsq/((double)ndgf));
/* We scale the azimuthal error by 1/sin(theta) to get a stable
error estimate that correctly goes to infinitity when theta -> 0*/
scoor = unit_vector_to_spherical(pmavg->major);
pmerr->dphi_major = (pmerr->dtheta_major)/sin(scoor.theta);
/* We first project the minor axis vectors onto the plane
perpendicular to the average major axis. This reduces the
degrees of freedom in a way that I consider reasonable and
is in line with with Lorie Bear did */
for(i=0,ii=0;i<n;++i,ii+=3)
{
double minor_scale;
/* Intentionally ignore error return of null project because
the only error condition in current code cannot happen
with this call. null_project writes result in the
last argument, so this step is functionally like the
v[ii]=pmv[i].major, etc. loop above, but combines
the projection operation . */
null_project(pmavg->major,3,1,pmv[i].minor,v+ii);
/* We also want to scale the vector by a factor
that is determinable from rectilinearity to keep
the axis length consistent to allow a refined
rectilinearity average below */
minor_scale = 1.0 - pmv[i].rectilinearity;
dscal(3,minor_scale,v+ii,1);
}
/* This constructs a rotational tranformation to a coordinate
system where x1 and x2 are in the desired projection plane.
Actually, the null projection above is redundant, but for now
the extra work is largely irrelevant and is a good cross check
for debugging. */
ray_coordinate_trans(scoor,U);
for(i=0;i<n;++i)
{
for(j=0;j<3;++j)
{
work[j] = ddot(3,v+j+3*i,1,U+j,3);
}
dcopy(3,work,1,v+3*i,1);
}
/* Note the change from above to a 2-d space now. The above
transformations zero the x3 direction after the transformation */
M_estimator_double_n_vector(v,2,n,
IQ_SCALE_RELATIVE,PM_MINSCALE_MINOR,avg,weight);
avg[2] = 0.0;
nrm_minor = hypot(avg[0],avg[1]);
/* This is the inverse tranformation -- u is orthogonal */
for(j=0;j<3;++j)
work[j] = ddot(3,U+j*3,1,avg,1);
/* This is similar to above, but, perhaps incorrectly, the
degrees of freedom are larger by one because we reduce the
space to 2d */
for(i=0,ii=0;i<n;++i,ii+=3)
{
dotprod = ddot(2,v+ii,1,avg,1);
nrmtest = dnrm2(2,v+ii,1);
if(nrmtest<=0.0)
{
elog_notify(0,"pmvector_average: minor axis estimate %d of %d estimates has 0 projection perpendicular to major\nArtificially set to average\n",
i,n);
workn[0] = 0.0;
}
else
{
dotprod/= nrmtest;
/* because avg wasn't normalized we have divide by norm */
dotprod /= nrm_minor;
workn[i] = acos(dotprod);
}
}
/* We want the final result normalized to a unit vector length */
for(i=0;i<3;++i) pmavg->minor[i] = work[i]/nrm_minor;
/* weighted mean formula again */
for(i=0,sumwt=0.0,sumsq=0.0;i<n;++i)
{
sumsq += workn[i]*workn[i]*weight[i]*weight[i];
sumwt += weight[i];
}
ndgf = nint(sumwt) - 2;
if(ndgf<1)
{
elog_notify(0,"pmvector_average: sum of weights = %lf in minor axis average implies degrees of freedom less than 1\nUsing 1 degree of freedom\n",sumwt);
ndgf = 1;
}
pmerr->ndgf_minor = ndgf;
pmerr->dtheta_minor = sqrt(sumsq/((double)ndgf));
/* We cast the minor axis in spherical coordinates like
the major axis. This differ's from Lorie's skew measures, but
it is simpler to deal with in a database output as it treats
the two vector in a common way */
scoor = unit_vector_to_spherical(pmavg->minor);
pmerr->dphi_minor = (pmerr->dtheta_major)/sin(scoor.theta);
/* Finally, we deal with rectilinearity.
We use the contents of v which are the projected
minor axis values rather than the raw minor
axes. This estimator will tend to give slightly
better rectilinearity using the raw vectors
because a projection is always <= original */
for(i=0;i<n;++i)
{
double minor_nrm;
minor_nrm = dnrm2(3,v+i*3,1);
/* Not needed because the major axis vector
was previously normalized to unit length
major_nrm = dnrm2(3,pmv[i].major,1);
*/
workn[i] = 1.0 - minor_nrm;
}
stats = MW_calc_statistics_double(workn,n);
pmavg->rectilinearity = stats.median;
pmerr->ndgf_rect = n - 1;
/* Assume a simple normal distribution to convert interquartiles
to standard deviation */
pmerr->delta_rect = NORMAL_IQSCALE*((stats.q3_4)-(stats.q1_4));
free(weight);
free(workn);
free(v);
}
int decimate_trace(Tbl *dectbl,float *in, int nin, double dt0, double t0,
float **out, int *nout, double *dt, double *t0out)
{
int i,nstages;
float *buf, *buf2;
FIR_decimation *d;
int decfac; /* current decimation factor */
double deltat0=0.0; /* accumulation of time offsets for edge
condition of FIR filter (i.e. we don't
do partial convolutions on edges) */
double dt_this_stage;
double si; /* current sample interval (staged to larger values) */
int n; /* current number of samples */
int ret_code;
nstages = maxtbl(dectbl);
buf = (float *) calloc (nin,sizeof(float));
buf2 = (float *) calloc (nin,sizeof(float));
if( (buf == NULL) || (buf2 == NULL) )
{
elog_notify(0,"decimate_trace: cannot malloc buffers of length %d\n",
nin);
return(-999);
}
/* Note this routine works if nstages = 0 (empty tbl) */
scopy(nin,in,1,buf,1);
decfac = 1;
si=dt0;
n=nin;
for (i=0; i<nstages; i++)
{
d = (FIR_decimation *) gettbl(dectbl,i);
/* this computation of the time offset to the first
decimated output sample assumes the FIR filter is
zero phase and symmetric. The -1 may surprise
you, but is correct and was verified by tests.
It is the interval versus points problem. */
decfac *= d->decfac;
dt_this_stage = si*((double)((d->ncoefs)-1))/2.0;
deltat0 += dt_this_stage;
si *= (double)(d->decfac);
if((d->decfac == 1) && (d->ncoefs == 0) )
{
/* Fall in this block for no decimation with
zero length filter (the "none" case ) */
scopy(n,buf,1,buf2,1);
*nout = n;
}
else
{
if((d->ncoefs)>n)
{
free(buf);
free(buf2);
out = NULL;
*nout = 0;
return(-1);
}
ret_code = sconv(buf,n,d->coefs,d->ncoefs,0,d->decfac,
buf2,nout);
/* This fragment should never really be executed, but better
safe than sorry. We don't issue a warning because the
correction should be appropriate. */
if(ret_code > 0)
{
double time_correction;
time_correction = si*((double)ret_code);
deltat0 += time_correction;
}
}
/* this always works because nout <= nin */
scopy(*nout,buf2,1,buf,1);
n = *nout;
}
/* finally the output vector is created here */
*out = (float *)calloc(*nout,sizeof(float));
if(*out == NULL)
elog_die(0,"decimate_trace: cannot malloc output vector of length %d\n",
*nout);
scopy(*nout,buf2,1,*out,1);
*t0out = t0 + deltat0;
*dt = si;
free(buf);
free(buf2);
return(decfac);
}
Travel_Time_Function_Output ttlvz_time_exec(Ray_Endpoints x,
char *phase, int mode)
{
double delta, d_km; /* epicentral distance in radians and km resp.*/
double azimuth; /* source to receiver azimuth angle (radians) */
double z0; /* hold first layer depth (see below) */
Travel_Time_Function_Output o;
Vmodel *mod;
double *v, *z;
int nz;
double *work1,*work2;
double p;
int up; /* direct ray flag from ttlvz */
/* First we compute the epicentral distance and azimuth */
dist(rad(x.slat), rad(x.slon), rad(x.rlat), rad(x.rlon),
&delta, &azimuth);
d_km = delta*RADIUS_EARTH;
/* We fetch the correct model structure for this phase */
mod = (Vmodel *)getarr(ttlvz_models,phase);
if (mod == NULL)
{
elog_complain(1,"ttlvz_time_exec: Don't know how to compute travel times for phase %s\n",phase);
o.time = TIME_INVALID;
return(o);
}
/* We cheat and distort the model to handle elevation corrections.
We do this by storing the original velocity and depth of the
first layer in (v0,z0), and then set the first point to the
receiver depth. I also do something devious here that could
be confusing. I set the pointers v and z to the P or S
model vectors depending on which phase I want to compute. This
avoids repetitious code, but adds a slight overhead at the end
where we need to reset the first layer values again.*/
z0 = mod->ztop[0];
if(x.rz < mod->ztop[1])
mod->ztop[0] = x.rz;
else
{
elog_notify(0,"Warning (ttlvz_time_exec): elevation correction error\nStation elevation %f lies below first layer depth %f\nElevation ignored\n",
x.rz, mod->ztop[1]);
}
/* This could be avoided, but it is a relic of the earlier code */
v = mod->velocity;
z = mod->ztop;
nz = mod->nlayers;
work1 = (double *) calloc(2*nz,sizeof(double));
work2 = (double *) calloc(2*nz,sizeof(double));
if( (work1 == NULL) || (work2 == NULL) )
die(1,"ttlvz_time_exec: Cannot alloc work arrays for phase %s\n",
phase);
ttlvz_(&d_km, &x.sz, &nz, v, z, work1, work2, &o.time, &p, &up);
if (o.time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave travel time for phase %s\n",phase);
o.time = TIME_INVALID;
return(o);
}
if(mode == ALL)
{
/* For this routine I calculate time derivatives from the
ray parameter that is returned by ttlvz.*/
int i,iz;
double vsource;
if(d_km <= 0.0)
{
o.dtdx = 0.0;
o.dtdy = 0.0;
p = 0.0;
}
else
{
o.dtdx = - fabs(p)*sin(azimuth);
o.dtdy = - fabs(p)*cos(azimuth);
}
/* Find the velocity in the layer in which the
source lies. We need to for the dtdz calculation */
for(i=1,iz=nz-1;i<nz;++i)
{
if(x.sz <= z[i])
{
iz = i-1;
break;
}
}
vsource = v[iz];
o.dtdz = cos(asin(fabs(p)*vsource))/vsource;
/* The strange logic for p<0.0 corrects the
sign of dtdz for the special case when the source
is above the first layer top. In this case, ttlvz
returns a negative p, and the proper sign of dtdz
is negative. */
if( (!up) || (p < 0.0) )
o.dtdz = -o.dtdz;
}
mod->ztop[0] = z0;
free(work1);
free(work2);
return(o);
}
/* This function extracts a time subset of a MWstack object defined
by the Time_Window function passed to it. It copies the subset of
the stack requested and returns a new MWstack object with the
ancillary parameters that define it correctly set. REturns a
NULL pointer if the time window requested does not overlap the
input stack data at all. If the input data span a smaller range
than the requested window a diagnostic is issue and the object
will be trimmed to match what is possible.
Arguments:
instack - input MWstack object
win - Time_Window defining region to be extractged
(only the start and end parameters are used)
Author: Gary Pavlis
Written: December 2001
*/
MWstack *MWextract_stack_window(MWstack *instack,Time_Window *win)
{
int i,j,k,kk,its,ite;
int tstart, tend; /* start and end values(in samples) actually used */
int nused;
int lag;
char *message="MWextract_stack_window: requested window is inconsistent with the stack window";
MWstack *outstack;
int nwavelets,nchan;
nwavelets = instack->nwavelets;
nchan = instack->nchan;
its = nint((instack->tstart)/(instack->dt));
ite = nint((instack->tend)/(instack->dt));
if(((win->tstart)>=ite) || ((win->tend)<=its) )
{
elog_complain(0,"%s\nStack window is %d to %d samples; Requested %d to %d\n",
message,its, ite, win->tstart, win->tend);
return(NULL);
}
else if( ((win->tstart)<its) && ((win->tend)<=ite))
{
tstart = its;
tend = win->tend;
elog_complain(0,"%s\nStack window is %d to %d samples; Requested %d to %d\nReset to %d to %d\n",
message,its, ite, win->tstart, win->tend,tstart,tend);
}
else if( ((win->tstart)>=its) && ((win->tend)>ite))
{
tstart = win->tstart;
tend = ite;
elog_complain(0,"%s\nStack window is %d to %d samples; Requested %d to %d\nReset to %d to %d\n",
message,its, ite, win->tstart, win->tend,tstart,tend);
}
else
{
tstart = win->tstart;
tend = win->tend;
}
lag = tstart - its;
nused = tend - tstart + 1;
outstack = create_MWstack(nwavelets,nchan,nused);
outstack->dt = instack->dt;
outstack->tstart = instack->tstart + ((double)lag)*instack->dt;
outstack->tend = outstack->tstart + ((double)(nused-1))*instack->dt;
outstack->dt = instack->dt;
for(i=0;i<nwavelets;++i)
for(j=0;j<nchan;++j)
{
outstack->amp[i][j].r = instack->amp[i][j].r;
outstack->amp[i][j].i = instack->amp[i][j].i;
}
for(j=0;j<nchan;++j) outstack->weights[j]=instack->weights[j];
if(instack->timeweight_applied)
{
elog_notify(0,"MWextract_subset_window: existing stack has a time weight function already applied\nResults may be biased\n");
for(k=0,kk=lag;k<nused;++k,++kk)
outstack->timeweight[k]=instack->timeweight[kk];
}
else
for(k=0;k<nused;++k) outstack->timeweight[k]=1.0;
outstack->stack_is_valid = 1;
for(i=0;i<nwavelets;++i)
ccopy(nused,instack->z[i]+lag,1,outstack->z[i],1);
return(outstack);
}
Slowness_Function_Output ttlvz_slow_exec (Ray_Endpoints x,
char *phase, int mode)
{
double delta, d_km; /* epicentral distance in radians and km resp.*/
double s2raz; /* source to receiver azimuth angle (radians) */
double uaz; /* gcp expected azimuth of propagation of arrival
(uaz != s2raz on a spherical earth) */
double z0; /* hold first layer depth (see below) */
Slowness_Function_Output o;
Vmodel *mod;
double *v, *z;
double *work1,*work2;
int nz;
double time, p;
int up; /* direct ray flag from ttlvz */
double ztmp;
/* First we compute the epicentral distance and azimuth */
dist(rad(x.slat), rad(x.slon), rad(x.rlat), rad(x.rlon),
&delta, &s2raz);
d_km = delta*RADIUS_EARTH;
/* Now compute the great circle path propagation azimuth */
dist(rad(x.rlat),rad(x.rlon),rad(x.slat),rad(x.slon),&delta,&uaz);
uaz += M_PI;
if(uaz >= 2.0*M_PI) uaz -= (2.0*M_PI);
/* We fetch the correct model structure for this phase */
mod = (Vmodel *)getarr(ttlvz_models,phase);
if (mod == NULL)
{
elog_complain(1,"ttlvz_slow_exec: Don't know how to compute slowness vectors for phase %s\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
/* We cheat and distort the model to handle elevation corrections.
We do this by storing the original velocity and depth of the
first layer in (v0,z0), and then set the first point to the
receiver depth. I also do something devious here that could
be confusing. I set the pointers v and z to the P or S
model vectors depending on which phase I want to compute. This
avoids repetitious code, but adds a slight overhead at the end
where we need to reset the first layer values again.*/
z0 = mod->ztop[0];
if(x.rz < mod->ztop[1])
mod->ztop[0] = x.rz;
else
{
elog_notify(0,"Warning (ttlvz_slowness_exec): elevation correction error\nStation elevation %f lies below first layer depth %f\nElevation ignored\n",
x.rz, mod->ztop[1]);
}
/* This could be avoided, but it is a relic of the earlier code */
v = mod->velocity;
z = mod->ztop;
nz = mod->nlayers;
work1 = (double *) calloc(2*nz,sizeof(double));
work2 = (double *) calloc(2*nz,sizeof(double));
if( (work1 == NULL) || (work2 == NULL) )
die(1,"ttlvz_slow_exec: Cannot alloc work arrays for phase %s\n",
phase);
ttlvz_(&d_km, &x.sz, &nz, v, z, work1, work2, &time, &p, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
/* This would be executed only for close, shallow sources.
It could probably be deleted, but we'll do it for completeness*/
if(p<0.0) p = -p;
o.ux = p*sin(uaz);
o.uy = p*cos(uaz);
if(mode == ALL)
{
double dx, dudr, dudz;
double sin_a, sin_a0, cos_a, cos_a0;
double p0,p1,p3,p4;
double dis;
sin_a0 = sin(s2raz);
cos_a0 = cos(s2raz);
sin_a = sin(uaz);
cos_a = cos(uaz);
if(up)
{
/* we calculate dudr by a 5 point central
difference formula. I don't mess with
truncation error calculations here, but I
do have to assure distance >=0 and < direct
to refracted crossover. Both points are
singular. When we get to close to the edges
we revert to simple forward or backward difference
formula.*/
dx = DX_STEP_SIZE;
if( d_km < 2.0*MINIMUM_DX)
{
dis = d_km+dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p1, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dudr = (p1-p)/dx;
}
else if(d_km-2.0*dx < 0.0)
{
while(d_km-2.0*dx < 0.0)
dx *= DX_SCALING_FACTOR;
}
/* Now check that the value at x+2*dx is
still an upward branch of the travel time curve.
If it isn't, reset the step size until it is.
When this isn't possible, revert to a backward
difference at the minumum step size. */
dis = d_km+2.0*dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p4, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
while(!up && (dx>=MINIMUM_DX) )
{
dx *= DX_SCALING_FACTOR;
dis = d_km+2.0*dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p4, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
}
if(dx<MINIMUM_DX)
{
/* In this situation, we revert to
a two point backward difference */
dx = MINIMUM_DX;
/* special for shallow sources close */
if(d_km-dx < 0.0) dx = d_km;
dis = d_km +dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p0, &up);
dudr = (p-p0)/dx;
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
}
else
{
/* if we land here we can safely use the
full 5 point formula. Five point is
a misnomer since the central point
cancels out, but so what*/
dis = d_km-2.0*dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p0, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dis = d_km-dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p1, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dis = d_km+dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p3, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dis = d_km+2.0*dx;
ttlvz_(&dis,&x.sz, &nz, v, z,
work1, work2, &time, &p4, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dudr = (p0-8.0*p1+8.0*p3-p4)/(12.0*dx);
}
/* bug fix Feb 1998. Else conditional is necessary
to avoid an indeterminate form that arises when
offset is 0.0 */
if(d_km > D_KM_CUTOFF)
{
o.duxdx = -sin_a*sin_a0*dudr - p*cos_a*cos_a0/d_km;
o.duxdy = -sin_a*cos_a0*dudr + p*cos_a*sin_a0/d_km;
o.duydx = -cos_a*sin_a0*dudr + p*sin_a*cos_a0/d_km;
o.duydy = -cos_a*cos_a0*dudr - p*sin_a*sin_a0/d_km;
}
else
{
o.duxdx = -dudr;
o.duxdy = 0.0;
o.duydx = 0.0;
o.duydy = -dudr;
}
/* We do the z derivatives more crudely because
they are of significant size only when a source is
close and below the array. In that situation,
accuracy should not be a serious problem with
fairly crude scaling like this. We do a simple
backward difference to avoid crossing over into
refracted branches. However, when source is shallow
we always use a forward difference to avoid
negative depths problems. */
if(x.sz <= DZ_STEP_SIZE)
{
ztmp = x.sz+DZ_STEP_SIZE;
ttlvz_(&d_km,&ztmp, &nz, v, z,
work1, work2, &time, &p0, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dudz = (p0 - p)/DZ_STEP_SIZE;
}
else
{
ztmp = x.sz-DZ_STEP_SIZE;
ttlvz_(&d_km,&ztmp, &nz, v, z,
work1, work2, &time, &p0, &up);
if (time < 0.0)
{
elog_complain(1,"ttlvz_time_exec: ttlvz could not compute direct wave slowness vector for phase %s while computing derivatives\n",phase);
o.ux = SLOWNESS_INVALID;
o.uy = SLOWNESS_INVALID;
return(o);
}
dudz = (p - p0)/DZ_STEP_SIZE;
}
o.duxdz = dudz*sin_a;
o.duydz = dudz*cos_a;
}
else
{
o.duxdx = -p*cos_a*cos_a0/d_km;
o.duxdy = p*cos_a*sin_a0/d_km;
o.duydx = p*sin_a*cos_a0/d_km;
o.duydy = -p*sin_a*sin_a0/d_km;
/* With constant velocity layer models, refracted
rays have exactly zero slowness derviatives wrt z*/
o.duxdz = 0.0;
o.duydz = 0.0;
}
}
mod->ztop[0] = z0;
free(work1);
free(work2);
return(o);
}
int main (int argc, char **argv)
{
Dbptr master_db, dbtmp;
char dbname[512]; /* dbtmp name assigned by maketmpdb */
char *orbname;
char *pffile=NULL;
Pf *pf; /* Input pf object handle */
Arr *arr_sta;
Arr *arr_a; /*Array object associative array -- purely a place holder*/
Arr *arr_phase;
int i;
char *statefile=NULL;
Point origin;
int orbin,orbout; /* We establish both a read and write connection
on seperate sockets so we can use orbreap on
the input */
int quit=0,last_pktid;
double last_pkttime;
int exhume_rcode; /* value returned by exhume*/
char *packet=0;
int orid_used;
Location_options o;
RTlocate_Options rt_opts;
ORB_Hypocenter hyp;
/* This initialization is necessary for the orb_arrivals_in routine
to work correctly on the first pass*/
hyp.assocs = NULL;
elog_init(argc, argv);
elog_notify (0, "$Revision$ $Date$") ;
if(argc < 2) usage(argv[0]);
orbname = argv[1];
for(i=2;i<argc;++i)
{
if(!strcmp(argv[i],"-pf"))
{
++i;
pffile = argv[i];
}
else if(!strcmp(argv[i],"-S"))
{
++i;
statefile = argv[i];
}
else
{
/* For this kind of program it seems wise to make it a fatal error to
have the arguments botched */
elog_complain(0,"Unrecognized argument %s\n",argv[i]);
usage(argv[0]);
}
}
/* set default this way*/
if(pffile == NULL) pffile = strdup(DEFAULT_PFFILE);
if(statefile == NULL) statefile = strdup(DEFAULT_STATEFILE);
/* parse parameter file and form all the genloc control and
internal static data structures */
i = pfread(pffile,&pf);
if(i != 0) elog_die(1,"Pfread error\n");
o = parse_options_pf (pf);
arr_sta = load_station_table(pf);
arr_a = load_array_table(pf);
arr_phase = parse_phase_parameter_file(pf);
/* Note this is a slightly different use of these variables
than that used by other genloc routines. Here we use it
like a coordinate system origin to select range of distances
to use. We actually reset these again in the location function,
but check them here to make sure these variables are in the
parameter space. pfget_double will cause the program to die
if these aren't defined.*/
origin.lat = pfget_double(pf,"center_latitude");
origin.lon = pfget_double(pf,"center_longitude");
origin.z = 0.0;
rt_opts = parse_rt_options(pf);
if(dbopen(rt_opts.work_db,"r+",&master_db ) == dbINVALID)
elog_die(1,"Unable to open master database %s\n",
rt_opts.work_db);
/* Now we open the orb server connections */
if( (orbin=orbopen(orbname,"r&")) < 0)
elog_die(0,"Cannot open ring buffer %s for reading\n",orbname);
if(orbselect(orbin,"/db/event|/db/origin|/db/assoc|/db/arrival") < 0)
elog_die(0,"Cannot select any db records from ring buffer %s\n",
orbname);
/* These are the state saving routines. quit is set nonzero
whenever the program catches a signal. We call bury below when
this happens. exhume_state is a function because I expect
it could be used again */
exhume_rcode = exhume ( statefile, 0, 0, 0 );
exhume_state(exhume_rcode);
if ( orbresurrect ( orbin, &last_pktid, &last_pkttime ) == 0 )
elog_complain( 0, "resurrection successful: repositioned to pktid #%d\n", last_pktid ) ;
else
{
orbseek (orbin, ORBOLDEST);
last_pktid = orbtell(orbin);
elog_complain( 0, "resurrection unsuccessful\nStarting at beginning of current orb at packet id %d\n",last_pktid ) ;
}
/* The following is basically a trick to create a db pointer that
never references any tables. This is the preferred approach for
orbpkt2db records which utilize the scratch record of this database
pointer. The fact that we destroy the file this creates turns
out to be a feature of datascope we can exploit here. */
if (maketmpdb ("css3.0", &dbtmp, dbname) < 0) {
elog_complain(0, "maketmpdb() error.\n");
exit (1);
}
/* This little routine initilizes the null record for each table
used here. This was necessary because we assemble records in the
scratch record. This sets proper nulls in fields that are not
referenced by this program. */
if(initialize_scratch_records(dbtmp) == dbINVALID)
elog_complain(0,"Warning: errors initializing null records in tables. May generate invalid data in some fields\n");
/*
unlink (dbname);
*/
if( (orbout=orbopen(orbname,"w&")) < 0)
elog_die(0,"Cannot open ring buffer %s for writing\n",orbname);
/* This loop is broken only by an error. We call bury after each
event is processed saving the current packet id. This should
effectively skip events that cause orbgenloc to die for some
reason. */
while(1)
{
int return_code;
return_code = orb_arrivals_in(orbin, dbtmp, &hyp,
&last_pktid,rt_opts);
if(return_code)
{
if(return_code < 0)
elog_complain(0,"Error reading db records from orb\nCurrent event skipped\n");
else
elog_complain(0,"Sequencing error reading db packets from orbassoc.\nOne or more events were probably skipped\n");
continue;
}
if(bury())
elog_complain(0,
"bury failed writing statefile %s\n",statefile);
compute_location(o,rt_opts,arr_sta,arr_a,arr_phase,
pf,master_db, dbtmp, hyp, orbout);
/* when last_pktid is -1 orb_arrivals_in does not do
an orbseek, so we always reset it here */
last_pktid = -1;
/* This is the only appropriate place to release
this space. This block is malloced in orb_arrivals_in*/
free(hyp.assocs);
hyp.assocs = NULL;
}
}
/*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;
}
}
}
int main(int argc, char **argv)
{
SEGYBinaryFileHeader reel;
SEGYTraceHeader *header;
char *dbin;
char *outfile;
FILE *fp;
Pf *pf;
Arr *channels; /* channel order list */
Arr *table_list; /* array of valid tables */
int nchan;
char *stest;
float **traces;
char text_file_header[SEGY_TEXT_HEADER_SIZE];
Dbptr db, trdb, dbj;
Dbptr trdbss;
int nsamp0;
double time0, endtime0, samprate0;
long int nsamp;
double samprate;
int i,j;
char stime[30],etime[30];
char s[128];
double tlength;
double phi, theta;
char *newchan_standard[3]={"X1","X2","X3"};
char *trsubset="chan=~/X./";
char *newchan[3]={"R","T","Z"};
Tbl *sortkeys=newtbl(0);
char sta[10],chan[10];
double lat, lon, elev, dnorth, deast, edepth;
char segtype;
char refsta[10];
int total_traces=0;
char *time_str;
long int evid,shotid=1;
int rotate=0;
long int ntraces;
int ichan;
int map_to_cdp; /* logical switch to output data like cdp stacked data */
char *fmt="%Y %j %H %M %S %s";
char *pfname;
int Verbose=0;
/* New features added 2009 */
/* this is a boolean. If true (nonzero) it is assumed stdin will
contain four numbers: time,lat, lon, elev. If false, only the
time field is read and remainder of any input on each line is dropped.*/
int input_source_coordinates;
/* scale factor for source coordinates. Needed because segy uses
an int to store source coordinates. Sensible choices are
3600 for arc seconds and 10000 for a pseudodecimal. Note this
parameter is ignored unless input_source_coordinates is true.*/
int coordScale;
/* If true use passcal 32 bit extension num_samps as record length.
SEGY standard uses a 16 bit entry that easily overflows with large
shots at long offset. In this ase assume the 16 bit quantity is
meaningless. */
int use_32bit_nsamp;
/* This is switched on by argument switch. When set to a nonzero
(default) the reel headers are written. When 0 `
the reel headers will not be written -- used by seismic unix
and passcal*/
int write_reel_headers=1;
/* SEG-Y version to output. Default is original 1975 spec (rev 0) */
int16_t segy_format = SEGY_FORMAT_REV_0;
/* dbsubset query string */
char *substr=NULL;
/* text_header_description is a buffer holding a user-supplied description
* to be placed in the 3200-byte text header block. It is controlled by
* the parameter file value text_header_description or by the -d command
* line option, with the latter taking precedence */
char* text_header_description=NULL;
if(argc < 3) usage();
dbin = argv[1];
outfile = argv[2];
pfname = NULL;
for(i=3;i<argc;++i)
{
if(!strcmp(argv[i],"-pf"))
{
++i;
pfname = argv[i];
}
else if(!strcmp(argv[i],"-SU"))
{
write_reel_headers=0;
}
else if(!strcmp(argv[i],"-v"))
{
Verbose=1;
}
else if(!strcmp(argv[i],"-d"))
{
++i;
text_header_description = strdup(argv[i]);
}
else if(!strcmp(argv[i],"-ss"))
{
++i;
substr=argv[i];
}
else if(!strcmp(argv[i],"-V"))
{
++i;
if (!strcmp(argv[i],"0")) {segy_format = SEGY_FORMAT_REV_0;}
else if(!strcmp(argv[i],"1")) {segy_format = SEGY_FORMAT_REV_1_0;}
else if(!strcmp(argv[i],"SU"))
{
segy_format = SEGY_FORMAT_SU;
write_reel_headers=0;
}
else
{
elog_complain(0, "SEG-Y Version must be either 1 or 0");
usage();
}
}
else
{
usage();
}
}
/* Command-line parameter sanity checking */
if (write_reel_headers==0 && segy_format != SEGY_FORMAT_SU){
complain(0, "The SU option cannot be used with the -V option");
usage();
}
if(pfname == NULL) pfname = strdup("db2segy");
elog_init(argc, argv);
if(pfread(pfname,&pf)) {
elog_die(0,"pfread error for pf file %s.pf\n",argv[0]);
}
/* Read the text_header_description if we weren't passed the -d option */
if (!text_header_description) {
text_header_description=pfget_string(pf, "text_header_description");
}
/* rotation parameters */
rotate=pfget_boolean(pf,"rotate");
if(rotate)
{
phi = pfget_double(pf,"phi");
theta = pfget_double(pf,"theta");
}
/* This function creates the channel order list keyed by
station channel names */
channels = build_stachan_list(pf,&nchan,Verbose);
map_to_cdp = pfget_boolean(pf,"map_to_cdp");
if(map_to_cdp && Verbose)
elog_notify(0,"Casting data as CDP stacked section\n");
if(dbopen(dbin,"r",&db) == dbINVALID)
{
elog_complain(1,"Cannot open db %s\n", dbin);
usage();
}
/* We grab the sample rate and trace length (in seconds) and
use this to define global sample rates for the data.
SEG-Y REV0 REQUIRES fixed length records and sample rates, so
irregular sample rates will cause this program to die.
One could add a decimate/interpolate function, but this
is not currently implemented */
samprate0 = pfget_double(pf,"sample_rate");
tlength = pfget_double(pf,"trace_length");
nsamp0 = (int)(tlength*samprate0);
use_32bit_nsamp=pfget_boolean(pf,"use_32bit_nsamp");
if (ntohs(segy_format) >= 0x0100 && use_32bit_nsamp) {
elog_complain(0,"The 32-bit extension field is incompatible with SEG-Y REV 1. Ignoring 'use_32bit_nsamp' from the parameter file");
use_32bit_nsamp=0;
}
/* nsamp in segy is a 16 bit field. Handling depends on
setting of use_32bit_nsamp boolean */
if(nsamp0 > SEGY_MAX_NSAMP)
{
if(use_32bit_nsamp)
{
elog_notify(0,"Warning: segy uses a 16 bit entity to store number of samples\nThat field is garbage. Using the 32 bit extension field.");
}
else
{
elog_complain(0,
"Warning: segy uses a 16 bit entity to store number of samples. Requested %d samples per trace. Trucated to %d", nsamp0, SEGY_MAX_NSAMP);
nsamp0 = SEGY_MAX_NSAMP;
}
}
/* boolean. When nonzero set coordinates as geographic arc seconds values */
int use_geo_coordinates=pfget_boolean(pf,"use_geo_coordinates");
/* boolean. When nonzero, output decimal degrees instead of arcseconds if
* the requested output format supports it (rev1 only) */
int prefer_decimal_degrees=pfget_boolean(pf, "prefer_decimal_degrees");
/* We now have enough information to decide the coordUnits for all traces */
int coordUnits = 0;
if (!use_geo_coordinates) {
coordUnits=SEGY_TRACE_COORDUNITS_LENGTH;
} else if (ntohs(segy_format) >= 0x0100 && prefer_decimal_degrees) {
coordUnits=SEGY_TRACE_COORDUNITS_DECIMAL_DEGREES;
} else {
coordUnits=SEGY_TRACE_COORDUNITS_ARCSECONDS;
}
/* We should have set our coordinate units now */
assert(coordUnits!=0);
input_source_coordinates=pfget_boolean(pf,"input_source_coordinates");
if(input_source_coordinates)
{
coordScale=pfget_int(pf,"coordinate_scale_factor");
}
else if (coordUnits==SEGY_TRACE_COORDUNITS_DECIMAL_DEGREES)
{
/* Use a sane scalar for decimal degrees. 10000 gives four decimal
* places of accuracy, which matches the CSS3.0 spec for lat and lon */
coordScale=10000;
}
else
{
coordScale=1;
}
/* Print a diagnostic message if the user gave a sub-optimal value for the
* coordScale */
if (coordUnits == SEGY_TRACE_COORDUNITS_DECIMAL_DEGREES &&
coordScale < 10000)
{
elog_alert(0,
"The supplied parameter 'coordinate_scale_factor' value of %d is less than 10000, and will cause loss of precision for decimal degree coordinates.",
coordScale);
}
else if (coordUnits == SEGY_TRACE_COORDUNITS_ARCSECONDS)
{
if (coordScale > 1000) {
elog_alert(0,
"The supplied parameter 'coordinate_scale_factor' value of %d is greater than 1000, and will cause loss of precision for arcsecond coordinates.",
coordScale);
}
}
/* trace_gain_type: signed int */
int16_t trace_gain_type = pfget_int(pf,"trace_gain_type");
if (trace_gain_type < 0)
{
die(0, "The trace_gain_type must be zero or greater");
}
else
{
trace_gain_type=htons(trace_gain_type);
}
/* check list of tables defined in pf. Return array of
logicals that define which tables are valid and join
tables. */
table_list = check_tables(db,pf);
check_for_required_tables(table_list);
dbj = join_tables(db,pf,table_list);
if(dbj.record == dbINVALID) elog_die(0,"dbjoin error\n");
if(substr!=NULL) dbj=dbsubset(dbj,substr,0);
long int ndbrows;
dbquery(dbj,dbRECORD_COUNT,&ndbrows);
if(ndbrows<=0)
{
elog_complain(1,"Working database view is empty\n");
if(substr!=NULL) elog_complain(0,"Subset condtion =%s a likely problem\n",
substr);
usage();
}
fp = fopen(outfile,"w");
if(fp == NULL)
{
elog_complain(0,"Cannot open output file %s\n",outfile);
usage();
}
/* These are needed for sort below */
pushtbl(sortkeys,"sta");
pushtbl(sortkeys,"chan");
/* Set up and write the Textual File Header */
initialize_text_header(text_file_header, segy_format,
text_header_description);
if(write_reel_headers){
if ( fwrite(text_file_header,1,SEGY_TEXT_HEADER_SIZE,fp) \
!= SEGY_TEXT_HEADER_SIZE ) {
elog_die(1,"An error occurred writing the textual file header");
}
}
/* memory allocation for trace data. This is a large matrix
that is cleared for each event. This model works because of
segy's fixed length format.*/
traces = calloc(nchan, sizeof(float*));
if(traces == NULL)
elog_die(1,"out of memory");
for (int r = 0; r < nchan; r++)
{
traces[r] = calloc(nsamp0, sizeof(float));
if(traces[r] == NULL)
elog_die(1,"out of memory");
}
header = (SEGYTraceHeader *)calloc((size_t)nchan,sizeof(SEGYTraceHeader));
if(header == NULL)
elog_die(0,"Cannot alloc memory for %d segy header workspace\n",nchan);
if(write_reel_headers)
{
if (Verbose) {
elog_debug(0,"Binary Headers - Using segy_format code 0x%04X\n", ntohs(segy_format));
}
initialize_binary_file_header(&reel, segy_format);
/* now fill in the binary reel header and write it */
reel.kjob = htonl(1);
reel.kline = htonl(1);
reel.kreel = htonl(1);
reel.kntr = htons((int16_t)nchan);
reel.knaux = htons(0);
reel.sr = htons((int16_t)(1000000.0/samprate0));
reel.kfldsr = reel.sr;
reel.knsamp = htons((int16_t)nsamp0);
reel.kfsamp = htons((int16_t)nsamp0);
reel.dsfc = htons(5); /* This is ieee floats*/
reel.kmfold = htons(0);
if(map_to_cdp)
reel.ksort = htons(2);
else
reel.ksort = htons(1);
reel.kunits = htons(1); /* This sets units to always be meters */
if(fwrite((void *)(&reel),sizeof(SEGYBinaryFileHeader),1,fp) != 1)
{
elog_die(1,"Write error for binary reel header");
}
}
/* Now we enter a loop over stdin reading start times.
Program will blindly ask for data from each start time to
time+tlength. The trace buffer will be initialized to
zeros at the top of the loop always. If nothing is found
only zeros will be written to output.
*/
while((stest=fgets(s,80,stdin)) != NULL)
{
double slat,slon,selev; /* Used when reading source location*/
if(Verbose)
elog_notify(0,"Processing: %s\n",s);
for(i=0;i<nchan;++i)
{
initialize_trace_header(&(header[i]), segy_format);
header[i].gainType = trace_gain_type;
header[i].lineSeq = htonl(total_traces + i + 1);
header[i].reelSeq = header[i].lineSeq;
if(map_to_cdp)
{
header[i].cdpEns = htonl(i + 1);
header[i].traceInEnsemble = htonl(1);/* 1 trace per cdp faked */
}
else
{
header[i].channel_number = htonl(i + 1);
}
header[i].event_number = htonl(shotid);
header[i].energySourcePt = htonl(shotid);
for(j=0;j<nsamp0;++j) traces[i][j] = htonf((Trsample)0.0);
}
if(input_source_coordinates)
{
char stmp[40];
sscanf(s,"%s%ld%lf%lf%lf",stmp,&shotid,&slon,&slat,&selev);
time0=str2epoch(stmp);
if(coordUnits == SEGY_TRACE_COORDUNITS_ARCSECONDS) {
slat*=3600.0;
slon*=3600.0;
}
slat *= (double)coordScale;
slon *= (double)coordScale;
}
else
{
time0 = str2epoch(s);
}
endtime0 = time0 + tlength;
sprintf(stime,"%20.4f",time0);
sprintf(etime,"%20.4f",endtime0);
trdb.database = -1;
if(trload_css(dbj,stime,etime,&trdb,0, 0) < 0)
{
if(Verbose)
{
elog_notify(0,"trload_css failed for shotid=%ld",shotid);
elog_notify(0," No data in time range %s to %s\n",
strtime(time0),strtime(endtime0) );
elog_notify(0,"No data written for this shotid block.");
elog_notify(0," Handle this carefully in geometry definitions.\n");
}
continue;
}
/* This does gap processing */
repair_gaps(trdb);
trapply_calib(trdb);
if(rotate)
{
if(rotate_to_standard(trdb,newchan_standard))
elog_notify(0,"Data loss in rotate_to_standard for event %s to %s\n",
stime, etime);
/* This is need to prevent collisions of channel names */
trdbss = dbsubset(trdb,trsubset,0);
if(trrotate(trdbss,phi,theta,newchan))
elog_notify(0,"Data loss in trrotate for event %s to %s\n",
stime, etime);
}
if(Verbose)
elog_notify(0,"Station chan_name chan_number seq_number shotid evid\n");
trdb = dbsort(trdb,sortkeys,0,0);
dbquery(trdb,dbRECORD_COUNT,&ntraces);
if(Verbose) elog_debug(0,"Read %ld traces for event at time%s\n",
ntraces,strtime(time0));
for(trdb.record=0;trdb.record<ntraces;++trdb.record)
{
Trsample *trdata;
if(dbgetv(trdb,0,
"evid",&evid,
"sta",sta,
"chan",chan,
"nsamp", &nsamp,
"samprate",&samprate,
"data",&trdata,
"lat", &lat,
"lon", &lon,
"elev",&elev,
"refsta",refsta,
"dnorth",&dnorth,
"deast",&deast,
"edepth",&edepth,
"segtype",&segtype,
NULL) == dbINVALID)
{
elog_complain(0," dbgetv error reading record %ld. Trace will be skipped for station %s and channel %s",
trdb.record,sta,chan);
continue;
}
/* Allow 1 percent samprate error before killing */
double fsrskew=fabs((samprate-samprate0)/samprate0);
double frskewcut=0.01;
if(fsrskew>frskewcut)
{
elog_complain(0,"%s:%s sample rate %f is significantly different from base sample rate of %f. Trace skipped -- segy requires fixed sample rates",
sta,chan,samprate,samprate0);
continue;
}
if(nsamp > nsamp0)
{
elog_complain(0,"%s:%s trace has extra samples=%ld. Truncated to length %d",
sta, chan, nsamp, nsamp0);
nsamp = nsamp0;
}
else if(nsamp < nsamp0)
{
elog_complain(0,"%s:%s trace is shorter than expected %d samples. Zero padded after sample %ld",
sta, chan, nsamp0, nsamp);
}
ichan = get_channel_index(channels,sta,chan);
if(ichan > nchan)
{
elog_die(0,"Channel index %d outside limit of %d. Cannot continue",
ichan, nchan);
}
if(ichan >= 0)
{
if(Verbose)
elog_debug(0,"%s:%s\t%-d\t%-d\t%-ld\t%-ld\n",
sta,chan,ichan+1,
ntohl(header[ichan].reelSeq),
shotid, evid);
header[ichan].traceID = get_trace_id_code_from_segtype(segtype);
for(j=0;j<nsamp;++j) {
traces[ichan][j] = htonf((float)trdata[j]);
}
/* header fields coming from trace table */
header[ichan].samp_rate = htonl(
(int32_t) (1000000.0/samprate0));
/* according to the behavior specified in the man page:
* if use_geo_coordinates is false:
* - coordUnits is length (meters)
* - therefore, we use deast for X and dnorth for Y
* if use_geo_coordinates is true:
* - we're using either arcseconds or decimal degrees
* - and therefore, we use lon for X and lat for Y
*
* coordUnits is based on use_arcseconds and the requested
* version of segY */
/* set the coordinate units in the trace header */
header[ichan].coordUnits = coordUnits;
/* Pick the source db fields for our receiver X and Y */
double recLongOrX = 0;
double recLatOrY = 0;
if (coordUnits == SEGY_TRACE_COORDUNITS_LENGTH) {
/* Use deast and dnorth
* CSS3.0 Schema specifies deast and dnorth are in KM.
* SEG-Y specifies easting and northing as meters,
* hence the 1000.0 multiplier here. */
recLongOrX = deast * 1000.0;
recLatOrY = dnorth * 1000.0;
} else if (coordUnits == SEGY_TRACE_COORDUNITS_ARCSECONDS){
/* Use lat and lon, converted to arcseconds */
recLongOrX = lon * 3600.0;
recLatOrY = lat * 3600.0;
} else {
/* Default case, which covers decimal degrees */
recLongOrX = lon;
recLatOrY = lat;
}
/* Apply our coordScale - the user can specify negative numbers,
* but they are treated as inverting the value, not as a divisor
* as in the SEG-Y field usage. See below where we always treat
* the scalar as a divisor in the SEG-Y field */
recLongOrX *= (double)coordScale;
recLatOrY *= (double)coordScale;
/* Set the coordScale in the header.
* Note negative here. This is a oddity of segy that - means
* divide by this to get actual. Always make this negative in
* case user inputs a negative number.
* Don't set it -1 for cosmetic reasons */
if (abs(coordScale) == 1)
{
header[ichan].coordScale = htons(1);
} else
{
header[ichan].coordScale = htons(-abs(coordScale));
}
/* Finally, write out the X and Y */
header[ichan].recLongOrX
= htonl((int32_t)recLongOrX);
header[ichan].recLatOrY
= htonl((int32_t)recLatOrY);
/* CSS3.0 specfies elev as being in km, SEG-Y wants it in m */
header[ichan].recElevation = htonl((int32_t)(elev*1000.0));
header[ichan].deltaSample = htons(
(int16_t) (1000000.0/samprate0));
header[ichan].sampleLength = htons((int16_t)nsamp0);
if (ntohs(segy_format)<0x0100)
{
header[ichan].num_samps = htonl((int32_t)nsamp0);
}
/* This cracks the time fields */
time_str = epoch2str(time0,fmt);
int16_t hyear, hday, hhour, hminute, hsecond, hm_secs;
hyear=hday=hhour=hminute=hsecond=hm_secs=0;
sscanf(time_str,"%hd %hd %hd %hd %hd %hd",
&hyear, &hday, &hhour, &hminute, &hsecond, &hm_secs);
header[ichan].year = htons(hyear);
header[ichan].day = htons(hday);
header[ichan].hour = htons(hhour);
header[ichan].minute = htons(hminute);
header[ichan].second = htons(hsecond);
header[ichan].m_secs = htons(hm_secs);
if (ntohs(segy_format)<0x0100)
{
/* These are IRIS-PASSCAL extensions */
header[ichan].trigyear = header[ichan].year;
header[ichan].trigday = header[ichan].day;
header[ichan].trighour = header[ichan].hour;
header[ichan].trigminute = header[ichan].minute;
header[ichan].trigsecond = header[ichan].second;
}
free(time_str);
if(input_source_coordinates)
{
/* Write out our pre-scaled and optionally
* arcsecond-converted source lat/lon plus our elevation */
header[ichan].sourceLongOrX = htonl((int32_t)slon);
header[ichan].sourceLatOrY = htonl((int32_t)slat);
header[ichan].sourceSurfaceElevation
= htonl((int32_t)selev);
/* No easy way to specify both elev and depth*/
header[ichan].sourceDepth=htonl(0);
}
else if(map_to_cdp)
{
/* When faking CDP data we make this look
like a zero offset, single fold data set */
header[ichan].sourceLongOrX = header[ichan].recLongOrX;
header[ichan].sourceLatOrY = header[ichan].recLatOrY;
header[ichan].sourceSurfaceElevation
= header[ichan].recElevation;
header[ichan].sourceDepth = htonl(0);
header[ichan].sourceToRecDist = htonl(0);
}
else
{
/* This is the mechanism for adding other
information with added tables. The one
table currently supported is a "shot" table
that holds shot coordinates. If other tables
were added new functions could be added with
a similar calling sequence. This procedure
silently does nothing if a shot table is not
present.*/
set_shot_variable(db,table_list,
evid,&header[ichan]);
}
}
else
{
if(Verbose)
elog_notify(0,"Station %s and channel %s skipped\n",
sta,chan);
}
}
/* Now we write the data */
for(i=0;i<nchan;++i)
{
if(fwrite((void *)(&(header[i])),sizeof(SEGYTraceHeader),1,fp) != 1)
elog_die(0,"Write error on header for trace %d\n",total_traces+i);
if(fwrite((void *)traces[i],sizeof(float),
(size_t)nsamp0,fp) != nsamp0)
elog_die(0,"Write error while writing data for trace %d\n",
total_traces+i);
}
total_traces += nchan;
trdestroy(&trdb);
if(!input_source_coordinates) ++shotid;
}
return 0 ;
}
int
main(int argc, char **argv)
{
double modified_after =now() , last_lddate, last_mtime, mtime;
char *orbname = NULL;
char *dbname = NULL;
int orb;
int naptime = -1, check_lddate_interval = -1;
Dbptr db, dbt, dbs;
char *prefix = NULL;
struct stat filestat;
int i;
Tbl *tablenames, *tables_containing_dfile, *check_tables = NULL,
*ignore_tables = NULL;
long table_present, recc, is_view;
char *tablename, *schemaname;
char *filename;
int counter = 0, force_check = 0;
char expr[512];
char *statefilename = NULL, *pfname = "dbnew2orb";
Pf *pf = NULL;
void *priv_dfile = (void *) NULL;
void *private = (void *) NULL;
int pmsi; /* poor man's string index, replacment for
* searchtbl... */
char *pmsp;
double lastburytime;
Relic relic;
char *s;
Expression *expr_lddate;
double *mtimes;
double *lddates;
elog_init(argc, argv);
if (argc < 2) {
usage();
exit(1);
}
for (argc--, argv++; argc > 0; argc--, argv++) {
if (!strcmp(*argv, "-modified_after")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -modified_after argument.\n");
usage();
exit(1);
}
modified_after = str2epoch(*argv);
} else if (!strcmp(*argv, "-prefix")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -prefix argument.\n");
usage();
exit(1);
}
prefix = *argv;
} else if (!strcmp(*argv, "-pf")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -pf argument.\n");
usage();
exit(1);
}
pfname = *argv;
} else if (!strcmp(*argv, "-state")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -state argument.\n");
usage();
exit(1);
}
statefilename = *argv;
} else if (!strcmp(*argv, "-sleep")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -sleep argument.\n");
usage();
exit(1);
}
naptime = atoi(*argv);
} else if (!strcmp(*argv, "-check_lddate_interval")) {
argc--;
argv++;
if (argc < 1) {
complain(0, "Need -check_lddate_interval argument.\n");
usage();
exit(1);
}
check_lddate_interval = atoi(*argv);
} else if (!strcmp(*argv, "-v")) {
verbose++;
} else if (**argv != '-') {
break;
} else {
complain(0, "Unrecognized argument '%s'.\n", *argv);
usage();
exit(1);
}
}
if (pfread(pfname, &pf)) {
elog_die(0, "parse_pf: pfread('%s') error.\n", pfname);
}
if (check_lddate_interval < 1) {
if (parse_param(pf, "check_lddate_interval", P_LINT, 1, &check_lddate_interval) < 0) {
elog_die(1, "parse_pf: sleep check_lddate_interval needed!\n");
} else {
if (check_lddate_interval < 0) {
check_lddate_interval = 1;
}
}
}
if (naptime < 1) {
if (parse_param(pf, "sleep", P_LINT, 1, &naptime) < 0) {
elog_die(1, "parse_pf: sleep value needed!\n");
} else {
if (naptime < 0) {
naptime = 1;
}
}
}
if (!prefix) {
if (parse_param(pf, "prefix", P_STR, 0, &prefix) < 0) {
printf("NO PREFIX!\n");
prefix = NULL;
}
}
parse_param(pf, "check_tables", P_TBL, 0, &check_tables);
if (check_tables) {
if (maxtbl(check_tables) < 1) {
freetbl(check_tables, 0);
check_tables = NULL;
}
}
parse_param(pf, "ignore_tables", P_TBL, 0, &ignore_tables);
if (ignore_tables) {
if (maxtbl(ignore_tables) < 1) {
freetbl(ignore_tables, 0);
ignore_tables = NULL;
}
}
/*
* no good here, would erase the table above pffree(pf);
*/
if (argc < 1) {
complain(0, "Need db argument.\n");
usage();
exit(1);
}
dbname = *argv;
argc--;
argv++;
if (argc < 1) {
complain(0, "Need orb argument.\n");
usage();
exit(1);
}
orbname = *argv;
argc--;
argv++;
if (argc > 0) {
complain(0, "Unrecognized argument '%s'.\n", *argv);
usage();
exit(1);
}
if (dbopen(dbname, "r", &db) < 0) {
elog_complain(0, "Can't open database");
exit(1);
}
dbquery(db, dbSCHEMA_NAME, &schemaname);
orb = orbopen(orbname, "w&");
if (orb < 0) {
elog_die(0, "orbopen(%s) error\n", orbname);
}
/*
* prepare for later call to dbquery(dbFIELD_TABLES) to find only
* tables containing lddate
*/
/*
* dbtables is much better, does not require the existence of table
* origin dbf = dblookup(db, 0, "origin", "lddate", "dbNULL");
* dbquery(dbf, dbFIELD_TABLES, &tablenames);
*/
dbex_compile(db, "max(lddate)", &expr_lddate, dbTIME);
tablenames = dbtables(db, "lddate");
tables_containing_dfile = dbtables(db, "dfile");
/* waste a few bytes... */
ntables = maxtbl(tablenames);
mtimes = malloc(ntables * sizeof(double));
lddates = malloc(ntables * sizeof(double));
bury_times = malloc(ntables * sizeof(double));
static_flags = malloc(ntables * sizeof(long));
if (statefilename) {
if (exhume(statefilename, &Stop, 10, mortician)) {
elog_notify(0, "read old state file\n");
} else {
elog_complain(0, "could not read old statefile\n");
}
}
for (i = 0; i < ntables; i++) {
/*
* mtimes[i] = modified_after; lddates[i] = modified_after;
*/
static_flags[i] = NEW_TABLE;
}
for (;;) {
tablenames = dbtables(db, "lddate");
for (i = 0; i < ntables; i++) {
tablename = gettbl(tablenames, i);
if (!tablename) {
continue;
}
dbt = dblookup(db, 0, tablename, 0, 0);
dbquery(dbt, dbTABLE_PRESENT, &table_present);
if (!table_present) {
continue;
}
dbquery(dbt, dbTABLE_IS_VIEW, &is_view);
if (is_view) {
continue;
}
/* lastid is not a good idea (my personal choice)... */
if (strcmp(tablename, "lastid") == 0) {
continue;
}
/* remove after Dan fixed the bug with remark */
if (strcmp(tablename, "remark") == 0) {
continue;
}
if (findtbl(tablename, tables_containing_dfile)) {
continue;
}
if (check_tables) {
if (!findtbl(tablename,check_tables)) {
if (verbose > 1 && static_flags[i]==NEW_TABLE) elog_notify(0,"ignoring table %s because it's NOT in 'check_tables'\n",tablename);
continue;
}
}
if (ignore_tables) {
if (findtbl(tablename,ignore_tables)) {
if (verbose > 1 && static_flags[i]==NEW_TABLE) elog_notify(0,"ignoring table %s because it's in 'ignore_tables'\n",tablename);
continue;
}
}
dbquery(dbt, dbRECORD_COUNT, &recc);
if (recc < 1) {
continue;
}
if (statefilename) {
if (static_flags[i] == NEW_TABLE) {
relic.dp = &bury_times[i];
if (resurrect(tablename, relic, TIME_RELIC) == 0) {
mtimes[i] = bury_times[i];
lddates[i] = bury_times[i];
if (verbose > 1) {
elog_notify(0, "resurrection successful: check %s after %s\n", tablename, s = strtime(bury_times[i]));
free(s);
}
} else {
bury_times[i] = modified_after;
mtimes[i] = modified_after;
lddates[i] = modified_after;
if (verbose > 1) {
elog_notify(0, "resurrection unsuccessful: check %s after %s\n", tablename, s = strtime(modified_after));
free(s);
}
}
static_flags[i] = TABLE_SEEN;
}
} else {
if (static_flags[i] == NEW_TABLE) {
bury_times[i] = modified_after;
mtimes[i] = modified_after;
lddates[i] = modified_after;
static_flags[i] = TABLE_SEEN;
}
}
dbquery(dbt, dbTABLE_FILENAME, &filename);
if (stat(filename, &filestat) < 0) {
elog_die(1, "stat(%s) error.\n", filename);
}
last_mtime = mtimes[i];
last_lddate = lddates[i];
mtime = filestat.st_mtime;
/*
* the whole mtime stuff is not soo good: mtime is
* typically > lddate, so setting modified_after to
* mtime will certainly ignore the last value. To get
* everything, I will have to keep 2 arrays: mtimes
* to detect file modifications and lddates to get
* the actual entries...
*/
if (force_check || mtime > last_mtime) {
sprintf(expr, "lddate > %f", last_lddate);
dbs = dbsubset(dbt, expr, 0);
dbquery(dbs, dbRECORD_COUNT, &recc);
if (recc > 0) {
if (dbrows2orb(dbs, orb, prefix) == 0) {
/*
* dbex_evalstr(dbs,
* "max(lddate)", dbTIME,
* &lddates[i]);
*/
dbex_eval(dbs, expr_lddate, 0, &lddates[i]);
mtimes[i] = mtime;
bury_times[i] = lddates[i];
}
}
dbfree(dbs);
}
/*
* a call to dbfree(dbt) would remove it from the
* list of tablenames, all later calls to tablename
* would return NIL...
*/
if (Stop) {
bury();
return (0);
}
}
sleep(naptime);
if ((counter + 1) >= check_lddate_interval) {
counter = 0;
force_check = 1;
} else {
force_check = 0;
counter++;
}
if (statefilename) {
double nowtime;
nowtime = now();
if (nowtime - lastburytime > 600.0) {
lastburytime = nowtime;
bury();
}
}
}
}
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 );
}
}
*/
}
void
mortician()
{
if (verbose > 1)
elog_notify(0, "saving state\n");
}
int main(int argc, char **argv)
{
char *dbin; /* Input db name */
char *dbout; /* output db name */
Dbptr db; /* input db pointer */
Dbptr dbo; /* base output db pointer */
Dbptr dbv; /* set to view formed by join */
char *pfin=NULL; /* input parameter file */
char *sift_exp; /* sift expression for subset */
int sift = 0; /* default is no sift. */
Tbl *sortkeys;
Tbl *joinkey1, *joinkey2;
/*Pointers to views returned by dbgroup (keyed to origin and event
respectively */
Dbptr dborigin_group;
Tbl *origin_group; /* relation keys used in grouping*/
long nevents;
/* db row variables */
long evid;
long nrows, nrows_raw;
int useold=0;
Pf *pf;
Tbl *ta,*tu;
Tbl *reason_converged, *residual;
Location_options o;
Arr *arr_phase;
int i;
Tbl *converge_history;
Hypocenter h0;
Hypocenter *hypos;
long niterations;
char *vmodel;
int ret_code; /* ggnloc return code */
double **C; /* covariance matrix*/
float emodel[4];
/* entries for S-P feature */
long nbcs;
Arr *badclocks;
/* need global setting of this to handle fixed depth solutions*/
int global_fix_depth;
C=dmatrix(0,3,0,3);
if(argc < 3) usage();
dbin = argv[1];
dbout = argv[2];
for(i=3;i<argc;++i)
{
if(!strcmp(argv[i],"-pf"))
{
++i;
if(i>=argc) usage();
pfin = argv[i];
}
else if(!strcmp(argv[i],"-sift"))
{
++i;
if(i>=argc) usage();
sift_exp = argv[i];
sift = 1;
}
else if(!strcmp(argv[i],"-useold"))
useold = 1;
else
usage();
}
/* set default this way*/
if(pfin == NULL) pfin = strdup("relocate");
/* Initialize the error log and write a version notice */
elog_init (argc, argv) ;
cbanner("Version $Revision$ $Date$\n",
"relocate inputdb outputdb [-pf pf -sift expression -useold]\n",
"Gary Pavlis",
"Indiana University",
"*****@*****.**");
/* Alway join assoc, arrival, and site. We join site
to make sure station table is properly dynamic to account for
time changes. With this setup, the stations can even move
around and this should still work.*/
if(dbopen(dbin,"r",&db) == dbINVALID)
elog_die(1,"Unable to open input database %s\n",dbin);
if(dbopen(dbout,"r+",&dbo) == dbINVALID)
elog_die(1,"Unable to open output database %s\n",dbout);
dbv = dbjoin ( dblookup(db,0,"event",0,0),
dblookup(db,0,"origin",0,0),
0,0,0,0,0);
if(dbv.table == dbINVALID)
elog_die(1,"event->origin join failed\n");
dbv = dbjoin ( dbv, dblookup(db,0,"assoc",0,0),
0,0,0,0,0);
if(dbv.table == dbINVALID)
elog_die(1,"event->origin->assoc join failed\n");
dbv = dbjoin ( dbv, dblookup(db,0,"arrival",0,0),
0,0,0,0,0);
if(dbv.table == dbINVALID)
elog_die(1,"event->origin->assoc->arrival join failed\n");
/* We will explicitly set the keys for this join because it
was found to fail sometimes */
joinkey1 = newtbl(0);
joinkey2 = newtbl(0);
pushtbl(joinkey1,"arrival.sta");
pushtbl(joinkey1,"arrival.time");
pushtbl(joinkey2,"sta");
pushtbl(joinkey2,"ondate::offdate");
dbv = dbjoin ( dbv, dblookup(db,0,"site",0,0),
&joinkey1,&joinkey2,0,0,0);
if(dbv.table == dbINVALID)
elog_die(1,"event->origin->assoc->arrival->site join failed\n");
/* Subset using sift_key if requested */
if(sift)
{
dbv = dbsubset(dbv,sift_exp,0);
if(dbv.record == dbINVALID)
elog_die(1,"dbsubset of %s with expression %s failed\n",
dbin, sift_exp);
}
/* This keeps only the prefered origin records intact */
dbv = dbsubset(dbv,"orid == prefor", 0);
if(dbv.record == dbINVALID)
elog_die(1,"Subset to preferred origin records failed\n");
/* First we have to run a unique key sort in the following order
to remove redundant picks made on multiple channels. We will
issue a warning if the record count changes. */
dbquery(dbv, dbRECORD_COUNT, &nrows_raw);
sortkeys = newtbl(0);
pushtbl(sortkeys,"evid");
pushtbl(sortkeys,"sta");
pushtbl(sortkeys,"phase");
dbv = dbsort(dbv,sortkeys,UNIQUE,0);
dbquery(dbv, dbRECORD_COUNT, &nrows);
if(nrows != nrows_raw)
elog_complain(0,"Input database has duplicate picks of one or more phases on multiple channels\n\
Which picks will be used here is unpredictable\n\
%ld total picks, %ld unique\nContinuing\n", nrows_raw, nrows);
/* This sort is the required one for the grouping that follows*/
sortkeys = newtbl(3);
pushtbl(sortkeys,"evid");
pushtbl(sortkeys,"orid");
pushtbl(sortkeys,"arrival.time");
dbv = dbsort(dbv,sortkeys,0,0);
if(dbv.record == dbINVALID)
elog_die(1,"dbsort on evid,orid,arrival.time failed\n");
/* Set up grouping by events */
origin_group = newtbl(0);
pushtbl(origin_group, "evid");
dborigin_group = dbgroup(dbv, origin_group, "origin_group",1);
if(dborigin_group.record == dbINVALID)
elog_die(1,"dbgroup by origin failed\n");
dbquery(dborigin_group,dbRECORD_COUNT,&nevents);
elog_notify(0,"Attempting to relocate %ld events in subsetted database\n",
nevents);
/* DB is now set up correctly, now we turn to the parameter files */
i = pfread(pfin,&pf);
if(i != 0) elog_die(1,"Pfread error\n");
o = parse_options_pf (pf);
global_fix_depth=o.fix[2];
arr_phase = parse_phase_parameter_file(pf);
vmodel = pfget_string(pf,"velocity_model_name");
/* set up minus phase for bad clock problems */
badclocks = newarr(0);
if(db_badclock_definition(db,pf,badclocks))
elog_complain(0,"Warning: problems in database definitions of bad clock time periods\n");
pfget_badclocks(pf,badclocks);
nbcs = cntarr(badclocks);
if(nbcs>0) fprintf(stdout,"relocate: bad clock feature enabled\n\n");
/* Change by JN to output evid and orid. */
/* fprintf(stdout,"lat lon depth time rms wrms interquartile ndata ndgf iterations\n"); */
fprintf(stdout,"evid orid lat lon depth time rms wrms interquartile ndata ndgf iterations\n");
/* Main loop. We utilize the group views and loop through by
events */
for(dborigin_group.record=0;
dborigin_group.record< nevents;++dborigin_group.record)
{
Dbptr db_bundle; /* db pointer returned from bundle field
of dborigin_group for current event */
Arr *station_table;
Arr *array_table;
long is, ie;
long orid; /* orid assigned relocated event in output db */
if(dbgetv(dborigin_group,0,"evid", &evid,
"bundle", &db_bundle,NULL ) == dbINVALID)
elog_complain(1,"dbgetv error for row %ld of event group\n",
dborigin_group.record);
dbget_range(db_bundle,&is,&ie);
station_table = dbload_station_table(dbv,
is,ie,pf);
array_table = dbload_array_table(dbv,
is,ie,pf);
ta = dbload_arrival_table(dbv,
is,ie,station_table, arr_phase);
tu = dbload_slowness_table(dbv,
is,ie,array_table, arr_phase);
/* this actually sets up the minus phase feature for bad clocks*/
if(nbcs)
{
if(minus_phases_arrival_edit(ta,arr_phase,badclocks))
elog_complain(0,"Warning(relocate): problems in minus_phase_arrival_edit function\n");
}
if(useold)
{
char dtype[2];
h0 = db_load_initial(dbv,is);
/* keep fixed depth if done before.
setting dbv.record here is a bit of
a potential maintenance problem */
dbv.record=is;
dbgetv(dbv,0,"dtype",dtype,NULL );
if( (!strcmp(dtype,"g")) || (!strcmp(dtype,"r")) )
o.fix[2]=1;
}
else
h0 = initial_locate(ta, tu, o, pf);
ret_code = ggnloc(h0,ta,tu,o,
&converge_history,&reason_converged,&residual);
if(ret_code < 0)
{
elog_complain(1,"ggnloc failed to produce a solution\n");
}
else
{
if(ret_code > 0)
elog_complain(1,"%d travel time calculator failures in ggnloc\nSolution ok\n",
ret_code);
niterations = maxtbl(converge_history);
hypos = (Hypocenter *)gettbl(converge_history,
niterations-1);
predicted_errors(*hypos,ta,tu,o,C,emodel);
/* Next 3 calls changed by JN to output evid, orid and number_data */
orid = save_origin(dbv,is,ie,o.fix[3],*hypos,dbo);
evid = save_event(dbv,is,ie,orid,dbo);
fprintf(stdout,"%ld %ld %lf %lf %lf %lf %g %g %g %d %d %ld\n",
evid,
orid,
hypos->lat,hypos->lon,hypos->z,hypos->time,
hypos->rms_raw, hypos->rms_weighted,
hypos->interquartile,
hypos->number_data,
hypos->degrees_of_freedom,
niterations);
save_origerr(orid,*hypos,C,dbo);
save_assoc(dbv,is,ie,orid,vmodel,residual,*hypos,dbo);
/* These save genloc add on tables */
save_emodel(orid,emodel,dbo);
save_predarr(dbo,ta,tu,*hypos,orid,vmodel);
}
o.fix[2]=global_fix_depth;
if(maxtbl(converge_history)>0)freetbl(converge_history,free);
if(maxtbl(reason_converged)>0)freetbl(reason_converged,free);
if(maxtbl(residual)>0)freetbl(residual,free);
destroy_data_tables(tu, ta);
destroy_network_geometry_tables(station_table,array_table);
}
return(0);
}
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);
}
/*
* Main program loop
*/
int main(int iArgCount, char *aArgList[]) {
uint8_t *aBBAPkt; /* Buffer to hold a bba packet read from the wire */
struct stBBAPacketInfo oPktInfo; /* Struct to hold information from the packet header */
double dPrevTime;
int bOKToSend;
char *sOutPkt; /* Packet to put onto the orb */
int iOutPktLen; /* Length of sOutPkt */
elog_init(iArgCount, aArgList);
/* Parse out command line options */
if (parseCommandLineOptions(iArgCount, aArgList) == RESULT_SUCCESS) {
/* Read in the parameter file */
if (paramFileRead() == RESULT_FAILURE) {
elog_complain(1,
"main(): Error encountered during paramFileRead() operation.");
dcbbaCleanup(-1);
}
/* Exit if bPFValidateFlag is set */
if (oConfig.bPFValidateFlag == TRUE) {
elog_notify(
0,
"main(): Parameter File %s validated successfully. Exiting.",
oConfig.sParamFileName);
dcbbaCleanup(0);
}
/* Allocate memory for our packet */
allot (uint8_t *, aBBAPkt, oConfig.iBBAPktBufSz);
/* Set up a signal handler to re-read the parameter file on SIGUSR1*/
signal(SIGUSR1, sig_hdlr);
/* Connect to the ORB */
if ((orbfd = orbopen(oConfig.sOrbName, "w&")) < 0) {
elog_complain(1, "orbopen: unable to connect to ORB \"%s\".",
oConfig.sOrbName);
dcbbaCleanup(-1);
}
/* Connect to Data Concentrator's Data read port */
if (dcDataConnect(oConfig.iConnectionType, oConfig.sDCConnectionParams)
== RESULT_SUCCESS) {
dPrevTime = now();
/*** BEGIN MAIN LOOP ***/
while (readFromDC(&oPktInfo, aBBAPkt) == RESULT_SUCCESS) {
bOKToSend = TRUE;
/* Check the packet age */
/*if (fabs(oPktInfo.dPktTime - dPrevTime) > 86400.0) {
dPrevTime = now();
if (fabs(oPktInfo.dPktTime - dPrevTime) > 86400.0) {
elog_complain(
0,
"%s packet has bad time - %s (epoch:%lf). Will discard packet.\n",
oPktInfo.sSrcname, sTimeStamp = strtime(
oPktInfo.dPktTime), oPktInfo.dPktTime);
free(sTimeStamp);
bOKToSend = FALSE;
} else
dPrevTime = oPktInfo.dPktTime;
} else
dPrevTime = oPktInfo.dPktTime;*/
if (bOKToSend == TRUE) {
/* Add orb header to Packet */
iOutPktLen = (int) stuffBBAPkt(&oPktInfo, aBBAPkt, &sOutPkt);
if (iOutPktLen == 0) {
/* There was an error stuffing the packet*/
elog_complain(
1,
"An error occurred while adding the ORB header to the raw packet. Not submitting to the orb.");
} else if (sOutPkt == 0) {
elog_die(1,
"Output packet length was non-zero but pointer to Output packet is null");
} else {
/* put it into the orb */
if (oConfig.bVerboseModeFlag == TRUE) {
showPkt(0, oPktInfo.sSrcname, oPktInfo.dPktTime,
sOutPkt, iOutPktLen, stderr, PKT_UNSTUFF);
showPkt(0, oPktInfo.sSrcname, oPktInfo.dPktTime,
sOutPkt, iOutPktLen, stderr, PKT_DUMP);
}
if (orbput(orbfd, oPktInfo.sSrcname, oPktInfo.dPktTime,
sOutPkt, iOutPktLen)) {
elog_complain(0, "orbput() failed in main()\n");
dcbbaCleanup(-1);
}
if (oConfig.bVerboseModeFlag == TRUE)
elog_notify(0, "packet submitted under %s\n",
oPktInfo.sSrcname);
/* Free the packet */
free(sOutPkt);
}
}
}
/*
* If we get here, it means readFromDC failed to get a packet from oDCDataBNS.
* This could be either that an EOF was reached if we were reading from a file,
* or that the socket died unexpectedly.
*/
dcbbaCleanup(-1);
}
/* Else unable to connect, cleanup with failure (-1) exit code */
else
dcbbaCleanup(-1);
} else {
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 response[STRSZ];
char *resp_ptr;
int i;
sprintf( key, "%s:%s:%s", net, sta, dls_var );
rrd = getarr( Rrd_files, key );
if( rrd == NULL || ! is_present( rrd ) ) {
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,
0 );
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 ) );
}
fprintf( Rrdfp, "%s\n", command );
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, 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 );
}
sprintf( command, "update %s %d:%f", rrd, (int) floor( time ), val );
fprintf( Rrdfp, "%s\n", command );
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 );
}
}
}
