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; }