main()
{
int n,nc,nr,i;
float *rz=(float*)cz;
float cpucc,cpurc;
for (nc=npfa(NMIN),nr=npfar(nc);
nc<NMAX && nr<NMAX;
nc=npfa(nc+1),nr=npfar(nc)) {
for (i=0; i<nc*nc; i++)
cz[i] = cmplx(0.0,0.0);
cpucc = cpusec();
pfa2cc(1,1,nc,nc,cz);
cpucc = cpusec()-cpucc;
for (i=0; i<nr*nr; i++)
rz[i] = 0.0;
cpurc = cpusec();
pfa2rc(1,1,nr,nr,rz,cz);
cpurc = cpusec()-cpurc;
printf("nc,nr,cc,rc,cc/rc = %d %d %f %f %f\n",
nc,nr,cpucc,cpurc,cpucc/cpurc);
}
}
void rcm_fft(REAL *data, complex *cdata, int n1, int n2, int ldr, int ldc, int sign)
{
int j, i;
double *datft;
if (NINT(pow(2.0, (double)NINT(log((double)n1)/log(2.0)))) != n1) {
if (npfar(n1) == n1) {
if (ldr == n1 && ldc == n2) {
pfa2rc(sign, 1, n1, n2, data, cdata);
}
else {
for (i = 0; i < n2; i++) {
pfarc(sign, n1, &data[i*ldr], &cdata[i*ldc]);
}
}
}
else {
for (i = 0; i < n2; i++) {
rcdft(&data[i*ldr], &cdata[i*ldc], n1, sign);
}
}
}
else {
datft = (double *)malloc(n1*sizeof(double));
if (datft == NULL) fprintf(stderr,"rcm_fft: memory allocation error\n");
for (i = 0; i < n2; i++) {
for (j = 0; j < n1; j++) datft[j] = (double)data[i*ldr+j];
realfft(n1, datft);
cdata[i*ldc].i = 0.0;
for (j = 0; j < n1/2; j++) {
cdata[i*ldc+j].r = (REAL)datft[j];
cdata[i*ldc+j+1].i = sign*(REAL)datft[n1-j-1];
}
cdata[i*ldc+n1/2].r = (REAL)datft[n1/2];
cdata[i*ldc+n1/2].i = 0.0;
}
free(datft);
}
return;
}
int
main(int argc, char **argv)
{
int nx1,nx2; /* numbers of samples */
int ix1, ix2; /* sample indices */
float a1,a2; /* filter dimensions */
float pi; /* pi number */
float vmax; /* maximum value of the data */
float vfmax; /* scale factor after filtering */
float c1,c2;
float **v=NULL; /* array of velocities */
float *k1=NULL,*k2=NULL; /* wavenumber arrays */
float *kfilt1=NULL,*kfilt2=NULL;/* intermediate filter arrays */
float dk1,dk2; /* wavenumber interval */
float **kfilter=NULL; /* array of filter values */
int nx1fft,nx2fft; /* dimensions after padding for FFT */
int nK1,nK2; /* transform dimension */
int ik1,ik2; /* wavenumber indices */
register complex **ct=NULL; /* complex FFT workspace */
register float **rt=NULL; /* float FFT workspace */
FILE *tracefp=NULL; /* temp file to hold traces */
FILE *hfp=NULL; /* temp file to hold trace headers */
/* hook up getpar to handle the parameters */
initargs(argc, argv);
requestdoc(1);
/* Get parameters from command line */
if (!getparfloat("a1",&a1)) a1=0.;
if (!getparfloat("a2",&a2)) a2=0.;
/* Get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
if (tr.trid != TRID_DEPTH) warn("tr.trid=%d",tr.trid);
nx1=tr.ns;
/* Store traces in tmpfile while getting a count */
tracefp=etmpfile();
hfp=etmpfile();
nx2=0;
do {
++nx2;
efwrite(&tr,HDRBYTES, 1, hfp);
efwrite(tr.data, FSIZE, nx1, tracefp);
} while (gettr(&tr));
/* Determine number of wavenumbers in K1 and K2 */
nx1fft=npfaro(nx1, LOOKFAC*nx1);
nx2fft=npfa(nx2);
if (nx1fft >=SU_NFLTS || nx1fft >= PFA_MAX)
err("Padded nx1=%d--too big",nx1fft);
if (nx2fft >= PFA_MAX)
err("Padded nx2=%d--too big",nx2fft);
/* Determine number of wavenumbers in K1 and K2 */
nK1=nx1fft/2 + 1;
nK2=nx2fft/2 + 1;
/* Allocate space */
v=alloc2float(nx1,nx2);
rt=alloc2float(nx1fft,nx2fft);
ct=alloc2complex(nK1,nx2fft);
kfilter=alloc2float(nx1fft,nx2fft);
k1=alloc1float(nK1);
k2=alloc1float(nK2);
kfilt1= alloc1float(nK1);
kfilt2= alloc1float(nK2);
/* Zero all arrays */
memset((void *) rt[0], 0, nx1fft*nx2fft*FSIZE);
memset((void *) kfilter[0], 0, nx1fft*nx2fft*FSIZE);
memset((void *) ct[0], 0, nK1*nx2fft*sizeof(complex));
memset((void *) k1, 0, nK1*FSIZE);
memset((void *) k2, 0, nK2*FSIZE);
memset((void *) kfilt1, 0, nK1*FSIZE);
memset((void *) kfilt2, 0, nK2*FSIZE);
/* Determine wavenumber arrays for the filter */
pi=PI;
dk1=2*pi / nx1fft;
dk2=2*pi / nx2fft;
for (ik1=0; ik1<nK1; ++ik1) {
c1=a1*ik1*dk1/ 2;
kfilt1[ik1]= exp(-pow(c1,2));
}
for (ik2=0; ik2<nK2; ++ik2) {
c2= a2*ik2*dk2/2;
kfilt2[ik2]= exp(-pow(c2,2));
}
/* Build Gaussian filter */
/* positive k1, positive k2 */
for (ik2=0; ik2<nK2; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
kfilter[ik2][ik1]=kfilt2[ik2]*kfilt1[ik1];
}
}
/* positive k1, negative k2 */
for (ik2=nK2; ik2<nx2fft; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
kfilter[ik2][ik1]=kfilt2[nx2fft-ik2]*kfilt1[ik1];
}
}
/* Read velocities from temp file and determine maximum */
rewind(tracefp);
fread(v[0],sizeof(float),nx2*nx1,tracefp);
vmax=v[0][0];
for (ix2=0; ix2<nx2; ++ix2) {
for (ix1=0; ix1<nx1; ++ix1) {
vmax=MAX(vmax,v[ix2][ix1]);
}
}
/* Load data into FFT arrays */
rewind(tracefp);
for (ix2=0; ix2<nx2; ++ix2) {
efread(rt[ix2], FSIZE, nx1, tracefp);
}
/* Fourier transform dimension 1 */
pfa2rc(-1,1,nx1fft,nx2,rt[0],ct[0]);
/* Fourier transform dimension 2 */
pfa2cc(-1,2,nK1,nx2fft,ct[0]);
/* Apply filter to the data */
for (ik2=0; ik2<nx2fft; ++ik2) {
for (ik1=0; ik1<nK1; ++ik1) {
ct[ik2][ik1]=crmul(ct[ik2][ik1], kfilter[ik2][ik1]) ;
}
}
/* Inverse Fourier transformation dimension 2 */
pfa2cc(1,2,nK1,nx2fft,ct[0]);
/* Inverse Fourier transformation dimension 1 */
pfa2cr(1,1,nx1fft,nx2,ct[0],rt[0]);
/* Find maximum of filtered data */
vfmax=rt[0][0];
for (ix2=0; ix2<nx2; ++ix2) {
for (ix1=0; ix1<nx1; ++ix1) {
vfmax=MAX(vfmax,rt[ix2][ix1]);
}
}
/* Rescale and output filtered data */
erewind(hfp);
for (ix2=0; ix2<nx2; ++ix2) {
efread(&tr, HDRBYTES, 1, hfp);
for (ix1=0; ix1<nx1; ++ix1)
tr.data[ix1]=(rt[ix2][ix1]) * vmax / vfmax;
puttr(&tr);
}
efclose(hfp);
return(CWP_Exit());
}
int main (int argc, char **argv)
{
int nt,it,np,ntau,itau,nx,ix,nk,nkmax,ik,
ntfft,nxfft,nv,trans,norm,conv,verbose;
float dt,dx,dpx,k,dk,kscl,t,*tt,*vt,*tmig,*vmig,
(*vsind)[4],**ptx,**divcor;
complex **ptk;
char *vfile="";
FILE *hfp,*tfp;
/* hook up getpar */
initargs(argc,argv);
requestdoc(1);
/* get information from the first header */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
dt = tr.dt/1000000.0;
/* get parameters */
if (!getparfloat("dxcdp",&dx)) err("dxcdp required");
if (!getparint("np",&np)) np=50;
if (!getparint("trans",&trans)) trans=0;
if (!getparint("norm",&norm)) norm=1;
if (!getparint("conv",&conv)) conv=0;
if (!getparint("verbose",&verbose)) verbose=0;
/* get velocity function */
vt=ealloc1float(nt);
tt=ealloc1float(nt);
for (it=0; it<nt; it++)
tt[it]=it*dt;
if (!getparstring ("vfile",&vfile)){
ntau = countparval("tmig");
if (ntau==0) ntau=1;
tmig = ealloc1float(ntau);
if (!getparfloat("tmig",tmig)) tmig[0] = 0.0;
nv = countparval("vmig");
if (nv==0) nv=1;
if (nv!=ntau)
err("number of tmig and vmig must be equal");
vmig = ealloc1float(nv);
if (!getparfloat("vmig",vmig)) vmig[0] = 1500.0;
for (itau=1; itau<ntau; itau++)
if (tmig[itau]<=tmig[itau-1])
err("tmig must increase monotonically");
for (it=0,t=0.0; it<nt; ++it,t+=dt)
intlin(ntau,tmig,vmig,vmig[0],vmig[ntau-1],
1,&t,&vt[it]);
if (ntau!=nt){
vsind = (float (*)[4])ealloc1float(ntau*4);
cmonot(ntau,tmig,vmig,vsind);
intcub(0,ntau,tmig,vsind,nt,tt,vt);
}
} else{
if (fread(vt,sizeof(float),nt,fopen(vfile,"r"))!=nt)
err("Not %d velocities in file %s",nt,vfile);
}
/* copy traces and headers to temporary files */
tfp = tmpfile();
hfp = tmpfile();
nx = 0;
do {
nx++;
fwrite(&tr,HDRBYTES,1,hfp);
fwrite(tr.data,sizeof(float),nt,tfp);
} while(gettr(&tr));
fseek(hfp,0L,SEEK_SET);
fseek(tfp,0L,SEEK_SET);
if (verbose) fprintf(stderr,"\t%d traces input\n",nx);
/* determine wavenumber and frequency sampling */
nxfft = npfar(nx);
ntfft = npfa(nt);
nk = nxfft/2+1;
dx *= 0.001;
dk = 2.0*PI/(nxfft*dx);
/* allocate space for Fourier transform */
ptk = ealloc2complex(nt,nk);
ptx = ealloc1(nxfft,sizeof(float*));
for (ix=0; ix<nxfft; ++ix)
ptx[ix] = (float*)ptk[0]+ix*nt;
/* allocate space for divergence correction */
divcor=ealloc2float(nt,np);
/* build table of divergence corrections */
divcortable(nt,np,dt,tt,vt,divcor,trans,norm);
/* apply conventional correction if required */
if (conv==1){
for (ix=0; ix<nx; ++ix){
efread(ptx[ix],sizeof(float),nt,tfp);
for (it=0; it<nt; ++it)
ptx[ix][it] *= divcor[0][it];
}
} else {
/* read and apply fft scaling to traces */
kscl = 1.0/nxfft;
for (ix=0; ix<nx; ++ix) {
efread(ptx[ix],sizeof(float),nt,tfp);
for (it=0; it<nt; ++it)
ptx[ix][it] *= kscl;
}
/* pad with zeros */
for (ix=nx; ix<nxfft; ++ix)
for (it=0; it<nt; ++it)
ptx[ix][it] = 0.0;
/* Fourier transform ptx(t,x) to ptk(t,k) */
pfa2rc(-1,2,nt,nxfft,ptx[0],ptk[0]);
if (verbose) fprintf(stderr,"\tFourier transform done\n");
/* define relevant k range */
nkmax = MIN(nk,NINT(PI/dt/vt[0]/dk));
dpx = 1.0/(np-1)/vt[0];
fprintf(stderr,
"nkmax %d nk %d dk %f dpx %f \n",nkmax,nk,dk,dpx);
/* special case k=0 */
for (it=0; it<nt; it++){
ptk[0][it].r *= divcor[0][it];
ptk[0][it].i *= divcor[0][it];
}
/* loop over wavenumbers */
for (ik=1,k=dk; ik<nkmax; ++ik,k+=dk){
/* report */
if (verbose && ik%(nkmax/10>0?nkmax/10:1)==0)
fprintf(stderr,"\t%d of %d wavenumbers done\n",
ik,nkmax);
/* dip filter divergence correction */
dipfilt(k,dpx,dt,np,ntfft,nt,divcor,ptk[ik],ptk[ik]);
}
/* Fourier transform p(t,k) to p(t,x) */
pfa2cr(1,2,nt,nxfft,ptk[0],ptx[0]);
if (verbose)
fprintf(stderr,"\tinverse Fourier transform done\n");
} /* end else dipdivcor */
/* output migrated traces with headers */
for (ix=0; ix<nx; ++ix) {
efread(&tr,HDRBYTES,1,hfp);
memcpy((void *) tr.data,
(const void *) ptx[ix], nt*sizeof(float));
puttr(&tr);
}
return EXIT_SUCCESS;
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int ntau; /* number of migrated time samples */
int nx; /* number of midpoints */
int ik,ix,it,itau,itmig;/* loop counters */
int nxfft; /* fft size */
int nk; /* number of wave numbers */
int ntmig,nvmig;
float dt; /* time sampling interval */
float ft; /* first time sample */
float dtau; /* migrated time sampling interval */
float ftau; /* first migrated time value */
float dk; /* wave number sampling interval */
float fk; /* first wave number */
float Q, ceil; /* quality factor, ceiling of amplitude */
float t,k; /* time,wave number */
float *tmig, *vmig; /* arrays of time, interval velocities */
float dx; /* spatial sampling interval */
float *vt; /* velocity v(t) */
float **p,**q; /* input, output data */
complex **cp,**cq; /* complex input,output */
char *vfile=""; /* name of file containing velocities */
int verbose=0; /* flag for echoing info */
char *tmpdir; /* directory path for tmp files */
cwp_Bool istmpdir=cwp_false;/* true for user-given path */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
/* get optional parameters */
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparint("ntau",&ntau)) ntau = nt; CHECK_NT("ntau",ntau);
if (!getparfloat("dtau",&dtau)) dtau = dt;
if (!getparfloat("ftau",&ftau)) ftau = ft;
if (!getparfloat("Q",&Q)) Q = 1.0e6;
if (!getparfloat("ceil",&ceil)) ceil = 1.0e6;
if (verbose)warn("Q=%f ceil=%f",Q,ceil);
if (!getparint("verbose", &verbose)) verbose = 0;
/* Look for user-supplied tmpdir */
if (!getparstring("tmpdir",&tmpdir) &&
!(tmpdir = getenv("CWP_TMPDIR"))) tmpdir="";
if (!STREQ(tmpdir, "") && access(tmpdir, WRITE_OK))
err("you can't write in %s (or it doesn't exist)", tmpdir);
/* store traces and headers in tempfiles while getting a count */
if (STREQ(tmpdir,"")) {
tracefp = etmpfile();
headerfp = etmpfile();
if (verbose) warn("using tmpfile() call");
} else { /* user-supplied tmpdir */
char directory[BUFSIZ];
strcpy(directory, tmpdir);
strcpy(tracefile, temporary_filename(directory));
strcpy(headerfile, temporary_filename(directory));
/* Trap signals so can remove temp files */
signal(SIGINT, (void (*) (int)) closefiles);
signal(SIGQUIT, (void (*) (int)) closefiles);
signal(SIGHUP, (void (*) (int)) closefiles);
signal(SIGTERM, (void (*) (int)) closefiles);
tracefp = efopen(tracefile, "w+");
headerfp = efopen(headerfile, "w+");
istmpdir=cwp_true;
if (verbose) warn("putting temporary files in %s", directory);
}
nx = 0;
do {
++nx;
efwrite(&tr,HDRBYTES,1,headerfp);
efwrite(tr.data, FSIZE, nt, tracefp);
} while (gettr(&tr));
erewind(tracefp);
erewind(headerfp);
/* determine wavenumber sampling (for real to complex FFT) */
nxfft = npfar(nx);
nk = nxfft/2+1;
dk = 2.0*PI/(nxfft*dx);
fk = 0.0;
/* allocate space */
p = alloc2float(nt,nxfft);
q = alloc2float(ntau,nxfft);
cp = alloc2complex(nt,nk);
cq = alloc2complex(ntau,nk);
/* load traces into the zero-offset array and close tmpfile */
efread(*p, FSIZE, nt*nx, tracefp);
efclose(tracefp);
/* determine velocity function v(t) */
vt = ealloc1float(ntau);
if (!getparstring("vfile",&vfile)) {
ntmig = countparval("tmig");
if (ntmig==0) ntmig = 1;
tmig = ealloc1float(ntmig);
if (!getparfloat("tmig",tmig)) tmig[0] = 0.0;
nvmig = countparval("vmig");
if (nvmig==0) nvmig = 1;
if (nvmig!=ntmig) err("number of tmig and vmig must be equal");
vmig = ealloc1float(nvmig);
if (!getparfloat("vmig",vmig)) vmig[0] = 1500.0;
for (itmig=1; itmig<ntmig; ++itmig)
if (tmig[itmig]<=tmig[itmig-1])
err("tmig must increase monotonically");
for (it=0,t=0.0; it<ntau; ++it,t+=dt)
intlin(ntmig,tmig,vmig,vmig[0],vmig[ntmig-1],
1,&t,&vt[it]);
} else {
if (fread(vt,sizeof(float),nt,fopen(vfile,"r"))!=nt)
err("cannot read %d velocities from file %s",nt,vfile);
}
checkpars();
/* pad with zeros and Fourier transform x to k */
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<nt; it++)
p[ix][it] = 0.0;
pfa2rc(-1,2,nt,nxfft,p[0],cp[0]);
/* migrate each wavenumber */
for (ik=0,k=fk; ik<nk; ik++,k+=dk)
gazdagvt(k,nt,dt,ft,ntau,dtau,ftau,vt,cp[ik],cq[ik], Q, ceil);
/* Fourier transform k to x (including FFT scaling) */
pfa2cr(1,2,ntau,nxfft,cq[0],q[0]);
for (ix=0; ix<nx; ix++)
for (itau=0; itau<ntau; itau++)
q[ix][itau] /= nxfft;
/* restore header fields and write output */
for (ix=0; ix<nx; ++ix) {
efread(&tr,HDRBYTES,1,headerfp);
tr.ns = ntau ;
tr.dt = dtau * 1000000.0 ;
tr.delrt = ftau * 1000.0 ;
memcpy( (void *) tr.data, (const void *) q[ix],ntau*FSIZE);
puttr(&tr);
}
/* Clean up */
efclose(headerfp);
if (istmpdir) eremove(headerfile);
if (istmpdir) eremove(tracefile);
return(CWP_Exit());
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
/*int nxshot_orig;*/ /* first value of nxshot */
int iz,iw,ix,it; /* loop counters */
int igx; /* integerized gx value */
int ntfft; /* fft size */
int nw,truenw; /* number of wave numbers */
int dip=79; /* dip angle */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
/* float oldgxmin; */ /* old gx position */
/* float oldgxmax; */ /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int oldisx=0; /* old value of source index */
int oldigx=0; /* old value of integerized gx value */
int ix1,ix2,ix3,ixshot; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
float w; /* frequency */
float dx; /* spatial sampling interval */
float **p=NULL; /* input data */
float **cresult=NULL; /* output result */
float v1; /* average velocity */
double kz2;
float **v=NULL,**vp=NULL;/* pointers for the velocity profile */
complex cshift2;
complex *wlsp=NULL; /* complex input,output */
complex **cp=NULL; /* ... */
complex **cp1=NULL; /* ... */
complex **cq=NULL; /* ... */
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile",&vfile);
MUSTGETPARINT("nxshot",&nxshot);
/* get optional parameters */
if (!getparfloat("fmax",&fmax)) fmax = 25.0;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=79;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocating space */
cresult = alloc2float(nz,nxo);
vp = alloc2float(nxo,nz);
/* load velicoty file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
/* save value of nxshot */
/* nxshot_orig=nxshot; */
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
if(verbose) warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
if(verbose) warn("tr.d2 not set, assuming d2=1.0");
}
}
checkpars();
oldisx=0;
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated*/
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated*/
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if(verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
/*
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
*/
/* New code: we put in the wavelet in a centered fashion */
for(it=0;it<ntw;it++)
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
igx=0;
oldigx=0;
oldsx=sx;
oldgx=gx;
/* oldgxmax=gxmax; */
/* oldgxmin=gxmin; */
do { /* begin looping over traces within a shot gather */
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
/* get sx and gx */
get_sx_gx(&sx,&gx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
igx = NINT(gx/dx);
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
++nx;
} while(gettr(&tr) && sx==oldsx);
isx=NINT(oldsx/dx);
ixshot=isx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=NINT(oldsx/dx);
ix2=NINT(gxmin/dx);
ix3=NINT(gxmax/dx);
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ++ix) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)) {
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];
}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* loops over depth */
for(iz=0; iz<nz; ++iz) {
/* the imaging condition */
for(ix=0; ix<nx; ++ix){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the average velocity */
v1=0.0;
for(ix=0;ix<nx;++ix)
v1+=v[iz][ix]/nx;
/* compute time-invariant wavefield */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw) {
kz2=-(1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
/* wave-propagation using finite-difference method */
fdmig(cp, nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
fdmig(cp1,nx, nw,v[iz],fw,dw,dz,dx,dt,dip);
/* apply thin lens term here */
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
kz2=-(1.0/v[iz][ix]-1.0/v1)*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cp[iw][ix],cshift2);
cp1[iw][ix]=cmul(cp1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
int main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx,nxshot; /* number of midpoints,shotgathers, the folds in a shot
gather */
int flag=1; /*flag to use ft or meter as the unit*/
int dip=65; /*maximum dip angle to migrate*/
int iz,iw,ix,it,oldsx; /* loop counters*/
int ntfft; /* fft size*/
int nw; /* number of wave numbers */
int mytid,tids[NNTASKS],msgtype,rc,i;/*variable for PVM function*/
int nw1,task;
int lpad=9999,rpad=9999; /*zero-traces padded on left and right sides*/
float f1,f2,f3,f4; /*frequencies to build the Hamming window*/
int nf1,nf2,nf3,nf4; /*the index for above frequencies*/
int NTASKS=0; /*number of slave tasks to start*/
char cpu_name[NNTASKS][80]; /*strings to store the computers' name*/
int flag_cpu=0; /*flag to control if using NTASKS variable*/
float sx,gxmin,gxmax; /*location of geophone and receivers*/
int isx,nxo,ifx=0; /*index for geophone and receivers*/
int ix1,ix2,ix3,il,ir; /*dummy index*/
float *wl,*wtmp; /*pointers for the souce function*/
float Fmax=25; /*peak frequency to make the Ricker wavelet*/
int ntw,truenw; /*number of frequencies to be migrated*/
float dt=0.004,dz; /*time, depth sampling interval*/
float ft; /*first time sample*/
float dw; /*frequency sampling interval*/
float fw; /*first frequency*/
float dx; /*spatial sampling interval*/
float **p,**cresult,**result_tmp; /* input, output data*/
float **v; /*double pointer direct to velocity structure*/
complex *wlsp,**cp,**cq,**cq1; /*pointers for internal usage*/
char *vfile=""; /* name of file containing velocities */
char *cpufile=""; /* name of file containing CPU name */
FILE *vfp,*cpu_fp;
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get optional parameters */
if (!getparfloat("ft",&ft)) ft = 0.0;
if (!getparint("nz",&nz)) err("nz must be specified");
if (!getparfloat("dz",&dz)) err("dz must be specified");
if (!getparstring("vfile", &vfile)) err("vfile must be specified");
if (!getparint("nxo",&nxo)) err("nxo must be specified");
if (!getparint("nxshot",&nxshot)) err("nshot must be specified");
if (!getparfloat("Fmax",&Fmax)) err("Fmax must be specified");
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("flag",&flag)) flag=1;
if (!getparint("dip",&dip)) dip=65;
if (getparstring("cpufile", &cpufile)){
cpu_fp=fopen(cpufile,"r");
NTASKS=0;
while(!feof(cpu_fp)){
fscanf(cpu_fp,"%s",cpu_name[NTASKS]);
NTASKS++;
}
NTASKS-=1;
flag_cpu=1;
}
else /*if cpufile not specified, the use NTASKS*/
if (!getparint("NTASKS",&NTASKS)) err("No CPUfile specified, NTASKS must be specified");
/*allocate space for the velocity profile*/
tshot=nxshot;
v=alloc2float(nxo,nz);
/*load velicoty file*/
vfp=efopen(vfile,"r");
efread(v[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/*PVM communication starts here*/
mytid=pvm_mytid(); /*get my pid*/
task=NTASKS;
warn("\n %d",task);
rc=0;
/*spawn slave processes here*/
if(!flag_cpu){
rc=pvm_spawn(child,NULL,PvmTaskDefault,"",task,tids);
}
else{
for(i=0;i<NTASKS;i++){
rc+=pvm_spawn(child,NULL,PvmTaskHost,cpu_name[i],1,&tids[i]);
}
}
/*show the pid of slaves if*/
for(i=0;i<NTASKS;i++){
if(tids[i]<0)warn("\n %d",tids[i]);
else warn("\nt%x\t",tids[i]);
}
/*if not all the slaves start, then quit*/
if(rc<NTASKS){ warn("error");pvm_exit();exit(1);}
/*broadcast the global parameters nxo,nz,dip to all slaves*/
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&nxo,1,1);
rc=pvm_pkint(&nz,1,1);
rc=pvm_pkint(&dip,1,1);
msgtype=PARA_MSGTYPE;
task=NTASKS;
rc=pvm_mcast(tids,task,msgtype);
/*broadcast the velocity profile to all slaves*/
pvm_initsend(PvmDataDefault);
rc=pvm_pkfloat(v[0],nxo*nz,1);
msgtype=VEL_MSGTYPE;
rc=pvm_mcast(tids,task,msgtype);
/*free the space for velocity profile*/
free2float(v);
/*loop over shot gathers begin here*/
loop:
/* get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
sx=tr.sx;
isx=sx/dx;
gxmin=gxmax=tr.gx;
oldsx=sx;
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/*compute the index of the frequency to be migrated*/
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/*the number of frequency to migrated*/
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
fw=0.0;
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/*generate the Ricker wavelet*/
wtmp=ricker(Fmax,dt,&ntw);
for(it=0;it<ntfft;it++)
wl[it]=0.0;
for(it=0;it<ntw-12;it++)
wl[it]=wtmp[it+12];
free1float( wtmp);
/*Fourier transform the Ricker wavelet to frequency domain*/
pfarc(-1,ntfft,wl,wlsp);
/* allocate space */
p = alloc2float(ntfft,nxo);
cp = alloc2complex(nw,nxo);
for (ix=0; ix<nxo; ix++)
for (it=0; it<ntfft; it++)
p[ix][it] = 0.0;
/*read in a single shot gather*/
ix=tr.gx/dx;
memcpy( (void *) p[ix], (const void *) tr.data,nt*FSIZE);
nx = 0;
while(gettr(&tr)){
int igx;
if(tr.sx!=oldsx){ fseek(stdin,(long)(-240-nt*4),SEEK_CUR); break;}
igx=tr.gx/dx;
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
if(gxmin>tr.gx)gxmin=tr.gx;
if(gxmax<tr.gx)gxmax=tr.gx;
nx++;
oldsx=tr.sx;
}
warn("\nnx= %d",nx);
warn("sx %f , gxmin %f gxmax %f",sx,gxmin,gxmax);
/*transform the shot gather from time to frequency domain*/
pfa2rc(1,1,ntfft,nxo,p[0],cp[0]);
/*compute the most left and right index for the migrated section*/
ix1=sx/dx;
ix2=gxmin/dx;
ix3=gxmax/dx;
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
il=ix2;
ir=ix3;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/*the total traces to be migrated*/
nx=ix3-ix2+1;
/*allocate space*/
cq = alloc2complex(nx,nw);
cq1 = alloc2complex(nx,nw);
/*transpose the frequency domain data from data[ix][iw] to data[iw][ix] and
apply a Hamming at the same time*/
for (ix=0; ix<nx; ix++)
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw<nf1||iw>nf4)
cq[iw][ix]=cmplx(0.0,0.0);
else{
if(iw>=nf1&&iw<=nf2){tmpp=PI/(nf2-nf1);tmppp=tmpp*(iw-nf1)-PI;tmpp=0.54+0.46*cos(tmppp);
cq[iw][ix]=crmul(cp[ix+ix2][iw],tmpp);}
else{
if(iw>=nf3&&iw<=nf4){tmpp=PI/(nf4-nf3);tmppp=tmpp*(iw-nf3);tmpp=0.54+0.46*cos(tmppp);
cq[iw][ix]=crmul(cp[ix+ix2][iw],tmpp);}
else
{cq[iw][ix]=cp[ix+ix2][iw];}
}
}
cq[iw][ix]=cp[ix+ix2][iw];
cq1[iw][ix]=cmplx(0.0,0.0);
}
ix=sx/dx-ifx;
warn("ix %d",ix);
for(iw=0;iw<nw;iw++){
cq1[iw][ix-ix2]=wlsp[iw];
}
free2float(p);
free2complex(cp);
free1float(wl);
free1complex(wlsp);
/*if the horizontal spacing interval is in feet, convert it to meter*/
if(!flag)
dx*=0.3048;
/*start of the timing function*/
time(&t1);
/* send local parameters to all slaves*/
pvm_initsend(PvmDataDefault);
ix=15;
rc=pvm_pkint(&ix,1,1);
rc=pvm_pkint(&ntfft,1,1);
rc=pvm_pkint(&ix2,1,1);
rc=pvm_pkint(&ix3,1,1);
rc=pvm_pkint(&isx,1,1);
rc=pvm_pkint(&il,1,1);
rc=pvm_pkint(&ir,1,1);
rc=pvm_pkfloat(&dx,1,1);
rc=pvm_pkfloat(&dz,1,1);
rc=pvm_pkfloat(&dw,1,1);
rc=pvm_pkfloat(&dt,1,1);
msgtype=PARA_MSGTYPE;
task=NTASKS;
rc=pvm_mcast(tids,task,msgtype);
/* send all the frequency to slaves*/
count=NTASKS*5; /*count is the number of frequency components in a shot
gather*/
nw=truenw;
nw1=nw/(count);
if(nw1==0)nw1=1;
total=count=ceil(nw*1.0/nw1);
/* if it is the first shot gather, send equal data to all the slaves, then for
the following shot gathers, only send data when slave requests*/
if(nxshot==tshot){
for(i=0;i<NTASKS;i++){
float *tmpp;
float fw1;
int nww,byte,nwww;
pvm_initsend(PvmDataDefault);
nww=nf1+i*nw1;fw1=fw+nww*dw;
nwww=nw1;
byte=UnDone;
rc=pvm_pkint(&byte,1,1);
rc=pvm_pkfloat(&fw1,1,1);
rc=pvm_pkint(&nwww,1,1);
rc=pvm_pkfloat((float *)cq[nww],nx*nwww*2,1);
rc=pvm_pkfloat((float *)cq1[nww],nx*nwww*2,1);
msgtype=DATA_MSGTYPE;
pvm_send(tids[i],msgtype);
}
count-=NTASKS;
}
while(count){
int tid0,bufid;
float *tmpp;
float fw1;
int nww,byte,nwww;
int i;
i=total-count;
msgtype=COM_MSGTYPE;
bufid=pvm_recv(-1,msgtype);
rc=pvm_upkint(&tid0,1,1);
pvm_freebuf(bufid);
pvm_initsend(PvmDataDefault);
nww=nf1+i*nw1;fw1=fw+nww*dw;
if(i==total-1)nwww=nw-nw1*i;
else nwww=nw1;
byte=UnDone;
rc=pvm_pkint(&byte,1,1);
rc=pvm_pkfloat(&fw1,1,1);
rc=pvm_pkint(&nwww,1,1);
rc=pvm_pkfloat((float *)cq[nww],nx*nwww*2,1);
rc=pvm_pkfloat((float *)cq1[nww],nx*nwww*2,1);
msgtype=DATA_MSGTYPE;
pvm_send(tid0,msgtype);
count--;
}
ix=Done;
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&ix,1,1);
msgtype=DATA_MSGTYPE;
pvm_mcast(tids,task,msgtype);
free2complex(cq);
free2complex(cq1);
time(&t2);
warn("\n %d shot been finished in %f seconds, Ntask=%d",nxshot,difftime(t2,t1),NTASKS);
nxshot--;
if(nxshot)goto loop;
/*when all the shot gathers done, send signal to all slaves to request the
partial imaging*/
ix=FinalDone;
pvm_initsend(PvmDataDefault);
rc=pvm_pkint(&ix,1,1);
msgtype=PARA_MSGTYPE;
pvm_mcast(tids,task,msgtype);
/*allocate space for the final image*/
cresult = alloc2float(nz,nxo);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
{ cresult[ix][iz]=0.0;
}
result_tmp= alloc2float(nz,nxo);
/*receive partial image from all the slaves*/
msgtype=RESULT_MSGTYPE;
i=0;
while(i<NTASKS){
int bufid;
bufid=pvm_recv(-1,msgtype);
rc=pvm_upkfloat(result_tmp[0],nxo*nz,1);
pvm_freebuf(bufid);
for(ix=0;ix<nxo;ix++)
for(iz=0;iz<nz;iz++)
{
cresult[ix][iz]+=result_tmp[ix][iz];
}
i=i+1;
warn("\n i=%d been received",i);
}
/*send signal to all slaves to kill themselves*/
pvm_initsend(PvmDataDefault);
pvm_mcast(tids,task,COM_MSGTYPE);
/*output the final image*/
for(ix=0; ix<nxo; ix++){
tr.ns = nz ;
tr.dt = dz*1000000.0 ;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
pvm_exit();
return EXIT_SUCCESS;
}
void slopefilter (int nslopes, float slopes[], float amps[], float bias,
int nt, float dt, int nx, float dx, FILE *tracefp)
/******************************************************************************
apply slope filter in frequency-wavenumber domain
*******************************************************************************
Input:
nslopes number of slopes (and amplitudes) specified
slopes slopes at which amplitudes are specified (see notes below)
amps amplitudes corresponding to slopes (see notes below)
bias linear moveout slope before and after filtering
nt number of time samples
dt time sampling interval
nx number of traces
dx trace space (spatial sampling interval)
tracefp file pointer to data to be filtered
Output:
tracefp file pointer to filtered data
*******************************************************************************
Notes:
Linear interpolation and constant extrapolation are used to
determine amplitudes for slopes that are not specified.
******************************************************************************/
{
int ntfft; /* nt after padding for FFT */
int nxfft; /* nx after padding for FFT */
float sfft; /* scale factor for FFT */
int nw; /* number of frequencies */
float dw; /* frequency sampling interval */
float fw; /* first frequency */
int nk; /* number of wavenumbers */
float dk; /* wavenumber sampling interval */
float w,k; /* frequency and wavenumber */
int it,ix,iw,ik; /* sample indices */
float slope,amp; /* slope and amplitude for particular w,k */
complex **cpfft; /* complex FFT workspace */
float **pfft; /* float FFT workspace */
float phase; /* phase shift for bias */
complex cshift; /* complex phase shifter for bias */
/* determine lengths and scale factors for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
sfft = 1.0/(ntfft*nxfft);
/* determine frequency and wavenumber sampling */
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
fw = 0.000001*dw; /* non-zero to avoid divide by zero w */
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
/* allocate real and complex workspace for FFTs */
cpfft = alloc2complex(nw,nk);
pfft = alloc2float(ntfft,nxfft);
/* copy data from input to FFT array and pad with zeros */
rewind(tracefp);
for (ix=0; ix<nx; ix++) {
efread(pfft[ix], FSIZE, nt, tracefp);
for (it=nt; it<ntfft; it++)
pfft[ix][it] = 0.0;
}
for (ix=nx; ix<nxfft; ix++)
for (it=0; it<ntfft; it++)
pfft[ix][it] = 0.0;
/* Fourier transform t to w */
pfa2rc(1,1,ntfft,nx,pfft[0],cpfft[0]);
/* do linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = -ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform x to k */
pfa2cc(-1,2,nw,nxfft,cpfft[0]);
/* loop over wavenumbers */
for (ik=0; ik<nk; ik++) {
/* determine wavenumber */
k = (ik<=nk/2) ? ik*dk : (ik-nk)*dk;
/* loop over frequencies */
for (iw=0,w=fw; iw<nw; iw++,w+=dw) {
/* determine biased slope */
slope = k/w+bias;
/* linearly interpolate to find amplitude */
intlin(nslopes,slopes,amps,amps[0],amps[nslopes-1],
1,&slope,&);
/* include fft scaling */
amp *= sfft;
/* filter real and imaginary parts */
cpfft[ik][iw].r *= amp;
cpfft[ik][iw].i *= amp;
}
}
/* Fourier transform k to x */
pfa2cc(1,2,nw,nxfft,cpfft[0]);
/* undo linear moveout bias via phase shift */
for (ix=0; ix<nx; ix++) {
for (iw=0,w=0.0; iw<nw; iw++,w+=dw) {
phase = ix*dx*w*bias;
cshift = cmplx(cos(phase),sin(phase));
cpfft[ix][iw] = cmul(cpfft[ix][iw],cshift);
}
}
/* Fourier transform w to t */
pfa2cr(-1,1,ntfft,nx,cpfft[0],pfft[0]);
/* copy filtered data from FFT array to output */
rewind(tracefp);
for (ix=0; ix<nx; ix++)
efwrite(pfft[ix], FSIZE, nt, tracefp);
/* free workspace */
free2complex(cpfft);
free2float(pfft);
}
main(int argc, char **argv)
{
int nt,nx; /* numbers of samples */
float dt,dx; /* sampling intervals */
float d1,d2; /* output intervals in F, K */
float f1,f2; /* output first samples in F, K */
int it,ix; /* sample indices */
int ntfft,nxfft; /* dimensions after padding for FFT */
int nF,nK; /* transform (output) dimensions */
int iF,iK; /* transform sample indices */
register complex **ct; /* complex FFT workspace */
register float **rt; /* float FFT workspace */
FILE *tracefp; /* temp file to hold traces */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
askdoc(1);
/* Get info from first trace */
if (!gettr(&intrace)) err("can't get first trace");
nt = intrace.ns;
/* dt is used only to set output header value d1 */
if (!getparfloat("dt", &dt)) {
if (intrace.dt) { /* is dt field set? */
dt = (float) intrace.dt / 1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (intrace.d2) { /* is d2 field set? */
dx = intrace.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
/* Store traces in tmpfile while getting a count */
/*tracefp = etmpfile();*/
tracefp = etempfile(NULL);
nx = 0;
do {
++nx;
efwrite(intrace.data, FSIZE, nt, tracefp);
} while (gettr(&intrace));
/* Determine lengths for prime-factor FFTs */
ntfft = npfar(nt);
nxfft = npfa(nx);
if (ntfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nt=%d--too big",ntfft);
if (nxfft >= MIN(SU_NFLTS, PFA_MAX)) err("Padded nx=%d--too big",nxfft);
/* Determine output header values */
d1 = 1.0/(ntfft*dt);
d2 = 1.0/(nxfft*dx);
f1 = 0.0;
f2 = -1.0/(2*dx);
/* Determine complex transform sizes */
nF = ntfft/2+1;
nK = nxfft;
/* Allocate space */
ct = alloc2complex(nF, nK);
rt = alloc2float(ntfft, nxfft);
/* Load traces into fft arrays and close tmpfile */
rewind(tracefp);
for (ix=0; ix<nx; ++ix) {
efread(rt[ix], FSIZE, nt, tracefp);
/* if ix odd, negate to center transform of dimension 2 */
if (ISODD(ix))
for (it=0; it<nt; ++it) rt[ix][it] = -rt[ix][it];
/* pad dimension 1 with zeros */
for (it=nt; it<ntfft; ++it) rt[ix][it] = 0.0;
}
efclose(tracefp);
/* Pad dimension 2 with zeros */
for (ix=nx; ix<nxfft; ++ix)
for (it=0; it<ntfft; ++it) rt[ix][it] = 0.0;
/* Fourier transform dimension 1 */
pfa2rc(1,1,ntfft,nx,rt[0],ct[0]);
/* Fourier transform dimension 2 */
pfa2cc(-1,2,nF,nxfft,ct[0]);
/* Compute and output amplitude spectrum */
for (iK=0; iK<nK; ++iK) {
for (iF=0; iF<nF; ++iF) outtrace.data[iF] = fcabs(ct[iK][iF]);
/* set header values */
outtrace.tracl = iK + 1;
outtrace.ns = nF;
outtrace.dt = 0; /* d1 is now the relevant step size */
outtrace.trid = KOMEGA;
outtrace.d1 = d1;
outtrace.f1 = f1;
outtrace.d2 = d2;
outtrace.f2 = f2;
puttr(&outtrace);
}
}
int
main (int argc, char **argv)
{
int nt; /* number of time samples */
int nz; /* number of migrated depth samples */
int nx; /* number of horizontal samples */
int nxshot; /* number of shots to be migrated */
int iz,iw,ix,it,ik; /* loop counters */
int igx; /* integerized gx value */
int ntfft,nxfft; /* fft size */
int nw,truenw,nk; /* number of wave numbers */
int dip=65; /* dip angle */
int oldigx=0; /* old value of integerized gx value */
int oldisx=0; /* old value of integerized sx value */
float sx,gx; /* x source and geophone location */
float gxmin=0.0,gxmax=0.0; /* x source and geophone location */
float min_sx_gx; /* min(sx,gx) */
float oldgx; /* old gx position */
float oldgxmin; /* old gx position */
float oldgxmax; /* old gx position */
float oldsx=0.0; /* old sx position */
int isx=0,nxo; /* index for source and geophone */
int ix1,ix2,ix3,ixshot,il=0,ir=0; /* dummy index */
int lpad,rpad; /* padding on both sides of the migrated section */
float *wl=NULL,*wtmp=NULL;
float fmax;
float f1,f2,f3,f4;
int nf1,nf2,nf3,nf4;
int ntw;
float dt=0.004,dz; /* time and depth sampling interval */
float dw,dk; /* wavenumber and frequency sampling interval */
float fw,fk; /* first wavenumber and frequency */
float w,k; /* wavenumber and frequency */
float dx; /* spatial sampling interval */
float **p=NULL;
float **cresult=NULL; /* input, output data */
float v1,vmin;
double kz1,kz2;
double phase1;
float **v=NULL;
float **vp=NULL;
complex cshift1,cshift2;
complex *wlsp=NULL;
complex **cp=NULL;
complex **cp1=NULL;
complex **cq=NULL;
complex **cq1=NULL; /*complex input,output*/
char *vfile=""; /* name of file containing velocities */
FILE *vfp=NULL;
int verbose; /* verbose flag */
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get optional parameters */
MUSTGETPARINT("nz",&nz);
MUSTGETPARFLOAT("dz",&dz);
MUSTGETPARSTRING("vfile", &vfile);
MUSTGETPARINT("nxo",&nxo);
MUSTGETPARINT("nxshot",&nxshot);
if (!getparfloat("fmax",&fmax)) fmax = 25. ;
if (!getparfloat("f1",&f1)) f1 = 10.0;
if (!getparfloat("f2",&f2)) f2 = 20.0;
if (!getparfloat("f3",&f3)) f3 = 40.0;
if (!getparfloat("f4",&f4)) f4 = 50.0;
if (!getparint("lpad",&lpad)) lpad=9999;
if (!getparint("rpad",&rpad)) rpad=9999;
if (!getparint("dip",&dip)) dip=65;
if (!getparint("verbose",&verbose)) verbose = 0;
/* allocate space */
cresult = alloc2float(nz,nxo);
vp=alloc2float(nxo,nz);
/* load velocity file */
vfp=efopen(vfile,"r");
efread(vp[0],FSIZE,nz*nxo,vfp);
efclose(vfp);
/* zero out cresult array */
memset((void *) cresult[0], 0, nxo*nz*FSIZE);
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
get_sx_gx(&sx,&gx);
min_sx_gx = MIN(sx,gx);
gxmin=gxmax=gx;
erewind(stdin);
/*
sx = sx - min_sx_gx;
gx = gx - min_sx_gx;
*/
/* let user give dt and/or dx from command line */
if (!getparfloat("dt", &dt)) {
if (tr.dt) { /* is dt field set? */
dt = ((double) tr.dt)/1000000.0;
} else { /* dt not set, assume 4 ms */
dt = 0.004;
warn("tr.dt not set, assuming dt=0.004");
}
}
if (!getparfloat("dx",&dx)) {
if (tr.d2) { /* is d2 field set? */
dx = tr.d2;
} else {
dx = 1.0;
warn("tr.d2 not set, assuming d2=1.0");
}
}
do { /* begin loop over shots */
/* determine frequency sampling interval*/
ntfft = npfar(nt);
nw = ntfft/2+1;
dw = 2.0*PI/(ntfft*dt);
/* compute the index of the frequency to be migrated */
fw=2.0*PI*f1;
nf1=fw/dw+0.5;
fw=2.0*PI*f2;
nf2=fw/dw+0.5;
fw=2.0*PI*f3;
nf3=fw/dw+0.5;
fw=2.0*PI*f4;
nf4=fw/dw+0.5;
/* the number of frequencies to migrated */
truenw=nf4-nf1+1;
fw=0.0+nf1*dw;
if (verbose)
warn("nf1=%d nf2=%d nf3=%d nf4=%d nw=%d",nf1,nf2,nf3,nf4,truenw);
/* allocate space */
wl=alloc1float(ntfft);
wlsp=alloc1complex(nw);
/* generate the Ricker wavelet */
wtmp=ricker(fmax,dt,&ntw);
/* zero out wl[] array */
memset((void *) wl, 0, ntfft*FSIZE);
/* CHANGE BY CHRIS STOLK, Dec. 11, 2005 */
/* The next two lines are the old code, */
/* it is erroneous because the peak of */
/* the wavelet occurs at positive time */
/* instead of time zero. */
for(it=0;it<ntw;it++)
wl[it]=wtmp[it];
/* New code: we put in the wavelet in a centered fashion */
/*
for(it=0;it<ntw;it++) {
wl[(it-ntw/2+ntfft) % ntfft]=wtmp[it];
}
*/
/* warn("%12i %12f \n",(it-ntw/2+ntfft) % ntfft,wtmp[it]); */
/* End of new code */
free1float(wtmp);
/* fourier transform wl array */
pfarc(-1,ntfft,wl,wlsp);
/* CS TEST: this was used to output the array wlsp
(the wavelet in the frequency domain) to the file CSinfo,
no longer needed and commented out */
/*
FILE *CSinfo;
CSinfo=fopen("CSinfo","w");
fprintf(CSinfo,"ntfft=%10i\n",ntfft);
fprintf(CSinfo,"ntw=%10i\n",ntw);
for(iw=0;iw<ntfft/2+1;iw++)
fprintf(CSinfo,"%12f %12f \n",wlsp[iw].r,wlsp[iw].i);
fclose(CSinfo);
*/
/* conclusion from the analysis of this info:
the wavelet (whose fourier transform is in wlsp)
is not zero phase!!!
so there is a timeshift error!!!
Conclusion obtained dec 11 2005 */
/* CS */
/* allocate space */
p = alloc2float(ntfft,nxo);
cq = alloc2complex(nw,nxo);
/* zero out p[][] array */
memset((void *) p[0], 0, ntfft*nxo*FSIZE);
/* initialize a number of items before looping over traces */
nx = 0;
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
oldigx=igx;
oldsx=sx;
oldgx=gx;
oldgxmax=gxmax;
oldgxmin=gxmin;
while(gettr(&tr)) { /* begin looping over traces within a shot gather */
/* get sx and gx */
get_sx_gx(&sx,&gx);
/*
warn("%d nx=%d", igx, nx);
sx = (sx - min_sx_gx);
gx = (gx - min_sx_gx);
*/
if (gx < 0 ) {
igx=gx/dx + nxo;
} else {
igx=gx/dx ;
}
if (igx==oldigx)
warn("repeated igx!!! check dx or scalco value!!!");
oldigx = igx;
if(tr.sx!=oldsx){ efseeko(stdin,(off_t)(-240-nt*4),SEEK_CUR); break;}
if(gxmin>gx)gxmin=gx;
if(gxmax<gx)gxmax=gx;
if(verbose)
warn(" inside loop: min_sx_gx %f isx %d igx %d gx %f sx %f",min_sx_gx,isx,igx,gx,sx);
/* sx, gx must increase monotonically */
if (!(oldsx <= sx) )
err("sx field must be monotonically increasing!");
if (!(oldgx <= gx) )
err("gx field must be monotonically increasing!");
memcpy( (void *) p[igx], (const void *) tr.data,nt*FSIZE);
++nx;
}
isx=oldsx/dx;
if (isx==oldisx)
warn("repeated isx!!! check dx or scalco value!!!");
oldisx=isx;
ixshot=isx;
if(verbose) {
warn("sx %f, gx %f , gxmin %f gxmax %f nx %d",sx,gx,gxmin,gxmax, nx);
warn("isx %d igx %d ixshot %d" ,isx,igx,ixshot);
}
/* transform the shot gather from time to frequency domain */
pfa2rc(1,1,ntfft,nxo,p[0],cq[0]);
/* compute the most left and right index for the migrated */
/* section */
ix1=oldsx/dx;
ix2=gxmin/dx;
ix3=gxmax/dx;
if(ix1>=ix3)ix3=ix1;
if(ix1<=ix2)ix2=ix1;
il=ix2;
ir=ix3;
ix2-=lpad;
ix3+=rpad;
if(ix2<0)ix2=0;
if(ix3>nxo-1)ix3=nxo-1;
/* the total traces to be migrated */
nx=ix3-ix2+1;
nw=truenw;
/* determine wavenumber sampling (for complex to complex FFT) */
nxfft = npfa(nx);
nk = nxfft;
dk = 2.0*PI/(nxfft*dx);
fk = -PI/dx;
/* allocate space for velocity profile within the aperature */
v=alloc2float(nx,nz);
for(iz=0;iz<nz;iz++)
for(ix=0;ix<nx;ix++)
v[iz][ix]=vp[iz][ix+ix2];
/* allocate space */
cp = alloc2complex(nx,nw);
cp1 = alloc2complex(nx,nw);
/* transpose the frequency domain data from */
/* data[ix][iw] to data[iw][ix] and apply a */
/* Hamming at the same time */
for (ix=0; ix<nx; ix++) {
for (iw=0; iw<nw; iw++){
float tmpp=0.0,tmppp=0.0;
if(iw>=(nf1-nf1)&&iw<=(nf2-nf1)){
tmpp=PI/(nf2-nf1);
tmppp=tmpp*(iw-nf1)-PI;
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
if(iw>=(nf3-nf1)&&iw<=(nf4-nf1)){
tmpp=PI/(nf4-nf3);
tmppp=tmpp*(iw-nf3);
tmpp=0.54+0.46*cos(tmppp);
cp[iw][ix]=crmul(cq[ix+ix2][iw+nf1],tmpp);
} else {
cp[iw][ix]=cq[ix+ix2][iw+nf1];}
}
cp1[iw][ix]=cmplx(0.0,0.0);
}
}
for(iw=0;iw<nw;iw++){
cp1[iw][ixshot-ix2]=wlsp[iw+nf1];
}
if(verbose) {
warn("ixshot %d ix %d ix1 %d ix2 %d ix3 %d",ixshot,ix,ix1,ix2,ix3);
warn("oldsx %f ",oldsx);
}
free2float(p);
free2complex(cq);
free1float(wl);
free1complex(wlsp);
/* allocating space */
cq=alloc2complex(nxfft,nw);
cq1=alloc2complex(nxfft,nw);
/* loops over depth */
for(iz=0;iz<nz;++iz){
/* the imaging condition */
for(ix=0;ix<nx;ix++){
for(iw=0,w=fw;iw<nw;w+=dw,iw++){
complex tmp;
float ratio=10.0;
if(fabs(ix+ix2-ixshot)*dx<ratio*iz*dz)
tmp=cmul(cp[iw][ix],cp1[iw][ix]);
else
tmp=cmplx(0.0,0.0);
cresult[ix+ix2][iz]+=tmp.r/ntfft;
}
}
/* get the minimum velocity */
vmin=0;
for(ix=il-ix2;ix<=ir-ix2;ix++){
vmin+=1.0/v[iz][ix]/(ir-il+1);
}
vmin=1.0/vmin;
/* compute the shifted wavefield */
for (ik=0;ik<nx;++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = ik%2 ? cneg(cp[iw][ik]) : cp[iw][ik];
cq1[iw][ik] = ik%2 ? cneg(cp1[iw][ik]) : cp1[iw][ik];
}
}
/* zero out cq[][] cq1[][] */
for (ik=nx; ik<nk; ++ik) {
for (iw=0; iw<nw; ++iw) {
cq[iw][ik] = cmplx(0.0,0.0);
cq1[iw][ik] = cmplx(0.0,0.0);
}
}
/* FFT to W-K domain */
pfa2cc(-1,1,nk,nw,cq[0]);
pfa2cc(-1,1,nk,nw,cq1[0]);
v1=vmin;
for(ik=0,k=fk;ik<nk;++ik,k+=dk) {
for(iw=0,w=fw;iw<nw;++iw,w+=dw){
if(w==0.0)w=1.0e-10/dt;
kz1=1.0-pow(v1*k/w,2.0);
if(kz1>0.15){
phase1 = -w*sqrt(kz1)*dz/v1;
cshift1 = cmplx(cos(phase1), sin(phase1));
cq[iw][ik] = cmul(cq[iw][ik],cshift1);
cq1[iw][ik] = cmul(cq1[iw][ik],cshift1);
} else {
cq[iw][ik] = cq1[iw][ik] = cmplx(0.0,0.0);
}
}
}
pfa2cc(1,1,nk,nw,cq[0]);
pfa2cc(1,1,nk,nw,cq1[0]);
for(ix=0;ix<nx;++ix) {
for(iw=0,w=fw;iw<nw;w+=dw,++iw){
float a=0.015,g=1.0;
int I=10;
if(ix<=I)g=exp(-a*(I-ix)*(I-ix));
if(ix>=nx-I)g=exp(-a*(-nx+I+ix)*(-nx+I+ix));
cq[iw][ix] = crmul( cq[iw][ix],1.0/nxfft);
cq[iw][ix] =ix%2 ? cneg(cq[iw][ix]) : cq[iw][ix];
kz2=(1.0/v1-1.0/v[iz][ix])*w*dz;
cshift2=cmplx(cos(kz2),sin(kz2));
cp[iw][ix]=cmul(cq[iw][ix],cshift2);
cq1[iw][ix] = crmul( cq1[iw][ix],1.0/nxfft);
cq1[iw][ix] =ix%2 ? cneg(cq1[iw][ix]) : cq1[iw][ix];
cp1[iw][ix]=cmul(cq1[iw][ix],cshift2);
}
}
}
free2complex(cp);
free2complex(cp1);
free2complex(cq);
free2complex(cq1);
free2float(v);
--nxshot;
} while(nxshot);
/* restore header fields and write output */
for(ix=0; ix<nxo; ix++){
tr.ns = nz;
tr.d1 = dz;
tr.d2 = dx;
tr.offset = 0;
tr.cdp = tr.tracl = ix;
memcpy( (void *) tr.data, (const void *) cresult[ix],nz*FSIZE);
puttr(&tr);
}
return(CWP_Exit());
}
int
main(int argc, char **argv)
{
int nt,nx; /* numbers of samples */
float dt; /* sampling intervals */
int it,ix; /* sample indices */
int ntfft; /* dimensions after padding for FFT */
int nF; /* transform (output) dimensions */
int iF; /* transform sample indices */
register complex **ct=NULL; /* complex FFT workspace */
register float **rt=NULL; /* float FFT workspace */
int verbose; /* flag for echoing information */
char *tmpdir=NULL; /* directory path for tmp files */
cwp_Bool istmpdir=cwp_false;/* true for user-given path */
float v,fv,dv; /* phase velocity, first, step */
float amp,oamp; /* temp vars for amplitude spectrum */
int nv,iv; /* number of phase vels, counter */
float x; /* offset */
float omega; /* circular frequency */
float domega; /* circular frequency spacing (from dt) */
float onfft; /* 1 / nfft */
float phi; /* omega/phase_velocity */
complex *cDisp=NULL; /* temp array for complex dispersion */
float arg; /* temp var for phase calculation */
complex cExp; /* temp vars for phase calculation */
float *offs=NULL; /* input data offsets */
float fmax; /* max freq to proc (Hz) */
int out; /* output real or abs v(f) spectrum */
int norm; /* normalization flag */
float xmax; /* maximum abs(offset) of input */
float twopi, f; /* constant and frequency (Hz) */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* Get info from first trace */
if (!gettr(&intrace)) err("can't get first trace");
nt = intrace.ns;
/* dt is used only to set output header value d1 */
if (!getparfloat("dt", &dt)) {
if (intrace.dt) { /* is dt field set? */
dt = ((double) intrace.dt)/ 1000000.0;
} else { /* dt not set, exit */
err("tr.dt not set, stop.");
}
}
warn("dt=%f",dt);
if (!getparfloat("fv",&fv)) fv = 330;
if (!getparfloat("dv",&dv)) dv = 25;
if (!getparint("nv",&nv)) nv = 100;
if (!getparint("out",&out)) out = 0;
if (!getparint("norm",&norm)) norm = 0;
if (!getparfloat("fmax",&fmax)) fmax = 50;
if (!getparint("verbose", &verbose)) verbose = 0;
/* Look for user-supplied tmpdir */
if (!getparstring("tmpdir",&tmpdir) &&
!(tmpdir = getenv("CWP_TMPDIR"))) tmpdir="";
if (!STREQ(tmpdir, "") && access(tmpdir, WRITE_OK))
err("you can't write in %s (or it doesn't exist)", tmpdir);
checkpars();
/* Set up tmpfile */
if (STREQ(tmpdir,"")) {
tracefp = etmpfile();
if (verbose) warn("using tmpfile() call");
} else { /* user-supplied tmpdir */
char directory[BUFSIZ];
strcpy(directory, tmpdir);
strcpy(tracefile, temporary_filename(directory));
/* Trap signals so can remove temp files */
signal(SIGINT, (void (*) (int)) closefiles);
signal(SIGQUIT, (void (*) (int)) closefiles);
signal(SIGHUP, (void (*) (int)) closefiles);
signal(SIGTERM, (void (*) (int)) closefiles);
tracefp = efopen(tracefile, "w+");
istmpdir=cwp_true;
if (verbose) warn("putting temporary files in %s", directory);
}
/* we have to allocate offs(nx) before we know nx */
offs = alloc1float(MAX_OFFS);
ix = 0;
nx = 0;
xmax = 0.0;
/* get nx and max abs(offset) */
do {
++nx;
efwrite(intrace.data, FSIZE, nt, tracefp);
offs[ix] = intrace.offset;
if ( abs(intrace.offset) > xmax ) xmax = abs(intrace.offset);
++ix;
} while (gettr(&intrace));
/* confirm that offsets are set */
if ( xmax == 0.0 ) err("tr.offset not set, stop.");
/* Determine lengths for prime-factor FFTs */
ntfft = npfar(nt);
if (ntfft >= SU_NFLTS || ntfft >= PFA_MAX)
err("Padded nt=%d--too big",ntfft);
/* Determine complex transform sizes */
nF = ntfft/2+1; /* must be this nF for fft */
onfft = 1.0 / ntfft;
twopi = 2.0 * PI;
domega = twopi * onfft / dt;
/* Allocate space */
ct = alloc2complex(nF,nx);
rt = alloc2float(ntfft,nx);
/* Load traces into fft arrays and close tmpfile */
erewind(tracefp);
for (ix=0; ix<nx; ++ix) {
efread(rt[ix], FSIZE, nt, tracefp);
/* pad dimension 1 with zeros */
for (it=nt; it<ntfft; ++it) rt[ix][it] = 0.0;
}
efclose(tracefp);
/* Fourier transform dimension 1 */
pfa2rc(1,1,ntfft,nx,rt[0],ct[0]);
/* set nF for processing */
if (fmax == 0) {
/* process to nyquist */
nF = ntfft/2+1;
} else {
/* process to given fmax */
nF = (int) (twopi * fmax / domega);
}
/* data now in (w,x) domain
allocate arrays */
cDisp = alloc1complex(nF);
/* if requested, normalize by amplitude spectrum
(normalizing by amplitude blows up aliasing and other artifacts) */
if (norm == 1) {
for (iF=0; iF<nF; ++iF) {
/* calc this frequency */
omega = iF * domega;
f = omega / twopi;
/* loop over traces */
for (ix=0; ix<nx; ++ix) {
/* calc amplitude at this (f,x) location */
amp = rcabs(ct[ix][iF]);
oamp = 1.0/amp;
/* scale field by amp spectrum */
ct[ix][iF] = crmul(ct[ix][iF],oamp);
}
}
}
/* set global output trace headers */
outtrace.ns = 2 * nF;
outtrace.dt = dt*1000000.;
outtrace.trid = FUNPACKNYQ;
outtrace.d1 = 1.0 / (ntfft * dt); /* Hz */
outtrace.f1 = 0;
outtrace.d2 = dv;
outtrace.f2 = fv;
/* loop over phase velocities */
for (iv=0; iv<nv; ++iv) {
/* this velocity */
v = fv + iv*dv;
/* loop over frequencies */
for (iF=0; iF<nF; ++iF) {
/* this frequency and phase */
omega = iF * domega;
f = omega / twopi;
phi = omega / v;
/* initialize */
cDisp[iF] = cmplx(0.0,0.0);
/* sum over abs offset (this is ok for 3D, too) */
for (ix=0; ix<nx; ++ix) {
/* get this x */
x = abs(offs[ix]);
/* target phase */
arg = - phi * x;
cExp = cwp_cexp(crmul(cmplx(0.0,1.0), arg));
/* phase vel profile for this frequency */
cDisp[iF] = cadd(cDisp[iF],cmul(ct[ix][iF],cExp));
}
}
/* set trace counter */
outtrace.tracl = iv + 1;
/* copy results to output trace
interleaved format like sufft.c */
for (iF = 0; iF < nF; ++iF) {
outtrace.data[2*iF] = cDisp[iF].r;
outtrace.data[2*iF+1] = cDisp[iF].i;
}
/* output freqs at this vel */
puttr(&outtrace);
} /* next frequency */
/* Clean up */
if (istmpdir) eremove(tracefile);
return(CWP_Exit());
}
static void dmooff (float offset, float fmax, int nx, float dx,
int nt, float dt, float ft, float *vrms, float **ptx, float gamma,
float *boh, float *zoh, int ntable, float s1, float s2, float sign)
/*****************************************************************************
perform dmo in f-k domain for one offset
******************************************************************************
Input:
offset source receiver offset
fmax maximum frequency
s1 DMO stretch factor
s2 DMO stretch factor
sign sign of shift
nx number of midpoints
dx midpoint sampling interval
nt number of time samples
dt time sampling interval
ft first time
vrms array[nt] of rms velocities
ptx array[nx][nt] for p(t,x), zero-padded for fft (see notes)
Output:
ptx array[nx][nt] for dmo-corrected p(t,x)
******************************************************************************
Notes:
To avoid having to allocate a separate work space that is larger than the
array ptx[nx][nt], ptx must be zero-padded to enable Fourier transform from x
to k via prime factor FFT. nxpad (nx after zero-padding) can be estimated by
nxpad = 2+npfar(nx+(int)(0.5*ABS(offset/dx)));
where npfar() is a function that returns a valid length for real-to-complex
prime factor FFT. ptx[nx] to ptx[nxfft-1] must point to zeros.
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 08/08/91
*****************************************************************************/
{
int nxfft,itmin,nu,nufft,nw,nk,ix,iu,iw,ik,it,iwn,
iwmin,iwmax,nupad,ikmax,*itn,lnt;
float dw,dk,tcon,wwscl,wwscl2,scale,scales,kmax,lt,
amp,phase,fr,fi,pwr,pwi,cphase,sphase,os1,os2,
wmin,wmax,fftscl,du,fu,w,k,*uoft,*tofu,g1,h,vmin,hk,t,*bboh=NULL;
complex czero=cmplx(0.0,0.0),**ptk,*pu,*pw;
/* number of cdps after padding for fft */
nxfft = npfar(nx+(int)(0.5*ABS(offset/dx)));
/* get minimum time of first non-zero sample */
for (ix=0,itmin=nt; ix<nx; ++ix) {
for (it=0; it<itmin && ptx[ix][it]==0.0; ++it);
itmin = it;
}
/* if all zeros, simply return */
if (itmin>=nt) return;
/* make stretch and compress functions t(u) and u(t) */
maketu(offset,itmin,fmax,nt,dt,ft,vrms,&uoft,&nu,&du,&fu,&tofu,&tcon);
/* constants depending on gamma, offset, vrms[0], and nt */
g1 = 2.0*sqrt(gamma)/(1.0+gamma);
h = offset/2.0;
lnt = nt-1;
lt = (nt-1)*dt;
vmin = 0.5*MIN((1.0+1.0/gamma)*vrms[0],(1.0+gamma)*vrms[0]);
/* if gamma != 1, get bboh[] and itn[] for this offset */
if(gamma!=1.0)
getbbohitn (offset,itmin,nt,dt,vrms,ntable,boh,zoh, \
gamma,&bboh,&itn);
/* inverse of dmo stretch/squeeze factors */
os1 = 1.0/s1;
os2 = 1.0/s2;
/* maximum DMO shift (in samples) for any wavenumber k */
nupad = 1.5*((s1+s2)/2.0)*tcon/du;
/* frequency sampling */
nufft = npfa(nu+nupad);
nw = nufft;
dw = 2.0*PI/(nufft*du);
/* allocate workspace */
pu = pw = ealloc1complex(nufft);
/* wavenumber sampling and maximum wavenumber to apply dmo */
nk = nxfft/2+1;
dk = 2.0*PI/ABS(nxfft*dx);
kmax = PI/ABS(dx);
ikmax = NINT(kmax/dk);
/* pointers to complex p(t,k) */
ptk = (complex**)ealloc1(nk,sizeof(complex*));
for (ik=0; ik<nk; ++ik)
ptk[ik] = (complex*)ptx[0]+ik*nt;
/* fft scale factor */
fftscl = (float)nk/(float)(ikmax+1)/(nufft*nxfft);
/* Fourier transform p(t,x) to p(t,k) */
pfa2rc(-1,2,nt,nxfft,ptx[0],ptk[0]);
/* loop over wavenumbers less than maximum */
for (ik=0,k=0.0; ik<=ikmax; ++ik,k+=dk) {
/* apply time vriant linear phase shift */
hk=sign*h*k;
for (it=lnt,t=lt; it>=itmin; --it,t-=dt) {
/* calculate phase-shift=boh*h*k, h=offset/2 */
if(gamma != 1.0)
phase = bboh[it]*hk;
else
phase = 0.0;
/* phase shift p(t,k) */
cphase=cos(phase);
sphase=sin(phase);
fr = ptk[ik][it].r;
fi = ptk[ik][it].i;
ptk[ik][it].r = fr*cphase + fi*sphase;
ptk[ik][it].i = -fr*sphase + fi*cphase;
}
/* stretch p(t;k) to p(u) */
ints8c(nt,dt,ft,ptk[ik],czero,czero,nu,tofu,pu);
/* pad with zeros and Fourier transform p(u) to p(w) */
for (iu=nu; iu<nufft; ++iu)
pu[iu].r = pu[iu].i = 0.0;
pfacc(1,nufft,pu);
/* minimum and maximum frequencies to process */
wmin = ABS(0.5*vmin*k);
wmax = ABS(PI/du);
iwmin = MAX(1,MIN((nw-1)/2,NINT(wmin/dw)));
iwmax = MAX(0,MIN((nw-1)/2,NINT(wmax/dw)));
/* constant independent of w */
wwscl = os1*pow(g1*hk/tcon,2.0);
wwscl2 = wwscl*os2/os1;
/* zero dc (should be zero anyway) */
pw[0].r = pw[0].i = 0.0;
/* zero frequencies below minimum */
for (iw=1,iwn=nw-iw; iw<iwmin; ++iw,--iwn)
pw[iw].r = pw[iw].i = pw[iwn].r = pw[iwn].i = 0.0;
/* do dmo between minimum and maximum frequencies */
for (iw=iwmin,iwn=nw-iwmin,w=iwmin*dw;
iw<=iwmax; ++iw,--iwn,w+=dw) {
/* positive w */
scales = 1.0+wwscl/(w*w);
scale = sqrt(scales);
phase = s1*w*tcon*(scale-1.0);
amp = fftscl*(1.0-s1+s1/scale);
fr = amp*cos(phase);
fi = amp*sin(phase);
pwr = pw[iw].r;
pwi = pw[iw].i;
pw[iw].r = pwr*fr-pwi*fi;
pw[iw].i = pwr*fi+pwi*fr;
/* negative w */
scales = 1.0+wwscl2/(w*w);
scale = sqrt(scales);
phase = s2*w*tcon*(scale-1.0);
amp = fftscl*(1.0-s2+s2/scale);
fr = amp*cos(phase);
fi = amp*sin(phase);
pwr = pw[iwn].r;
pwi = pw[iwn].i;
pw[iwn].r = pwr*fr+pwi*fi;
pw[iwn].i = pwi*fr-pwr*fi;
}
/* zero frequencies above maximum to Nyquist (if present) */
for (iw=iwmax+1,iwn=nw-iw; iw<=nw/2; ++iw,--iwn)
pw[iw].r = pw[iw].i = pw[iwn].r = pw[iwn].i = 0.0;
/* Fourier transform p(w) to p(u) */
pfacc(-1,nufft,pu);
/* compress p(u) to p(t;k) */
ints8c(nu,du,fu,pu,czero,czero,nt,uoft,ptk[ik]);
}
/* zero wavenumber between maximum and Nyquist */
for (; ik<nk; ++ik)
for (it=0; it<nt; ++it)
ptk[ik][it].r = ptk[ik][it].i = 0.0;
/* Fourier transform p(t,k) to p(t,x) */
pfa2cr(1,2,nt,nxfft,ptk[0],ptx[0]);
/* free workspace */
free1float(tofu);
free1float(uoft);
free1complex(pu);
free1(ptk);
}
static void dmooff (float offset, float fmax, float sdmo, int nx, float dx,
int nt, float dt, float ft, float *vrms, float **ptx)
/*****************************************************************************
perform dmo in f-k domain for one offset
******************************************************************************
Input:
offset source receiver offset
fmax maximum frequency
sdmo DMO stretch factor
nx number of midpoints
dx midpoint sampling interval
nt number of time samples
dt time sampling interval
ft first time
vrms array[nt] of rms velocities
ptx array[nx][nt] for p(t,x), zero-padded for fft (see notes)
Output:
ptx array[nx][nt] for dmo-corrected p(t,x)
******************************************************************************
Notes:
To avoid having to allocate a separate work space that is larger than the
array ptx[nx][nt], ptx must be zero-padded to enable Fourier transform from x
to k via prime factor FFT. nxpad (nx after zero-padding) can be estimated by
nxpad = 2+npfar(nx+(int)(0.5*ABS(offset/dx)));
where npfar() is a function that returns a valid length for real-to-complex
prime factor FFT. ptx[nx] to ptx[nxfft-1] must point to zeros.
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 08/08/91
*****************************************************************************/
{
int nxfft,itmin,nu,nufft,nw,nk,ix,iu,iw,ik,it,iwn,
iwmin,iwmax,nupad,ikmax;
float dw,dk,tcon,wwscl,scale,scales,kmax,
amp,phase,fr,fi,pwr,pwi,
wmin,wmax,fftscl,du,fu,w,k,osdmo,*uoft,*tofu;
complex czero=cmplx(0.0,0.0),**ptk,*pu,*pw;
/* number of cdps after padding for fft */
nxfft = npfar(nx+(int)(0.5*ABS(offset/dx)));
/* get minimum time of first non-zero sample */
for (ix=0,itmin=nt; ix<nx; ++ix) {
for (it=0; it<itmin && ptx[ix][it]==0.0; ++it);
itmin = it;
}
/* if all zeros, simply return */
if (itmin>=nt) return;
/* make stretch and compress functions t(u) and u(t) */
maketu(offset,itmin,fmax,nt,dt,ft,vrms,&uoft,&nu,&du,&fu,&tofu,&tcon);
/* adjust DMO stretch factor for nominal error in log stretch; */
/* solve sdmo*(sqrt(1-a/sdmo)-1) = 0.5*log(1-a), where a=0.5 */
sdmo *= .62;
/* inverse of dmo stretch factor */
osdmo = 1.0/sdmo;
/* maximum DMO shift (in samples) for any wavenumber k */
nupad = 1.5*sdmo*tcon/du;
/* frequency sampling */
nufft = npfa(nu+nupad);
nw = nufft;
dw = 2.0*PI/(nufft*du);
/* allocate workspace */
pu = pw = ealloc1complex(nufft);
/* wavenumber sampling and maximum wavenumber to apply dmo */
nk = nxfft/2+1;
dk = 2.0*PI/ABS(nxfft*dx);
kmax = PI/ABS(dx);
ikmax = NINT(kmax/dk);
/* pointers to complex p(t,k) */
ptk = (complex**)ealloc1(nk,sizeof(complex*));
for (ik=0; ik<nk; ++ik)
ptk[ik] = (complex*)ptx[0]+ik*nt;
/* fft scale factor */
fftscl = (float)nk/(float)(ikmax+1)/(nufft*nxfft);
/* Fourier transform p(t,x) to p(t,k) */
pfa2rc(-1,2,nt,nxfft,ptx[0],ptk[0]);
/* loop over wavenumbers less than maximum */
for (ik=0,k=0.0; ik<=ikmax; ++ik,k+=dk) {
/* stretch p(t;k) to p(u) */
ints8c(nt,dt,ft,ptk[ik],czero,czero,nu,tofu,pu);
/* pad with zeros and Fourier transform p(u) to p(w) */
for (iu=nu; iu<nufft; ++iu)
pu[iu].r = pu[iu].i = 0.0;
pfacc(1,nufft,pu);
/* minimum and maximum frequencies to process */
wmin = ABS(0.5*vrms[0]*k);
wmax = ABS(PI/du);
iwmin = MAX(1,MIN((nw-1)/2,NINT(wmin/dw)));
iwmax = MAX(0,MIN((nw-1)/2,NINT(wmax/dw)));
/* constant independent of w */
wwscl = osdmo*pow(k*0.5*offset/tcon,2.0);
/* zero dc (should be zero anyway) */
pw[0].r = pw[0].i = 0.0;
/* zero frequencies below minimum */
for (iw=1,iwn=nw-iw; iw<iwmin; ++iw,--iwn)
pw[iw].r = pw[iw].i = pw[iwn].r = pw[iwn].i = 0.0;
/* do dmo between minimum and maximum frequencies */
for (iw=iwmin,iwn=nw-iwmin,w=iwmin*dw;
iw<=iwmax; ++iw,--iwn,w+=dw) {
scales = 1.0+wwscl/(w*w);
scale = sqrt(scales);
phase = sdmo*w*tcon*(scale-1.0);
amp = fftscl*(1.0-sdmo+sdmo/scale);
fr = amp*cos(phase);
fi = amp*sin(phase);
pwr = pw[iw].r;
pwi = pw[iw].i;
pw[iw].r = pwr*fr-pwi*fi;
pw[iw].i = pwr*fi+pwi*fr;
pwr = pw[iwn].r;
pwi = pw[iwn].i;
pw[iwn].r = pwr*fr+pwi*fi;
pw[iwn].i = pwi*fr-pwr*fi;
}
/* zero frequencies above maximum to Nyquist (if present) */
for (iw=iwmax+1,iwn=nw-iw; iw<=nw/2; ++iw,--iwn)
pw[iw].r = pw[iw].i = pw[iwn].r = pw[iwn].i = 0.0;
/* Fourier transform p(w) to p(u) */
pfacc(-1,nufft,pu);
/* compress p(u) to p(t;k) */
ints8c(nu,du,fu,pu,czero,czero,nt,uoft,ptk[ik]);
}
/* zero wavenumber between maximum and Nyquist */
for (; ik<nk; ++ik)
for (it=0; it<nt; ++it)
ptk[ik][it].r = ptk[ik][it].i = 0.0;
/* Fourier transform p(t,k) to p(t,x) */
pfa2cr(1,2,nt,nxfft,ptk[0],ptx[0]);
/* free workspace */
free1float(tofu);
free1float(uoft);
free1complex(pu);
free1(ptk);
}
