void crm_fft(complex *cdata, REAL *data, int n1, int n2, int ldc, int ldr, 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) {
pfa2cr(sign, 1, n1, n2, cdata, data);
}
else {
for (i = 0; i < n2; i++) {
pfacr(sign, n1, &cdata[i*ldc], &data[i*ldr]);
}
}
}
else {
for (i = 0; i < n2; i++) {
crdft(&cdata[i*ldc], &data[i*ldr], n1, sign);
}
}
}
else {
datft = (double *)malloc(n1*sizeof(double));
if (datft == NULL) fprintf(stderr,"crm_fft: memory allocation error\n");
for (i = 0; i < n2; i++) {
for (j = 0; j < n1/2; j++) {
datft[j] = (double)cdata[i*ldc+j].r;
datft[n1-1-j] = (double)cdata[i*ldc+j+1].i;
}
datft[n1/2] = (double)cdata[i*ldc+n1/2].r;
realifft(n1, datft);
if (sign == -1) {
for (j = 0; j < n1; j++) data[i*ldr+j] = (REAL)datft[j];
}
else if (sign == 1) {
for (j = 1; j < n1; j++) data[i*ldr+j] = (REAL)datft[n1-j];
data[i*ldr] = (REAL)datft[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());
}
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);
}
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);
}
