int main(int argc, char *argv){
char *msg;
init_server();
while(1){
printf("%s%s", username, ": ");
msg = input();
if(strlen(msg) == 0){
setmsg("\n");
}
else if(strcmp(msg,"/exit") == 0){
free(msg);
killout();
pthread_exit(&retm);
}else{
char *newline = "\n";
msg = addchar(msg, newline);
setmsg(msg);
pthread_t tid;
pthread_create(&tid, NULL, sendmesgptr, NULL);
pthread_join(tid, NULL);
}
free(msg);
}
killout();
killinc();
}
/**
* Verify that the dependent variable for all files in the data file list
* are in the allowed range
*
* @param rngmin
* Minimum allowed value
* @param rngmax
* Maximum allowed value
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_DATA_POINTS_OUTSIDE_OF_RANGE
*
* @date 820818: Original version.
*
*/
void
vfrng(double rngmin,
double rngmax,
int *nerr) {
int jdfl, ndx1, ndx2, nlen;
char *tmp;
*nerr = 0;
/* - For each file in DFL: */
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
tmp = string_list_get(datafiles, jdfl-1);
/* -- Get header from memory manager. */
getfil( jdfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
/* -- Check range of dependent variable. */
if( *depmin < rngmin || *depmax > rngmax ){
*nerr = ERROR_DATA_POINTS_OUTSIDE_OF_RANGE;
setmsg( "ERROR", *nerr );
apfmsg( rngmin );
apfmsg( rngmax );
apcmsg2(tmp, strlen(tmp)+1);
goto L_8888;
}
}
L_8888:
return;
}
/**
* Verify that no files in the data file list have more than
* a certain number of data points
*
* @param maxn
* Maximum number of data points that can be in each file
* @param maxf
* Maximum number of points found in the files
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_TOO_MANY_DATA_POINTS
*
* @date 820622: Original version.
*
*/
void
vfmaxn(int maxn,
int *maxf,
int *nerr) {
int jdfl, ndx1, ndx2, nlen;
char *tmp;
*nerr = 0;
*maxf = 0;
/* - For each file in DFL: */
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
tmp = string_list_get(datafiles, jdfl-1);
/* -- Get header from memory manager. */
getfil( jdfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
/* -- See if this files number exceeds maximum found so far. */
if( *npts > *maxf )
*maxf = *npts;
/* -- Check number of data points versus maximum allowable. */
if( *npts > maxn ){
*nerr = ERROR_TOO_MANY_DATA_POINTS;
setmsg( "ERROR", *nerr );
apimsg( maxn );
apcmsg2(tmp, strlen(tmp)+1);
goto L_8888;
}
}
L_8888:
return;
}
void
ckint_err(short base, char *error)
{
char defmesg[64];
setmsg(defmesg, base);
puterror(stdout, defmesg, error);
}
void
ckint_hlp(short base, char *help)
{
char defmesg[64];
setmsg(defmesg, base);
puthelp(stdout, defmesg, help);
}
/**
* Verify that there is at least one file in the data file list
*
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_NO_DATA_FILES_READ_IN
*
* @date 820622: Original version.
*
*/
void
vflist(int *nerr) {
*nerr = 0;
if( cmdfm.ndfl <= 0 ){
*nerr = ERROR_NO_DATA_FILES_READ_IN;
setmsg( "ERROR", *nerr );
}
return;
}
void
allamb(struct t_cmmem *memstruct,
int nsize,
int *index,
int *nerr)
{
float **tempptr;
int i, j, ierr;
*nerr = 0;
ierr = 0;
/* find an available pointer to use */
/* SAC HACK: start at sacmem[1] rather than sacmem[0] to avoid */
/* handing out index of zero, because this has historical */
/* significance throughout the code */
for(i=1; (i<memstruct->nallocated && memstruct->sacmem[i] != NULL); i++)
{ /* do nothing */ }
if(i == memstruct->nallocated){
/* there were no available entries, expand pointer array in place */
if((tempptr = (float **)realloc(memstruct->sacmem,
(memstruct->nallocated+MEMINC)*sizeof(float *))) == NULL)
ierr = 1;
else {
memstruct->sacmem = tempptr;
memstruct->nallocated += MEMINC;
for (j=i; j<memstruct->nallocated; j++)memstruct->sacmem[j] = NULL;
}
}
/* Changed malloc to calloc to initialize to zero. maf 960709 */
if((memstruct->sacmem[i] = (float*)calloc(nsize,sizeof(float))) == NULL)
ierr = 1;
else
*index = i;
DEBUG("id: %d size: %d\n", *index, nsize);
if( ierr != 0 ) {
*index = 0;
*nerr = 301;
setmsg( "ERROR", *nerr );
apimsg( nsize );
}
}
void
show_var(var *v, char *name, FILE *fp) {
if( cmexm.lnames ){
out("%s = ", name);
}
switch(v->type) {
case VAR_VALUE: out("%g", v->value); break;
case VAR_STRING: out("'%s'", v->str); break;
case VAR_INTEGER: out("%d", v->ival); break;
}
if( cmexm.lnewline ) {
newline( fp );
clrmsg();
setmsg( "OUTPUT", 99 );
}
}
/**
* Display the about message if requested
*
*/
void
xabout ( ) {
char kvdate[200];
/* char fmt[] = "SEISMIC ANALYSIS CODE [%s (Version 00.59.49)]"; */
char fmt[] = "SEISMIC ANALYSIS CODE [%s (Version %s)]";
char kcopyr[] = "Copyright 1995 Regents of the University of California\n" ;
if(! display_copyright(OPTION_GET)) {
return;
}
sprintf( kvdate, fmt, BUILD_DATE, PACKAGE_VERSION );
setmsg( "OUTPUT", 99 );
apcmsg( kvdate, strlen ( kvdate ) + 1 );
aplmsg( kcopyr, strlen ( kcopyr ) + 1 );
outmsg();
clrmsg();
}
int
ckint(long *intval, short base, char *defstr, char *error, char *help,
char *prompt)
{
long value;
char *ptr,
input[MAX_INPUT],
defmesg[64],
temp[64];
if (!prompt) {
setprmpt(temp, base);
prompt = temp;
}
setmsg(defmesg, base);
start:
putprmpt(stderr, prompt, NULL, defstr);
if (getinput(input))
return (1);
if (strlen(input) == 0) {
if (defstr) {
*intval = strtol(defstr, NULL, (int)base);
return (0);
}
puterror(stderr, defmesg, error);
goto start;
} else if (strcmp(input, "?") == 0) {
puthelp(stderr, defmesg, help);
goto start;
} else if (ckquit && (strcmp(input, "q") == 0))
return (3);
value = strtol(input, &ptr, (int)base);
if (*ptr != '\0') {
puterror(stderr, defmesg, error);
goto start;
}
*intval = value;
return (0);
}
void xp1(int *nerr)
{
int n;
char *kptext, kret[9];
int l1dttm, lany, lbotaxsave, lbottcsave, lframesave, ltitlsave,
ltoptcsave, lwait, lxgrdsave, lxlabsave, lxlims, lylabsave,
lprint = FALSE , ltry = FALSE ;
int i, jdfl, jdfl1, jdfl2, jfr, jperfr, n1dttm[6],
ncret, nfr, nlcx, nlcy, nperfr, num, notused;
float tmax, tmaxj, tmin, tminj, toff[MDFL], ypdel, ypmxsave;
static int lrel = FALSE;
static int lperpl = FALSE;
static int nperpl = 3;
static char kwait[9] = "Waiting$";
float *const Toff = &toff[0] - 1;
/*=====================================================================
* PURPOSE: To execute the action command P1.
* This command makes a multi-trace, multi-window plot.
*=====================================================================
* OUTPUT ARGUMENTS:
* nerr: Error return flag. Set to 0 if no error occurred.
* Potential error numbers: 1001, 1504.
*=====================================================================
* MODULE/LEVEL: gam/2
*=====================================================================
* GLOBAL INPUT:
* mach:
* dfm: ndfl, sacmem
* hdr: begin, ennd, delta
* gem: lbotax, lbottc, ltopax, ltoptc, lxlab, lylab, ltitl,
* lxgrd, ypmn, ypmx, chht, tsdef
* gam: kgddef
*=====================================================================
* SUBROUTINES CALLED:
*=====================================================================
* MODIFICATION HISTORY:
* 970908: Modified response to ddttm. maf
* 970723: Commented out an if statement to fix a bug which kept
* p1 relative from functioning when xlim was set. maf
* 970130: Added arguments to dispid() to plot file number. maf
* 910607: Move stmt label 8888 back to where it was.
* Changed gots to goto plrest after call to plsave.
* Error condition before lframesave goes to return. (wct).
* 910607: Added call to zgetgd when no graphics device specified.
* Changed call to begindevice to begindevices. (wct)
* 910220: Move stmt label 8888, so lframe etc. are restored on err exit
* 880411: Axes annotation now controlled by GEM variables.
* 850321: Now displaying REL offset below FILEID.
* 821228: Added calls to DISPID, DISPPK and PLHOME.
* 821122: Added check for bad date fields.
* Fixed bug involving titles and PP option.
* 820823: Fixed bug involving extra x axes when using PP option.
* 820721: Changed to newest set of parsing and checking functions.
* 811228: Deleted call to ZCLIP.
* 810120: Changed to output message retrieval from disk.
* 800920: Added PERPLOT option.
* Fixed bug in REL/ABS option.
* 800905: Pick and file id options to new DISPLAY command.
* 800618: Added pick display capability to this plot.
*=====================================================================
* DOCUMENTED/REVIEWED:
*===================================================================== */
/* PROCEDURE: */
/* Errors before plsave have to avoid going to execute plrest. */
*nerr = 0;
/* PARSING PHASE: */
/* - Loop on each token in command: */
while ( lcmore( nerr ) ){
/* -- "PERPLOT ON/OFF/n": change number of files plotted per frame. */
if( lklogi( "PERPLOT$",9, &lperpl, &nperpl ) )
{ /* do nothing */ }
/* -- "RELATIVE/ABSOLUTE": change method of displaying time on x axis. */
else if( lclog2( "RELATIVE$",10, "ABSOLUTE$",10, &lrel ) )
{ /* do nothing */ }
/* if PRINT option is tried, get printer name */
else if ( ltry ) {
lcchar ( MAXPRNTRNAMELEN , kmgem.kptrName ,
MAXPRNTRNAMELEN+1 , ¬used ) ;
terminate ( kmgem.kptrName ) ;
if ( !lprint )
kmgem.kptrName[0] = '\0' ;
ltry = FALSE ;
}
/* -- "PRINT": print the final product */
else if( lckey( "PRINT#$", 8 ) ) {
ltry = TRUE ;
if ( cmgdm.lbegf ) {
setmsg ( "WARNING" , 2403 ) ;
outmsg () ;
clrmsg () ;
}
else {
lprint = TRUE ;
}
}
/* -- Bad syntax. */
else{
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
} /* end while */
/* - The above loop is over when one of two conditions has been met:
* (1) An error in parsing has occurred. In this case NERR is > 0 .
* (2) All the tokens in the command have been successfully parsed. */
if( *nerr != 0 )
goto L_8888;
/* CHECKING PHASE: */
/* - Check for null data file list. */
vflist( nerr );
if( *nerr != 0 )
goto L_8888;
/* - Check to make sure all files are time series files. */
vftime( nerr );
if( *nerr != 0 ){
aplmsg( "Use PLOTSP command to plot spectral data.",42 );
goto L_8888;
}
/* - If no graphics device is open, try to open the default device. */
getstatus( "ANY", &lany );
if( !lany ){
zgetgd( kmgam.kgddef,9 );
begindevices( kmgam.kgddef,9, 1, nerr );
if( *nerr != 0 )
goto L_8888;
}
/* EXECUTION PHASE: */
/* - Save current plot and x limit attributes.
* - Error after plsave have to go to execute plrest. */
plsave();
/* initialize plot offsets */
for ( i=0; i<MDFL; i++) toff[i] = 0.0;
/* - Set up specific options that apply only to this plot. */
lbotaxsave = cmgem.axis[BOTTOM].annotate;
lbottcsave = cmgem.axis[BOTTOM].ticks;
ltoptcsave = cmgem.axis[TOP].ticks;
cmgem.axis[BOTTOM].ticks = FALSE;
cmgem.axis[BOTTOM].annotate = FALSE;
lxlabsave = cmgem.xlabel.on;
lylabsave = cmgem.ylabel.on;
ltitlsave = cmgem.title.on;
lxgrdsave = cmgem.lxgrd;
cmgem.xlabel.on = FALSE;
cmgem.ylabel.on = FALSE;
cmgem.title.on = FALSE;
cmgem.lxgrd = FALSE;
/* - Set up y window for each subplot. */
if( lperpl ){
nfr = (cmdfm.ndfl - 1)/nperpl + 1;
nperfr = nperpl;
}
else{
nfr = 1;
nperfr = cmdfm.ndfl;
}
ypdel = (cmgem.plot.ymax - cmgem.plot.ymin)/(float)( nperfr );
/* - Check WAIT option. This is on when:
* -- A wait request has been made.
* -- An active device (normally the user's terminal) is on. */
if( cmgam.lwaitr )
getstatus( "ACTIVE", &lwait );
else
lwait = FALSE;
/* - Loop on number of frames: */
jdfl1 = 1;
ypmxsave = cmgem.plot.ymax;
lframesave = cmgem.lframe;
for( jfr = 1; jfr <= nfr; jfr++ ){
/* set cmgem.lframe FALSE for each pass through loop, because
endframe() sets it back to TRUE for the next pass. */
cmgem.lframe = FALSE;
/* -- No wait after last frame. */
if( jfr == nfr && !cmgam.lwaite )
lwait = FALSE;
/* -- Loop on data files in each frame: */
jdfl2 = min( cmdfm.ndfl, jdfl1 + nperfr - 1 );
/* -- Determine time limits for x axis of this frame.
* (Correct for any differences in GMT reference time.) */
getfil( jdfl1, TRUE, &num, &nlcy, &nlcx, nerr );
if( *nerr != 0 )
goto L_7777;
jperfr = 1;
getxlm( &lxlims, &tmin, &tmax );
/* if( !lxlims ){ commented out to allow relative mode when xlim is set. maf 970723 */
if( lrel ){
tmax = tmax - tmin;
Toff[jperfr] = -tmin;
tmin = 0.;
}
else{
copyi( nzdttm, n1dttm, 6 );
l1dttm = ldttm( n1dttm );
Toff[jperfr] = 0.;
}
for( jdfl = jdfl1 + 1; jdfl <= jdfl2; jdfl++ ){
jperfr = jperfr + 1;
getfil( jdfl, TRUE, &num, &nlcy, &nlcx, nerr );
if( *nerr != 0 )
goto L_7777;
getxlm( &lxlims, &tminj, &tmaxj );
if( lrel ){
tmax = fmax( tmax, tmaxj - tminj );
Toff[jperfr] = -tminj;
}
else{
if( l1dttm && ldttm( nzdttm ) ){
ddttm( nzdttm, n1dttm, &Toff[jperfr] );
/* if it starts 2 days after the first file,
plot relative. maf 970908 */
if ( fabs ( Toff[jperfr] ) > TWODAYS )
Toff[jperfr] = 0 ;
}
else{
Toff[jperfr] = 0.;
}
tmin = fmin( tmin, tminj + Toff[jperfr] );
tmax = fmax( tmax, tmaxj + Toff[jperfr] );
} /* end else associated with if ( lrel ) */
} /* end for( jdfl = jdfl1 + 1; jdfl <= jdfl2; jdfl++ ) */
/* } end if ( !lxlims ) commented out to allow relative mode when xlim is set. maf 970723 */
/* - Check range of time limits to avoid errors that could occur
* later during plotting. *
if( fabs( tmax - tmin ) > (float)( MLARGE ) ){
*nerr = 1504;
setmsg( "ERROR", *nerr );
goto L_7777;
} */
/* - Set x axis plot limits. */
cmgem.lxlim = TRUE;
cmgem.ximn = tmin;
cmgem.ximx = tmax;
if( lframesave ){
beginframe( lprint , nerr );
if( *nerr != 0 )
goto L_7777;
getvspace( &cmgem.view.xmin, &cmgem.view.xmax,
&cmgem.view.ymin, &cmgem.view.ymax );
}
jperfr = 0;
cmgem.tsdef = fmin( cmgem.tsdef, (cmgem.view.ymax - cmgem.view.ymin)/(8.0*
(float)( nperfr )) );
cmgam.tsfid = cmgem.tsdef;
cmgam.tspk = cmgem.tsdef;
cmgem.tsaxis = cmgem.tsdef;
for( jdfl = jdfl1; jdfl <= jdfl2; jdfl++ ){
jperfr = jperfr + 1;
cmgem.plot.ymin = cmgem.plot.ymax - ypdel;
/* --- Get pointers to this file's location in memory. */
getfil( jdfl, TRUE, &num, &nlcy, &nlcx, nerr );
if( *nerr != 0 )
goto L_7777;
/* --- Set up x axis data values. */
if( *leven ){
cmgem.xgen.on = TRUE;
cmgem.xgen.delta = *delta;
cmgem.xgen.first = *begin + Toff[jperfr];
}
else{
cmgem.xgen.on = FALSE;
}
/* --- Set up y axis plot limits. */
getylm( &cmgem.lylim, &cmgem.yimn, &cmgem.yimx );
/* --- Plot this file. */
pl2d( cmmem.sacmem[nlcx], cmmem.sacmem[nlcy], num, 1, 1, nerr );
if( *nerr != 0 )
goto L_7777;
/* --- Plot picks and fileid. */
disppk( Toff[jperfr] );
/* --- Add a label with offset time if this is a REL plot. */
kptext = NULL;
n = 0;
if( lrel && cmgam.lfidrq ){
asprintf(&kptext, "OFFSET: %10.3e", -Toff[jperfr] );
n = 1;
}
dispid( cmgam.lfinorq , jdfl, n, &kptext );
if(kptext) {
free(kptext);
kptext = NULL;
}
cmgem.plot.ymax = cmgem.plot.ymin;
}
/* -- Draw bottom x axis. */
cmgem.axis[BOTTOM].annotate = lbotaxsave;
cmgem.axis[BOTTOM].ticks = lbottcsave;
cmgem.axis[TOP].ticks = ltoptcsave;
cmgem.lxgrd = lxgrdsave;
cmgem.uplot.ymax = ypmxsave*cmgem.view.ymax;
cmgem.chht = cmgem.tsaxis;
cmgem.chwid = cmgem.txrat*cmgem.chht;
settextsize( cmgem.chwid, cmgem.chht );
if( cmgem.ixint == AXIS_LINEAR ){
xlinax();
}
else if( cmgem.ixint == AXIS_LOG ){
xlogax();
}
/* -- Draw axes labels and title. */
if( lxlabsave )
centxt( kmgem.kxlab,145, cmgem.xlabel.len, cmgem.xlabel.pos, cmgem.xlabel.text_size );
if( lylabsave )
centxt( kmgem.kylab,145, cmgem.ylabel.len, cmgem.ylabel.pos, cmgem.ylabel.text_size );
if( ltitlsave )
centxt( kmgem.ktitl,145, cmgem.title.len, cmgem.title.pos, cmgem.title.text_size );
/* -- Home cursor, advance frame and restore some GEM parameters. */
plhome();
if( lframesave )
endframe( FALSE , nerr );
else
flushbuffer( nerr );
cmgem.plot.ymax = ypmxsave;
cmgem.axis[BOTTOM].annotate = FALSE;
cmgem.axis[BOTTOM].ticks = FALSE;
/* -- Wait for user prompt before plotting next frame if appropriate. */
if( lwait ){
zgpmsg( kwait,9, kret,9 );
ncret = indexb( kret,9 );
upcase( kret, ncret, kret,9 );
if( kret[0] == 'K' )
goto L_7777;
if( kret[0] == 'G' )
lwait = FALSE;
}
jdfl1 = jdfl2 + 1;
} /* end for ( jfr ) */
/* - Restore plot and x limit attributes. Return. */
L_7777:
plrest();
cmgam.tsfid = cmgem.tsdef;
cmgam.tspk = cmgem.tsdef;
cmgem.tsaxis = cmgem.tsdef;
cmgem.plot.ymax = ypmxsave;
cmgem.axis[BOTTOM].annotate = lbotaxsave;
cmgem.axis[BOTTOM].ticks = lbottcsave;
cmgem.lframe = lframesave;
L_8888:
return;
} /* end of function */
/**
* Execute the getbb command which gets the blackboard variables
*
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 890104: Changed from terminal output to message subsystem.
* @date 880901: Added TO, NAMES, and NEWLINE options.
* @date 870917: Added ALL option.
* @date 870514: Original version.
*
*/
void
xgetbb(int *nerr) {
char kbbvalue[MCMSG+1];
int ic1, ic2, nc, ncbb ;
var *v;
char *name;
*nerr = 0;
memset(kmexm.knmbbwrite,0, sizeof(kmexm.knmbbwrite));
memset(kbbvalue, 0, sizeof(kbbvalue));
while ( lcmore( nerr ) ){
/* -- "ALL": report all of the currently defined blackboard variables. */
if( lckey( "ALL#$",6 ) ){
cmexm.lbball = TRUE;
}
/* -- "TO TERMINAL|filename": define where the output is to be sent. */
else if( lckey( "TO#$",5 ) ){
if( lckey( "TERM#INAL$",11 ) ){
cmexm.nunbbwrite = MUNOUT;
}
else if( lcchar( MCPFN, kmexm.knmbbwrite,MCPFN+1, &nc ) ){
cmexm.nunbbwrite = (FILE *)NULL;
if( *nerr != 0 )
goto L_8888;
}
else{
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
}
/* -- "NAMES ON|OFF": option to include the
bb variable name with the value. */
else if( lklog( "NAMES#$",8, &cmexm.lnames ) ) { }
/* -- "NEWLINE ON|OFF": option to append newline
after each bb variable value. */
else if( lklog( "NEWLINE#$",10, &cmexm.lnewline ) ) { }
/* -- The rest of the tokens should be names of a blackboard variables.
* First unset ALL flag and initialize list of bb variables.
* Then set up an inner parsing loop to collect all of the
* variable names. */
else{
cmexm.lbball = FALSE;
memset ( kmexm.kbbcl , ' ' , MCMSG );
if(!lccl(kmexm.kbbcl, MCMSG+1, &ncbb)) {
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
}
} /* end while */
/* - The above loop is over when one of two conditions has been met:
* (1) An error in parsing has occurred. In this case NERR is > 0 .
* (2) All the tokens in the command have been successfully parsed. */
if( *nerr != 0 )
goto L_8888;
/* EXECUTION PHASE: */
/* - Open disk file if necessary. */
if( cmexm.nunbbwrite != MUNOUT ){
znfiles( &cmexm.nunbbwrite, kmexm.knmbbwrite,MCPFN+1, "TEXT",5, nerr );
if( *nerr != 0 )
goto L_8888;
if ( fseek ( cmexm.nunbbwrite , 0L , SEEK_END ) != 0 )
fprintf ( stdout , "fseek returned error-xgetbb\n" ) ;
}
/* - Sequentially access blackboard if ALL was requested. */
setmsg( "OUTPUT", 99 );
if( cmexm.lbball ){
int i = 0;
char **keys = sac_vars_keys(kmbbs.knmbbs);
while(keys && keys[i]) { i++; }
if(i > 0) {
qsort(keys, i, sizeof(char*), string_cmp);
i = 0;
while ( keys && keys[i] ){
if(!(v = sac_vars_get_var(kmbbs.knmbbs, keys[i]))) {
error(ERROR_FINDING_VARIABLE, "%s", keys[i]);
outmsg();
clrmsg();
i++;
continue;
}
show_var(v, keys[i], cmexm.nunbbwrite);
i++;
}
if( !cmexm.lnewline ) {
newline( cmexm.nunbbwrite );
}
i = 0;
while(keys && keys[i]) {
FREE(keys[i]);
i++;
}
FREE(keys);
}
}
/* - Otherwise, get value for each item in request list. */
else {
ic1 = 0;
while ( lnxtcl( kmexm.kbbcl,MCMSG+1, &ic1, &ic2 ) ){
name = strcut(kmexm.kbbcl, ic1, ic2);
if(!(v = getbb(name))) {
error(ERROR_FINDING_VARIABLE, "%s", name);
outmsg();
clrmsg();
continue;
}
show_var(v, name, cmexm.nunbbwrite);
free(name);
}
if( !cmexm.lnewline ) {
newline( cmexm.nunbbwrite );
}
}
clrmsg();
if( cmexm.nunbbwrite != MUNOUT ){
zcloses( &cmexm.nunbbwrite, nerr );
if( *nerr != 0 )
goto L_8888;
}
L_8888:
return;
} /* end of function */
/**
* Replace or append to the filelist in memory
*
* @param call_data
* Structure containing the descriptions of the sac files
* @see extfunc.h
* @param update
* - REPLACE to replace the current files in memory
* - FALSE to append to the current file list
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @bug This routine assumes the size of the header does not change.
*
* @date 960229: Original version.
*
*/
void
updatedfl(sac_files call_data,
int update,
int *nerr) {
char kline[MCMSG+1], kfile[MCPFN+1];
int jdfl, ndxh, ndx1, ndx2, i, ndflsave;
sac_header *this_header;
float *ydata, *xdata;
*nerr = 0;
if( update == REPLACE ) {
cleardfl(nerr);
if( *nerr != 0 ) return;
}
/* check to make sure that there is room for the files. */
if((cmdfm.ndfl + call_data.nfiles) > MDFL ){
setmsg("OUTPUT", 0);
sprintf(kline,"%s%3d%s","Adding ", call_data.nfiles ,
" files would exceed the maximum number of files SAC can handle.");
aplmsg(kline,MCMSG+1);
aplmsg("No update being done.",22);
wrtmsg( MUNOUT );
clrmsg();
*nerr = ERROR_EXT_INTERFACE_NO_SPACE_LEFT;
return;
}
ndflsave = cmdfm.ndfl;
cmdfm.ndfl += call_data.nfiles;
for( i=0; i<call_data.nfiles; i++ ){
this_header = call_data.ext_hdrs[i];
ydata = call_data.ext_yvalues[i];
xdata = call_data.ext_xvalues[i];
jdfl = ndflsave + i + 1 ;
/* If evenly spaced */
if( getlhdr(this_header, "leven", nerr) == TRUE ){
Ncomp[jdfl] = 1;
}else{
Ncomp[jdfl] = 2;
}
Nlndta[jdfl] = getnhdr(this_header, "npts", nerr);
Ndsndx[jdfl] = 1 ;
if( i <= 9 ){
sprintf(kfile,"%s%1d", "EXTERN0", i );
}else{
sprintf(kfile,"%s%2d", "EXTERN", i );
}
/* filename to storage */
string_list_put(datafiles, kfile, MCPFN+1);
if( *nerr != 0 ) return;
/* allocate space for a sac file in memory */
crsac( jdfl, Ncomp[jdfl], Nlndta[jdfl], &ndxh,
&ndx1, &ndx2, nerr);
if( *nerr != 0 ) return;
/* store the header away */
memcpy(cmhdr.fhdr, this_header->ext_fhdr, MFHDR*sizeof(float));
memcpy(cmhdr.nhdr, this_header->ext_nhdr, MNHDR*sizeof(int));
memcpy(cmhdr.ihdr, this_header->ext_ihdr, MIHDR*sizeof(int));
memcpy(cmhdr.lhdr, this_header->ext_lhdr, MLHDR*sizeof(int));
memcpy(kmhdr.khdr, this_header->ext_khdr, MKHDR*9);
/* store the data */
memcpy(cmmem.sacmem[ndx1], ydata, (Nlndta[jdfl]*sizeof(float)));
if(Ncomp[jdfl] == 2)
memcpy(cmmem.sacmem[ndx2], xdata, (Nlndta[jdfl]*sizeof(float)));
extrma( cmmem.sacmem[ndx1], 1, *npts, depmin, depmax, depmen);
putfil( jdfl, nerr);
if( *nerr != 0 ) return;
}
return;
}
/**
* Destroy a family of file names given the base name. A two (2) digit
* integer is appended to the base name.
*
* @param kbase
* Base name
* @param kbase_s
* Length of \p kbase
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_ILLEGAL_BASE_NAME
*
* @date 860818: Changed to new message system.
* @date 810120: Changed to output message retrieval from disk.
* @date 800906: Fixed bug in determining correct base name.
* @date 800823: Added tree name capability [Prime].
* Allowed a lower as well as upper range to be specified.
* @date 800103: Original version.
*
* @bug Only used by co/zquit() for destroy "ZDLF" files, which may
* not exist anymore.
*
*/
void
zdestf(char *kbase,
int kbase_s,
int *nerr) {
char kname[MCPFN+1];
int j, jdig, jten, nbase;
static char kint[10]={'0','1','2','3','4','5','6','7','8','9'};
char *const Kint = &kint[0] - 1;
*nerr = 0;
/* - Make sure basename is legitimate. */
if( memcmp(kbase," ",1) == 0 ){
*nerr = ERROR_ILLEGAL_BASE_NAME;
setmsg( "ERROR", *nerr );
apcmsg( kname,MCPFN+1 );
goto L_8888;
}
else{
/* - Determine number of characters in base name. */
nbase = indexb( kbase,kbase_s );
if( nbase <= 0 ){
nbase = MCPFN - 2;
}
else if( nbase > MCPFN - 2 ){
nbase = MCPFN - 2;
}
/* - Destroy files with basename staring at "01"
* until an error occurs. ASSUME this error means
* that there are no more files with basename. */
jten = 1;
jdig = 2;
for( j = 1; j <= 99; j++ ){
/* -- Create file name. */
memset(kname,(int)' ',MCPFN);
kname[MCPFN] = '\0';
memcpy(kname,kbase,nbase);
kname[nbase] = Kint[jten];
kname[nbase + 1] = Kint[jdig];
/* -- Try to destroy it. Return on error.
* This should normally be "File does not exist." */
zdest( kname,MCPFN+1, nerr );
if( *nerr != 0 )
goto L_8888;
/* -- Increment numbers appended to basename. */
if( jdig < 10 ){
jdig = jdig + 1;
}
else{
jten = jten + 1;
jdig = 1;
}
}
}
/* - Clear error condition for "File does not exist." */
L_8888:
if( *nerr == ERROR_FILE_DOES_NOT_EXIST ){
*nerr = 0;
clrmsg();
}
return;
} /* end of function */
/**
* Compute the distance and azimuth between locations
*
* @param the
* Event latitude, North positive
* @param phe
* Event longitude, East positive
* @param ths
* Array of station latitudes
* @param phs
* Array of station longitudes
* @param ns
* Length of \p ths and \p phs
* @param dist
* Output array of epicentral distances in km
* @param az
* Output array of azimuths in degrees
* @param baz
* Output array of back azimuths in degrees
* @param xdeg
* Output array of great circle arc lengths in degrees
* @param nerr
* Error Return Flag
* - 0 on Success
* - Non-Zero on Error
* - 904 Internal consistency checks failed
*
* @note Calculations are based upon the reference spheroid of 1968 and
* are defined by the major radius (RAD) and the flattening (FL).
*
* @note Distance is computed using Rudoe's forumula given in GEODESY,
* secontion 2.15(b).
* (There is some numerical problem with the following formulae.
* If the station is in the southern hemisphere and the event in
* in the northern, these equations give the longer, not the
* shorter distance between the two locations. Since the
* equations are fairly messy, the simplist solution is to reverse
* the meanings of the two locations for this case.)
*
* @note Geodesy, G. Bomford, Carlendon Press, 4th ed, 1980, Section 2.15(b)
* page 121
*
* @bug Documentation for computing distance and azimumth should be added
*
* @bug Variables here are declared static, which is really not what they
* should be declared. The actual values are difficult to identify
* what they are referring to as well.
*
* @date 830603: Fixed bug with negative station latiudes.
* @date 810000: Original version.
*
*/
void
distaz(double the,
double phe,
float *ths,
float *phs,
int ns,
float *dist,
float *az,
float *baz,
float *xdeg,
int *nerr)
{
int laz, lbaz, ldist, lxdeg;
int idx;
double a, a1, a12, a12bot, a12top, al, b, b0, b1, c, c0, c1, c2,
c4, cosa12, costhi, costhk, d, d1, dl, du, e, e1, e1p1, e2, e3,
ec2, el, f, f1, g, g1, h, h1, onemec2, p1, p2, pdist, pherad,
phsrad, sc, sd, sina12, sinthi, sinthk, sqrte1p1, ss, t1, t2,
tanthi, tanthk, temp, therad, thg, thsrad, u1, u1bot, u2, u2bot,
u2top, v1, v2, x2, y2, z1, z2;
static float rad = 6378.160; /* Earth Radius */
static float fl = 0.00335293; /* Earth Flattening */
static float twopideg = 360.; /* Two Pi in Degrees */
static float c00 = 1.;
static float c01 = 0.25;
static float c02 = -4.6875e-02;
static float c03 = 1.953125e-02;
static float c21 = -0.125;
static float c22 = 3.125e-02;
static float c23 = -1.46484375e-02;
static float c42 = -3.90625e-03;
static float c43 = 2.9296875e-03;
static float degtokm = 111.3199; /* Conversion from degrees to km */
float *const Az = &az[0] - 1;
float *const Baz = &baz[0] - 1;
float *const Dist = &dist[0] - 1;
float *const Phs = &phs[0] - 1;
float *const Ths = &ths[0] - 1;
float *const Xdeg = &xdeg[0] - 1;
/* - Initialize. */
*nerr = 0;
ec2 = 2.*fl - fl*fl;
onemec2 = 1. - ec2;
/* eps = 1. + ec2/onemec2; */
/* - Check which output items are required. */
laz = TRUE;
if( Az[1] < 0. )
laz = FALSE;
lbaz = TRUE;
if( Baz[1] < 0. )
lbaz = FALSE;
ldist = TRUE;
if( Dist[1] < 0. )
ldist = FALSE;
lxdeg = TRUE;
if( Xdeg[1] < 0. )
lxdeg = FALSE;
/* - Convert event location to radians.
* (Equations are unstable for latidudes of exactly 0 degrees.) */
temp = the;
if( temp == 0. )
temp = 1.0e-08;
therad = TORAD*temp;
pherad = TORAD*phe;
/* - Must convert from geographic to geocentric coordinates in order
* to use the spherical trig equations. This requires a latitude
* correction given by: 1-EC2=1-2*FL+FL*FL */
if ( the == 90 || the == -90 ) {/* special attention at the poles */
thg = the*TORAD ; /* ... to avoid division by zero. */
} else {
thg = atan( onemec2 * tan(therad) );
}
d = sin( pherad );
e = -cos( pherad );
f = -cos( thg );
c = sin( thg );
a = f*e;
b = -f*d;
g = -c*e;
h = c*d;
/* - Loop on stations: */
for( idx = 1; idx <= ns; idx++ ){
/* -- Convert to radians. */
temp = Ths[idx];
if( temp == 0. )
temp = 1.0e-08;
thsrad = TORAD*temp;
phsrad = TORAD*Phs[idx];
/* -- Calculate some trig constants. */
if ( Ths[idx] == 90 || Ths[idx] == -90 )
thg = Ths[idx] * TORAD ;
else
thg = atan( onemec2*tan( thsrad ) );
d1 = sin( phsrad );
e1 = -cos( phsrad );
f1 = -cos( thg );
c1 = sin( thg );
a1 = f1*e1;
b1 = -f1*d1;
g1 = -c1*e1;
h1 = c1*d1;
sc = a*a1 + b*b1 + c*c1;
/* - Spherical trig relationships used to compute angles. */
if( lxdeg ){
sd = 0.5*sqrt( (powi(a - a1,2) + powi(b - b1,2) + powi(c -
c1,2))*(powi(a + a1,2) + powi(b + b1,2) + powi(c + c1,2)) );
Xdeg[idx] = atan2( sd, sc )*TODEG;
if( Xdeg[idx] < 0. )
Xdeg[idx] = Xdeg[idx] + twopideg;
}
if( laz ){
ss = powi(a1 - d,2) + powi(b1 - e,2) + powi(c1,2) - 2.;
sc = powi(a1 - g,2) + powi(b1 - h,2) + powi(c1 - f,2) - 2.;
Az[idx] = atan2( ss, sc )*TODEG;
if( Az[idx] < 0. )
Az[idx] = Az[idx] + twopideg;
}
if( lbaz ){
ss = powi(a - d1,2) + powi(b - e1,2) + powi(c,2) - 2.;
sc = powi(a - g1,2) + powi(b - h1,2) + powi(c - f1,2) - 2.;
Baz[idx] = atan2( ss, sc )*TODEG;
if( Baz[idx] < 0. )
Baz[idx] = Baz[idx] + twopideg;
}
/* - Now compute the distance between the two points using Rudoe's
* formula given in GEODESY, section 2.15(b).
* (There is some numerical problem with the following formulae.
* If the station is in the southern hemisphere and the event in
* in the northern, these equations give the longer, not the
* shorter distance between the two locations. Since the
* equations are fairly messy, the simplist solution is to reverse
* the meanings of the two locations for this case.) */
if( ldist ){
if( thsrad > 0. ){
t1 = thsrad;
p1 = phsrad;
t2 = therad;
p2 = pherad;
/* special attention at the poles to avoid atan2 troubles
and division by zero. */
if ( the == 90.0 ) {
costhk = 0.0 ;
sinthk = 1.0 ;
tanthk = FLT_MAX ;
}
else if ( the == -90.0 ) {
costhk = 0.0 ;
sinthk = -1.0 ;
tanthk = -FLT_MAX ;
}
else {
costhk = cos( t2 );
sinthk = sin( t2 );
tanthk = sinthk/costhk;
}
/* special attention at the poles continued. */
if ( Ths[idx] == 90.0 ) {
costhi = 0.0 ;
sinthi = 1.0 ;
tanthi = FLT_MAX ;
}
else if ( Ths[idx] == -90.0 ) {
costhi = 0.0 ;
sinthi = -1.0 ;
tanthi = -FLT_MAX ;
}
else {
costhi = cos( t1 );
sinthi = sin( t1 );
tanthi = sinthi/costhi;
}
}
else{
t1 = therad;
p1 = pherad;
t2 = thsrad;
p2 = phsrad;
/* more special attention at the poles */
if ( Ths[idx] == 90.0 ) {
costhk = 0.0 ;
sinthk = 1.0 ;
tanthk = FLT_MAX ;
}
else if ( Ths[idx] == -90.0 ) {
costhk = 0.0 ;
sinthk = -1.0 ;
tanthk = -FLT_MAX ;
}
else {
costhk = cos( t2 );
sinthk = sin( t2 );
tanthk = sinthk/costhk;
}
/* more special attention at the poles continued */
if ( the == 90.0 ) {
costhi = 0.0 ;
sinthi = 1.0 ;
tanthi = FLT_MAX ;
}
else if ( the == -90.0 ) {
costhi = 0.0 ;
sinthi = -1.0 ;
tanthi = -FLT_MAX ;
}
else {
costhi = cos( t1 );
sinthi = sin( t1 );
tanthi = sinthi/costhi;
}
}
el = ec2/onemec2;
e1 = 1. + el;
al = tanthi/(e1*tanthk) + ec2*sqrt( (e1 + powi(tanthi,2))/
(e1 + powi(tanthk,2)) );
dl = p1 - p2;
a12top = sin( dl );
a12bot = (al - cos( dl ))*sinthk;
/* Rewrote these three lines with help from trig identities. maf 990415 */
a12 = atan2( a12top, a12bot );
cosa12 = cos( a12 );
sina12 = sin( a12 );
/*cosa12 = sqrt ( a12bot*a12bot / ( a12bot*a12bot + a12top*a12top ) ) ;
sina12 = sqrt ( a12top*a12top / ( a12bot*a12bot + a12top*a12top ) ) ; */
e1 = el*(powi(costhk*cosa12,2) + powi(sinthk,2));
e2 = e1*e1;
e3 = e1*e2;
c0 = c00 + c01*e1 + c02*e2 + c03*e3;
c2 = c21*e1 + c22*e2 + c23*e3;
c4 = c42*e2 + c43*e3;
v1 = rad/sqrt( 1. - ec2*powi(sinthk,2) );
v2 = rad/sqrt( 1. - ec2*powi(sinthi,2) );
z1 = v1*(1. - ec2)*sinthk;
z2 = v2*(1. - ec2)*sinthi;
x2 = v2*costhi*cos( dl );
y2 = v2*costhi*sin( dl );
e1p1 = e1 + 1.;
sqrte1p1 = sqrt( e1p1 );
u1bot = sqrte1p1*cosa12;
u1 = atan2( tanthk, u1bot );
u2top = v1*sinthk + e1p1*(z2 - z1);
u2bot = sqrte1p1*(x2*cosa12 - y2*sinthk*sina12);
u2 = atan2( u2top, u2bot );
b0 = v1*sqrt( 1. + el*powi(costhk*cosa12,2) )/e1p1;
du = u2 - u1;
pdist = b0*(c2*(sin( 2.*u2 ) - sin( 2.*u1 )) + c4*(sin( 4.*
u2 ) - sin( 4.*u1 )));
Dist[idx] = fabs( b0*c0*du + pdist );
if( lxdeg && (fabs( Dist[idx] - degtokm*Xdeg[idx] )) > 100. ){
*nerr = 904;
setmsg( "ERROR", *nerr );
apimsg( idx );
}
} /* end if ( ldist ) */
} /* end for */
return;
}
/**
* Define memory requirement for a given data fiile
*
* @param idfl
* Data file list number
* @param lcutnow
* - TRUE if the file is being read and needs to be cut
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 850415: Changes due to restructuring of DFM common block.
* @date 840228: Moved cut logic to new subroutine, DEFCUT.
* @date 820809: Changed method of storing cut parameters.
* @date 810903: Fixed bug in computing stop time when "N" option used.
*
*/
void
defmem(int idfl,
int lcutnow,
int *nerr) {
int lall;
char *tmp;
*nerr = 0;
/* - Get name of data file. */
tmp = string_list_get(datafiles, idfl-1);
/* - Entire file is read if:
* (1) cut option is off.
* (2) file is a spectral file
* (3) file is unevenly spaced */
if( !cmdfm.lcut || !lcutnow ){
lall = TRUE;
}
else if( *iftype == *irlim || *iftype == *iamph ){
setmsg( "WARNING", ERROR_CANT_CUT_SPECTRAL_FILE );
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
lall = TRUE;
}
else if( !*leven ){
setmsg( "WARNING", ERROR_CANT_CUT_UNEVENLY_SPACED_FILE );
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
lall = TRUE;
}
else{
lall = FALSE;
}
/* - Set parameters if entire file is to be read. */
if( lall ){
Nstart[idfl] = 1;
Nstop[idfl] = *npts;
Ntotal[idfl] = *npts;
Nfillb[idfl] = 0;
Nfille[idfl] = 0;
}
/* - Set parameters for partial read. */
else{
defcut( kmdfm.kcut , cmdfm.ocut , idfl , nerr );
if( *nerr != 0 )
goto L_8888;
}
/* - Define number of data components. */
if( (*iftype == *itime || *iftype == *ixy) || *iftype == *iunkn ){
if( *leven ){
Ncomp[idfl] = 1;
}
else{
Ncomp[idfl] = 2;
}
}
else if( *iftype == *ixyz ){
Ncomp[idfl] = 1;
}
else{
Ncomp[idfl] = 2;
}
/* - Define length of each data component, including zero fill. */
Nlndta[idfl] = Nstop[idfl] - Nstart[idfl] + 1;
L_8888:
return;
}
/**
* Get an enumerated header value from the current SAC file
*
* @param kname
* Name of the header field to get
* @param kvalue
* Value of heade field from the current SAC data file
* Each value represents a specific condition
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_UNDEFINED_HEADER_FIELD_VALUE
* - 1337
* @param kname_s
* Length of \p kname
* @param kvalue_s
* Length of \p kvalye
*
* @date 870902: Original version.
*
*/
void
getihv(char *kname,
char *kvalue,
int *nerr,
int kname_s,
int kvalue_s) {
char ktest[9];
int index, ivalue, ntest;
char *kname_c;
int callFromC = 0;
if(kname_s < 0) {
callFromC = 1;
}
kname_c = fstrdup(kname, kname_s);
kname_s = strlen(kname_c) + 1;
*nerr = 0;
/* - Convert input name to uppercase and
* check versus list of legal names. */
ntest = min( indexb( kname_c,kname_s ), SAC_HEADER_STRING_LENGTH_FILE );
strcpy( ktest, " " );
modcase( TRUE, kname_c, ntest, ktest );
index = nequal( ktest, (char*)kmlhf.kihdr,9, SAC_HEADER_ENUMS );
/* - If legal name, return current value.
* Otherwise, set error condition. */
if( index > 0 ){
ivalue = Ihdr[index];
if( ivalue == cmhdr.iundef ){
fstrncpy( kvalue, kvalue_s-1, "UNDEFINED", 9);
*nerr = ERROR_UNDEFINED_HEADER_FIELD_VALUE;
}
else{
fstrncpy( kvalue, kvalue_s-1, kmlhf.kiv[ivalue - 1],
strlen(kmlhf.kiv[ivalue - 1]) );
}
}
else{
fstrncpy( kvalue, kvalue_s-1, "ILLEGAL", 7);
*nerr = 1337;
}
/* - Create error message and write to terminal. */
if( *nerr != 0 ){
setmsg( "WARNING", *nerr );
apcmsg( kname_c,kname_s );
outmsg();
clrmsg();
}
if(callFromC) { /* C String Termination */
kvalue[ max(0,min(kvalue_s,8))] = 0;
} else { /* Fortran String Non-Termination by Spaces */
if(kvalue_s > 8) {
memset(kvalue + 8, ' ', kvalue_s - 8);
}
}
free(kname_c);
return;
}
/**
* Define cut parameters for a given data file
*
* @param kcut
* Which parameter
* @param ocut
* Cut times
* @param idfl
* Data file list number
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_SAC_LOGIC_ERROR
* - ERROR_UNDEFINED_START_CUT_TIME
* - ERROR_UNDEFINED_STOP_CUT_TIME
* - ERROR_START_TIME_LESS_THAN_BEGIN
* - ERROR_STOP_TIME_GREATER_THAN_END
* - ERROR_START_TIME_GREATER_THAN_END
* - ERROR_STOP_TIME_LESS_THAN_BEGIN
* - ERROR_START_TIME_GREATER_THAN_STOP
* - ERROR_CORRECTED_BY_FILL_WITH_ZEROS
* - ERROR_CORRECTED_BY_USING_START_TIME
* - ERROR_CORRECTED_BY_USING_END_TIME
*
* @date 961211, 970114, 970214, and 970304:
* I made incremental changes to harden cut. It now cuts
* precisely on the values entered. maf
* @date 880128: Fixed bug that occurred when the sampling interval
* was smaller than the machine roundoff factor.
* @date 850415: Changes due to restructuring of DFM common block.
* @date 840228: Original version from DEFMEM.
*
*/
void
defcut(char kcut[2][9],
double ocut[2],
int idfl,
int *nerr) {
int jdx, nptrd;
float pick[2], start, stop;
float *const Pick = &pick[0] - 1;
char *tmp;
*nerr = 0;
/* - Get file name from character list. */
tmp = string_list_get(datafiles, idfl-1);
/* - Save total number of points in file. */
Ntotal[idfl] = *npts;
/* - Compute start value. */
if( strcmp(kcut[0],"Z ") == 0 ){
Pick[1] = 0.;
}
else if ( strcmp(kcut[0],"N ") != 0 ) {
jdx = nequal( (char*)kcut[0], (char*)kmdfm.kpick,9, MPICK );
if( jdx > 0 )
Pick[1] = Fhdr[Ipckhd[jdx]];
else{
*nerr = ERROR_SAC_LOGIC_ERROR;
setmsg( "ERROR", *nerr );
apcmsg( "DEFCUT #2",10 );
return ;
}
} else {
*nerr = ERROR_SAC_LOGIC_ERROR;
setmsg( "ERROR", *nerr );
apcmsg( "DEFCUT #2",10 );
return ;
}
/* - Check to make sure the requested pick field
* in the header is defined.
*/
if( Pick[1] == cmhdr.fundef ){
if( cmdfm.icuter == 1 ){
*nerr = ERROR_UNDEFINED_START_CUT_TIME;
setmsg( "ERROR", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
return ;
}
else{
setmsg( "WARNING", ERROR_UNDEFINED_START_CUT_TIME );
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg( "OUTPUT", ERROR_CORRECTED_BY_USING_BEGIN_TIME );
outmsg();
start = *begin;
Nstart[idfl] = 1;
}
}
else{
start = Pick[1] + ocut[0];
cut_define(*begin, *delta, start, &Nstart[idfl]);
}
/* - Compute stop value. */
if( strcmp(kcut[1],"N ") == 0 ){
nptrd = ocut[1] + RNDOFF**delta;
stop = start + (float)( nptrd - 1 )**delta;
Nstop[idfl] = Nstart[idfl] + nptrd - 1;
Pick[2] = 0.;
}
else{
jdx = nequal( (char*)kcut[1], (char*)kmdfm.kpick,9, MPICK );
if(jdx <= 0) {
*nerr = ERROR_SAC_LOGIC_ERROR;
setmsg( "ERROR", *nerr );
apcmsg( "DEFCUT #3",10 );
return ;
} else {
if(strcmp(kcut[1],"Z ") == 0 ) {
Pick[2] = 0.0;
} else {
Pick[2] = Fhdr[Ipckhd[jdx]];
}
stop = Pick[2] + ocut[1];
cut_define(*begin, *delta, stop, &Nstop[idfl]);
}
}
/* - Make sure stop pick is defined. */
if( Pick[2] == cmhdr.fundef ){
if( cmdfm.icuter == 1 ){
*nerr = ERROR_UNDEFINED_STOP_CUT_TIME;
setmsg( "ERROR", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
return ;
}
else{
setmsg( "WARNING", ERROR_UNDEFINED_STOP_CUT_TIME );
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg( "OUTPUT", ERROR_CORRECTED_BY_USING_END_TIME );
outmsg();
stop = *ennd;
Nstop[idfl] = *npts;
}
}
/* Check the cut time and adjust Nstart, Nstop, Nfillb, Nfille */
cut_define_check(start, stop, *npts, cmdfm.icuter,
&Nstart[idfl], &Nstop[idfl],
&Nfillb[idfl], &Nfille[idfl], nerr);
/* Error checking */
if(*nerr) {
switch(*nerr) {
case ERROR_START_TIME_GREATER_THAN_STOP:
error(*nerr, "%s\n\ttime: %f >= %f\n\tindex: %d >= %d", tmp, start, stop, Nstart[idfl], Nstop[idfl]);
return ;
break;
case ERROR_START_TIME_GREATER_THAN_END:
error(*nerr, "%s\n\ttime: %f > %f\n\tindex: %d > %d", tmp, start, *e, Nstart[idfl], *npts);
return ;
break;
case ERROR_STOP_TIME_LESS_THAN_BEGIN:
error(*nerr, "%s\n\ttime: %f < %f\n\tindex: %d < %d", tmp, stop, *b, Nstop[idfl], 1);
return ;
break;
case ERROR_START_TIME_LESS_THAN_BEGIN:
if( cmdfm.icuter == 2 ){
setmsg( "WARNING", *nerr);
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg( "OUTPUT", ERROR_CORRECTED_BY_USING_BEGIN_TIME );
outmsg();
*nerr = SAC_OK;
} else {
setmsg( "ERROR", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
return ;
}
break;
case ERROR_STOP_TIME_GREATER_THAN_END:
if( cmdfm.icuter == 2 ){
setmsg( "WARNING", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg( "OUTPUT", ERROR_CORRECTED_BY_USING_END_TIME );
outmsg();
*nerr = SAC_OK;
} else {
setmsg( "ERROR", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
return ;
}
break;
case ERROR_CUT_TIMES_BEYOND_DATA_LIMITS:
/* Begin */
setmsg("WARNING", ERROR_START_TIME_LESS_THAN_BEGIN);
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg("OUTPUT", ERROR_CORRECTED_BY_USING_BEGIN_TIME);
outmsg();
/* End */
setmsg("WARNING", ERROR_STOP_TIME_GREATER_THAN_END);
apcmsg2(tmp, strlen(tmp)+1);
outmsg();
setmsg("OUTPUT", ERROR_CORRECTED_BY_USING_END_TIME);
outmsg();
*nerr = SAC_OK;
break;
}
}
/* - Convert these start and stop points to new begin and end times. */
*begin = *begin + (float)( Nstart[idfl] - 1 )**delta;
*npts = Nstop[idfl] - Nstart[idfl] + 1;
*ennd = *begin + (float)( *npts - 1 )**delta;
}
void xgamc(int index, int *nerr)
{
/*=====================================================================
* PURPOSE: To execute a MOD command given its index number.
*=====================================================================
* INPUT ARGUMENTS:
* INDEX: The index number of the command.
*=====================================================================
* OUTPUT ARGUMENTS:
* NERR: Error flag. Set to 0 if no error occurred.
* Potential error numbers: 0901.
*=====================================================================
* MODULE/LEVEL: GAM/1
*=====================================================================
* GLOBAL INPUT:
* MACH:
*=====================================================================
* GLOBAL OUTPUT:
* GAM: LRTWXL, KRTWXL, ORTWXL
*=====================================================================
* SUBROUTINES CALLED:
* SACLIB: GTOUTM, XP, XP1, XP2, XPPK, XPC, XFID, XPICKS, XPLOTPM
*=====================================================================
* MODIFICATION HISTORY:
* 970204: Added FILENUMBER to allow or disallow file number
* display. maf
* 890421: Added PLOTXY command.
* 870728: Moved XLIM and YLIM commands from GEM.
* 870420: Added SETDEVICE command.
* 861203: Added PLOTPM command.
* 830105: Deleted PUSER command.
* 821228: Added FILEID and PICKS commands. Deleted DISPLAY command.
* 821005: Added PLOTC command.
* 820825: Original version.
*===================================================================== */
/* PROCEDURE: */
*nerr = 0;
/* - Jump to correct command based upon its index number. */
switch( index ){
case 1: goto L_100;
case 2: goto L_200;
case 3: goto L_300;
case 4: goto L_400;
case 5: goto L_500;
case 6: goto L_600;
case 7: goto L_700;
case 8: goto L_800;
case 9: goto L_900;
case 10: goto L_1000;
case 11: goto L_1100;
case 12: goto L_1200;
case 13: goto L_1300;
case 14: goto L_1400;
case 15: goto L_1500;
case 16: goto L_1600; /* added for FILENUMBER. maf 970204 */
case 17: goto L_1700; /* added for PRINT. maf 990422 */
case 18: goto L_1800;
}
/* - Error return if bad index value. */
*nerr = 901;
setmsg( "ERROR", *nerr );
apcmsg( "in XGAMC",9 );
goto L_8888;
L_100:
/* - Command 01: PLOT */
xp( nerr );
goto L_8888;
L_200:
/* - Command 02: PLOT1 */
xp1( nerr );
goto L_8888;
L_300:
/* - Command 03: PLOT2 */
xp2( nerr );
goto L_8888;
L_400:
/* - Command 04: PLOTPK */
xppk( nerr );
goto L_8888;
L_500:
/* - Command 05: PLOTC */
xpc( nerr );
goto L_8888;
L_600:
/* - Command 06: FILEID */
xfid( nerr );
goto L_8888;
L_700:
/* - Command 07: PICKS */
xpicks( nerr );
goto L_8888;
L_800:
/* - Command 08: PLOTPM */
xplotpm( nerr );
goto L_8888;
L_900:
/* - Command 09: SETDEVICE */
xsetdevice( nerr );
goto L_8888;
L_1000:
/* - Command 10: XLIM */
xcrtw( &cmgam.lrtwxl, (char*)kmgam.krtwxl,9, cmgam.ortwxl, nerr );
goto L_8888;
L_1100:
/* - Command 11: YLIM */
xylim( nerr );
goto L_8888;
L_1200:
/* - Command 12: PLOTXY */
xplotxy( nerr );
goto L_8888;
L_1300:
/* - Command 13: FITXY */
xfitxy( nerr );
goto L_8888;
L_1400:
/* - Command 14: PLOTDY */
xplotdy( nerr );
goto L_8888;
L_1500:
/* - Command 15: PLOTALPHA */
xplotalpha( nerr );
goto L_8888;
L_1600:
/* - Command 16: FILENUMBER */
xfilenumber ( nerr ) ;
goto L_8888 ;
L_1700:
/* - Command 17: PRINT */
xprint ( nerr ) ;
goto L_8888 ;
L_1800:
xsave( );
goto L_8888;
L_8888:
return;
} /* end of function */
/**
* Execute the command LISTHDR (LH) which lists header values
*
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 970425: Fix bug so display fits in the window. maf
* @date 970129: Print file number (jdfl). maf
* @date 961212: All of the header variables are now in the default list.
* Added INCLUSIVE option to show headers whether they are
* defined or not. maf
* @date 900507: Fixed bug with an odd number of items being listed with
* the two-column output option. (VAX/VMS bug fix.)
* @date 890104: Now sending output to message handling system.
* @date 860930: Added a wait mechanism after each full screen.
* @date 841026: Extensive modifications made to entire subroutine.
* @date 820806: Changed to newest set of parsing and checking functions.
* Updated line formatting using F77 character constructs.
* @date 820119: Fixed bug in listing KHDR values.
* @date 811029: Changed floating point output to G8.1 format.
* @date 810528: Added option to list only first file in dfl.
* @date 810223: Added check for null data file list.
* @date 810120: Changed to output message retrieval from disk.
*
*/
void
xlh(int *nerr) {
char kerase[41], kline[MCMSG+1], kresp[9], krpttx[MRPT][41], ktok[9],
kwait[9];
int lwait;
int j, j_, jdfl, jrpt, jrpt_, jrpttx, jrpttx_,
jsprpt, junk1, junk2, junk3, nc1, nc2, nc3, nc4, nctx[MRPT],
nctxm, nferr, nlscrn, nlw, nrpttx, ntused;
static int iform = 1;
static char kblank[41] = " ";
char *cattemp;
char *strtemp1, *strtemp2, *strtemp3, *strtemp4, *strtemp5;
int idx, ldef ;
char *tmp;
int *const Nctx = &nctx[0] - 1;
*nerr = 0;
ldef = FALSE;
for( idx = 0 ; idx < 8 ; idx++ )
ktok[idx] = ' ' ;
ktok[ 8 ] = '\0' ;
/* currently executing listhdr command. maf 961212 */
cmhdr.llh = TRUE ;
for( idx = 0 ; idx < MCMSG ; idx++ )
kline[ idx ] = ' ' ;
kline[ MCMSG ] = '\0' ;
jsprpt = 0;
/* - Loop on each token in command: */
while ( lcmore( nerr ) ){
/* -- "DEFAULT/PICKS/SPECIAL": change type of header report. */
if( lclist( (char*)kmlhf.krpttp,9, cmlhf.nrpttp, &cmlhf.irpttp ) ){
if( cmlhf.irpttp == 1 || cmlhf.irpttp == 4 ){
for( j = 1; j <= cmlhf.nstrpt; j++ ){
j_ = j - 1;
strcpy( kmlhf.krpt[j_], kmlhf.kstrpt[j_] );
}
cmlhf.nrpt = cmlhf.nstrpt;
}
else if( cmlhf.irpttp == 2 ){
for( j = 1; j <= cmlhf.npkrpt; j++ ){
j_ = j - 1;
strcpy( kmlhf.krpt[j_], kmlhf.kpkrpt[j_] );
}
cmlhf.nrpt = cmlhf.npkrpt;
}
else if( cmlhf.irpttp == 3 ){
for( j = 1; j <= cmlhf.nsprpt; j++ ){
j_ = j - 1;
strcpy( kmlhf.krpt[j_], kmlhf.ksprpt[j_] );
}
cmlhf.nrpt = cmlhf.nsprpt;
}
}
/* -- "FILES ALL/nlist": print all headers or only a subset. */
else if( lckey( "FILES#$",8 ) ){
if( lckey( "ALL$",5 ) ){
cmlhf.lstall = TRUE;
}
else if( lckey( "NONE$",6 ) ){
ldef = TRUE;
}
else if( lcia( 1, cmdfm.ndfl, cmlhf.ilhlst, &cmlhf.nlhlst ) ){
cmlhf.lstall = FALSE;
}
}
/* -- "INCLUSIVE": print headers even if they are undefined.*/
else if ( lklog( "INC#LUSIVE$", 12, &cmhdr.linc ) )
{ /* do nothing */ }
/* -- "COLUMNS n": change number of output columns. */
else if( lkirc( "COLUMNS#$",10, 1, 2, &cmlhf.nlhcol ) )
{ /* do nothing */ }
/* -- "FIRST": Obsolete keyword for first file only. */
else if( lckey( "FIRST#$",8 ) ){
cmlhf.lstall = FALSE;
cmlhf.nlhlst = 1;
Ilhlst[1] = 1;
}
else if( lcchar( MCPW, ktok,9, &ntused ) ){
if( jsprpt < MSPRPT ){
jsprpt = jsprpt + 1;
strcpy( kmlhf.ksprpt[jsprpt - 1], ktok );
cmlhf.nrpt = jsprpt;
strcpy( kmlhf.krpt[cmlhf.nrpt - 1], ktok );
}
else{
*nerr = 1309;
setmsg( "ERROR", *nerr );
apimsg( jsprpt );
}
} else{
/* -- Bad syntax. */
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
}
if( *nerr != 0 ) {
/* no longer executing xlh() */
cmhdr.llh = FALSE ;
return;
}
/* - Save length of special report if needed. */
if( jsprpt > 0 )
cmlhf.nsprpt = jsprpt;
if( ldef ) {
/* no longer executing xlh(). */
cmhdr.llh = FALSE;
return;
}
/* CHECKING PHASE: */
/* - Check for null data file list. */
vflist( nerr );
if( *nerr != 0 ) {
/* no longer executing xlh().*/
cmhdr.llh = FALSE ;
return;
}
/* EXECUTION PHASE: */
/* - Get screen attributes (number of lines per screen and
* text to send to erase screen, if any.) */
getalphainfo( &nlscrn, kerase,41 );
if( nlscrn <= 0 )
nlscrn = 23;
if( cmlhf.lstall ){
setinputmode( "ALL" );
}
else{
setinputmode( "SELECT" );
selectinputfiles( cmlhf.ilhlst, cmlhf.nlhlst );
}
nlw = 0;
gettextwait( kwait,9 );
lwait = memcmp(kwait,"ON",2) == 0;
autooutmsg( TRUE );
setmsg( "OUTPUT", 99 );
if(!use_tty()) {
lwait = FALSE;
}
jdfl = 0;
L_4000:
if( nextinputfile( &jdfl ) ){
getfil( jdfl, FALSE, &junk1, &junk2, &junk3, nerr );
if( *nerr != 0 ) {
autooutmsg( FALSE );
/* no longer executing xlh(). */
cmhdr.llh = FALSE ;
return ;
}
if((tmp = string_list_get(datafiles, jdfl-1))) {
aplmsg( " ",2 );
cattemp = malloc(7+strlen(tmp)+7);
sprintf(cattemp, " FILE: %s - %d", tmp, jdfl);
aplmsg( cattemp, strlen ( cattemp ) + 1 );
free(cattemp);
memset(kline,'-',strlen(tmp)+6);
kline[strlen(tmp)+6]='\n';
kline[strlen(tmp)+7]='\0';
aplmsg( kline,MCMSG+1 );
nlw = nlw + 4;
}
nrpttx = 0;
nctxm = 0;
for( jrpt = 1; jrpt <= cmlhf.nrpt; jrpt++ ){
jrpt_ = jrpt - 1;
nrpttx = nrpttx + 1;
formhv( (char*)kmlhf.krpt[jrpt_],9,
iform, (char*)krpttx[nrpttx - 1], 41, &nferr );
if( nferr == 0 ){
Nctx[nrpttx] = indexc((char*)krpttx[nrpttx - 1], 41, '=' );
nctxm = max( nctxm, Nctx[nrpttx] );
}
else if ( !cmhdr.linc ) {
nrpttx = nrpttx - 1;
}
}
if( cmlhf.nlhcol == 1 ){
for( jrpttx = 1; jrpttx <= nrpttx; jrpttx++ ){
jrpttx_ = jrpttx - 1;
nc1 = 2 + nctxm - Nctx[jrpttx];
nc2 = indexb( (char*)krpttx[jrpttx_],41 );
strtemp1 = malloc(nc1+1);
strtemp2 = malloc(nc2+1);
strncpy(strtemp1,kblank,nc1);
strncpy(strtemp2,krpttx[jrpttx_],nc2);
strtemp1[nc1] = '\0';
strtemp2[nc2] = '\0';
sprintf(kline," %s %s",strtemp1,strtemp2);
free(strtemp1);
free(strtemp2);
aplmsg( kline,MCMSG+1 );
nlw = nlw + 1;
if( lwait && (nlw >= (nlscrn - 2)) ){
outmsg();
clrmsg();
setmsg( "OUTPUT", 99 );
zgpmsg( "Waiting $",10, kresp,9 );
upcase( kresp, 1, kresp,9 );
nlw = 0;
if( kresp[0] == 'K' || kresp[0] == 'Q' ) {
autooutmsg( FALSE );
/* no longer executing xlh(). */
cmhdr.llh = FALSE ;
return ;
}
else if( kresp[0] == 'G' ){
if( strcmp(kerase," ") != 0 ) {
fprintf(MUNOUT," %s\n",kerase);
}
lwait = FALSE;
}
else if( kresp[0] == 'N' ){
if( strcmp(kerase," ") != 0 ) {
fprintf(MUNOUT," %s\n",kerase);
}
goto L_4000;
}
}
}
} else {
strcpy( krpttx[nrpttx], " " );
for( jrpttx = 1; jrpttx <= nrpttx; jrpttx += 2 ){
jrpttx_ = jrpttx - 1;
nc1 = 2 + nctxm - Nctx[jrpttx];
nc2 = indexb( (char*)krpttx[jrpttx_],41 );
nc3 = 2 + nctxm - Nctx[jrpttx + 1];
nc4 = indexb( (char*)krpttx[jrpttx_ + 1],41 );
if( nc4 > 0 ){
strtemp1 = malloc(nc1+1);
strtemp2 = malloc(nc2+1);
strtemp3 = malloc(nc3+1);
strtemp4 = malloc(nc4+1);
strncpy(strtemp1,kblank,nc1);
strtemp1[nc1] = '\0';
strncpy(strtemp2,krpttx[jrpttx_],nc2);
strtemp2[nc2] = '\0';
strncpy(strtemp3,kblank,nc3);
strtemp3[nc3] = '\0';
strncpy(strtemp4,krpttx[jrpttx_ + 1],nc4);
strtemp4[nc4] = '\0';
if ((nc1+nc2) < 40 ) {
strtemp5 = malloc(40-(nc1+nc2)+1);
memset(strtemp5,' ',40-(nc1+nc2));
strtemp5[40-(nc1+nc2)] = '\0';
sprintf(kline," %s%s%s%s%s",
strtemp1,strtemp2,strtemp5,strtemp3,strtemp4);
free(strtemp5);
}
else {
sprintf(kline," %s%s%s%s",
strtemp1,strtemp2,strtemp3,strtemp4);
}
free(strtemp1);
free(strtemp2);
free(strtemp3);
free(strtemp4);
}
else{
strtemp1 = malloc(nc1+1);
strtemp2 = malloc(nc2+1);
strncpy(strtemp1,kblank,nc1);
strtemp1[nc1] = '\0';
strncpy(strtemp2,krpttx[jrpttx_],nc2);
strtemp2[nc2] = '\0';
sprintf(kline," %s%s",strtemp1,strtemp2);
free(strtemp1);
free(strtemp2);
}
aplmsg( kline,MCMSG+1 );
nlw = nlw + 1;
if( lwait && (nlw >= (nlscrn - 1)) ){
outmsg();
clrmsg();
setmsg( "OUTPUT", 99 );
nlw = 0;
zgpmsg( "Waiting $",10, kresp,9 );
upcase( kresp, 1, kresp,9 );
if( kresp[0] == 'K' || kresp[0] == 'Q' ) {
autooutmsg( FALSE );
/* no longer executing xlh(). */
cmhdr.llh = FALSE ;
return ;
}
else if( kresp[0] == 'G' ){
if( strcmp(kerase," ") != 0 ) {
fprintf(MUNOUT," %s\n",kerase);
}
lwait = FALSE;
}
else if( kresp[0] == 'N' ){
if( strcmp(kerase," ") != 0 ) {
fprintf(MUNOUT," %s\n",kerase);
}
goto L_4000;
}
}
}
}
/* -- Loop on entries in input dfl. */
goto L_4000;
}
/* - Turn automatic output mode off before returning. */
autooutmsg( FALSE );
/* no longer executing xlh() */
cmhdr.llh = FALSE ;
return;
}
/**
* Execute the command WRITEHDR which writes a SAC Header
*
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 850801: Deleted SOCKITOME format.
* @date 830930: Added error condition when CUT option is on.
* @date 820721: Changed to newest set of parsing and checking functions.
* @date 801003: Original version.
* @date 810223: Added check for null data file list.
*
*/
void
xwh(int *nerr) {
char *tmp;
int jdfl, ndx1, ndx2, nlen;
*nerr = 0;
if ( lcmore ( nerr ) ) {
/* -- "COMMIT|RECALLTRACE|ROLLBACK": how to treat existing data */
if ( lckeyExact ( "COMMIT" , 7 ) )
cmdfm.icomORroll = COMMIT ;
else if (lckeyExact ( "RECALLTRACE" , 12 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "RECALL" , 7 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "ROLLBACK" , 9 ) )
cmdfm.icomORroll = ROLLBACK ;
}
/* CHECKING PHASE: */
/* - Check for null data file list. */
vflist( nerr );
if( *nerr != 0 )
goto L_8888;
/* - Make sure CUT is off. */
if( cmdfm.lcut ){
*nerr = 1341;
setmsg( "ERROR", *nerr );
goto L_8888;
}
/* EXECUTION PHASE: */
alignFiles ( nerr ) ;
if ( *nerr )
return ;
/* - For each file in DFL: */
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
/* -- Get header from working memory or disk determine file name. */
getfil( jdfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
tmp = string_list_get(datafiles, jdfl-1);
/* -- Check to see if overwrite flag is enabled. */
if( !*lovrok ){
*nerr = 1303;
setmsg( "ERROR", *nerr );
apcmsg2(tmp, strlen(tmp)+1);
goto L_8888;
}
/* -- Write header. */
wrsac( jdfl, tmp, strlen(tmp)+1, FALSE, nerr );
if( *nerr != 0 )
goto L_8888;
}
L_8888:
return;
}
void /* FUNCTION */ fdWriteFiles ( int * memptr , char * kprefix ,
float * userData , int newnpts ,
int * nerr )
{
/* index sacmem for amplitude, phase, group delay,
and the impulse response. */
int fileDescriptor = 0 , hdrindex , xbegin = 0 ,
idx, jdx, nlcmem, nlcdsk, nptwr,
unused1 , unused2 , unused3 ;
char kname[ MCPFN ] , ksuffix[ 3 ][ 6 ] ;
float *bufout = NULL , *ptr , amph[ 2 ][ 2 * NDATPTS - 2 ] ;
void zwabs() ;
*nerr = 0;
/* handle strings */
if ( strlen ( kprefix ) > MCPFN - 4 )
kprefix[ MCPFN - 4 ] = '\0' ;
strcpy ( ksuffix[ 0 ] , ".spec" ) ;
strcpy ( ksuffix[ 1 ] , ".gd" ) ;
strcpy ( ksuffix[ 2 ] , ".imp" ) ;
/* Determine the begin of the impulse */
for ( ptr = cmmem.sacmem[memptr[ 9 ]] ; *ptr == 0.0 ; ptr++ )
xbegin++ ;
/* fill the amplitude and phase array */
for ( idx = 0 ; idx < NDATPTS ; idx++ ) {
amph[ 0 ][ idx ] = cmmem.sacmem[ memptr[ 6 ] ][ idx ] ;
amph[ 1 ][ idx ] = cmmem.sacmem[ memptr[ 7 ] ][ idx ] ;
}
for ( ; idx < 2 * NDATPTS - 2 ; idx++ ) {
amph[ 0 ][ idx ] = cmmem.sacmem[ memptr[ 6 ] ][ 2*NDATPTS-idx-2 ] ;
amph[ 1 ][ idx ] = -cmmem.sacmem[ memptr[ 7 ] ][ 2*NDATPTS-idx-2 ] ;
}
/* Allocate block for headers. */
allamb ( &cmmem, SAC_HEADER_WORDS, &hdrindex , nerr ) ;
if ( *nerr != 0 )
goto L_ERROR ;
/* null the header */
for ( idx = 0 ; idx < SAC_HEADER_FLOATS ; idx++ )
cmhdr.fhdr[ idx ] = SAC_FLOAT_UNDEFINED ;
for ( idx = 0 ; idx < SAC_HEADER_INTEGERS ; idx++ )
cmhdr.nhdr[ idx ] = SAC_INT_UNDEFINED ;
for ( idx = 0 ; idx < SAC_HEADER_ENUMS ; idx++ )
cmhdr.ihdr[ idx ] = SAC_INT_UNDEFINED ;
for ( idx = 0 ; idx < SAC_HEADER_STRINGS ; idx++ )
strcpy ( kmhdr.khdr[ idx ] , SAC_CHAR_UNDEFINED ) ;
/* fill some fields. */
for ( idx = 0 ; idx < 9 ; idx++ ) /* user fields */
*( user0 + idx ) = userData[ idx ] ;
switch ( (int) (*user0 + 0.5) ) {
case 1: strcpy ( kuser0 , "lowpass " ) ;
break ;
case 2: strcpy ( kuser0 , "highpass" ) ;
break ;
case 3: strcpy ( kuser0 , "bandpass" ) ;
break ;
case 4: strcpy ( kuser0 , "bandrej " ) ;
break ;
default: strcpy ( kuser0 , "-12345 " ) ;
break ;
}
switch ( (int) (*user1 + 0.5) ) {
case 1: strcpy ( kuser1 , "Butter " ) ;
break ;
case 2: strcpy ( kuser1 , "Bessel " ) ;
break ;
case 3: strcpy ( kuser1 , "C1 " ) ;
break ;
case 4: strcpy ( kuser1 , "C2 " ) ;
break ;
default: strcpy ( kuser1 , "-12345 " ) ;
break ;
}
fillNZ () ; /* time fields */
*begin = 0.0 ; /* other fields */
*sb = 0.0 ;
*nvhdr = 6 ;
*idep = IUNKN ;
*iztype = IB ;
*leven = TRUE ;
*lpspol = TRUE ;
*lovrok = TRUE ;
*lcalda = FALSE ;
for ( jdx = 0 ; jdx < 3 ; jdx++ ) { /* loop between output files. */
/* fill other header fields specific to the data */
switch ( jdx ) {
case 0: aphdr( newnpts ) ;
nlcmem = memptr[ 6 ] ;
break ;
case 1: gdhdr( newnpts ) ;
nlcmem = memptr[ 8 ] ;
break ;
case 2: irhdr( newnpts ) ;
nlcmem = memptr[ 9 ] ;
break ;
default: goto L_ERROR ;
}
/* Get file name */
sprintf ( kname , "%s%s" , kprefix , ksuffix[ jdx ] ) ;
/* Open file */
znfile( &fileDescriptor , kname , MCPFN , "DATA" , 5 , nerr );
if ( *nerr )
goto L_ERROR ;
/* Get ready to write header to disk */
nlcdsk = 0;
nptwr = SAC_HEADER_WORDS_FILE;
if ( ( bufout = (float *) malloc ( SAC_HEADER_SIZEOF_FILE) ) == NULL ) {
*nerr = 301;
goto L_ERROR ;
}
/* move header into working memory */
/* copy ( (int*) cmhdr.fhdr , (int*) cmmem.sacmem[ hdrindex ] , SAC_HEADER_NUMBERS ); */
copy_float( cmhdr.fhdr, cmmem.sacmem[ hdrindex ], SAC_HEADER_NUMBERS );
zputc ( kmhdr.khdr[ 0 ] , 9 , (int *)(cmmem.sacmem[ hdrindex ] + SAC_HEADER_NUMBERS),
( MCPW + 1 ) * SAC_HEADER_STRINGS) ;
/* move header into output buffer */
map_hdr_out ( cmmem.sacmem[ hdrindex ] , bufout , FALSE) ;
/* write the headers */
zwabs( (int *)&fileDescriptor, (char *)(bufout), nptwr, (int *)&nlcdsk, (int *)nerr );
free(bufout);
bufout = NULL ;
nlcdsk += nptwr;
nptwr = NDATPTS ;
/* Write data to disk */
switch ( jdx ) {
case 0: nptwr = 2 * NDATPTS - 2 ;
zwabs ( (int *)&fileDescriptor, (char *)(amph[ 0 ]) , nptwr, (int *)&nlcdsk, (int *)nerr ) ;
/* nlcmem = memptr[ 7 ] ; */
nlcdsk += nptwr;
zwabs ( (int *)&fileDescriptor, (char *)(amph[ 1 ]) , nptwr, (int *)&nlcdsk, (int *)nerr ) ;
break ;
case 1: zwabs( (int *)&fileDescriptor, (char *)(cmmem.sacmem[nlcmem]), nptwr, (int *)&nlcdsk, (int *)nerr );
break ;
case 2: zwabs( (int *)&fileDescriptor, (char *)(cmmem.sacmem[nlcmem] + xbegin), nptwr, (int *)&nlcdsk, (int *)nerr );
break ;
}
/* Close file */
zclose ( &fileDescriptor , nerr ) ;
fileDescriptor = 0 ;
} /* end for */
L_ERROR:
if ( *nerr ) {
setmsg ( "ERROR" , *nerr ) ;
outmsg () ;
clrmsg () ;
}
if ( cmdfm.ndfl > 0 )
getfil ( 1 , TRUE , &unused1 , &unused2 , &unused3 , nerr ) ;
if ( bufout )
free ( bufout ) ;
if ( fileDescriptor )
zclose ( &fileDescriptor , nerr ) ;
relamb ( cmmem.sacmem , hdrindex , nerr );
}
/*
* handle_lang
*
* take care of the LANGUAGE specification
*/
char *
handle_lang(struct cache_pack *cp, struct msg_pack *mp)
{
Gettext_t *gt = global_gt;
struct stat64 statbuf;
const char *p, *op, *q;
char *locale = NULL, *olocale, *result;
unsigned int hash_locale;
size_t locale_len, olocale_len = 0;
int gnu_mo_found = 0;
int fd;
int ret;
#ifdef GETTEXT_DEBUG
(void) printf("*************** handle_lang(0x%p, 0x%p)\n",
(void *)cp, (void *)mp);
printcp(cp, 0);
printmp(mp, 0);
#endif
p = mp->language;
while (*p) {
op = p;
q = strchr(p, ':');
if (!q) {
locale_len = strlen(p);
p += locale_len;
} else {
locale_len = q - p;
p += locale_len + 1;
}
if ((locale_len >= MAXPATHLEN) ||
(locale_len == 0)) {
/* illegal locale name */
continue;
}
if (olocale_len < locale_len) {
olocale = locale;
locale = (char *)realloc(locale, locale_len + 1);
if (!locale) {
if (olocale)
free(olocale);
DFLTMSG(result, mp->msgid1, mp->msgid2,
mp->n, mp->plural);
return (result);
}
olocale_len = locale_len;
}
(void) memcpy(locale, op, locale_len);
locale[locale_len] = '\0';
hash_locale = get_hashid(locale, NULL);
mp->locale = locale;
mp->hash_locale = hash_locale;
mp->locale_len = locale_len;
#ifdef GETTEXT_DEBUG
*mp->msgfile = '\0';
#endif
if (mk_msgfile(mp) == NULL) {
/* illegal locale name */
continue;
}
cp->node_hash = NULL;
ret = check_cache(cp, mp);
if (ret) {
/*
* found in cache
*/
switch (cp->mnp->type) {
case T_ILL_MO:
/* invalid MO */
continue;
case T_SUN_MO:
/* Solaris MO */
goto out_loop;
case T_GNU_MO:
/* GNU MO */
gnu_mo_found = 1;
result = handle_gnu_mo(cp, mp, gt);
if (result) {
free(locale);
return (result);
}
continue;
}
/* NOTREACHED */
}
/*
* not found in cache
*/
fd = nls_safe_open(mp->msgfile, &statbuf, &mp->trusted, 1);
if ((fd == -1) || (statbuf.st_size > LONG_MAX)) {
if (connect_invalid_entry(cp, mp) == -1) {
DFLTMSG(result, mp->msgid1, mp->msgid2,
mp->n, mp->plural);
free(locale);
return (result);
}
continue;
}
mp->fsz = (size_t)statbuf.st_size;
mp->addr = mmap(0, mp->fsz, PROT_READ, MAP_SHARED, fd, 0);
(void) close(fd);
if (mp->addr == (caddr_t)-1) {
if (connect_invalid_entry(cp, mp) == -1) {
DFLTMSG(result, mp->msgid1, mp->msgid2,
mp->n, mp->plural);
free(locale);
return (result);
}
continue;
}
cp->mnp = create_mnp(mp);
if (!cp->mnp) {
free(locale);
free_mnp_mp(cp->mnp, mp);
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n,
mp->plural);
return (result);
}
if (setmsg(cp->mnp, (char *)mp->addr, mp->fsz) == -1) {
free(locale);
free_mnp_mp(cp->mnp, mp);
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n,
mp->plural);
return (result);
}
if (!cp->cacheline) {
cp->cnp = create_cnp(cp->mnp, mp);
if (!cp->cnp) {
free(locale);
free_mnp_mp(cp->mnp, mp);
DFLTMSG(result, mp->msgid1, mp->msgid2,
mp->n, mp->plural);
return (result);
}
}
cp->mnp->trusted = mp->trusted;
connect_entry(cp);
switch (cp->mnp->type) {
case T_ILL_MO:
/* invalid MO */
continue;
case T_SUN_MO:
/* Solaris MO */
goto out_loop;
case T_GNU_MO:
/* GNU MO */
gnu_mo_found = 1;
result = handle_gnu_mo(cp, mp, gt);
if (result) {
free(locale);
return (result);
}
continue;
}
/* NOTREACHED */
}
out_loop:
if (gnu_mo_found) {
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n, mp->plural);
free(locale);
return (result);
}
if (locale)
free(locale);
return (NULL);
}
/**
* Read pick preference file.
*
* @param lauth
* - TRUE Read Author Lit
* - FALSE Do not read Author List
* @param lphase
* - TRUE Read Header Info
* - FALSE Do not read Header Info
*
* 970409: Original version. maf
*
*/
void
getprefs (int lauth,
int lphase) {
char prefsLine [ 120 ] ;
int nAuthors = 0; /* number of authors. */
int idx ;
FILE *pFile ;
/* Open the file to count the number of authors in list. */
pFile = fopen ( kmdfm.kprefsFileName , "r" ) ;
if ( pFile == NULL ) {
setmsg ( "WARNING" , ERROR_FILE_DOES_NOT_EXIST ) ;
apcmsg ( kmdfm.kprefsFileName , strlen ( kmdfm.kprefsFileName ) ) ;
apcmsg ( ". readcss will not read picks." , 32 ) ;
outmsg () ;
clrmsg () ;
return ;
}
while ( fgetsp ( prefsLine , 120 , pFile ) && !isspace ( prefsLine[ 0 ] ) )
nAuthors++ ;
if(nAuthors == 0) {
fprintf(stderr, "Pick Preferences File %s is empty\n", kmdfm.kprefsFileName);
fclose(pFile);
return;
}
/* Reading Authors */
if ( lauth ) {
fclose ( pFile );
/* free up space from previous authors ( if any ) */
if ( kmdfm.kauthors != NULL ) {
for ( idx = 0 ; idx < cmdfm.iauthors ; idx++ )
free( kmdfm.kauthors[idx] ) ;
free ( kmdfm.kauthors ) ;
cmdfm.iauthors = 0 ;
}
/* allocate space for author names. */
kmdfm.kauthors = (char **) calloc ( nAuthors , sizeof( char * ) ) ;
if ( kmdfm.kauthors == NULL ) {
setmsg ( "ERROR" , ERROR_OUT_OF_MEMORY ) ;
apcmsg ( " readcss will not read picks." , 31 ) ;
outmsg () ;
clrmsg () ;
return ;
}
for ( idx = 0 ; idx < nAuthors ; idx++ ) {
kmdfm.kauthors[ idx ] = ( char * ) calloc ( 16 , sizeof ( char ) ) ;
if ( kmdfm.kauthors[ idx ] == NULL ) {
setmsg ( "ERROR" , ERROR_OUT_OF_MEMORY ) ;
apcmsg ( " readcss will not read picks." , 31 ) ;
outmsg () ;
clrmsg () ;
nAuthors = idx ;
goto L_8888 ;
}
}
/* Open the file to read it. */
pFile = fopen ( kmdfm.kprefsFileName , "r" ) ;
/* Read author names */
for ( idx = 0 ; idx < nAuthors ; idx++ )
{
char * firstWhiteSpace = NULL ;
fgetsp ( prefsLine , 120 , pFile ) ;
firstWhiteSpace = strpbrk ( prefsLine , " \n\t\v\f" ) ;
if ( firstWhiteSpace == NULL )
prefsLine[15] = '\0' ;
else
* firstWhiteSpace = '\0' ;
/* convert to lowercase for case insensitive comparisons. */
modcase ( FALSE , prefsLine , strlen( prefsLine ) , prefsLine ) ;
strcpy ( kmdfm.kauthors[idx] , prefsLine ) ;
}
/* Read blank line delimiter */
fgetsp ( prefsLine , 120 , pFile ) ;
}
/* if reading header information */
if ( lphase ) {
/* Read default phases and authors for individual pick header vars. */
for ( idx = 0 ; idx < 10 ; idx++ )
{
int check ;
check = fscanf ( pFile , "t%*d\t%s\t%s\n" , kmdfm.ktPh[idx] ,
kmdfm.ktAu[idx] ) ;
if ( check != 2 || strlen ( kmdfm.ktPh[idx] ) > 8 ||
strlen ( kmdfm.ktAu[idx] ) > 15 ) {
setmsg ( "WARNING" , ERROR_BADLY_FORMATTED_CSSPICKSPREFS ) ;
apcmsg ( " readcss will not read picks." , 31 ) ;
outmsg () ;
clrmsg () ;
return ;
}
/* convert to lower case for case insensitive comparisons. */
modcase ( FALSE , kmdfm.ktAu[idx] , strlen( kmdfm.ktAu[idx] ) ,
kmdfm.ktAu[idx] ) ;
}
}
if ( lauth )
cmdfm.iauthors = nAuthors ;
return ;
L_8888:
/* on error free up allocated memory */
for ( idx = 0 ; idx < nAuthors ; idx ++ )
free ( kmdfm.kauthors[idx] ) ;
free ( kmdfm.kauthors ) ;
return ;
}
/*
* handle_mo() returns NULL if invalid MO found.
*/
char *
handle_mo(struct msg_pack *mp)
{
int fd;
char *result;
struct stat64 statbuf;
Msg_node *mnp;
Gettext_t *gt = global_gt;
#define CONNECT_ENTRY \
mnp->next = gt->m_node; \
gt->m_node = mnp; \
gt->c_m_node = mnp
#ifdef GETTEXT_DEBUG
gprintf(0, "*************** handle_mo(0x%p)\n", (void *)mp);
printmp(mp, 1);
#endif
mnp = check_cache(mp);
if (mnp != NULL) {
/* cache found */
return (handle_type_mo(mnp, mp));
}
/*
* Valid entry not found in the cache
*/
mnp = calloc(1, sizeof (Msg_node));
if (mnp == NULL) {
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n, mp->plural);
return (result);
}
mnp->hashid = mp->hash_domain;
mnp->path = strdup(mp->msgfile);
if (mnp->path == NULL) {
free(mnp);
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n, mp->plural);
return (result);
}
fd = nls_safe_open(mp->msgfile, &statbuf, &mp->trusted, !mp->nlsp);
if ((fd == -1) || (statbuf.st_size > LONG_MAX)) {
if (fd != -1)
(void) close(fd);
mnp->type = T_ILL_MO;
CONNECT_ENTRY;
return (NULL);
}
mp->fsz = (size_t)statbuf.st_size;
mp->addr = mmap(NULL, mp->fsz, PROT_READ, MAP_SHARED, fd, 0);
(void) close(fd);
if (mp->addr == MAP_FAILED) {
free(mnp->path);
free(mnp);
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n, mp->plural);
return (result);
}
if (setmsg(mnp, (char *)mp->addr, mp->fsz) == -1) {
free(mnp->path);
free(mnp);
(void) munmap(mp->addr, mp->fsz);
DFLTMSG(result, mp->msgid1, mp->msgid2, mp->n, mp->plural);
return (result);
}
mnp->trusted = mp->trusted;
CONNECT_ENTRY;
return (handle_type_mo(mnp, mp));
}
void
xcutim ( int *nerr )
{
/* declare variables */
char kcutSave[ 2 ][ 9 ] ,
defaultWorksetName[] = "workset01" ,
*worksetName = NULL ;
int i;
char *tmp;
double dtmp[2];
int idx , jdx , jdfl ,
nBounds ,
nOriginalFiles = cmdfm.ndfl ,
nSacFiles = 0 ,
refTimeType = IB ;
const int charsInBase = 9 ;
int lname = FALSE , lnotused , lcutSave ;
const int lcuttrue = TRUE ;
int nlen , ndx1 , ndx2 ;
float ocutSave[ 2 ] ;
double refTime ; /* subract this from the picks. */
DBlist tree ;
struct cutPair {
char kbase[ 2 ][ 9 ] ;
float offset[ 2 ] ;
} bounds[ MAXPAIRS ] ;
/* save current global values */
lcutSave = cmdfm.lcut ;
ocutSave[ 0 ] = cmdfm.ocut[ 0 ] ;
ocutSave[ 1 ] = cmdfm.ocut[ 1 ] ;
strcpy ( kcutSave[ 0 ] , kmdfm.kcut[ 0 ] ) ;
strcpy ( kcutSave[ 1 ] , kmdfm.kcut[ 1 ] ) ;
/* PARSING PHASE */
/* -- "COMMIT|RECALLTRACE|ROLLBACK":
how to treat existing data */
if ( lckeyExact ( "COMMIT" , 7 ) )
cmdfm.icomORroll = COMMIT ;
else if (lckeyExact ( "RECALLTRACE" , 12 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "RECALL" , 7 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "ROLLBACK" , 9 ) )
cmdfm.icomORroll = ROLLBACK ;
/* Get the limits of the cut. */
for ( nBounds = 0 ; nBounds < MAXPAIRS ; nBounds++ ) {
if ( !lcrtw ( &lnotused, (bounds[ nBounds ].kbase[0]), charsInBase, dtmp) ) {
break ;
} else {
bounds[ nBounds ].offset[0] = (float) dtmp[0];
bounds[ nBounds ].offset[1] = (float) dtmp[1];
}
if ( !strcmp ( bounds[ nBounds ].kbase [ 0 ] , "A " ) &&
!strcmp ( bounds[ nBounds ].kbase [ 1 ] , "F " ) ) {
break ;
}
} /* end for */
/* CHECKING PHASE */
/* - Check for null data file list. */
vflist( nerr );
if( *nerr != 0 )
return ;
/* - Check to make sure all files are evenly spaced time series files. */
vfeven( nerr );
if( *nerr != 0 )
return ;
/* Check that the resulting number of files won't exceed max */
if ( cmdfm.ndfl * nBounds > MDFL ) {
*nerr = 1403 ;
return ;
}
/* Check that cut point information is of the proper form. */
for ( idx = 0 ; idx < nBounds ; idx++ ) {
for ( jdx = 0 ; jdx < 2 ; jdx++ ) {
char *test = &( bounds[ idx ].kbase[ jdx ][ 0 ] ) ;
if ( *test != 'A' && /* first arrival */
*test != 'B' && /* begin time of trace */
*test != 'E' && /* end time of trace */
*test != 'F' && /* end of event */
*test != 'O' && /* origin */
*test != 'T' && /* zero seconds */
*test != 'Z' ) {
*nerr = 1405 ;
return ;
}
if ( *test == 'T' ) {
if ( !isdigit ( *(test+1) ) ) {
*nerr = 1405 ;
return ;
}
if ( strcmp ( test + 2 , " " ) ) {
*nerr = 1405 ;
return ;
}
} /* end if ( *test == 'T' ) */
else {
if ( strcmp ( test + 1 , " " ) ) {
*nerr = 1405 ;
return ;
}
}
}
} /* end for ( idx ) */
/* EXECUTION PHASE */
/* - Commit or rollback data according to lmore and cmdfm.icomORroll */
alignFiles ( nerr ) ;
if ( *nerr )
return ;
/* Get necessary SeisMgr information */
tree = smGetDefaultTree () ;
/* Remove all waveforms from Sacmem */
deleteAllSacFiles ( nerr , FALSE ) ; /* don't delete file names */
if ( *nerr )
return ;
/* set logical cut to TRUE */
cmdfm.lcut = TRUE ;
/* Loop between pairs of cut points */
for ( idx = 0 ; idx < nBounds ; idx++ ) {
struct wfdiscList *wfL = NULL ;
/* reset cut parameters. */
strcpy ( kmdfm.kcut[ 0 ] , bounds[ idx ].kbase[ 0 ] ) ;
strcpy ( kmdfm.kcut[ 1 ] , bounds[ idx ].kbase[ 1 ] ) ;
cmdfm.ocut[ 0 ] = bounds[ idx ].offset[ 0 ] ;
cmdfm.ocut[ 1 ] = bounds[ idx ].offset[ 1 ] ;
/* Loop between waveforms in SeisMgr */
do {
/* Get next waveform. */
if ( ! ( wfL = dblNextTableInstance ( wfL , tree , dbl_LIST_WFDISC ) ) )
break ;
/* Get the header to go with the waveform */
sacHeaderFromCSS( tree, &( globalSacHeader[ nSacFiles ] ),
wfL, refTimeType, &refTime, cmdfm.nMagSpec) ;
/* Get picks according to the preferences file and
pickauth and pickphase commands. */
nSacFiles++;
prefPicksToHeader( &( globalSacHeader[ nSacFiles ] ), nSacFiles,
wfL->element, tree, refTime, nerr ) ;
if ( *nerr ) {
setmsg ( "WARNING" , 1401 ) ;
outmsg () ;
clrmsg () ;
*nerr = 0 ;
}
if ( !lname && nSacFiles > nOriginalFiles )
lname = TRUE ;
/* Create a SAC file, fill the header and waveform. */
CSStoSAC( nSacFiles, &( globalSacHeader[ nSacFiles-1 ] ),
wfL->seis, lname , lcuttrue , nerr ) ;
if ( *nerr ) {
setmsg ( "WARNING" , 1402 ) ;
outmsg () ;
clrmsg () ;
*nerr = 0 ;
}
} while ( wfL ) ; /* End loop between waveforms in SeisMgr */
} /* End loop between pairs of cut points. */
/* Make nBounds copies of sac filenames */
for ( idx = 1 ; idx < nBounds ; idx++ ) {
for(i = 0; i < nOriginalFiles; i++) {
tmp = string_list_get(datafiles, i);
string_list_put(datafiles, tmp, strlen(tmp));
}
}
/* Set global number of files */
cmdfm.ndfl = nSacFiles ;
/* Remove all waveforms from SeisMgr */
/*smDeleteDefaultTree() ;*/
worksetName = smGetDefaultWorksetName () ;
if ( worksetName )
smDeleteWorksetByName ( worksetName ) ;
else
worksetName = defaultWorksetName ;
/* Read each waveform from Sacmem back to SeisMgr */
for ( jdfl = 1 ; jdfl <= nSacFiles ; jdfl++ ) {
sacSACdata newData ;
getfil ( jdfl , FALSE , &nlen , &ndx1 , &ndx2 , nerr ) ;
if ( *nerr ) {
*nerr = 1406 ;
goto L_ERROR ;
}
newData.dataType = globalSacHeader[ jdfl - 1 ].iftype ;
newData.xarray = cmmem.sacmem[ cmdfm.ndxdta[ jdfl - 1 ][ 1 ] ] ;
newData.yarray = cmmem.sacmem[ cmdfm.ndxdta[ jdfl - 1 ][ 0 ] ] ;
globalSacHeader[ jdfl-1 ].b = *begin ;
globalSacHeader[ jdfl-1 ].e = *ennd ;
globalSacHeader[ jdfl-1 ].npts = *npts ;
sacLoadFromHeaderAndData( &( globalSacHeader[ jdfl-1 ] ) , &newData ,
worksetName , FALSE , jdfl-1 , TRUE , TRUE ) ;
} /* end for ( jdfl ) */
/* clean up garbage in SeisMgr */
tree = smGetDefaultTree () ;
gcCollect ( tree ) ;
/* Make sure to reset global cut values whether the command worked or not. */
L_ERROR:
cmdfm.lcut = lcutSave ;
cmdfm.ocut[ 0 ] = ocutSave[ 0 ] ;
cmdfm.ocut[ 1 ] = ocutSave[ 1 ] ;
strcpy ( kmdfm.kcut[ 0 ] , kcutSave[ 0 ] ) ;
strcpy ( kmdfm.kcut[ 1 ] , kcutSave[ 1 ] ) ;
} /* end xcutim() */
/**
* Write a File to disk
*
* @param lsdd
* Set the Output to be a SDD file
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 970702: Changed lckey and lkchar to lckeyExact and lkcharExact
* throughout xw.c. This will allow files to begin with
* the same string as the various options (eg. sacxz.021.z)
* maf.
* @date 910731: Bug fixed in options PREPEND, DELETE, CHANGE.
* @date 900904: Added SDD as a format for write.
* @date 881228: Added four new options for generating write file list
* from data file list: APPEND, PREPEND, CHANGE, DELETE.
* @date 880204: Fixed logic involving use of DIR option in READ and WRITE
* by adding an ON/OFF flag as well as a directory name.
* @date 880115: Deleted call that forced default directory to lowercase.
* @date 870626: Added default directory option.
* @date 860917: Changed to character lists for storing data file names.
* @date 850730: Deleted SOCKITTOME format.
* @date 830120: Added SOCK and CI output formats.
* @date 820721: Changed to newest set of parsing and checking functions.
* @date 810120: Changed to output message retrieval from disk.
* @date 810203: Fixed bug in file overwrite option.
*
*/
void
xw(int lsdd,
int *nerr) {
int i;
char delimiter[2], kcdir[9], kchange[MCPFN+1], kdirpart[MCPFN+1];
char kfile[MCPFN+1], kpdir[9], kstring[MCPFN+1], ktemp[9];
int lexpnd;
int jdfl, nchange, nchar, nchg, ndx1, ndx2;
int nlen, nstr, nstring, nwrdir;
static int lwrdir = FALSE;
char *cattemp;
char *strtemp1, *strtemp2, *strtemp3;
char *file;
string_list *list, *files;
kschan[12]='\0';
kschdr[80]='\0';
ksclas[4]='\0';
kscom[40]='\0';
ksevnm[8]='\0';
ksfrmt[8]='\0';
ksstnm[8]='\0';
memset(kfile, 0, sizeof(kfile));
memset(kdirpart, 0, sizeof(kdirpart));
memset(kchange, 0, sizeof(kchange));
memset(ktemp, 0, sizeof(ktemp));
memset(kstring, 0, sizeof(kstring));
memset(kpdir, 0, sizeof(kpdir));
memset(kcdir, 0, sizeof(kcdir));
memset(delimiter, 0, sizeof(delimiter));
lexpnd = FALSE;
*nerr = 0;
files = string_list_init();
list = NULL;
if( lsdd )
cmdfm.iwfmt = 3;
/* PARSING PHASE: */
/* - Loop on each token in command: */
while ( lcmore( nerr ) ){
/* -- "SAC|ALPHA": set format to be used in writing files. */
if( lckeyExact( "SAC#$",6 ) )
cmdfm.iwfmt = 1;
else if( lckeyExact( "ALPHA#$",8 ) )
cmdfm.iwfmt = 2;
else if( lckeyExact( "CI#$",5 ) )
cmdfm.iwfmt = 2;
else if( lckeyExact( "SDD#$",6 ) )
cmdfm.iwfmt = 3;
else if( lckeyExact( "XDR#$",6 ) ) {
cmdfm.iwfmt = 4;
}
else if( lckeyExact( "SEGY#$", 7 ) )
cmdfm.iwfmt = 5;
/* -- "OVER": overwrite files from previous READ command. */
else if( lckeyExact( "OVER#$",7 ) ){
cmdfm.lovrrq = TRUE;
lexpnd = FALSE;
string_list_extend(files, datafiles);
}
/* generate names from the KSTCMP header field */
else if( lckeyExact( "KSTCMP#$",9 ) ){
lexpnd = FALSE;
gennames("KSTCMP ",7,files,string_list_length(datafiles),nerr);
if(*nerr != 0)
goto L_8888;
}
/* -- "APPEND string": append string to filenames from READ command. */
else if( lkcharExact( "APPEND#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
for(i = 0; i < cmdfm.ndfl; i++) {
strtemp1 = string_list_get(datafiles, i);
appendstring( kstring,MCPFN+1, strtemp1, strlen(strtemp1)+2, kfile,MCPFN+1 );
string_list_put(files, kfile, MCPFN+1);
if( *nerr != 0 )
goto L_8888;
}
cmdfm.lovrrq = FALSE;
lexpnd = TRUE;
}
/* -- "PREPEND string": prepend string to filenames from READ command. */
else if( lkcharExact( "PREPEND#$",10, MCPFN, kstring,MCPFN+1, &nstring ) ){
for(i = 0; i < cmdfm.ndfl; i++) {
strtemp1 = malloc(nstring+1);
strncpy(strtemp1,kstring,nstring);
strtemp1[nstring] = '\0';
strtemp2 = string_list_get(datafiles, i);
prependstring( strtemp1, nstring+1, strtemp2, strlen(strtemp2)+2, kfile,MCPFN+1);
free(strtemp1);
string_list_put(files, kfile, MCPFN+1);
if( *nerr != 0 )
goto L_8888;
}
cmdfm.lovrrq = FALSE;
lexpnd = TRUE;
}
/* -- "DELETE string": delete string from filenames from READ command. */
else if( lkcharExact( "DELETE#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
for(i = 0; i < cmdfm.ndfl; i++) {
strtemp1 = malloc(nstring+1);
strncpy(strtemp1,kstring,nstring);
strtemp1[nstring] = '\0';
strtemp2 = string_list_get(datafiles, i);
deletestring( strtemp1, nstring+1, strtemp2, strlen(strtemp2)+2, kfile,MCPFN+1);
free(strtemp1);
string_list_put(files, kfile, MCPFN+1);
if( *nerr != 0 )
goto L_8888;
}
cmdfm.lovrrq = FALSE;
lexpnd = TRUE;
}
/* -- "CHANGE string1 string2": change string1 to string2 in READ filenames. */
else if( lkcharExact( "CHANGE#$",9, MCPFN, kstring,MCPFN+1, &nstring ) ){
lcchar( MCPFN, kchange,MCPFN+1, &nchange );
for(i = 0; i < cmdfm.ndfl; i++) {
nstr = indexb( kstring,MCPFN+1 );
nchg = indexb( kchange,MCPFN+1 );
strtemp1 = malloc(nstr+1);
strtemp2 = malloc(nchg+1);
strncpy(strtemp1,kstring,nstr);
strncpy(strtemp2,kchange,nchg);
strtemp1[nstr] = '\0';
strtemp2[nchg] = '\0';
strtemp3 = string_list_get(datafiles, i);
changestring( strtemp1, nstr+1, strtemp2, nchg+1,
strtemp3, strlen(strtemp3)+2, kfile,MCPFN+1 );
free(strtemp1);
free(strtemp2);
string_list_put(files, kfile, MCPFN+1);
if( *nerr != 0 )
goto L_8888;
}
cmdfm.lovrrq = FALSE;
lexpnd = TRUE;
}
/* -- "DIR ON|OFF|CURRENT|name": set the name of the default subdirectory. */
else if( lkcharExact( "DIR#$",6, MCPFN, kmdfm.kwrdir,MCPFN+1, &nchar ) ){
modcase( TRUE, kmdfm.kwrdir, MCPW, ktemp );
if( strncmp(ktemp,"OFF ",8) == 0 ) {
lwrdir = FALSE;
} else if( strncmp(ktemp,"CURRENT ",8) == 0 ){
lwrdir = TRUE;
fstrncpy( kmdfm.kwrdir, MCPFN, " ", 1);
} else if( kmdfm.kwrdir[nchar - 1] != KDIRDL ){
/* If the string is mising the "/" path separator */
lwrdir = TRUE;
delimiter[0] = KDIRDL;
delimiter[1] = '\0';
subscpy( kmdfm.kwrdir, nchar, -1, MCPFN, delimiter );
} else {
/* Path is not OFF, CURRENT and has the "/" at the end */
lwrdir = TRUE;
}
}
/* -- "COMMIT|RECALLTRACE|ROLLBACK":
how to treat existing data */
else if ( lckeyExact ( "COMMIT" , 7 ) )
cmdfm.icomORroll = COMMIT ;
else if (lckeyExact ( "RECALLTRACE" , 12 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "RECALL" , 7 ) )
cmdfm.icomORroll = RECALL ;
else if ( lckeyExact ( "ROLLBACK" , 9 ) )
cmdfm.icomORroll = ROLLBACK ;
/* -- "filelist": write files using names in new filelist. */
else if( ( list = lcdfl() ) ){
cmdfm.lovrrq = FALSE;
lexpnd = FALSE;
}
/* -- Bad syntax. */
else{
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
} /* end while ( lcmore( nerr ) ) */
/* - The above loop is over when one of two conditions has been met:
* (1) An error in parsing has occurred. In this case NERR is > 0 .
* (2) All the tokens in the command have been successfully parsed. */
if( *nerr != 0 )
goto L_8888;
/* CHECKING PHASE: */
if(!list) {
list = files;
} else {
/* List + Modifiers :: Use List */
string_list_free(files);
files = NULL;
}
/* - Check for null write filelist. */
if( string_list_length(list) <= 0 ){
*nerr = 1311;
setmsg( "ERROR", *nerr );
goto L_8888;
}
/* - Make sure the write filelist has as many entries as read filelist. */
if( string_list_length(list) != cmdfm.ndfl ){
*nerr = 1312;
error(1312, "%d %d", string_list_length(list), cmdfm.ndfl);
goto L_8888;
}
/* EXECUTION PHASE: */
/* - Commit or rollback data according to cmdfm.icomORroll */
alignFiles ( nerr ) ;
if ( *nerr )
return ;
/* - Echo expanded filelist if requested. */
if( cmdfm.lechof && lexpnd ){
setmsg( "OUTPUT", 0 );
for(i = 0; i < string_list_length(list); i++) {
file = string_list_get(list, i);
getdir( file, strlen(file)+1, kcdir,9, kfile,MCPFN+1 );
/* -- Echo the filename part if there is no directory part. */
if( strcmp(kcdir," ") == 0 )
apcmsg( kfile,MCPFN+1 );
/* -- Prepend the filename part with some special characters if
* directory part is same as that of the previous file. */
else if( memcmp(kcdir,kpdir,min(strlen(kcdir),strlen(kpdir)))
== 0 ){
cattemp = malloc(3+strlen(kfile)+1);
strcpy(cattemp, "...");
strcat(cattemp,kfile);
apcmsg( cattemp, 3+strlen(kfile)+1 );
free(cattemp);
}
/* -- Echo complete pathname if directory part is different. */
else{
apcmsg2(file, strlen(file)+1);
strcpy( kpdir, kcdir );
}
}
wrtmsg( MUNOUT );
}
/* - Write each file in memory to disk. */
nwrdir = indexb( kmdfm.kwrdir,MCPFN+1 );
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
/* -- Get file from memory manager. */
file = string_list_get(list, jdfl-1);
getfil( jdfl, TRUE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
/* isolate file name */
file = string_list_get(list, jdfl-1);
/* -- Check overwrite-protect flag in header record. */
if( cmdfm.lovrrq && !*lovrok ){
*nerr = 1303;
setmsg( "ERROR", *nerr );
apcmsg2(file, strlen(file)+1);
outmsg () ;
clrmsg () ;
goto L_8888;
}
/* -- Prepare output file name:
* --- If directory option is ON (lwrdir=.TRUE. and nwrdir>0),
* concatenate directory name with file name part of write file list.
* --- If directory option is CURRENT (lwrdir=.TRUE. and nwrdir=0),
* use file name part of write file list.
* --- If directory option is OFF, use write file list. */
if( lwrdir ){
if( nwrdir > 0 ){
fstrncpy( kfile, MCPFN, kmdfm.kwrdir,min(nwrdir,MCPFN));
strtemp1 = file;
strtemp2 = malloc(130-(nwrdir+1));
strncpy(strtemp2,kfile+nwrdir,MCPFN+1-(nwrdir + 1));
strtemp2[MCPFN+1-(nwrdir+1)] = '\0';
getdir( strtemp1, strlen(strtemp1)+1,
kdirpart, MCPFN+1, strtemp2,-(nwrdir+1)+130);
subscpy(kfile,nwrdir,-1,MCPFN,strtemp2);
free(strtemp2);
}
else{
fstrncpy( kfile, MCPFN, " ", 1);
getdir( file, strlen(file)+1, kdirpart,MCPFN+1, kfile,MCPFN+1 );
}
}
else {
fstrncpy( kfile, MCPFN, file, strlen(file));
}
/* -- Write file in appropriate format. */
if( cmdfm.iwfmt == 2 )
wrci( jdfl, kfile,MCPFN+1, "%#15.7g", nerr );
else if( cmdfm.iwfmt == 3 )
wrsdd( jdfl, kfile,MCPFN+1, TRUE, nerr );
else if( cmdfm.iwfmt == 4 )
wrxdr( jdfl, kfile,MCPFN+1, TRUE, nerr );
else if( cmdfm.iwfmt == 5 )
wrsegy( jdfl , kfile , nerr ) ;
else
wrsac( jdfl, kfile,MCPFN+1, TRUE, nerr );
if( *nerr != 0 )
goto L_8888;
} /* end for ( jdfl ) */
L_8888:
return;
}
/**
* Sort a floating point array
*
* @param value
* Array to be sorted on input
* Sorted array on output
* @param num
* Length of \p value
* @param index
* Sorted indicies
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 800903: Original version.
* @date 810120: Changed to output message retrieval from disk.
* @date 810416: Replaced CMWORK with local storage.
*
*/
void
srtndx(float *value,
int num,
int *index,
int *nerr) {
int lagain;
int i, j, nax;
float svalue[MAX_], v;
int *const Index = &index[0] - 1;
float *const Svalue = &svalue[0] - 1;
float *const Value = &value[0] - 1;
/* PROCEDURE: */
*nerr = 0;
/* RANGE CHECK ON NUM */
if( num <= 0 || num > MAX_ ){
nax = MAX_;
*nerr = 910;
setmsg( "ERROR", *nerr );
apimsg( nax );
goto L_8888;
}
/* SET UP INDEX AND SCRATCH ARRAYS */
for( j = 1; j <= num; j++ ){
Svalue[j] = Value[j];
Index[j] = j;
}
/* SORT BOTH SCRATCH AND INDEX ARRAYS BASED ON SCRATCH ARRAY */
L_2000:
lagain = FALSE;
for( j = 1; j <= (num - 1); j++ ){
if ((Svalue[j] - Svalue[j + 1]) <= 0.0 )
goto L_4000;
v = Svalue[j];
Svalue[j] = Svalue[j + 1];
Svalue[j + 1] = v;
i = Index[j];
Index[j] = Index[j + 1];
Index[j + 1] = i;
lagain = TRUE;
L_4000:
;
}
if( lagain )
goto L_2000;
L_8888:
return;
}
