/************************************************************************
Subroutine to invert a square non-singular matrix via LU
decomposition. The original matrix is clobbered with the inverse
************************************************************************/
void inverse_matrix (int nrows, float **matrix)
/************************************************************************
Input:
nrows number of rows (and columns) in matrix to invert
matrix square, non-singular matrix to invert
Output:
matrix inverted matrix
************************************************************************
Credits:
Adapted from discussions in Numerical Recipes by Gabriel Alvarez (1995)
************************************************************************/
{
int i,j; /* loop counters */
float d; /* +/-1 depending on row interchanges even/odd*/
int *idx; /* vector of row permutations */
float *column; /* unit vector for backward substitution*/
float **inverse; /* array to hold the inverse matrix */
/* allocate working space */
idx = alloc1int(nrows);
column = alloc1float(nrows);
inverse = alloc2float(nrows,nrows);
/* first, do the LU decomposition of input matrix */
LU_decomposition (nrows, matrix, idx, &d);
/* find inverse by columns */
for (j=0; j<nrows; j++) {
/* unit vector corresponding to current column */
for (i=0; i<nrows; i++) column[i]=0.0;
column[j]=1.0;
/* backward substitution column by column */
backward_substitution (nrows, matrix, idx, column);
/* compute inverse matrix column by column */
for (i=0; i<nrows; i++)
inverse[i][j]=column[i];
}
/* clobber original matrix with its inverse */
for (i=0; i<nrows; i++)
for (j=0; j<nrows; j++)
matrix[i][j]=inverse[i][j];
/* free allocated space */
free1int(idx);
free1float(column);
free2float(inverse);
}
/* Break up reflectors by duplicating interior (x,z) points */
void breakReflectors (int *nr, float **ar,
int **nu, float ***xu, float ***zu)
{
int nri,nro,*nui,*nuo,ir,jr,iu;
float *ari,*aro,**xui,**zui,**xuo,**zuo;
/* input reflectors */
nri = *nr;
ari = *ar;
nui = *nu;
xui = *xu;
zui = *zu;
/* number of output reflectors */
for (ir=0,nro=0; ir<nri; ++ir)
nro += nui[ir]-1;
/* make output reflectors and free space for input reflectors */
aro = ealloc1float(nro);
nuo = ealloc1int(nro);
xuo = ealloc1(nro,sizeof(float*));
zuo = ealloc1(nro,sizeof(float*));
for (ir=0,jr=0; ir<nri; ++ir) {
for (iu=0; iu<nui[ir]-1; ++iu,++jr) {
aro[jr] = ari[ir];
nuo[jr] = 2;
xuo[jr] = ealloc1float(2);
zuo[jr] = ealloc1float(2);
xuo[jr][0] = xui[ir][iu];
zuo[jr][0] = zui[ir][iu];
xuo[jr][1] = xui[ir][iu+1];
zuo[jr][1] = zui[ir][iu+1];
}
free1float(xui[ir]);
free1float(zui[ir]);
}
free1float(ari);
free1int(nui);
free1(xui);
free1(zui);
/* output reflectors */
*nr = nro;
*ar = aro;
*nu = nuo;
*xu = xuo;
*zu = zuo;
}
int main(int argc, char **argv)
{
int i,ix,it; /* loop counters */
int wtype; /* =1 psv. =2 sh wavefields */
int wfield; /* =1 displcement =2 velocity =3 acceleration */
int stype; /* source type */
int int_type; /* =1 for trapezoidal rule. =2 for Filon */
int flt; /* =1 apply earth flattening correction */
int rand; /* =1 for random velocity layers */
int qopt; /* some flag ???? */
int vsp; /* =1 for vsp, =0 otherwise */
int win; /* =1 if frequency windowing required */
int verbose; /* flag to output processing information */
int nt; /* samples per trace in output traces */
int ntc; /* samples per trace in computed traces */
int nx; /* number of output traces */
int np; /* number of ray parameters */
int nlint=0; /* number of times layer interp is required */
int lsource; /* layer on top of which the source is located*/
int nw; /* number of frequencies */
int nor; /* number of receivers */
int nlayers; /* number of reflecting layers */
int layern;
int nrand_layers; /* maximum number of random layers permitted */
int nf; /* number of frequencies in output traces */
int *filters_phase=NULL; /* =0 for zero phase, =1 for minimum phase fil*/
int nfilters; /* number of required filters */
int wavelet_type; /* =1 spike =2 ricker1 =3 ricker2 =4 akb */
float dt; /* time sampling interval */
float tsec; /* trace length in seconds */
float fpeak; /* peak frequency for output wavelet */
float fref; /* first frequency */
float p2w; /* maximum ray parameter value */
float bp; /* smallest ray parameter (s/km) */
float bx; /* beginning of range in Kms. */
float fx; /* final range in Kms. */
float dx; /* range increment in Kms. */
float pw1,pw2,pw3,pw4; /* window ray parameters (to apply taper) */
float h1; /* horizontal linear part of the source */
float h2; /* vertical linear part of the source */
float m0; /* seismic moment */
float m1,m2,m3; /* components of the moment tensor */
float delta; /* dip */
float lambda; /* rake */
float phis; /* azimuth of the fault plane */
float phi; /* azimuth of the receiver location */
float sdcl,sdct; /* standar deviation for p and s-wave vels */
float z0=0.0; /* reference depth */
float zlayer; /* thickness of random layers */
int layer; /* layer over on top of which to compute rand*/
float tlag; /* time lag in output traces */
float red_vel; /* erducing velocity */
float w1=0.0; /* low end frequency cutoff for taper */
float w2=0.0; /* high end frequency cutoff for taper */
float wrefp; /* reference frequency for p-wave velocities */
float wrefs; /* reference frequency for s-wave velocities */
float epsp; /* .... for p-wave velocities */
float epss; /* .... for p-wave velocities */
float sigp; /* .... for p-wave velocities */
float sigs; /* .... for s-wave velocities */
float fs; /* sampling parameter, usually 0.07<fs<0.12 */
float decay; /* decay factor to avoid wraparound */
int *lobs; /* layers on top of which lay the receivers */
int *nintlayers=NULL; /* array of number of layers to interpolate */
int *filters_type; /* array of 1 lo cut, 2 hi cut, 3 notch */
float *dbpo=NULL; /* array of filter slopes in db/octave */
float *f1=NULL; /* array of lo frequencies for filters */
float *f2=NULL; /* array of high frequencies for filters */
float *cl; /* array of compressional wave velocities */
float *ql; /* array of compressional Q values */
float *ct; /* array of shear wave velocities */
float *qt; /* array of shear Q values */
float *rho; /* array of densities */
float *t; /* array of absolute layer thickness */
int *intlayers=NULL; /* array of layers to interpolate */
float *intlayth=NULL; /* array of thicknesses over which to interp */
float **wavefield1; /* array for pressure wavefield component */
float **wavefield2=NULL;/* array for radial wavefield component */
float **wavefield3=NULL;/* array for vertical wavefield component */
char *lobsfile=""; /* input file receiver layers */
char *clfile=""; /* input file of p-wave velocities */
char *qlfile=""; /* input file of compressional Q-values */
char *ctfile=""; /* input file of s-wave velocities */
char *qtfile=""; /* input file of shear Q-values */
char *rhofile=""; /* input file of density values */
char *tfile=""; /* input file of absolute layer thicknesses */
char *intlayfile=""; /* input file of layers to interpolate */
char *nintlayfile=""; /* input file of number of layers to interp */
char *intlaythfile=""; /*input file of layer thickness where to inter*/
char *filtypefile=""; /* input file of filter types to apply */
char *fphfile=""; /* input file of filters phases */
char *dbpofile=""; /* input file of filter slopes in db/octave */
char *f1file=""; /* input file of lo-end frequency */
char *f2file=""; /* input file of hi-end frequency */
char *wfp=""; /* output file of pressure */
char *wfr=""; /* output file of radial wavefield */
char *wfz=""; /* output file of vertical wavefield */
char *wft=""; /* output file of tangential wavefield */
char *outf=""; /* output file for processing information */
FILE *wfp_file; /* file pointer to output pressure */
FILE *wfr_file; /* file pointer to output radial wavefield */
FILE *wfz_file; /* file pointer to output vertical wavefield */
FILE *wft_file; /* file pointer to output tangential wavefield*/
FILE *outfp=NULL; /* file pointer to processing information */
FILE *infp; /* file pointer to input information */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(0); /* no input data */
/* get required parameter, seismic moment */
if (!getparfloat("m0",&m0))
err("error: the seismic moment, m0, is a required parameter\n");
/*********************************************************************/
/* get general flags and set their defaults */
if (!getparint("rand",&rand)) rand = 0;
if (!getparint("qopt",&qopt)) qopt = 0;
if (!getparint("stype",&stype)) stype = 1;
if (!getparint("wtype",&wtype)) wtype = 1;
if (!getparint("wfield",&wfield)) wfield = 1;
if (!getparint("int_type",&int_type)) int_type= 1;
if (!getparint("flt",&flt)) flt = 0;
if (!getparint("vsp",&vsp)) vsp = 0;
if (!getparint("win",&win)) win = 0;
if (!getparint("wavelet_type",&wavelet_type)) wavelet_type = 1;
if (!getparint("verbose",&verbose)) verbose = 0;
/* get model parameters and set their defaults */
if (!getparint("lsource",&lsource)) lsource = 0;
if (!getparfloat("fs",&fs)) fs = 0.07;
if (!getparfloat("decay",&decay)) decay = 50.0;
if (!getparfloat("tsec",&tsec)) tsec = 2.048;
/* get response parameters and set their defaults */
if (!getparfloat("fref",&fref)) fref = 1.0;
if (!getparint("nw",&nw)) nw = 100;
if (!getparint("nor",&nor)) nor = 100;
if (!getparint("np",&np)) np = 1300;
if (!getparfloat("p2w",&p2w)) p2w = 5.0;
if (!getparfloat("bx",&bx)) bx = 0.005;
if (!getparfloat("bp",&bp)) bp = 0.0;
if (!getparfloat("fx",&fx)) fx = 0.1;
if (!getparfloat("dx",&dx)) dx = 0.001;
if (!getparfloat("pw1",&pw1)) pw1 = 0.0;
if (!getparfloat("pw2",&pw2)) pw2 = 0.1;
if (!getparfloat("pw3",&pw3)) pw3 = 6.7;
if (!getparfloat("pw4",&pw4)) pw4 = 7.0;
if (!getparfloat("h1",&h1)) h1 = 1.0;
if (!getparfloat("h2",&h2)) h2 = 0.0;
/* get output parameters and set their defaults */
if (!getparint("nx",&nx)) nx = 100;
if (!getparfloat("dt",&dt)) dt = 0.004;
if (!getparint("nt",&nt)) nt = tsec/dt;
if (!getparint("nf",&nf)) nf = 50;
if (!getparfloat("red_vel",&red_vel)) red_vel = 5;
if (!getparfloat("fpeak",&fpeak)) fpeak = 25.;
if (!getparfloat("tlag",&tlag)) tlag = 0.;
/* get names of output files */
if (wtype==1) {
getparstring("wfp",&wfp);
getparstring("wfr",&wfr);
getparstring("wfz",&wfz);
} else if (wtype==2) {
getparstring("wft",&wft);
} else err ("wtype has to be zero or one");
/*********************************************************************/
/* get or compute moment tensor components */
if (stype==1) {
/* get source parameters */
if (!getparfloat("delta",&delta))
err("if stype==1, delta is a required parameter\n");
if (!getparfloat("lambda",&lambda))
err("if stype==1, lambda is a required parameter\n");
if (!getparfloat("phis",&phis))
err("if stype==1, phis is a required parameter\n");
if (!getparfloat("phi",&phi))
err("if stype==1, phi is a required parameter\n");
/* compute moment tensor components */
compute_moment_tensor (wtype, phi, lambda, delta, phis, m0,
&m1, &m2, &m3);
} else if (stype==2) {
/* get moment tensor components from input */
if (!getparfloat("m1",&m1))
err("if stype==2, m1 is a required parameter\n");
if (!getparfloat("m2",&m2))
err("if stype==2, m2 is a required parameter\n");
if (!getparfloat("m3",&m3))
err("if stype==2, m3 is a required parameter\n");
} else err("error, stype flag has to be one or two\n");
/*********************************************************************/
/* if q-option is not requesed, set corresponding parameters to zero */
if (!getparint("layern",&layern)) layern =0;
if (!getparfloat("wrefp",&wrefp)) wrefp =0.0;
if (!getparfloat("wrefs",&wrefs)) wrefs =0.0;
if (!getparfloat("epsp",&epsp)) epsp =0.0;
if (!getparfloat("epss",&epss)) epss =0.0;
if (!getparfloat("sigp",&sigp)) sigp =0.0;
if (!getparfloat("sigs",&sigs)) sigs =0.0;
/*********************************************************************/
/* get number of layers and check input parameters */
if (*clfile=='\0') { /* p-wave vels input from the comand line */
nlayers=countparval("cl");
} else { /* p-wave vels input from a file */
getparint("nlayers",&nlayers);
}
if (*ctfile=='\0') { /* s-wave vels input from the comand line */
if (nlayers !=countparval("cl"))
err("number of p-wave and s-wave velocities"
"has to be the same");
}
if (*qlfile=='\0') { /* compressional q-values from comand line */
if (nlayers !=countparval("ql"))
err("number of p-wave velocities and q-values"
"has to be the same");
}
if (*qtfile=='\0') { /* shear q-values input from comand line */
if (nlayers !=countparval("qt"))
err("number of p-wave velocities and shear q-values"
"has to be the same");
}
if (*rhofile=='\0') { /* densities input from comand line */
if (nlayers !=countparval("rho"))
err("number of p-wave velocities and densities"
"has to be the same");
}
if (*tfile=='\0') { /* layer thicknesses input from comand line */
if (nlayers !=countparval("t"))
err("number of p-wave velocities and thicknesses"
"has to be the same");
}
if (int_type!=1 && int_type!=2) err("int_type flag has to be one or two");
/*********************************************************************/
/* if layer interpolation is requested, get parameters */
if (*intlayfile !='\0') {
getparint("nlint",&nlint);
if ((infp=efopen(intlayfile,"r"))==NULL)
err("cannot open file of layer interp=%s\n",intlayfile);
intlayers=alloc1int(nlint);
fread (intlayers,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("intlayers") !=0) {
nlint=countparval("intlayers");
intlayers=alloc1int(nlint);
getparint("intlayers",intlayers);
}
if (*nintlayfile !='\0') {
if ((infp=efopen(nintlayfile,"r"))==NULL)
err("cannot open file of layer inter=%s\n",nintlayfile);
nintlayers=alloc1int(nlint);
fread (nintlayers,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("nintlayers") !=0) {
if (nlint !=countparval("nintlayers"))
err("number of values in intlay and nintlay not equal");
nintlayers=alloc1int(nlint);
getparint("nintlayers",nintlayers);
}
if (*intlaythfile !='\0') {
if ((infp=efopen(intlaythfile,"r"))==NULL)
err("cannot open file=%s\n",intlaythfile);
intlayth=alloc1float(nlint);
fread (intlayth,sizeof(int),nlint,infp);
efclose(infp);
} else if (countparval("intlayth") !=0) {
if (nlint !=countparval("intlayth"))
err("# of values in intlay and intlayth not equal");
intlayth=alloc1float(nlint);
getparfloat("intlayth",intlayth);
}
/* update total number of layers */
if (nlint!=0) {
for (i=0; i<nlint; i++) nlayers +=intlayers[i]-1;
}
/*********************************************************************/
/* if random velocity layers requested, get parameters */
if (rand==1) {
getparint("layer",&layer);
getparint("nrand_layers",&nrand_layers);
getparfloat("zlayer",&zlayer);
getparfloat("sdcl",&sdcl);
getparfloat("sdct",&sdct);
} else nrand_layers=0;
/*********************************************************************/
/* allocate space */
cl = alloc1float(nlayers+nrand_layers);
ct = alloc1float(nlayers+nrand_layers);
ql = alloc1float(nlayers+nrand_layers);
qt = alloc1float(nlayers+nrand_layers);
rho = alloc1float(nlayers+nrand_layers);
t = alloc1float(nlayers+nrand_layers);
lobs = alloc1int(nor+1);
lobs[nor]=0;
/*********************************************************************/
/* read input parameters from files or command line */
if (*clfile !='\0') { /* read from a file */
if ((infp=efopen(clfile,"r"))==NULL)
err("cannot open file of pwave velocities=%s\n",clfile);
fread(cl,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("cl",cl); /* get from command line */
if (*qlfile !='\0') {
if ((infp=efopen(qlfile,"r"))==NULL)
err("cannot open file of compressional Q=%s\n",qlfile);
fread(ql,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("ql",ql);
if (*ctfile !='\0') {
if ((infp=efopen(ctfile,"r"))==NULL)
err("cannot open file of swave velocities=%s\n",ctfile);
fread(ct,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("ct",ct);
if (*qtfile !='\0') {
if ((infp=efopen(qtfile,"r"))==NULL)
err("cannot open file of shear Q=%s\n",qtfile);
fread(qt,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("qt",qt);
if (*rhofile !='\0') {
if ((infp=efopen(rhofile,"r"))==NULL)
err("cannot open file of densities=%s\n",rhofile);
fread(rho,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("rho",rho);
if (*tfile !='\0') {
if ((infp=efopen(tfile,"r"))==NULL)
err("cannot open file of thicknesses=%s\n",tfile);
fread(t,sizeof(float),nlayers,infp);
efclose(infp);
} else getparfloat("t",t);
if (*lobsfile !='\0') {
if ((infp=efopen(lobsfile,"r"))==NULL)
err("can't open file of receiver layers=%s\n",lobsfile);
fread(lobs,sizeof(int),nor,infp);
efclose(infp);
} else getparint("lobs",lobs);
/*********************************************************************/
/* if requested, do interpolation and/or parameter adjustment */
if (nlint!=0)
parameter_interpolation (nlayers, intlayers, nintlayers,
intlayth, cl, ql, ct, qt, rho, t);
/* if requested, compute random velocity layers */
if (rand==1) {
random_velocity_layers (&nlayers, &lsource, nrand_layers, sdcl,
sdct, layer, zlayer, cl, ql, ct, qt, rho, t);
}
/* if requested, apply earth flattening approximation */
if (flt==1) {
apply_earth_flattening (nlayers, z0, cl, ct, rho, t);
}
/*********************************************************************/
/* get filter parameters */
if (*filtypefile !='\0') {
if ((infp=efopen(filtypefile,"r"))==NULL)
err("cannot open file=%s\n",filtypefile);
getparint("nfilters",&nfilters);
filters_type=alloc1int(nfilters);
fread (filters_type,sizeof(int),nfilters,infp);
efclose(infp);
} else {
nfilters=countparval("filters_type");
filters_type=alloc1int(nfilters);
getparint("filters_type",filters_type);
}
if (*fphfile !='\0') {
if ((infp=efopen(fphfile,"r"))==NULL)
err("cannot open file=%s\n",fphfile);
filters_phase=alloc1int(nfilters);
fread (filters_phase,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("filters_phase")) {
filters_phase=alloc1int(nfilters);
getparint("filters_phase",filters_phase);
} else err("number of elements infilterstype and phase must be equal");
if (*dbpofile !='\0') {
if ((infp=efopen(dbpofile,"r"))==NULL)
err("cannot open file=%s\n",dbpofile);
dbpo=alloc1float(nfilters);
fread (dbpo,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("dbpo")) {
dbpo=alloc1float(nfilters);
getparfloat("dbpo",dbpo);
} else err("number of elements in filters_type and dbpo must be equal");
if (*f1file !='\0') {
if ((infp=efopen(f1file,"r"))==NULL)
err("cannot open file=%s\n",f1file);
f1=alloc1float(nfilters);
fread (f1,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("f1")) {
f1=alloc1float(nfilters);
getparfloat("f1",f1);
} else err("number of elements in filters_type and f1 must be equal");
if (*f2file !='\0') {
if ((infp=efopen(f2file,"r"))==NULL)
err("cannot open file=%s\n",f2file);
f2=alloc1float(nfilters);
fread (f2,sizeof(float),nfilters,infp);
efclose(infp);
} else if (nfilters == countparval("f2")) {
f2=alloc1float(nfilters);
getparfloat("f2",f2);
} else err("number of elements in filters_type and f2 must be equal");
/*********************************************************************/
/* allocate space for wavefield computations */
wavefield1=alloc2float(nt,nx);
if (wtype==1) {
wavefield2=alloc2float(nt,nx);
wavefield3=alloc2float(nt,nx);
}
/* get name of output file for processing information */
if (verbose==2||verbose==3) {
if (!getparstring("outf",&outf)) outf="info";
if ((outfp=efopen(outf,"w"))==NULL) {
warn("cannot open processing file =%s, no processing\n"
"information file will be generated\n",outf);
verbose=1;
}
}
/* initialize wavefields */
if (wtype==1) {
for (ix=0;ix<nx;ix++) {
for (it=0;it<nt;it++) {
wavefield1[ix][it]=0.0;
wavefield2[ix][it]=0.0;
wavefield3[ix][it]=0.0;
}
}
} else if (wtype==2) {
for (ix=0;ix<nx;ix++) {
for (it=0;it<nt;it++) {
wavefield1[ix][it]=0.0;
}
}
}
/* number of time samples in computed traces */
ntc=tsec/dt;
if (int_type==2) bp=0.0;
/*********************************************************************/
/* Now, compute the actual reflectivities */
compute_reflectivities (int_type, verbose, wtype, wfield, vsp, flt,
win, nx, nt, ntc, nor, nf, nlayers, lsource, layern, nfilters,
filters_phase, nw, np, bp, tlag, red_vel, w1, w2, fx, dx, bx,
fs, decay, p2w, tsec, fref, wrefp, wrefs, epsp, epss, sigp,
sigs, pw1, pw2, pw3, pw4, h1, h2, m1, m2, m3, fref, lobs,
filters_type, dbpo, f1, f2, cl, ct, ql, qt, rho, t, wavefield1,
wavefield2, wavefield3, outfp);
/*********************************************************************/
/* if open, close processing information file */
if (verbose==2||verbose==3) efclose(outfp);
/* convolve with a wavelet and write the results out */
if (wtype==1) { /* PSV */
/* convolve with a wavelet to produce the seismograms */
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield1);
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield2);
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield3);
/* output results in SU format */
if(*wfp!='\0'){
if ((wfp_file=efopen(wfp,"w"))==NULL)
err("cannot open pressure file=%s\n",wfp);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr1.data[it]=wavefield1[ix][it];
/* headers*/
tr1.ns=nt;
tr1.dt=1000*(int)(1000*dt);
tr1.offset=(bx+ix*dx)*1000;
/* output trace */
fputtr(wfp_file, &tr1);
}
efclose (wfp_file);
}
}
if (*wfr !='\0') {
if ((wfr_file=efopen(wfr,"w"))==NULL)
err("cannot open radial wfield file=%s\n",wfr);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr2.data[it]=wavefield2[ix][it];
tr2.ns=nt;
tr2.dt=1000*(int)(1000*dt);
tr2.offset=(bx+ix*dx)*1000;
fputtr(wfr_file, &tr2);
}
efclose (wfr_file);
}
}
if (*wfz !='\0') {
if ((wfz_file=efopen(wfz,"w"))==NULL)
err("canno open vertical field file=%s\n",wfz);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr3.data[it]=wavefield3[ix][it];
tr3.ns=nt;
tr3.dt=1000*(int)(1000*dt);
tr3.offset=(bx+ix*dx)*1000;
fputtr(wfz_file, &tr3);
}
efclose (wfz_file);
}
}
/* free allocated space */
free2float(wavefield1);
free2float(wavefield2);
free2float(wavefield3);
} else if (wtype==2) { /* SH */
/* convolve with a wavelet to produce the seismogram */
convolve_wavelet (wavelet_type, nx, nt, dt, fpeak, wavefield1);
/* output the result in SU format */
if (*wft !='\0') {
if ((wft_file=efopen(wft,"w"))==NULL)
err("cannot open tangential file=%s\n",wft);
{ register int ix;
for (ix=0; ix<nx; ix++) {
for (it=0; it<nt; it++)
tr1.data[it]=wavefield1[ix][it];
tr1.ns=nt;
tr1.dt=1000*(int)(1000*dt);
tr1.offset=(bx+ix*dx)*1000;
fputtr(wft_file, &tr1);
}
efclose (wft_file);
}
}
/* free allocated space */
free2float(wavefield1);
}
/* free workspace */
free1float(cl);
free1float(ct);
free1float(ql);
free1float(qt);
free1float(rho);
free1float(t);
free1int(lobs);
free1int(filters_type);
free1int(filters_phase);
free1float(dbpo);
free1float(f1);
free1float(f2);
return EXIT_SUCCESS;
}
int main(int argc, char **argv)
{
int verbose;
time_t start,finish;
double elapsed_time;
int ix,nt,nx,nx_out;
float dt,dh,hmin,hmax;
float *h,*h_out;
float **din,**dout,**din_tw,**dout_tw;
int *ih,*ih_out;
int padt,padx;
int Ltw,Dtw;
int twstart;
float taper;
int itw,Itw,Ntw,niter;
float fmin,fmax;
/********/
fprintf(stderr,"*******SUALFT*********\n");
/* Initialize */
initargs(argc, argv);
requestdoc(1);
start=time(0);
/* Get parameters */
if (!getparint("verbose", &verbose)) verbose = 0;
if (!getparint("nx", &nx)) nx = 10000;
if (!getparfloat("dh", &dh)) dh = 10;
if (!gettr(&tr)) err("can't read first trace");
if (!tr.dt) err("dt header field must be set");
if (!tr.ns) err("ns header field must be set");
if (!getparint("Ltw", &Ltw)) Ltw = 200; /* length of time window in samples */
if (!getparint("Dtw", &Dtw)) Dtw = 10; /* overlap of time windows in samples */
dt = ((float) tr.dt)/1000000.0;
nt = (int) tr.ns;
if (!getparint("padt", &padt)) padt = 2; /* padding factor in time dimension*/
if (!getparint("padx", &padx)) padx = 2; /* padding factor in spatial dimension*/
if (!getparfloat("fmin",&fmin)) fmin = 0;
if (!getparfloat("fmax",&fmax)) fmax = 0.5/dt;
if (!getparint("niter", &niter)) niter = 100;
fmax = MIN(fmax,0.5/dt);
din = ealloc2float(nt,nx);
h = ealloc1float(nx);
ih = ealloc1int(nx);
/* ***********************************************************************
input data
*********************************************************************** */
ix=0;
do {
h[ix]=(float) tr.offset;
memcpy((void *) din[ix],(const void *) tr.data,nt*sizeof(float));
ix++;
if (ix > nx) err("Number of traces > %d\n",nx);
} while (gettr(&tr));
erewind(stdin);
nx=ix;
if (verbose) fprintf(stderr,"processing %d traces \n", nx);
hmin = h[0];
hmax = h[0];
for (ix=0;ix<nx;ix++){
if (hmin>h[ix]) hmin = h[ix];
if (hmax<h[ix]) hmax = h[ix];
}
for (ix=0;ix<nx;ix++){
ih[ix] = (int) truncf((h[ix]-hmin)/dh);
}
nx_out = 0;
for (ix=0;ix<nx;ix++){
if (nx_out<ih[ix]) nx_out = ih[ix] + 1;
}
nx_out = nx_out + 1;
ih_out = ealloc1int(nx_out);
h_out = ealloc1float(nx_out);
for (ix=0;ix<nx_out;ix++){
ih_out[ix] = ix;
h_out[ix] = ix*dh + hmin;
}
dout = ealloc2float(nt,nx_out);
Ntw = 9999;
/* number of time windows (will be updated during first
iteration to be consistent with total number of time samples
and the length of each window) */
din_tw = ealloc2float(Ltw,nx);
dout_tw = ealloc2float(Ltw,nx_out);
/***********************************************************************
process using sliding time windows
***********************************************************************/
twstart = 0;
taper = 0;
for (Itw=0;Itw<Ntw;Itw++){
if (Itw == 0){
Ntw = (int) truncf(nt/(Ltw-Dtw));
if ( (float) nt/(Ltw-Dtw) - (float) Ntw > 0) Ntw++;
}
twstart = (int) Itw * (int) (Ltw-Dtw);
if ((twstart+Ltw-1 >nt) && (Ntw > 1)){
twstart=nt-Ltw;
}
if (Itw*(Ltw-Dtw+1) > nt){
Ltw = (int) Ltw + nt - Itw*(Ltw-Dtw+1);
}
for (ix=0;ix<nx;ix++){
for (itw=0;itw<Ltw;itw++){
din_tw[ix][itw] = din[ix][twstart+itw];
}
}
fprintf(stderr,"processing time window %d of %d\n",Itw+1,Ntw);
if (verbose) fprintf(stderr,"Ltw=%d\n",Ltw);
if (verbose) fprintf(stderr,"Dtw=%d\n",Dtw);
process_time_window(din_tw,dout_tw,h,h_out,hmin,hmax,dt,Ltw,nx,nx_out,fmin,fmax,niter,padt,padx,verbose);
if (Itw==0){
for (ix=0;ix<nx_out;ix++){
for (itw=0;itw<Ltw;itw++){
dout[ix][twstart+itw] = dout_tw[ix][itw];
}
}
}
else{
for (ix=0;ix<nx_out;ix++){
for (itw=0;itw<Dtw;itw++){ /* taper the top of the time window */
taper = (float) ((Dtw-1) - itw)/(Dtw-1);
dout[ix][twstart+itw] = dout[ix][twstart+itw]*(taper) + dout_tw[ix][itw]*(1-taper);
}
for (itw=Dtw;itw<Ltw;itw++){
dout[ix][twstart+itw] = dout_tw[ix][itw];
}
}
}
}
/***********************************************************************
end of processing time windows
***********************************************************************/
/* ***********************************************************************
output data
*********************************************************************** */
rewind(stdin);
for (ix=0;ix<nx_out;ix++){
memcpy((void *) tr.data,(const void *) dout[ix],nt*sizeof(float));
tr.offset=(int) h_out[ix];
tr.ntr=nx_out;
tr.ns=nt;
tr.dt = NINT(dt*1000000.);
tr.tracl = ix+1;
tr.tracr = ix+1;
fputtr(stdout,&tr);
}
/******** End of output **********/
finish=time(0);
elapsed_time=difftime(finish,start);
fprintf(stderr,"Total time required: %6.2fs\n", elapsed_time);
free1float(h);
free1float(h_out);
free2float(din);
free2float(dout);
free1int(ih);
free1int(ih_out);
free2float(din_tw);
free2float(dout_tw);
return EXIT_SUCCESS;
}
main (int argc, char **argv)
{
int n1,n2,n3,
n1s,n2s,n3s,
id1s,id2s,id3s,
if1s,if2s,if3s,
*ix1s,*ix2s,*ix3s,
i1s,i2s,i3s,
i1,i2,i3,
offset;
float *p,*ps;
FILE *infp=stdin,*outfp=stdout;
/* hook up getpar to handle the parameters */
initargs(argc,argv);
askdoc(0);
/* get optional parameters */
if (!getparint("n1",&n1)) {
if (fseek(infp,0L,2)==-1)
err("input file size unknown; specify n1\n");
n1 = eftell(infp)/sizeof(float);
}
if (!getparint("n2",&n2)) {
if (fseek(infp,0L,2)==-1)
err("input file size unknown; specify n2\n");
n2 = eftell(infp)/(n1*sizeof(float));
}
if (!getparint("n3",&n3)) {
if (fseek(infp,0L,2)==-1)
err("input file size unknown; specify n3\n");
n3 = eftell(infp)/(n2*n1*sizeof(float));
}
ix1s = alloc1int(countparval("ix1s"));
if ((n1s=getparint("ix1s",ix1s))==0) {
free1int(ix1s);
if (!getparint("id1s",&id1s)) id1s = 1;
if (!getparint("if1s",&if1s)) if1s = 0;
if (!getparint("n1s",&n1s)) n1s = 1+(n1-if1s-1)/id1s;
ix1s = alloc1int(n1s);
for (i1s=0,i1=if1s; i1s<n1s; i1s++,i1+=id1s)
ix1s[i1s] = i1;
}
ix2s = alloc1int(countparval("ix2s"));
if ((n2s=getparint("ix2s",ix2s))==0) {
free1int(ix2s);
if (!getparint("id2s",&id2s)) id2s = 1;
if (!getparint("if2s",&if2s)) if2s = 0;
if (!getparint("n2s",&n2s)) n2s = 1+(n2-if2s-1)/id2s;
ix2s = alloc1int(n2s);
for (i2s=0,i2=if2s; i2s<n2s; i2s++,i2+=id2s)
ix2s[i2s] = i2;
}
ix3s = alloc1int(countparval("ix3s"));
if ((n3s=getparint("ix3s",ix3s))==0) {
free1int(ix3s);
if (!getparint("id3s",&id3s)) id3s = 1;
if (!getparint("if3s",&if3s)) if3s = 0;
if (!getparint("n3s",&n3s)) n3s = 1+(n3-if3s-1)/id3s;
ix3s = alloc1int(n3s);
for (i3s=0,i3=if3s; i3s<n3s; i3s++,i3+=id3s)
ix3s[i3s] = i3;
}
/* check parameters */
for (i1s=0; i1s<n1s; i1s++)
if (ix1s[i1s]<0 || ix1s[i1s]>n1-1)
err("ix1s[%d]=%d is out of bounds!\n",i1s,ix1s[i1s]);
for (i2s=0; i2s<n2s; i2s++)
if (ix2s[i2s]<0 || ix2s[i2s]>n2-1)
err("ix2s[%d]=%d is out of bounds!\n",i2s,ix2s[i2s]);
for (i3s=0; i3s<n3s; i3s++)
if (ix3s[i3s]<0 || ix3s[i3s]>n3-1)
err("ix3s[%d]=%d is out of bounds!\n",i3s,ix3s[i3s]);
/* allocate space for input and output arrays */
p = ealloc1float(n1);
ps = ealloc1float(n1s);
/* loop over 3rd dimension */
for (i3s=0; i3s<n3s; i3s++) {
/* loop over 2nd dimension */
for (i2s=0; i2s<n2s; i2s++) {
/* find beginning of input array */
offset = (ix2s[i2s]+ix3s[i3s]*n2)*n1*sizeof(float);
efseek(infp,offset,0);
/* read input array, if it exists */
if (fread(p,sizeof(float),n1,infp)==n1) {
/* loop over 1st dimension */
for (i1s=0; i1s<n1s; i1s++) {
ps[i1s] = p[ix1s[i1s]];
}
/* if input does not exist */
} else {
err("no input for ix2s[%d]=%d ix3s[%d]=%d!\n",
i2s,ix2s[i2s],
i3s,ix3s[i3s]);
}
/* write trace to output file */
efwrite(ps,sizeof(float),n1s,outfp);
}
}
}
int
main( int argc, char *argv[] )
{
int nx;
int fbt;
int nt;
float *stacked=NULL;
int *nnz=NULL;
int itr=0;
initargs(argc, argv);
requestdoc(1);
if (!getparint("nx", &nx)) nx = 51;
if( !ISODD(nx) ) {
nx++;
warn(" nx has been changed to %d to be odd.\n",nx);
}
if (!getparint("fbt", &fbt)) fbt = 60;
checkpars();
/* Get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
stacked = ealloc1float(fbt);
nnz = ealloc1int(fbt);
memset((void *) nnz, (int) '\0', fbt*ISIZE);
memset((void *) stacked, (int) '\0', fbt*FSIZE);
/* read nx traces and stack them */
/* The first trace is already read */
{ int i,it;
float **tr_b;
char **hdr_b;
int NXP2=nx/2;
short shft,scaler;
/* ramp on read the first nx traces and create stack */
tr_b = ealloc2float(nt,nx);
hdr_b = (char**)ealloc2(HDRBYTES,nx,sizeof(char));
memcpy((void *) hdr_b[0], (const void *) &tr, HDRBYTES);
memcpy((void *) tr_b[0], (const void *) &tr.data, nt*FSIZE);
for(i=1;i<nx;i++) {
gettr(&tr);
memcpy((void *) hdr_b[i], (const void *) &tr, HDRBYTES);
memcpy((void *) tr_b[i], (const void *) &tr.data, nt*FSIZE);
}
for(i=0;i<nx;i++)
for(it=0;it<fbt;it++)
stacked[it] += tr_b[i][it];
for(it=0;it<fbt;it++)
stacked[it] /=(float)nx;
/* filter and write out the first nx/2 +1 traces */
for(i=0;i<NXP2+1;i++) {
memcpy((void *) &tr, (const void *) hdr_b[i], HDRBYTES);
memcpy((void *) tr.data, (const void *) tr_b[i], nt*FSIZE);
remove_fb(tr.data,stacked,fbt,&scaler,&shft);
tr.trwf = scaler;
tr.grnors = shft;
puttr(&tr);
++itr;
}
/* do the rest of the traces */
gettr(&tr);
do {
/* Update the stacked trace - remove old */
for(it=0;it<fbt;it++)
stacked[it] -= tr_b[0][it]/(float)nx;
/* Bump up the storage arrays */
/* This is not very efficient , but good enough */
{int ib;
for(ib=1;ib<nx;ib++) {
memcpy((void *) hdr_b[ib-1],
(const void *) hdr_b[ib], HDRBYTES);
memcpy((void *) tr_b[ib-1],
(const void *) tr_b[ib], nt*FSIZE);
}
}
/* Store the new trace */
memcpy((void *) hdr_b[nx-1], (const void *) &tr, HDRBYTES);
memcpy((void *) tr_b[nx-1], (const void *) &tr.data, nt*FSIZE);
/* Update the stacked array - add new */
for(it=0;it<fbt;it++)
stacked[it] += tr_b[nx-1][it]/(float)nx;
/* Filter and write out the middle one NXP2+1 */
memcpy((void *) &tr, (const void *) hdr_b[NXP2], HDRBYTES);
memcpy((void *) tr.data, (const void *) tr_b[NXP2], nt*FSIZE);
remove_fb(tr.data,stacked,fbt,&scaler,&shft);
tr.trwf = scaler;
tr.grnors = shft;
puttr(&tr);
++itr;
} while(gettr(&tr));
/* Ramp out - write ot the rest of the traces */
/* filter and write out the last nx/2 traces */
for(i=NXP2+1;i<nx;i++) {
memcpy((void *) &tr, (const void *) hdr_b[i], HDRBYTES);
memcpy((void *) tr.data, (const void *) tr_b[i], nt*FSIZE);
remove_fb(tr.data,stacked,fbt,&scaler,&shft);
tr.trwf = scaler;
tr.grnors = shft;
puttr(&tr);
itr++;
}
}
free1float(stacked);
free1int(nnz);
return EXIT_SUCCESS;
}
int main(int argc, char **argv)
{
/********************* variables declaration **************************/
int info, itype, lda, ldb, lwork, order; /* variables for lapack function */
char jobz, uplo; /* variables for lapack function */
int nfreq; /* number of frequencies displayed on the screen */
int d; /* dimension of the problem - determine the size r of the partial basis*/
int shape; /* shape of the body */
int r; /* actual size of the partial basis */
int i, j; /* indices */
int ir1;
int *itab, *ltab, *mtab, *ntab; /* tabulation of indices */
int *irk;
int k;
int ns; /* symmetry of the system */
int hextype; /* type of hexagonal symmetry - VTI or HTI*/
double d1, d2, d3; /* dimension of the sample */
double rho; /* density */
double **cm;
double ****c; /* stiffness tensor */
double **e, **gamma, *work, **w; /* matrices of the eigenvalue problem */
double *wsort;
int outeigen; /* 1 if eigenvectors calculated */
char *eigenfile;
/** FILE *file; */
/********************* end variables declaration **********************/
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
if (!getparint("d", &d)) err("must specify d!\n");
if (!getpardouble("d1", &d1)) err("must specify d1!\n");
if (!getpardouble("d2", &d2)) err("must specify d2!\n");
if (!getpardouble("d3", &d3)) err("must specify d3!\n");
if (!getpardouble("rho", &rho)) err("must specify rho!\n");
if (!getparint("ns", &ns)) err("must specify ns!\n");
cm=ealloc2double(6,6);
for (i=0; i<6; ++i)
for (j=0; j<6; ++j)
cm[i][j]=0.0;
if (ns==2) {
/* isotropic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
cm[0][0]=cm[0][0]/100;
cm[3][3]=cm[3][3]/100;
cm[1][1]=cm[2][2]=cm[0][0];
cm[4][4]=cm[5][5]=cm[3][3];
cm[0][1]=cm[0][2]=cm[1][2]=cm[0][0]- 2.0*cm[3][3];
cm[1][0]=cm[2][0]=cm[2][1]=cm[0][0]- 2.0*cm[3][3];
} else if (ns==3) {
/* cubic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
cm[0][0]=cm[0][0]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[1][1]=cm[2][2]=cm[0][0];
cm[4][4]=cm[5][5]=cm[3][3];
cm[0][2]=cm[1][2]=cm[0][1];
cm[2][0]=cm[2][1]=cm[1][0]=cm[0][1];
} else if (ns==5) {
/* hexagonal */
if (!getparint("hextype", &hextype)) err("must specify hextype!\n");
if (hextype==1) {
/* VTI */
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[5][5]=cm[5][5]/100;
cm[0][0]=cm[1][1]=2.0*cm[5][5] + cm[0][1];
cm[0][2]=cm[2][0]=cm[2][1]=cm[1][2];
cm[1][0]=cm[0][1];
cm[4][4]=cm[3][3];
} else if (hextype==2) {
/* HTI */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[2][2]=cm[2][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[5][5]=cm[5][5]/100;
cm[1][2]=cm[2][1]=cm[2][2] - 2.0*cm[3][3];
cm[0][2]=cm[1][0]=cm[2][0]=cm[0][1];
cm[1][1]=cm[2][2];
cm[4][4]=cm[5][5];
}
else {
err("for hexagonal symmetry hextype must equal 1 (VTI) or 2 (HTI)!\n");
}
}
else if (ns==6){
/* tetragonal */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[3][3]=cm[3][3]/100;
cm[0][1]=cm[0][1]/100;
cm[5][5]=cm[5][5]/100;
cm[1][1]=cm[0][0];
cm[0][2]=cm[2][0]=cm[1][2];
cm[1][0]=cm[0][1];
cm[2][1]=cm[1][2];
cm[4][4]=cm[3][3];
}
else if (ns==9){/* orthorhombic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c22", &cm[1][1])) err("must specify c22!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c13", &cm[0][2])) err("must specify c13!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c55", &cm[4][4])) err("must specify c55!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[1][1]=cm[1][1]/100;
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[0][2]=cm[0][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[4][4]=cm[4][4]/100;
cm[5][5]=cm[5][5]/100;
cm[2][0]=cm[0][2];
cm[1][0]=cm[0][1];
cm[2][1]=cm[1][2];
}
else err("given elatic moduli does not fit given ns");
/* get optional parameters */
if (!getparint("outeigen", &outeigen)) outeigen=0;
if (outeigen!=0)
if (!getparstring("eigenfile", &eigenfile))
err("must specify eigenfile since outeigen>0!\n");
if (!getparint("shape", &shape)) shape=1; /* changed from zero default to 1 */
if (!getparint("nfreq", &nfreq)) nfreq=10;
/* dimension of the problem */
r= 3*(d+1)*(d+2)*(d+3)/6;
d1=d1/2.0; /* half sample dimensions are used in calculations */
d2=d2/2.0;
d3=d3/2.0;
/* alloc work space*/
itab=ealloc1int(r);
ltab=ealloc1int(r);
mtab=ealloc1int(r);
ntab=ealloc1int(r);
/* relationship between ir and l,m,n - filling tables */
irk=ealloc1int(8);
index_relationship(itab, ltab, mtab, ntab, d, irk);
/* alloc workspace to solve for eigenvalues and eigenfunctions */
e= (double **) malloc(8*sizeof(double *));
for (k=0; k<8; ++k)
e[k] = ealloc1double(irk[k]*irk[k]);
gamma= (double **) malloc(8*sizeof(double *));
for (k=0; k<8; ++k)
gamma[k] = ealloc1double(irk[k]*irk[k]);
/* filling matrix e */
for (k=0; k<8; ++k)
e_fill(e[k], itab, ltab, mtab, ntab,
r, d1, d2, d3, rho, shape, k, irk);
/* stiffness tensor calculation*/
c= (double ****) malloc(sizeof(double ***)*3);
for (i=0; i<3; ++i)
c[i]=ealloc3double(3,3,3);
stiffness (c, cm);
/* filling matrix gamma */
for (k=0; k<8; ++k)
gamma_fill(gamma[k], itab, ltab, mtab,
ntab, r, d1, d2, d3, c, shape, k, irk);
/* clean workspace */
free1int(itab);
free1int(ltab);
free1int(mtab);
free1int(ntab);
for (i=0; i<3; ++i)
free3double(c[i]);
free(c);
fprintf(stderr,"done preparing matrices\n");
/*-------------------------------------------------------------*/
/*--------- solve the generalized eigenvalue problem ----------*/
/*-------------------------------------------------------------*/
w= (double **) malloc(sizeof(double *)*8);
itype=1;
if (outeigen==0) jobz='N';
else jobz='V';
uplo='U';
for (k=0; k<8; ++k){
w[k] =ealloc1double(irk[k]);
lda=ldb=irk[k];
order=irk[k];
lwork=MAX(1, 3*order-1);
work=ealloc1double(lwork);
/* lapack routine */
dsygv_(&itype, &jobz, &uplo, &order, gamma[k],
&lda, e[k], &ldb, w[k], work, &lwork, &info);
free1double(work);
}
/*-------------------------------------------------------------*/
/*-------------------------------------------------------------*/
/*-------------------------------------------------------------*/
wsort=ealloc1double(r);
for (i=0, k=0; k<8; ++k)
for (ir1=0;ir1<irk[k];++ir1,++i)
wsort[i]=w[k][ir1];
/* sorting the eigenfrequencies */
dqksort(r,wsort);
for (i=0, ir1=0; ir1<nfreq;++i)
if ((wsort[i]>0) && ((sqrt(wsort[i])/(2.0*PI))>0.00001)){
++ir1;
/*fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI));*/
fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI));
}
/* modify output of freq values here*/
/* for (k=0;k<8;++k){
for (ir2=0;ir2<irk[k]*irk[k];++ir2){
fprintf(stderr,"gamma[%d][%d]=%f\n",k,ir2,gamma[k][ir2]);
fprintf(stderr,"e[%d][%d]=%f\n",k,ir2,e[k][ir2]);
}
}*/
/******************* write eigenvectors in files ***************/
/*if (outeigen==1){
z=ealloc2double(r,r);
for (ir1=0; ir1<r; ++ir1)
for (ir2=0; ir2<r; ++ir2)
z[ir2][ir1]=gamma[ir1][ir2*r+ir1]; */
/* change the order of the array at the same time */
/* since we go from fortran array */
/* to C array */
/* clean workspace */
/* free1double(gamma);
file = efopen(eigenfile, "w");
efwrite(&irf, sizeof(int), 1, file);
efwrite(w, sizeof(double), r, file);
efwrite(z[0], sizeof(double), r*r, file);
efclose(file);*/
/* clean workspace */
/* free2double(z); */
/* }*/
/* clean workspace */
/* free1double(w); */
/* end of main */
return EXIT_SUCCESS;
}
int main( int argc, char *argv[] )
{
int ntr=0; /* number of traces */
int ntrv=0; /* number of traces */
int ns=0;
int nsv=0;
float dt;
float dtv;
cwp_String fs;
cwp_String fv;
FILE *fps;
FILE *fpv;
FILE *headerfp;
float *data; /* data matrix of the migration volume */
float *vel; /* velocity matrix */
float *velfi; /* velocity function interpolated to ns values*/
float *velf; /* velocity function */
float *vdt;
float *ddt;
float *ap; /* array of apperture values in m */
float apr; /* array of apperture values in m */
int *apt=NULL; /* array of apperture time limits in mig. gath*/
float r; /* maximum radius with a given apperture */
float ir2; /* r/d2 */
float ir3; /* r/d3 */
float d2; /* spatial sampling int. in dir 2. */
float d3; /* spatial sampling int. in dir 3. */
float **mgd=NULL; /* migration gather data */
float *migt; /* migrated data trace */
int **mgdnz=NULL; /* migration gather data non zero samples*/
float dm; /* migration gather spatial sample int. */
int im; /* number of traces in migration gather */
int *mtnz; /* migrated trace data non zero smaples */
char **dummyi; /* index array that the trace contains zeros only */
float fac; /* velocity scale factor */
int sphr; /* spherical divergence flag */
int imt; /* mute time sample of trace */
float tmp;
int imoff;
int **igtr=NULL;
int nigtr;
int n2;
int n3;
int verbose;
/* phase shift filter stuff */
float power; /* power of i omega applied to data */
float amp; /* amplitude associated with the power */
float arg; /* argument of power */
float phasefac; /* phase factor */
float phase; /* phase shift = phasefac*PI */
complex exparg; /* cexp(I arg) */
register float *rt; /* real trace */
register complex *ct; /* complex transformed trace */
complex *filt; /* complex power */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
float sign; /* sign in front of i*omega default -1 */
int nfft; /* number of points in nfft */
int nf; /* number of frequencies (incl Nyq) */
float onfft; /* 1 / nfft */
size_t nzeros; /* number of padded zeroes in bytes */
initargs(argc, argv);
requestdoc(1);
MUSTGETPARSTRING("fs",&fs);
MUSTGETPARSTRING("fv",&fv);
MUSTGETPARINT("n2",&n2);
MUSTGETPARINT("n3",&n3);
MUSTGETPARFLOAT("d2",&d2);
MUSTGETPARFLOAT("d3",&d3);
if (!getparfloat("dm", &dm)) dm=(d2+d3)/2.0;
/* open datafile */
fps = efopen(fs,"r");
fpv = efopen(fv,"r");
/* Open tmpfile for headers */
headerfp = etmpfile();
/* get information from the first data trace */
ntr = fgettra(fps,&tr,0);
if(n2*n3!=ntr) err(" Number of traces in file %d not equal to n2*n3 %d \n",
ntr,n2*n3);
ns=tr.ns;
if (!getparfloat("dt", &dt)) dt = ((float) tr.dt)/1000000.0;
if (!dt) {
dt = .002;
warn("dt not set, assumed to be .002");
}
/* get information from the first velocity trace */
ntrv = fgettra(fpv,&trv,0);
if(ntrv!=ntr) err(" Number of traces in velocity file %d differ from %d \n",
ntrv,ntr);
nsv=trv.ns;
if (!getparfloat("dtv", &dtv)) dtv = ((float) trv.dt)/1000000.0;
if (!dtv) {
dtv = .002;
warn("dtv not set, assumed to be .002 for velocity");
}
if (!getparfloat("fac", &fac)) fac=2.0;
if (!getparint("verbose", &verbose)) verbose=0;
if (!getparint("sphr", &sphr)) sphr=0;
if (!getparfloat("apr", &apr)) apr=75;
apr*=3.141592653/180;
/* allocate arrays */
data = bmalloc(sizeof(float),ns,ntr);
vel = bmalloc(sizeof(float),nsv,ntr);
velf = ealloc1float(nsv);
velfi = ealloc1float(ns);
migt = ealloc1float(ns);
vdt = ealloc1float(nsv);
ddt = ealloc1float(ns);
ap = ealloc1float(ns);
mtnz = ealloc1int(ns);
dummyi = (char **) ealloc2(n2,n3,sizeof(char));
/* Times to do interpolation of velocity from sparse sampling */
/* to fine sampling of the data */
{ register int it;
for(it=0;it<nsv;it++) vdt[it]=it*dtv;
for(it=0;it<ns;it++) ddt[it]=it*dt;
}
/* Read traces into data */
/* Store headers in tmpfile */
ntr=0;
erewind(fps);
erewind(fpv);
{ register int i2,i3;
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
fgettr(fps,&tr);
fgettr(fpv,&trv);
if(tr.trid > 2) dummyi[i3][i2]=1;
else dummyi[i3][i2]=0;
efwrite(&tr, 1, HDRBYTES, headerfp);
bmwrite(data,1,0,i3*n2+i2,ns,tr.data);
bmwrite(vel,1,0,i3*n2+i2,nsv,trv.data);
}
erewind(headerfp);
/* set up the phase filter */
power = 1.0;sign = 1.0;phasefac = 0.5;
phase = phasefac * PI;
/* Set up for fft */
nfft = npfaro(ns, LOOKFAC * ns);
if (nfft >= SU_NFLTS || nfft >= PFA_MAX)
err("Padded nt=%d -- too big", nfft);
nf = nfft/2 + 1;
onfft = 1.0 / nfft;
nzeros = (nfft - ns) * FSIZE;
domega = TWOPI * onfft / dt;
/* Allocate fft arrays */
rt = ealloc1float(nfft);
ct = ealloc1complex(nf);
filt = ealloc1complex(nf);
/* Set up args for complex power evaluation */
arg = sign * PIBY2 * power + phase;
exparg = cexp(crmul(I, arg));
{
register int i;
for (i = 0 ; i < nf; ++i) {
omega = i * domega;
/* kludge to handle omega=0 case for power < 0 */
if (power < 0 && i == 0) omega = FLT_MAX;
/* calculate filter */
amp = pow(omega, power) * onfft;
filt[i] = crmul(exparg, amp);
}
}
/* set up constants for migration */
if(verbose) fprintf(stderr," Setting up constants....\n");
r=0;
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
if(dummyi[i3][i2] < 1) {
/* get the velocity function */
bmread(vel,1,0,i3*n2+i2,nsv,velf);
/* linear interpolation from nsv to ns values */
intlin(nsv,vdt,velf,velf[0],velf[nsv-1],ns,ddt,velfi);
/* Apply scale factor to velocity */
{ register int it;
for(it=0;it<ns;it++) velfi[it] *=fac;
}
/* compute maximum radius from apperture and velocity */
{ register int it;
for(it=0;it<ns;it++)
ap[it] = ddt[it]*velfi[it]*tan(apr)/2.0;
}
tmp = ap[isamax(ns,ap,1)];
if(tmp>r) r=tmp;
}
}
r=MIN(r,sqrt(SQR((n2-1)*d2)+SQR((n3-1)*d3)));
ir2 = (int)(2*r/d2)+1;
ir3 = (int)(2*r/d3)+1;
im = (int)(r/dm)+1;
/* allocate migration gather */
mgd = ealloc2float(ns,im);
mgdnz = ealloc2int(ns,im);
apt = ealloc1int(im);
/* set up the stencil for selecting traces */
igtr = ealloc2int(ir2*ir3,2);
stncl(r, d2, d3,igtr,&nigtr);
if(verbose) {
fprintf(stderr," Maximum radius %f\n",r);
fprintf(stderr," Maximum offset %f\n",
sqrt(SQR((n2-1)*d2)+SQR((n3-1)*d3)));
}
/* main processing loop */
for(i3=0;i3<n3;i3++)
for(i2=0;i2<n2;i2++) {
memset( (void *) tr.data, (int) '\0',ns*FSIZE);
if(dummyi[i3][i2] < 1) {
memset( (void *) mgd[0], (int) '\0',ns*im*FSIZE);
memset( (void *) mgdnz[0], (int) '\0',ns*im*ISIZE);
/* get the velocity function */
bmread(vel,1,0,i3*n2+i2,nsv,velf);
/* linear interpolation from nsv to ns values */
intlin(nsv,vdt,velf,velf[0],velf[nsv-1],ns,ddt,velfi);
/* Apply scale factor to velocity */
{ register int it;
for(it=0;it<ns;it++) velfi[it] *=fac;
}
/* create the migration gather */
{ register int itr,ist2,ist3;
for(itr=0;itr<nigtr;itr++) {
ist2=i2+igtr[0][itr];
ist3=i3+igtr[1][itr];
if(ist2 >= 0 && ist2 <n2)
if(ist3 >= 0 && ist3 <n3) {
if(dummyi[ist3][ist2] <1) {
imoff = (int) (
sqrt(SQR(igtr[0][itr]*d2)
+SQR(igtr[1][itr]*d3))/dm+0.5);
bmread(data,1,0,ist3*n2+ist2,ns,tr.data);
imoff=MIN(imoff,im-1);
{ register int it;
/* get the mute time for this
offset, apperture and velocity */
xindex(ns,ap,imoff*dm,&imt);
for(it=imt;it<ns;it++)
if(tr.data[it]!=0) {
mgd[imoff][it]+=tr.data[it];
mgdnz[imoff][it]+=1;
}
}
}
}
}
}
/* normalize the gather */
{ register int ix,it;
for(ix=0;ix<im;ix++)
for(it=0;it<ns;it++)
if(mgdnz[ix][it] > 1) mgd[ix][it] /=(float) mgdnz[ix][it];
}
memset( (void *) tr.data, (int) '\0',ns*FSIZE);
memset( (void *) mtnz, (int) '\0',ns*ISIZE);
/* do a knmo */
{ register int ix,it;
for(ix=0;ix<im;ix++) {
/* get the mute time for this
offset, apperture and velocity */
xindex(ns,ap,ix*dm,&imt);
knmo(mgd[ix],migt,ns,velfi,0,ix*dm,dt,imt,sphr);
/* stack the gather */
for(it=0;it<ns;it++) {
if(migt[it]!=0.0) {
tr.data[it] += migt[it];
mtnz[it]++;
}
/* tr.data[it] += mgd[ix][it]; */
}
}
}
{ register int it;
for(it=0;it<ns;it++)
if(mtnz[it]>1) tr.data[it] /=(float)mtnz[it];
}
/*Do the phase filtering before the trace is released*/
/* Load trace into rt (zero-padded) */
memcpy( (void *) rt, (const void *) tr.data, ns*FSIZE);
memset((void *) (rt + ns), (int) '\0', nzeros);
pfarc(1, nfft, rt, ct);
{ register int i;
for (i = 0; i < nf; ++i) ct[i] = cmul(ct[i], filt[i]);
}
pfacr(-1, nfft, ct, rt);
memcpy( (void *) tr.data, (const void *) rt, ns*FSIZE);
} /* end of dummy if */
/* spit out the gather */
efread(&tr, 1, HDRBYTES, headerfp);
puttr(&tr);
if(verbose) fprintf(stderr," %d %d\n",i2,i3);
} /* end of i2 loop */
} /* end of i3 loop */
/* This should be the last thing */
efclose(headerfp);
/* Free memory */
free2int(igtr);
free2float(mgd);
free2int(mgdnz);
free1int(apt);
bmfree(data);
bmfree(vel);
free1float(velfi);
free1float(velf);
free1float(ddt);
free1float(vdt);
free1float(ap);
free1int(mtnz);
free1float(migt);
free1float(rt);
free1complex(ct);
free1complex(filt);
free2((void **) dummyi);
return EXIT_SUCCESS;
}
int
main (int argc, char **argv)
{
int n1,n2,n1tic,n2tic,nfloats,bbox[4],
i1,i2,grid1,grid2,style,
n1c,n2c,n1s,n2s,i1beg,i1end,i2beg,i2end,i1c,i2c,
nz,iz,i1step,i2step,verbose,hls,bps,
legend,ugrid=SOLID,lstyle=VERTLEFT,lz,lbegsup=0,lendsup=0,ln=256,
lbbox[4], threecolor=0; /* BEREND, Schoenfelder */
int lnice; /* c liner */
float labelsize,titlesize,perc,clip,bperc,wperc,bclip,wclip,
d1,f1,d2,f2,*z,*temp,zscale,zoffset,zi,
xbox,ybox,width,height,
x1beg,x1end,x2beg,x2end,
x1min,x1max,x2min,x2max,
d1num,f1num,d2num,f2num,
p1beg,p1end,p2beg,p2end,matrix[6],colors[3][3], /* for 3 color mode */
d1s,d2s,
lwidth,lheight,lx,ly,lbeg,lend,lmin=(float) FLT_MAX,lmax=(float) -FLT_MAX,
ldnum,lfnum,ld,lf=0,labmatrix[6]; /* BEREND, Schoenfelder */
float axeswidth, ticwidth, gridwidth;
unsigned char *cz,*czp,*sz,*data_legend=NULL;
char *label1="",*label2="",*title="",*units="",
*legendfont="times_roman10",
*labelfont="Helvetica",*titlefont="Helvetica-Bold",
*styles="seismic",*grid1s="none",*grid2s="none",
*titlecolor="black",*axescolor="black",*gridcolor="black",
*lstyles="vertleft",*lgrids="none";
FILE *infp=stdin;
float **x1curve=NULL,**x2curve=NULL,*curvewidth=NULL;
int i,j,curve=0,*npair=NULL,ncurvecolor=0,ncurvewidth=0,ncurvedash=0,*curvedash=NULL;
char **curvecolor=NULL,**curvefile=NULL;
FILE *curvefp=NULL;
cwp_Bool is_curve = cwp_false;
/* initialize getpar */
initargs(argc,argv);
requestdoc(1);
/* get parameters describing 1st dimension sampling */
if (!getparint("n1",&n1)) err("must specify n1!\n");
d1 = 1.0; getparfloat("d1",&d1);
f1 = 0.0; getparfloat("f1",&f1);
x1min = (d1>0.0)?f1:f1+(n1-1)*d1;
x1max = (d1<0.0)?f1:f1+(n1-1)*d1;
/* get parameters describing 2nd dimension sampling */
if (!getparint("n2",&n2)) {
if (efseeko(infp,(off_t) 0,SEEK_END)!=0)
err("must specify n2 if in a pipe!\n");
nfloats = (int) (eftello(infp)/((off_t) sizeof(float)));
efseeko(infp,(off_t) 0,SEEK_SET);
n2 = nfloats/n1;
}
d2 = 1.0; getparfloat("d2",&d2);
f2 = 0.0; getparfloat("f2",&f2);
x2min = (d2>0.0)?f2:f2+(n2-1)*d2;
x2max = (d2<0.0)?f2:f2+(n2-1)*d2;
/* read color parameters */
if (!getparint("threecolor",&threecolor)) threecolor=1;
bps = 8;
hls = 0;
/* color[][0] is black, color[][2] is white in 2 color mode */
colors[R][0] = colors[G][0] = colors[B][0] = 0.0;
colors[R][1] = colors[G][1] = colors[B][1] = 0.5;
colors[R][2] = colors[G][2] = colors[B][2] = 1.0;
if (countparval("brgb") || countparval("wrgb")) {
float brgb[3],grgb[3],wrgb[3];
brgb[R] = brgb[G] = brgb[B] = 0.0;
wrgb[R] = wrgb[G] = wrgb[B] = 1.0;
getparfloat("brgb",&brgb[0]);
getparfloat("wrgb",&wrgb[0]);
grgb[R] = (brgb[R] + wrgb[R])/2.;
grgb[G] = (brgb[G] + wrgb[G])/2.;
grgb[B] = (brgb[B] + wrgb[B])/2.;
if (threecolor==1)
getparfloat("grgb",&grgb[0]);
brgb[R] = MAX(0.0,MIN(1.0,brgb[R]));
grgb[R] = MAX(0.0,MIN(1.0,grgb[R]));
wrgb[R] = MAX(0.0,MIN(1.0,wrgb[R]));
brgb[G] = MAX(0.0,MIN(1.0,brgb[G]));
grgb[G] = MAX(0.0,MIN(1.0,grgb[G]));
wrgb[G] = MAX(0.0,MIN(1.0,wrgb[G]));
brgb[B] = MAX(0.0,MIN(1.0,brgb[B]));
grgb[B] = MAX(0.0,MIN(1.0,grgb[B]));
wrgb[B] = MAX(0.0,MIN(1.0,wrgb[B]));
colors[R][0] = brgb[R]; colors[R][1] = grgb[R]; colors[R][2] = wrgb[R];
colors[G][0] = brgb[G]; colors[G][1] = grgb[G]; colors[G][2] = wrgb[G];
colors[B][0] = brgb[B]; colors[B][1] = grgb[B]; colors[B][2] = wrgb[B];
if (!getparint("bps",&bps)) bps = 12;
if (bps!=12 && bps!=24)
err("bps must equal 12 or 24 for color plots!\n");
} else if (countparval("bhls") || countparval("whls")) {
float bhls[3],ghls[3],whls[3];
hls = 1;
bhls[H] = ghls[H] = whls[H] = 0.0;
bhls[L] = 0.0; ghls[L] = 0.5; whls[L] = 1.0;
bhls[S] = ghls[S] = whls[S] = 0.0;
getparfloat("bhls",&bhls[0]);
getparfloat("whls",&whls[0]);
ghls[H] = (bhls[H] + whls[H])/2.;
ghls[L] = (bhls[L] + whls[L])/2.;
ghls[S] = (bhls[S] + whls[S])/2.;
if (threecolor==1)
getparfloat("ghls",&ghls[0]);
bhls[L] = MAX(0.0,MIN(1.0,bhls[L]));
ghls[L] = MAX(0.0,MIN(1.0,ghls[L]));
whls[L] = MAX(0.0,MIN(1.0,whls[L]));
bhls[S] = MAX(0.0,MIN(1.0,bhls[S]));
ghls[S] = MAX(0.0,MIN(1.0,ghls[S]));
whls[S] = MAX(0.0,MIN(1.0,whls[S]));
colors[H][0] = bhls[0]; colors[H][1] = ghls[0]; colors[H][2] = whls[0];
colors[L][0] = bhls[1]; colors[L][1] = ghls[1]; colors[L][2] = whls[1];
colors[S][0] = bhls[2]; colors[S][1] = ghls[2]; colors[S][2] = whls[2];
if (!getparint("bps",&bps)) bps = 12;
if (bps!=12 && bps!=24)
err("bps must equal 12 or 24 for color plots!\n");
}
/* get legend specs BEREND, Schoenfelder */
legend = 0; getparint("legend", &legend); /* BEREND, Schoenfelder */
getparstring("units", &units); /* BEREND, Schoenfelder */
getparstring("legendfont", &legendfont); /* BEREND, Schoenfelder */
/* set up curve plotting */
if ((curve=countparval("curve"))!=0) {
curvefile=(char**)ealloc1(curve,sizeof(void*));
getparstringarray("curve",curvefile);
if ((x1curve=(float**)malloc(curve*sizeof(void*)))==NULL)
err("Could not allocate x1curve pointers\n");
if ((x2curve=(float**)malloc(curve*sizeof(void*)))==NULL)
err("Could not allocate x2curve pointers\n");
npair=ealloc1int(curve);
getparint("npair",npair);
is_curve = cwp_true;
} else {
npair=(int *)NULL;
curvefile=(char **)NULL;
x1curve=(float **)NULL;
x2curve=(float **)NULL;
is_curve = cwp_false;
}
if (is_curve) {
if ((ncurvecolor=countparval("curvecolor"))<curve) {
curvecolor=(char**)ealloc1(curve,sizeof(void*));
if (!getparstringarray("curvecolor",curvecolor)) {
curvecolor[0]=(char *)cwp_strdup("black\0");
ncurvecolor=1;
}
for (i=ncurvecolor; i<curve; i++)
curvecolor[i]=(char *)cwp_strdup(curvecolor[ncurvecolor-1]);
} else if (ncurvecolor) {
curvecolor=(char**)ealloc1(ncurvecolor,sizeof(void*));
getparstringarray("curvecolor",curvecolor);
}
for (j=0; j<curve; j++) {
curvefp=efopen(curvefile[j],"r");
x1curve[j]=ealloc1float(npair[j]);
x2curve[j]=ealloc1float(npair[j]);
for (i=0; i<npair[j]; i++) {
fscanf(curvefp,"%f",&x1curve[j][i]);
fscanf(curvefp,"%f",&x2curve[j][i]);
}
efclose(curvefp);
}
}
/* read binary data to be plotted */
nz = n1*n2;
z = ealloc1float(nz);
if (fread(z,sizeof(float),nz,infp)!=nz)
err("error reading input file!\n");
/* if necessary, determine clips from percentiles */
if (getparfloat("clip",&clip)) {
bclip = clip;
wclip = -clip;
}
if ((!getparfloat("bclip",&bclip) || !getparfloat("wclip",&wclip)) &&
!getparfloat("clip",&clip)) {
perc = 100.0; getparfloat("perc",&perc);
temp = ealloc1float(nz);
for (iz=0; iz<nz; iz++)
temp[iz] = z[iz];
if (!getparfloat("bclip",&bclip)) {
bperc = perc; getparfloat("bperc",&bperc);
iz = (nz*bperc/100.0);
if (iz<0) iz = 0;
if (iz>nz-1) iz = nz-1;
qkfind(iz,nz,temp);
bclip = temp[iz];
}
if (!getparfloat("wclip",&wclip)) {
wperc = 100.0-perc; getparfloat("wperc",&wperc);
iz = (nz*wperc/100.0);
if (iz<0) iz = 0;
if (iz>nz-1) iz = nz-1;
qkfind(iz,nz,temp);
wclip = temp[iz];
}
free1float(temp);
}
verbose = 1; getparint("verbose",&verbose);
if (verbose) warn("bclip=%g wclip=%g",bclip,wclip);
/* get scaled sampling intervals */
d1s = 1.0; getparfloat("d1s",&d1s);
d2s = 1.0; getparfloat("d2s",&d2s);
d1s = fabs(d1s); d1s *= d1;
d2s = fabs(d2s); d2s *= d2;
/* get axes parameters */
xbox = 1.5; getparfloat("xbox",&xbox); /* if psimage is called by ximage, it */
ybox = 1.5; getparfloat("ybox",&ybox); /* will xbox=1.166 and ybox=1.167 */
width = 6.0; getparfloat("wbox",&width); getparfloat("width",&width);
height = 8.0;getparfloat("hbox",&height);getparfloat("height",&height);
/* begin c liner */
lnice = 0; getparint("lnice",&lnice);
if (lnice==1) {
ybox = 2.2;
/* lx=8 is set below, after getpar on lx ... c liner */
width = 5.4;
height = 7.2;
}
/* end c liner */
x1beg = x1min; getparfloat("x1beg",&x1beg);
x1end = x1max; getparfloat("x1end",&x1end);
d1num = 0.0; getparfloat("d1num",&d1num);
f1num = x1min; getparfloat("f1num",&f1num);
n1tic = 1; getparint("n1tic",&n1tic);
getparstring("grid1",&grid1s);
if (STREQ("dot",grid1s))
grid1 = DOT;
else if (STREQ("dash",grid1s))
grid1 = DASH;
else if (STREQ("solid",grid1s))
grid1 = SOLID;
else
grid1 = NONE;
getparstring("label1",&label1);
x2beg = x2min; getparfloat("x2beg",&x2beg);
x2end = x2max; getparfloat("x2end",&x2end);
d2num = 0.0; getparfloat("d2num",&d2num);
f2num = 0.0; getparfloat("f2num",&f2num);
n2tic = 1; getparint("n2tic",&n2tic);
getparstring("grid2",&grid2s);
if (STREQ("dot",grid2s))
grid2 = DOT;
else if (STREQ("dash",grid2s))
grid2 = DASH;
else if (STREQ("solid",grid2s))
grid2 = SOLID;
else
grid2 = NONE;
getparstring("label2",&label2);
getparstring("labelfont",&labelfont);
labelsize = 18.0; getparfloat("labelsize",&labelsize);
getparstring("title",&title);
getparstring("titlefont",&titlefont);
titlesize = 24.0; getparfloat("titlesize",&titlesize);
getparstring("titlecolor",&titlecolor);
getparstring("axescolor",&axescolor);
getparstring("gridcolor",&gridcolor);
/* axes and tic width */
if(!getparfloat("axeswidth",&axeswidth)) axeswidth=1;
if (!getparfloat("ticwidth",&ticwidth)) ticwidth=axeswidth;
if(!getparfloat("gridwidth",&gridwidth)) gridwidth =axeswidth;
if (is_curve) {
if ((ncurvewidth=countparval("curvewidth"))<curve) {
curvewidth=ealloc1float(curve);
if (!getparfloat("curvewidth",curvewidth)) {
curvewidth[0]=axeswidth;
ncurvewidth=1;
}
for (i=ncurvewidth; i<curve; i++)
curvewidth[i]=curvewidth[ncurvewidth-1];
} else {
curvewidth=ealloc1float(ncurvewidth);
getparfloat("curvewidth",curvewidth);
}
if ((ncurvedash=countparval("curvedash"))<curve) {
curvedash=ealloc1int(curve);
if (!getparint("curvedash",curvedash)) {
curvedash[0]=0;
ncurvedash=1;
}
for (i=ncurvedash; i<curve; i++)
curvedash[i]=curvedash[ncurvedash-1];
} else {
curvedash=ealloc1int(ncurvedash);
getparint("curvedash",curvedash);
}
}
getparstring("style",&styles);
if (STREQ("normal",styles))
style = NORMAL;
else
style = SEISMIC;
/* Get or calc legend parameters */
/* Legend min and max: Calc from data read in */
if (legend) {
for (lz=0;lz<nz;lz++) {
lmin=FMIN(lmin,z[lz]);
lmax=FMAX(lmax,z[lz]);
}
if (verbose==2) warn("lmin=%g lmax=%g",lmin,lmax);
}
if (legend) {
lbeg = lmin; if (getparfloat("lbeg",&lbeg)) lbegsup=1;
lend = lmax; if (getparfloat("lend",&lend)) lendsup=1;
/* Change wclip,bclip to be inside legend range */
wclip = FMAX(lbeg,wclip); /* [wclip,bclip] has to be in [lbeg,lend] */
bclip = FMIN(lend,bclip);
if (lbegsup!=1) { /* Add white and black areas to show possible clipping */
float rangeperc=(bclip-wclip)/20.;
lbeg=wclip-rangeperc;
}
if (lendsup!=1) {
float rangeperc=(bclip-wclip)/20.;
lend=bclip+rangeperc;
}
lfnum = lmin; getparfloat("lfnum",&lfnum);
getparstring("lstyle",&lstyles);
if (STREQ("vertright",lstyles))
lstyle = VERTRIGHT;
else if (STREQ("horibottom",lstyles))
lstyle = HORIBOTTOM;
/* legend dimensions (BEREND), Schoenfelder */
lwidth = 0.1 ;lheight = height/2;
if (lstyle==HORIBOTTOM) {
lwidth=width/1.2 ;lheight = 0.24;
}
getparfloat("lwidth",&lwidth);
getparfloat("lheight",&lheight);
lx=.8;ly = ybox+(height-lheight)/2;
if (lstyle==VERTRIGHT) {
lx=xbox+width+0.1;
} else if (lstyle==HORIBOTTOM) {
lx=xbox+(width-lwidth)/2.0;ly = 1.0;
}
getparfloat("lx",&lx);
if (lnice==1) lx = 8; /* c liner */
getparfloat("ly",&ly);
getparstring("lgrid",&lgrids);
if (STREQ("dot",lgrids))
ugrid = DOT;
else if (STREQ("dash",lgrids))
ugrid = DASH;
else if (STREQ("solid",lgrids))
ugrid = SOLID;
else
ugrid = NONE;
}
/* adjust x1beg and x1end to fall on sampled values */
/* This will not allow to display an area greater than the data supplied */
i1beg = NINT((x1beg-f1)/d1);
i1beg = MAX(0,MIN(n1-1,i1beg));
x1beg = f1+i1beg*d1;
i1end = NINT((x1end-f1)/d1);
i1end = MAX(0,MIN(n1-1,i1end));
x1end = f1+i1end*d1;
/* adjust x2beg and x2end to fall on sampled values */
i2beg = NINT((x2beg-f2)/d2);
i2beg = MAX(0,MIN(n2-1,i2beg));
x2beg = f2+i2beg*d2;
i2end = NINT((x2end-f2)/d2);
i2end = MAX(0,MIN(n2-1,i2end));
x2end = f2+i2end*d2;
if (legend) {
/* Make legend color values */
int lll=0,lcount,perc5=13,ilbeg,ilend; /* color scale */
if (lbegsup!=1) {
ln+=perc5; /* white area */
}
if (lendsup!=1) {
ln+=perc5; /* black area */
}
data_legend = ealloc1(ln,sizeof(char));
if (lbegsup!=1) {
for (lll=0;lll<perc5;lll++) data_legend[lll]=(char) 255; /* white area */
}
for (lcount=255;lcount>=0;lcount--,lll++) data_legend[lll]=(char) lcount;
if (lendsup!=1) {
for (;lll<ln;lll++) data_legend[lll]=(char) 0; /* black area */
}
lf=lbeg;ld=(lend-lbeg)/(ln-1);
if (!(getparfloat("ldnum",&ldnum))) ldnum=0.0;
/* adjust lbeg and lend to fall on sampled values */
ilbeg = NINT((lbeg-lf)/ld);
ilbeg = MAX(0,MIN(ln-1,ilbeg));
lbeg = lf+ilbeg*ld;
ilend = NINT((lend-lf)/ld);
ilend = MAX(0,MIN(ln-1,ilend));
lend = lf+ilend*ld;
}
/* allocate space for image bytes */
n1c = 1+abs(i1end-i1beg);
n2c = 1+abs(i2end-i2beg);
cz = ealloc1(n1c*n2c,sizeof(char));
/* convert data to be imaged into unsigned characters */
zscale = (wclip!=bclip)?255.0/(wclip-bclip):1.0e10;
zoffset = -bclip*zscale;
i1step = (i1end>i1beg)?1:-1;
i2step = (i2end>i2beg)?1:-1;
czp = cz;
for (i1c=0,i1=i1beg; i1c<n1c; i1c++,i1+=i1step) {
for (i2c=0,i2=i2beg; i2c<n2c; i2c++,i2+=i2step) {
zi = zoffset+z[i1+i2*n1]*zscale;
if (zi<0.0) zi = 0.0;
if (zi>255.0) zi = 255.0;
*czp++ = (unsigned char)zi;
}
}
free1float(z);
/* determine sampling after scaling */
n1s = MAX(1,NINT(1+(n1c-1)*d1/d1s));
d1s = (n1s>1)?d1*(n1c-1)/(n1s-1):d1;
n2s = MAX(1,NINT(1+(n2c-1)*d2/d2s));
d2s = (n2s>1)?d2*(n2c-1)/(n2s-1):d2;
/* if necessary, interpolate to scaled sampling intervals */
if (n1s!=n1c || n2s!=n2c) {
sz = ealloc1(n1s*n2s,sizeof(char));
intl2b(n2c,d2,0.0,n1c,d1,0.0,cz,n2s,d2s,0.0,n1s,d1s,0.0,sz); /* Interpol array */
free1(cz);
} else {
sz = cz;
}
/* determine axes pads */
p1beg = (x1end>x1beg)?-fabs(d1s)/2:fabs(d1s)/2;
p1end = (x1end>x1beg)?fabs(d1s)/2:-fabs(d1s)/2;
p2beg = (x2end>x2beg)?-fabs(d2s)/2:fabs(d2s)/2;
p2end = (x2end>x2beg)?fabs(d2s)/2:-fabs(d2s)/2;
/* convert axes box parameters from inches to points */
xbox *= 72.0;
ybox *= 72.0;
width *= 72.0;
height *= 72.0;
if (legend) {
lx *= 72.0; /* Schoenfelder */
ly *= 72.0; /* Schoenfelder */
lwidth *= 72.0; /* Schoenfelder */
lheight *= 72.0; /* Schoenfelder */
}
/* set bounding box */
psAxesBBox(
xbox,ybox,width,height,
labelfont,labelsize,
titlefont,titlesize,
style,bbox);
if (legend) {
psLegendBBox( /* Space for legend Schoenfelder */
lx,ly,lwidth,lheight,
labelfont,labelsize,
lstyle,lbbox);
/* Include space for legend Schoenfelder */
bbox[0]=MIN(bbox[0],lbbox[0]);
bbox[1]=MIN(bbox[1],lbbox[1]);
bbox[2]=MAX(bbox[2],lbbox[2]);
bbox[3]=MAX(bbox[3],lbbox[3]);
}
boundingbox(bbox[0],bbox[1],bbox[2],bbox[3]);
/* begin PostScript */
begineps();
/* save graphics state */
gsave();
/* translate coordinate system by box offset */
translate(xbox,ybox);
/* determine image matrix */
if (style==NORMAL) {
matrix[0] = 0; matrix[1] = n1s; matrix[2] = n2s;
matrix[3] = 0; matrix[4] = 0; matrix[5] = 0;
} else {
matrix[0] = n2s; matrix[1] = 0; matrix[2] = 0;
matrix[3] = -n1s; matrix[4] = 0; matrix[5] = n1s;
}
scale(width,height);
/* draw the image (before axes so grid lines are visible) */
drawimage(hls,colors,n2s,n1s,bps,matrix,sz);
/***************************/
/* main image has been drawn, restore graphics state */
grestore();
/* *********************************/
/* draw the colorbar (before axes so grid lines are visible) Schoenfelder*/
if (legend) {
gsave();
translate(lx,ly);
scale(lwidth,lheight);
if ((lstyle==VERTLEFT) || (lstyle==VERTRIGHT)) {
labmatrix[0] = 1; labmatrix[1] = 0; labmatrix[2] = 0;
labmatrix[3] = ln; labmatrix[4] = 0; labmatrix[5] = 0;
drawimage(hls,colors,1,ln,bps,labmatrix,data_legend);
} else {
labmatrix[0] = -1; labmatrix[1] = 0; labmatrix[2] = 0;
labmatrix[3] = ln; labmatrix[4] = 0; labmatrix[5] = 0;
rotate(-90);
drawimage(hls,colors,1,ln,bps,labmatrix,data_legend);
rotate(90);
}
grestore();
}
/* draw curve */
for (i=0; i<curve; i++) {
gsave();
psDrawCurve(
xbox,ybox,width,height,
x1beg,x1end,p1beg,p1end,
x2beg,x2end,p2beg,p2end,
x1curve[i],x2curve[i],npair[i],
curvecolor[i],curvewidth[i],curvedash[i],style);
grestore();
}
gsave();
/* draw axes and title */
psAxesBox(
xbox,ybox,width,height,
x1beg,x1end,p1beg,p1end,
d1num,f1num,n1tic,grid1,label1,
x2beg,x2end,p2beg,p2end,
d2num,f2num,n2tic,grid2,label2,
labelfont,labelsize,
title,titlefont,titlesize,
titlecolor,axescolor,gridcolor,
ticwidth,axeswidth,gridwidth,
style);
/* restore graphics state */
grestore();
/* draw axes and title for legend Schoenfelder*/
if (legend) {
float lpbeg,lpend;
int lntic=1;
gsave();
lpbeg = 0.0; /*(lend>lbeg)?-fabs(d1s)/2:fabs(d1s)/2;*/
lpend = 0.0; /*(lend>lbeg)?fabs(d1s)/2:-fabs(d1s)/2;*/
psLegendBox(
lx,ly,lwidth,lheight,
lbeg,lend,lpbeg,lpend,
ldnum,lf,lntic,ugrid,units,
labelfont,labelsize,
axescolor,gridcolor,
lstyle);
grestore();
}
/* end PostScript */
showpage();
endeps();
if (curve) {
free1int(npair);
for (i=0; i<curve; i++) {
free1float(x1curve[i]);
free1float(x2curve[i]);
}
free1float(curvewidth);
free1int(curvedash);
free((void**)x1curve);
free((void**)x2curve);
free((void**)curvefile);
free((void**)curvecolor);
}
return 0;
}
