int ATM_cggrid_unregister( CGGrid *cgg )
{
char *key;
if( ATM_CGGrid_Registry == (Arr *) NULL )
{
mexWarnMsgTxt( "internal error, cggrid registry "
"not initialized" );
return 0;
}
allot( char *, key, STRSZ );
sprintf( key, "%x", (unsigned long) cgg );
if( getarr( ATM_CGGrid_Registry, key ) == NULL )
{
free( key );
mexWarnMsgTxt( "cggrid is already unregistered" );
return 1;
}
delarr( ATM_CGGrid_Registry, key );
free( key );
return 1;
}
static void
delete_Orb_relic( int orbfd ) {
char key[STRSZ];
if( Orb_relics == (Arr *) NULL ) {
return;
}
sprintf( key, "%d", orbfd );
delarr( Orb_relics, key );
return;
}
int
clrarr( Arr * arr, void (*free_value )() )
{
Tbl * tbl;
char * key;
void * oldval;
int size;
int i;
tbl = keysarr( arr );
size = maxtbl( tbl );
for ( i = 0; i < size; i++ )
{
key = poptbl( tbl );
oldval = delarr( arr, key );
if ( oldval ) free_value( oldval );
}
freetbl( tbl, 0 );
return 1;
}
/* Edits the array of phase handles to keep only phases
named in the keeplist Tbl of phase names strings. This
is complicated by the fact that keeplist is a simple
list. The algorithm used converts the keeplist to a
temporary associative array then passes through the
array of phase handles calling the free routine on
phases not found in the keeplist.
Author: G Pavlis
Written: August 2001
*/
void edit_phase_handle(Arr *a,Tbl *keeplist)
{
Tbl *akeys;
Arr *akeeper;
int dummy; /* used purely as a placeholder in akeeper*/
char *phase;
int i,n;
Phase_handle *ph;
n = maxtbl(keeplist);
if(n<=0)
elog_die(0,"List of phases to keep is empty.\n\
Check phases_to_keep parameter setting\n");
akeeper = newarr(0);
for(i=0; i<maxtbl(keeplist); ++i)
{
phase = (char *)gettbl(keeplist,i);
setarr(akeeper,phase,&dummy);
ph = (Phase_handle *)getarr(a,phase);
if(ph==NULL)elog_die(0,
"Don't know how to handle required phase %s\n",
phase);
}
akeys = keysarr(a);
for(i=0; i<maxtbl(akeys); ++i)
{
phase = gettbl(akeys,i);
if(getarr(akeeper,phase) == NULL)
{
ph = (Phase_handle *)getarr(a,phase);
free_phase_handle(ph);
delarr(a,phase);
}
}
freearr(akeeper,0);
freetbl(akeys,0);
}
save_ms ( Dbptr dborig ) {
Dbptr db;
Event *event;
Tbl *AllMs;
double sum, unc;
char auth[64], net[16], sta[16];
char magtype[8];
char *str, orig_str[16];
int numms, total;
int smags, nmags;
int i;
int arid, orid, evid, msid, magid;
AllMs = keysarr( AllEv );
numms = maxtbl( AllMs );
if( numms <= 0 ) {
complain (0, "Ther are no MS found for current orid.\n");
return 0 ;
}
unc = 0.0; sum=0.0; total=0;
for( i = 0; i < numms; i++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
sum += event->ms;
total ++;
}
sum /= total;
if( total > 1 ) {
for( i = 0; i < numms; i++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
unc += (event->ms-sum) * (event->ms-sum);
}
unc /= (total-1);
unc = sqrt(unc);
} else unc = -1.0;
/* Fill netmag table */
db = dblookup (dborig, 0, "netmag", 0, 0);
dbquery (db, dbRECORD_COUNT, &nmags);
magid = -1;
for ( db.record = 0; db.record < nmags; db.record++) {
dbgetv (db, 0,
"net", net,
"orid", &orid,
"magtype", magtype, 0);
sprintf( orig_str, "%d\0", orid);
if( !regexec( &orig_match, orig_str, (size_t) 0, NULL, 0 ) &&
/*!regexec( &net_match, net, (size_t) 0, NULL, 0 ) && */
orid == event->orid &&
!strcmp(magtype, "ms")) break;
}
if ( db.record < nmags) {
dbgetv (db, 0, "magid", &magid, 0);
dbputv (db, 0,
"magid", magid,
"evid", event->evid,
"magtype", "ms",
"nsta", total,
"magnitude", sum,
"uncertainty", unc,
"auth", "dbms", 0);
} else if ( sum > 0) {
magid = dbnextid (db, "magid");
db.field = dbALL;
db.record = dbSCRATCH;
dbputv (db, 0,
"net", event->net,
"orid", event->orid,
"evid", event->evid,
"magid", magid,
"magtype", "ms",
"nsta", total,
"magnitude", sum,
"uncertainty", unc,
"auth", "dbms", 0);
dbadd (db, 0);
}
msid = magid;
/* Fill origin table with MS */
if( !regexec( &orig_match, orig_str, (size_t) 0, NULL, 0 ) &&
!regexec( &auth_match, event->auth, (size_t) 0, NULL, 0 ) ) {
db = dball;
db.record = Crnt_record;
dbputv (db, 0, "ms", sum, "msid", msid, 0);
}
/* Fill MS into stamag table */
db = dball;
db = dblookup (db, 0, "stamag", 0, 0);
dbquery (db, dbRECORD_COUNT, &smags);
for( i = 0; i < numms; i ++ ) {
str = ( char *) gettbl( AllMs, i );
event = ( Event *) getarr( AllEv, str );
if( event->ms < 0 ) continue;
for (db.record=0; db.record<smags; db.record++) {
dbgetv (db, 0, "sta", sta, "magid", &magid, 0);
if (magid == msid && !strcmp(event->sta, sta)) break;
}
if (db.record<smags) {
dbputv (db, 0,
"arid", event->arid,
"orid", event->orid,
"evid", event->evid,
"phase", event->phase,
"magtype", "ms",
"magnitude", event->ms,
"auth", "dbms", 0);
} else if (event->ms > 0) {
db.field = dbALL;
db.record = dbSCRATCH;
dbputv (db, 0,
"sta", event->sta,
"arid", event->arid,
"orid", event->orid,
"evid", event->evid,
"phase", event->phase,
"magid", msid,
"magtype", "ms",
"magnitude", event->ms,
"auth", "dbms", 0);
dbadd (db, 0);
}
free(event);
delarr( AllEv, str);
}
freetbl( AllMs, 0 );
return (1);
}
void save_assoc(Tbl *ta, Tbl *tu,
int orid, char *vmodel, Hypocenter hypo,
Dbptr db, int orb)
{
double delta;
double seaz;
double esaz;
double azres;
double slores;
Arr *u_arr;
char key_arid[20];
Tbl *udregs;
int i,n;
double ux, uy, azimuth;
double duphi;
Arrival *a;
Slowness_vector *u;
/* We build an associative array keyed to arid for
all the slowness vector measurements.
Then in the loop below we can efficiently find any
slowness vectors associated with the same arid as
an Arrival. The overhead in this is significant, but
it makes it completely general and open ended. */
n = maxtbl(tu);
u_arr = newarr(0);
for(i=0;i<n;i++)
{
Slowness_vector *utmp;
utmp = (Slowness_vector *)gettbl(tu,i);
sprintf(key_arid,"%d",utmp->arid);
setarr(u_arr,key_arid,utmp);
}
db = dblookup(db,0,"assoc",0,0);
db.record = dbSCRATCH;
n=maxtbl(ta);
for(i=0;i<n;i++)
{
a=(Arrival*)gettbl(ta,i);
dist(rad(hypo.lat),rad(hypo.lon),
rad(a->sta->lat),rad(a->sta->lon),&delta,&esaz);
dist(rad(a->sta->lat),rad(a->sta->lon),
rad(hypo.lat),rad(hypo.lon),&delta,&seaz);
sprintf(key_arid,"%d",a->arid);
u = (Slowness_vector *) getarr(u_arr,key_arid);
if(u == NULL)
{
if(dbputv(db,0,
"orid",orid,
"arid",a->arid,
"sta",a->sta->name,
"phase",a->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timeres",(double)a->res.raw_residual,
"timedef","d",
"vmodel",vmodel,
"wgt",(double)a->res.residual_weight,
0)<0)
{
elog_complain(0,
"Can't add assoc record for station %s arid = %d orid = %d to working db scratch record\nRecord skipped and not saved anywhere\n",
a->sta->name,a->arid,orid);
continue;
}
}
else
{
slores = deg2km(sqrt(sqr(u->xres.raw_residual)
+ sqr(u->yres.raw_residual)));
azimuth = atan2 ( u->uy, u->ux ) ;
duphi = (u->ux*cos(azimuth)
- u->uy*sin(azimuth))
/ sqrt(sqr(u->ux)+ sqr(u->uy)) ;
azres = deg(duphi);
if(dbputv(db,"assoc",
"orid",orid,
"arid",a->arid,
"sta",a->sta->name,
"phase",a->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timeres",(double)a->res.raw_residual,
"timedef","d",
"vmodel",vmodel,
"slores",slores,
"slodef","d",
"azres",azres,
"azdef","d",
"wgt",(double)a->res.residual_weight,
0)<0)
{
elog_complain(0,
"Can't add assoc record for station %s arid = %d orid = %d to working db scratch record\nRecord skipped and not saved anywhere\n",
a->sta->name,a->arid,orid);
delarr(u_arr,key_arid);
continue;
}
/* We delete this entry from u_arr, then we
can scan below for the dregs easily */
delarr(u_arr,key_arid);
}
if(save_dbrecord(db,orb))
elog_complain(0,"Error saving assoc record for arid %d\n",
a->arid);
}
/* Since it is possible that slowness vectors can be measured
with no arrival time, we need to take care of that possibility.
We do that by checking for dregs in u_arr not removed with
delarr calls above */
udregs = keysarr(u_arr);
n = maxtbl(udregs);
for(i=0;i<n;i++)
{
char *key;
key = gettbl(udregs,i);
u = (Slowness_vector *) getarr(u_arr,key);
dist(rad(hypo.lat),rad(hypo.lon),
rad(u->array->lat),rad(u->array->lon),&delta,&esaz);
dist(rad(u->array->lat),rad(u->array->lon),
rad(hypo.lat),rad(hypo.lon),&delta,&seaz);
slores = deg2km(sqrt(sqr(u->xres.raw_residual)
+ sqr(u->yres.raw_residual)));
azimuth = atan2 ( u->uy, u->ux ) ;
duphi = (u->ux*cos(azimuth)
- u->uy*sin(azimuth))
/ sqrt(sqr(u->ux)+ sqr(u->uy)) ;
azres = deg(duphi);
/* The residual weight extraction from the ux component is
not ideal here because it could be wrong. It is unavoidable
due to polar-cartesian conversion */
if(dbputv(db,"assoc",
"orid",orid,
"arid",u->arid,
"sta",u->array->name,
"phase",u->phase->name,
"delta",deg(delta),
"seaz",deg(seaz),
"esaz",deg(esaz),
"timedef","n",
"vmodel",vmodel,
"slores",slores,
"slodef","d",
"azres",azres,
"azdef","d",
"wgt",(double)u->xres.residual_weight,
0)<0)
{
elog_complain(0,"Can't add assoc record for array slowness vector with %s arid = %d and orid = %d to working db scratch record\nNothing saved\n",
u->array->name,u->arid,orid);
continue;
}
if(save_dbrecord(db,orb))
elog_complain(0,"Error saving assoc record for arid %d\n",
u->arid);
}
/* We must not use regular free here, or later we could try
to free the same area twice. That is, u_tmp contains keyed
version of the pointers stored in tu. This releases only
the Arr structures, but leaves the pointers to be freed
later. I've never seen a better example of the need for
a decent garbage collection system. */
freetbl(udregs,free_nothing);
freearr(u_arr,free_nothing);
}
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);
}
