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