void
winclose(Win *w)
{
if(w->f == nil){
cmdprint("?\n");
return;
}
if(!decref(w->f)){
if(w->f->change > 0){
cmdprint("?\n");
incref(w->f);
w->f->change = -1;
return;
}
putfil(w->f);
w->f = nil;
}
freeimage(w->im);
if(w->f != nil){
w->wnext->wprev = w->wprev;
w->wprev->wnext = w->wnext;
}
w->next->prev = w->prev;
w->prev->next = w->next;
if(w == actw)
actw = nil;
if(w == actf)
actf = nil;
free(w);
}
/**
* Read data components from a SDD disk file to memory
*
* @param idfl
* Data file list index number
* @param nun
* Fortran file unit on which data file is open
* @param nerr
* Error Return Flag
* - 0 on Success
*
* @date 870515: Fixed bug involving zero fill option.
* @date 850415: Changes due to restructuring of DFM common block.
* @date 811202: Added calculation of BEGIN and ENND for uneven data.
* @date 811120: Added calculation of ENND.
* @date 810423: Deleted option to convert format of spectral files
* as they are read into memory.
* @date 810416: Replaced CMWORK with local storage.
* @date 810120: Changed to output message retrieval from disk.
*
*/
void
rdsdta(int idfl,
int *nun,
int *nerr) {
int i, jcomp, jcomp_, nlcdsk, nlcmem, numrd, offset;
float unused;
float *Sacmem;
int *Isacmem;
kschan[12] = '\0';
kschdr[80] = '\0';
ksclas[4] = '\0';
kscom[40] = '\0';
ksevnm[8] = '\0';
ksfrmt[8] = '\0';
ksstnm[8] = '\0';
*nerr = 0;
offset = 0;
/* - Define number of points to read and initial disk location. */
numrd = Nstop[idfl] - Nstart[idfl] + 1 - Nfillb[idfl] - Nfille[idfl];
nlcdsk = MWSHDR;
/* - For each data component: */
for( jcomp = 1; jcomp <= Ncomp[idfl]; jcomp++ ){
jcomp_ = jcomp - 1;
/* -- Define initial memory location. */
nlcmem = cmdfm.ndxdta[idfl - 1][jcomp_];
/* -- Fill beginning with zeros if requested.
* Update memory location. */
if( Nfillb[idfl] > 0 ){
fill( cmmem.sacmem[nlcmem], Nfillb[idfl], 0. );
offset += Nfillb[idfl];
}
/* -- Update disk location and read data. */
if( numrd > 0 ){
nlcdsk = nlcdsk + Nstart[idfl] - 1 + Nfillb[idfl];
Sacmem = cmmem.sacmem[nlcmem]+offset;
Isacmem = (int *)(cmmem.sacmem[nlcmem]+offset);
zrabs( (int *)nun, (char *)Isacmem, numrd,
(int *)&nlcdsk, (int *)nerr );
for( i = 0; i <= ( numrd - 1); i++ ){
*(Sacmem++) = *(Isacmem++)/100.0;
}
if( *nerr != 0 )
goto L_8888;
offset += numrd;
}
/* -- Fill end with zeros if requested. */
if( Nfille[idfl] > 0 ){
fill( cmmem.sacmem[nlcmem]+offset, Nfille[idfl], 0. );
offset += Nfille[idfl];
}
/* -- Update disk location to point to
* start of next component. */
nlcdsk = nlcdsk + Ntotal[idfl] - Nstart[idfl] + 1;
}
/* - Compute some header values. */
*npts = Nlndta[idfl];
extrma( cmmem.sacmem[cmdfm.ndxdta[idfl - 1][0]], 1, *npts, depmin,
depmax, depmen );
if( *leven ){
*ennd = *begin + (float)( *npts - 1 )**delta;
}
else{
extrma( cmmem.sacmem[cmdfm.ndxdta[idfl - 1][1]], 1,
*npts, begin, ennd, &unused );
}
/* - Move header back to working memory. */
putfil( idfl, nerr );
L_8888:
return;
}
/**
* 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;
}
/**
* Execute the action command "DIVF". This command divides a set of
* files into data in memory.
*
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_OPERATION_ON_SPECTRAL_FILE
* - ERROR_OPERATION_ON_UNEVEN_FILE
* - ERROR_HEADER_FILE_MISMATCH
*
* @date 881130: Fixed bug in begin time error checking.
* @date 850730: Changes due to new memory manager.
* @date 820809: Changed to newest set of parsing and checking functions.
* @date 820331: Combined "parse" and "control" modules.
* @date 810224: Original version.
*
*/
void
xdivf(int *nerr) {
int jdx, jbfl, jdfl, n1zdtm[6];
int ndx1, ndx1b, ndx2, ndx2b, nlen, nlenb, npts1;
int lnewhdr ; /* let header data come from new file */
float begin1, delta1, delta2, divsor;
float *Sacmem1, *Sacmem2;
string_list *list;
*nerr = 0;
list = NULL;
while ( lcmore( nerr ) ){
/* -- NEWHDR: take the header from the new file being merged in.*/
if ( lklog ( "NEWHDR" , 7 , &lnewhdr ) ) {
cmbom.lnewhdr = lnewhdr ;
}
/* -- "filelist': define a new binop filelist. */
if( ( list = lcdfl() ) ){
cmbom.ibflc = 0;
}
else{
cfmt( "ILLEGAL OPTION:",17 );
cresp();
}
}
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 evenly
* spaced time series files. */
vfeven( nerr );
if( *nerr != 0 )
goto L_8888;
/* - Check for a null binop file list. */
if(!list || string_list_length(list) <= 0) {
*nerr = ERROR_BINOP_FILE_LIST_EMPTY;
error(*nerr,"");
goto L_8888;
}
/* - Make sure each file in BFL are of the proper type. */
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
getfil( jdfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
npts1 = *npts;
delta1 = *delta;
copyi( nzdttm, n1zdtm, 6 );
begin1 = *begin;
jbfl = min( jdfl, string_list_length(list));
getbfl( list, jbfl, FALSE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
if((*nerr = vbeven()) != 0) {
error(*nerr, "%s", string_list_get(list, jbfl-1));
goto L_8888;
}
if((*nerr = delta_equal(delta1, *delta, datafiles, list, jdfl, jbfl)) != 0) {
goto L_8888;
}
if((*nerr = npts_equal(npts1, *npts, datafiles, list, jdfl, jbfl)) != 0) {
goto L_8888;
}
if((*nerr = time_equal(n1zdtm, nzdttm, begin1, *begin,
datafiles, list, jdfl, jbfl)) != 0) {
goto L_8888;
}
}
/* - Release last binop file. */
relbfl( nerr );
if( *nerr != 0 )
goto L_8888;
/* EXECUTION PHASE: */
/* - Perform the file division on each file in DFL. */
for( jdfl = 1; jdfl <= cmdfm.ndfl; jdfl++ ){
/* -- Get the next file in DFL, moving header to CMHDR. */
getfil( jdfl, TRUE, &nlen, &ndx1, &ndx2, nerr );
if( *nerr != 0 )
goto L_8888;
delta2 = *delta;
/* -- Get the next file in the BFL, moving header to CMHDR. */
jbfl = min( jdfl, string_list_length(list));
getbfl( list, jbfl, TRUE, &nlenb, &ndx1b, &ndx2b, nerr );
if( *nerr != 0 )
goto L_8888;
*delta = delta2;
/* -- Output file is the shorter of two input files. */
npts1 = min( nlen, nlenb );
Nlndta[jdfl] = npts1;
/* -- Perform file division on these two files. */
Sacmem1 = cmmem.sacmem[ndx1b];
Sacmem2 = cmmem.sacmem[ndx1];
for( jdx = 0; jdx <= (npts1 - 1); jdx++, Sacmem1++, Sacmem2++ ){
divsor = *Sacmem1;
if( fabs( divsor ) <= VSMALL ){
*Sacmem2 = sign( VLARGE, *Sacmem2 * divsor );
}
else{
*Sacmem2 = *Sacmem2/divsor;
}
}
/* -- Adjust header of file in DFL. */
if ( !cmbom.lnewhdr )
getfil ( jdfl , FALSE , &nlen , &ndx1 , &ndx2 , nerr ) ;
*npts = npts1 ;
extrma( cmmem.sacmem[ndx1], 1, *npts, depmin, depmax, depmen );
/* -- Return file in DFL to memory manager. */
putfil( jdfl, nerr );
if( *nerr != 0 )
goto L_8888;
}
/* - Release last binop file. */
relbfl( nerr );
if( *nerr != 0 )
goto L_8888;
/* - Calculate and set new range of dependent variable. */
setrng();
L_8888:
return;
}
