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);
}
/**************** end self doc ********************************/
static void cvstack(VND *vnda, VND *vnd, int icmp, int noff, float *off,
float *mute, int lmute, int nv, float *p2,
float dt, float dtout);
static void vget( float a, float b, float e, float d,
float theta, float *vel);
VND *ptabledmo(int nv, float *v, float etamin, float deta, int neta,
float d, float vsvp, int np, float dp, float dp2, char *file);
VND *ptablemig(int nv, float *v, float etamin, float deta,
int neta, float d, float vsvp, int np, char *file);
static void taper (int lxtaper, int lbtaper,
int nx, int ix, int nt, float *trace);
segy tr; /* input and output SEGY data */
FILE *fpl; /* file pointer for print listing */
int main(int argc, char **argv)
{
VND *vnd=NULL; /* big file holding data, all cmps, all etas, all velocities */
VND *vnda=NULL; /* holds one input cmp gather */
VND *vndb=NULL; /* holds (w,v) for one k component */
VND *vndvnmo=NULL; /* holds (vnmo,p) table for ti dmo */
VND *vndvphase=NULL; /* holds (vphase,p) table for ti Stolt migration */
long N[2]; /* holds number of values in each dimension for VND opens */
long key[2]; /* holds key in each dimension for VND i/o */
char **dir=NULL; /* could hold list of directories where to put VND temp files */
char *file; /* root name for temporary files */
char *printfile; /* name of file for printout */
complex *crt;
complex *ctemp;
complex czero;
float *rt;
char *ccrt;
char *fname;
float etamin; /* minimum eta scan to compute */
float etamax; /* maximum eta scan to compute */
float deta; /* increment in eta to compute for eta scan */
float dx; /* cmp spatial sampling interval */
float dk; /* wavenumber increment */
float dv; /* velocity increment */
float vmin; /* minimum output velocity */
float vmax; /* maximum output velocity */
float dt; /* input sample rate in seconds */
float dtout; /* output sample rate in seconds */
float *mute; /* array of mute times for this cmp */
float *off; /* array of offsets for this cmp */
float *v; /* array of output velocities */
float *p2stack; /* array of stacking 1/(v*v) */
float *rindex; /* array of interpolation indices */
float dp2=0.0; /* increment in slowness squared for input cvstacks */
float scale; /* used for trace scale factor */
float p; /* horizontal slowness */
float p2; /* p*p */
float v2; /* velocity squared */
float ak; /* horizontal wavenumber */
float dw; /* angular frequency increment */
float *w; /* array holding w values for Fowler */
float factor; /* scale factor */
float d; /* Thomsen's delta */
float vsvp; /* vs/vp ratio */
float dp; /* increment of slowness values in vndvnmo table */
float rp; /* real valued index in p */
float wgt; /* weight for linear interpolation */
float fmax; /* maximum frequency to use for antialias mute */
float salias; /* fraction of frequencies to be within sloth antialias limit */
float dpm; /* slowness increment in TI migration table */
float fw; /* first w in Stolt data table */
float vminstack;/* only used if reading precomputed cvstacks, minimum stacking vel */
int neta; /* number of eta scans to compute */
int ichoose; /* defines type of processing to do */
int ncmps; /* number of input and output cmps */
int nv; /* number of output velocity panels to generate */
int nvstack; /* number of cvstack panels to generate */
int ntpad; /* number of time samples to padd to avoid wraparound */
int nxpad; /* number of traces to padd to avoid wraparound */
int lmute; /* number of samples to taper mute */
int lbtaper; /* length of bottom time taper in ms */
int lstaper; /* length of side taper in traces */
int mxfold; /* maximum allowed number of input offsets/cmp */
int icmp; /* cmp index */
int ntfft; /* length of temporal fft for Fowler */
int ntffts; /* length of temporal fft for Stolt */
int nxfft; /* length of spatial fft */
int ntfftny; /* count of freq to nyquist */
int nxfftny; /* count of wavenumbers to nyquist */
int nmax; /* used to compute max number of samples for array allocation */
int oldcmp; /* current cdp header value */
int noff; /* number of offsets */
int k; /* wavenumber index */
int iwmin; /* minimum freq index */
int TI; /* 0 for isotropic, 1 for transversely isotropic */
long it; /* time index */
long iw; /* index for angular frequency */
long nt; /* number of input time samples */
long ntout; /* number of output time samples */
long iv; /* velocity index */
long ip; /* slowness index */
long ieta;
int nonhyp; /* flag equals 1 if do mute to avoid non-hyperbolic events */
int getcvstacks;/* flag equals 1 if input cvstacks precomputed */
int ngroup; /* number of traces per vel anal group */
int ndir; /* number of user specified directories for temp files */
/******************************************************************************/
/* input parameters, allocate buffers, and define reusable constants */
/******************************************************************************/
initargs(argc, argv);
requestdoc(1);
/* get first trace and extract critical info from header */
if(!gettr(&tr)) err("Can't get first trace \n");
nt=tr.ns;
dt=0.000001*tr.dt;
oldcmp=tr.cdp;
if (!getparstring("printfile",&printfile)) printfile=NULL;
if (printfile==NULL) {
fpl=stderr;
}else{
fpl=fopen(printfile,"w");
}
if (!getparfloat("salias",&salias)) salias=0.8;
if(salias>1.0) salias=1.0;
if (!getparfloat("dtout",&dtout)) dtout=1.5*dt;
ntout=1+nt*dt/dtout;
if (!getparint("getcvstacks",&getcvstacks)) getcvstacks=0;
if(getcvstacks) {
dtout=dt;
ntout=nt;
}
fmax=salias*0.5/dtout;
fprintf(fpl,"sutifowler: ntin=%ld dtin=%f\n",nt,dt);
fprintf(fpl,"sutifowler: ntout=%ld dtout=%f\n",ntout,dtout);
if (!getparstring("file",&file)) file="sutifowler";
if (!getparfloat("dx",&dx)) dx=25.;
if (!getparfloat("vmin",&vmin)) vmin=1500.;
if (!getparfloat("vmax",&vmax)) vmax=8000.;
if (!getparfloat("vminstack",&vminstack)) vminstack=vmin;
if (!getparfloat("d",&d)) d=0.0;
if (!getparfloat("etamin",&etamin)) etamin=0.0;
if (!getparfloat("etamax",&etamax)) etamax=0.5;
if (!getparfloat("vsvp",&vsvp)) vsvp=0.5;
if (!getparint("neta", &neta)) neta = 1;
if (fabs(etamax-etamin)<1.0e-7) neta = 1;
if (neta < 1) neta = 1;
if (!getparint("choose", &ichoose)) ichoose = 1;
if (!getparint("ncdps", &ncmps)) err("sutifowler: must enter ncdps");
if (!getparint("nv", &nv)) nv = 75;
if (!getparint("nvstack", &nvstack)) nvstack = 180;
if (!getparint("ntpad", &ntpad)) ntpad = 0.1*ntout;
if (!getparint("nxpad", &nxpad)) nxpad = 0;
if (!getparint("lmute", &lmute)) lmute = 24;
lmute=1 + 0.001*lmute/dtout;
if (!getparint("lbtaper", &lbtaper)) lbtaper = 0;
if (!getparint("lstaper", &lstaper)) lstaper = 0;
if (!getparint("mxfold", &mxfold)) mxfold = 120;
if (!getparint("nonhyp",&nonhyp)) nonhyp=1.;
if (!getparint("ngroup", &ngroup)) ngroup = 20;
ndir = countparname("p");
if(ndir==0) {
ndir=-1;
}else{
dir = (char **)VNDemalloc(ndir*sizeof(char *),"dir");
for(k=0;k<ndir;k++) {
it=getnparstring(k+1,"p",&dir[k]);
}
}
lbtaper=lbtaper/(1000.*dt);
TI=0;
if(fabs(d)>0. || fabs(etamin)>0 || neta>1 ) TI=1;
if(TI) fprintf(fpl,"sutifowler: operation in TI mode\n");
deta = 0.;
if(neta>1) deta=(etamax-etamin)/(neta-1);
dp=1./(vmin*(NP-5));
if(TI) dp=dp*sqrt(1.+2.*fabs(etamin));
if(ichoose>2) nvstack=nv;
if(ichoose==1 || ichoose==2 || ichoose==3) {
ntfft=ntout+ntpad;
}else{
ntfft=1;
}
if(ichoose==1 || ichoose==3) {
ntffts=2*ntout/0.6;
}else{
ntffts=1;
}
ntfft=npfao(ntfft,2*ntfft);
ntffts=npfao(ntffts,2*ntffts);
dw=2.*PI/(ntfft*dtout);
nxfft=npfar(ncmps+nxpad);
dk=2.*PI/(nxfft*dx);
fprintf(fpl,"sutifowler: ntfft=%d ntffts=%d nxfft=%d\n",ntfft,ntffts,nxfft);
czero.r=czero.i=0.;
scale=1.;
if(ichoose<5) scale=1./(nxfft);
if(ichoose==1 || ichoose==2 ) scale*=1./ntfft;
if(ichoose==1 || ichoose==3 ) scale*=1./ntffts;
nxfftny = nxfft/2 + 1;
ntfftny = ntfft/2 + 1;
nmax = nxfftny;
if(ntfft > nmax) nmax=ntfft;
if((NP/2+1)>nmax) nmax=(NP/2+1);
if(nvstack>nmax) nmax=nvstack;
if(nv*neta>nmax) nmax=nv*neta;
ctemp = (complex *)VNDemalloc(nmax*sizeof(complex),"allocating ctemp");
rindex=(float *)VNDemalloc(nmax*sizeof(float),"allocating rindex");
if(ntffts > nmax) nmax=ntffts;
crt = (complex *)VNDemalloc(nmax*sizeof(complex),"allocating crt");
rt = (float *)crt;
ccrt = (char *)crt;
fprintf(fpl,"sutifowler: nv=%d nvstack=%d\n",nv,nvstack);
v=(float *)VNDemalloc(nv*sizeof(float),"allocating v");
p2stack=(float *)VNDemalloc(nvstack*sizeof(float),"allocating p2stack");
mute=(float *)VNDemalloc(mxfold*sizeof(float),"allocating mute");
off=(float *)VNDemalloc(mxfold*sizeof(float),"allocating off");
fprintf(fpl,"sutifowler: allocating and filling w array\n");
w=(float *)VNDemalloc(ntfft*sizeof(float),"allocating w");
for(iw=0;iw<ntfft;iw++) {
if(iw<ntfftny){
w[iw]=iw*dw;
}else{
w[iw]=(iw-ntfft)*dw;
}
if(iw==0) w[0]=0.1*dw; /* fudge for dc component */
}
/******************************************************************************/
fprintf(fpl,"sutifowler: building function for stacking velocity analysis\n");
/******************************************************************************/
dv=(vmax-vmin)/MAX((nv-1),1);
for(iv=0;iv<nv;iv++) v[iv]=vmin+iv*dv;
if(ichoose>=3){
for(iv=0;iv<nvstack;iv++) {
p2stack[iv]=1./(v[iv]*v[iv]);
fprintf(fpl," stacking velocity %ld %f\n",iv,v[iv]);
}
}else{
if(nvstack<6) err("sutifowler: nvstack must be 6 or more");
dp2 = 1./(vminstack*vminstack*(nvstack-5));
for(iv=0;iv<nvstack;iv++) {
p2stack[iv]=iv*dp2;
if(iv>0) {
factor=1./sqrt(p2stack[iv]);
fprintf(fpl," stacking velocity %ld %f\n",iv,factor);
}else{
fprintf(fpl," stacking velocity %ld infinity\n",iv);
}
}
}
/******************************************************************************/
fprintf(fpl,"sutifowler: Opening and zeroing large block matrix disk file\n");
fprintf(fpl," This can take a while, but all is fruitless if the \n");
fprintf(fpl," necessary disk space is not there...\n");
/******************************************************************************/
N[0]=nxfft+2;
N[1]=ntout*MAX(nv*neta,nvstack);
fname=VNDtempname(file);
vnd = VNDop(2,0,2,N,1,sizeof(float),fname,ndir,dir,1);
VNDfree(fname,"main: freeing fname 1");
fprintf(fpl,"sutifowler: large file RAM mem buf = %ld bytes\n",
vnd->NumBytesMemBuf);
fprintf(fpl,"sutifowler: large file disk area = %ld bytes\n",
vnd->NumBytesPerBlock*vnd->NumBlocksPerPanel*vnd->NumPanels);
if(getcvstacks) {
/******************************************************************************/
fprintf(fpl,"sutifowler: reading input cvstacks\n");
/******************************************************************************/
for(icmp=0;icmp<ncmps;icmp++) {
key[0]=icmp;
key[1]=0;
for(iv=0;iv<nvstack;iv++) {
VNDrw('w',0,vnd,1,key,0,
(char *) tr.data,iv*ntout,1,ntout,
1,"writing cvstacks to disk");
if( !gettr(&tr) ) {
if(icmp==ncmps-1 && iv==nvstack-1 ) {
/* all ok, read all the input data */
}else{
err("sutifowler: error reading input cvstacks");
}
}
}
}
goto xffts;
}
/******************************************************************************/
fprintf(fpl,
"sutifowler: beginning constant velocity stacks of the input cmp gathers\n");
/******************************************************************************/
fname=VNDtempname(file);
vnda = V2Dop(2,1000000,sizeof(float),fname,nt,mxfold);
VNDfree(fname,"main: freeing fname 2");
fprintf(fpl,"sutifowler: cmp gather RAM mem buf = %ld bytes\n",
vnda->NumBytesMemBuf);
icmp=0;
noff=0;
do {
if(tr.cdp!=oldcmp) {
cvstack(vnda,vnd,icmp,noff,off,mute,lmute,
nvstack,p2stack,dt,dtout);
icmp++;
if(icmp==ncmps) {
fprintf(fpl,"sutifowler: more input cdps than ncdps parameter\n");
fprintf(fpl," Will only process ncdps gathers.\n");
goto done_with_input;
}
oldcmp=tr.cdp;
noff=0;
}
if(lbtaper>0 || lstaper>0) taper (lstaper,lbtaper,ncmps,icmp,nt,tr.data);
factor=scale;
for(it=0;it<nt;it++) tr.data[it]*=factor;
V2Dw0(vnda,noff,(char *)tr.data,1);
off[noff]=tr.offset;
if(ichoose==1 || ichoose==2) {
mute[noff]=fmax*off[noff]*off[noff]*dp2;
}else{
mute[noff]=0.;
}
if(nonhyp) mute[noff]=MAX(mute[noff],2*off[noff]/vmin);
noff++;
if(noff>mxfold) err("tifowler: input cdp has more traces than mxfold");
} while ( gettr(&tr) );
cvstack(vnda,vnd,icmp,noff,off,mute,lmute,
nvstack,p2stack,dt,dtout);
icmp++;
done_with_input:
ncmps=icmp;
fprintf(fpl,"sutifowler: read and stacked %d cmp gathers\n",ncmps);
VNDcl(vnda,1);
xffts:
VNDflush(vnd);
if(ichoose<5){
/******************************************************************************/
fprintf(fpl,"sutifowler: doing forward x -> k spatial fft's\n");
/******************************************************************************/
for(it=0;it<(ntout*nvstack);it++) {
V2Dr0(vnd,it,ccrt,21);
for(k=ncmps;k<nxfft+2;k++) rt[k]=0.;
pfarc(1,nxfft,rt,crt);
V2Dw0(vnd,it,ccrt,22);
}
VNDr2c(vnd);
}
if(ichoose<=3) {
fprintf(fpl,"sutifowler: looping over k\n");
if(TI && (ichoose==1 || ichoose==2)) { /* build ti vnmo(p) table */
vndvnmo=ptabledmo(nv,v,etamin,deta,neta,d,vsvp,NP,dp,dp2,file);
fprintf(fpl,"sutifowler: dmo index(p) RAM mem buf = %ld bytes\n",
vndvnmo->NumBytesMemBuf);
}
if(TI && (ichoose==1 || ichoose==3)){ /* build ti vphase(p) table */
vndvphase=ptablemig(nv,v,etamin,deta,neta,d,vsvp,NP,file);
fprintf(fpl,"sutifowler: migration scaler(p) RAM mem buf = %ld bytes\n",
vndvphase->NumBytesMemBuf);
}
if(ichoose==1 || ichoose==2){
iv=MAX(nv*neta,nvstack);
fname=VNDtempname(file);
vndb = V2Dop(2,750000,sizeof(complex),
fname,(long)ntfft,iv);
fprintf(fpl,"sutifowler: (w,v) RAM mem buf = %ld bytes\n",
vndb->NumBytesMemBuf);
VNDfree(fname,"main: freeing fname 3");
}
/******************************************************************************/
for(k=0;k<nxfftny;k++){ /* loop over spatial wavenumbers */
/******************************************************************************/
if(k==(20*(k/20))) {
fprintf(fpl,"sutifowler: k index = %d out of %d\n",
k,nxfftny);
}
ak=k*dk;
key[0]=k;
key[1]=0;
/******************************************************************************/
if(ichoose==1 || ichoose==2) { /* do Fowler DMO */
/******************************************************************************/
for(iv=0;iv<nvstack;iv++) { /* loop over input velocities */
VNDrw('r',0,vnd,1,key,0,ccrt,iv*ntout,1,ntout,
31,"Fowler DMO t -> w fft read");
for(it=ntout;it<ntfft;it++) crt[it]=czero;
pfacc(-1,ntfft,crt);
V2Dw0(vndb,iv,ccrt,32);
}
for(iw=0;iw<ntfft;iw++) {
p=0.5*ak/fabs(w[iw]);
if(TI) { /* anisotropic TI*/
ip=p/dp;
if(ip<NP) {
V2Dr0(vndvnmo,ip,(char *)rindex,40);
}else{
for(iv=0;iv<(nv*neta);iv++) rindex[iv]=-1.;
}
}else{ /* isotropic */
p2=p*p;
for(iv=0;iv<nv;iv++){
v2=v[iv]*v[iv];
rindex[iv]=(1-v2*p2)/(v2*dp2);
}
}
V2Dr1(vndb,iw,ccrt,41);
for(iv=0;iv<nvstack;iv++) ctemp[iv]=crt[iv];
ints8c(nvstack,1.0,0.0,ctemp,czero,czero,nv*neta,rindex,crt);
V2Dw1(vndb,iw,ccrt,42);
}
for(iv=0;iv<(nv*neta);iv++) { /* loop over output vel */
V2Dr0(vndb,iv,ccrt,51);
pfacc(1,ntfft,crt);
VNDrw('w',0,vnd,1,key,0,ccrt,iv*ntout,1,ntout,
52,"Fowler DMO w -> t fft write");
}
}
/******************************************************************************/
if( ichoose==3 && neta>1 ) { /* fix up disk order if only doing TI migrations */
/******************************************************************************/
for(iv=0;iv<nv;iv++) {
VNDrw('r',0,vnd,1,key,0,ccrt,iv*ntout,1,ntout,
57,"option 3 fixup for multiple eta read");
for(ieta=1;ieta<neta;ieta++) {
VNDrw('w',0,vnd,1,key,0,ccrt,
iv*ntout+ieta*nv*ntout,1,ntout,
58,"option 3 fixup for multiple eta write");
}
}
}
/******************************************************************************/
if( (ichoose==1 || ichoose==3 ) ) { /* do Stolt migration */
/******************************************************************************/
for(iv=0;iv<(nv*neta);iv++) {
if(TI) { /* anisotropic TI */
V2Dr0(vndvphase,iv,ccrt,50);
dpm=rt[0];
dw=2.*PI/(ntfft*dtout);
iwmin=0.5*ak/( (NP-3)*dpm*dw);
for(iw=iwmin+1;iw<ntfftny;iw++) {
p=0.5*ak/fabs(w[iw]);
rp=1.0+p/dpm;
ip=rp;
wgt=rp-ip;
factor=wgt*rt[ip+1]+(1.-wgt)*rt[ip];
rindex[iw]=w[iw]*factor;
rindex[ntfft-iw]=w[ntfft-iw]*factor;
}
fw=-2.*PI/dtout;
rindex[0]=fw;
for(iw=1;iw<iwmin+1;iw++) {
rindex[iw]=fw;
rindex[ntfft-iw]=fw;
}
}else{ /* isotropic */
scale=0.5*v[iv]*ak;
for(iw=0;iw<ntfft;iw++) {
if(fabs(w[iw])>scale) {
factor=scale/w[iw];
factor=sqrt(1+factor*factor);
rindex[iw]=w[iw]*factor;
}else{
rindex[iw]=-2.*PI/dtout;
}
}
}
VNDrw('r',0,vnd,1,key,0,ccrt,iv*ntout,1,ntout,
61,"Stolt t -> w fft read");
for(it=1;it<ntout;it+=2){
crt[it].r=-crt[it].r;
crt[it].i=-crt[it].i;
}
for(it=ntout;it<ntffts;it++) crt[it]=czero;
pfacc(1,ntffts,crt);
dw=2.*PI/(ntffts*dtout);
fw=-PI/dtout;
ints8c(ntffts,dw,fw,crt,czero,czero,
ntfft,rindex,ctemp);
/* obliquity factor code */
for(iw=0;iw<ntfft;iw++){
factor=fabs(w[iw]/rindex[iw]);
crt[iw].r=factor*ctemp[iw].r;
crt[iw].i=factor*ctemp[iw].i;
}
pfacc(-1,ntfft,crt);
VNDrw('w',0,vnd,1,key,0,ccrt,iv*ntout,1,ntout,
62,"Stolt w->t fft write");
}
}
}
fprintf(fpl,"sutifowler: completed loop over wavenumbers\n");
if(ichoose==1 || ichoose==2) VNDcl(vndb,1);
if(TI && (ichoose==1 || ichoose==2)) VNDcl(vndvnmo,1);
if(TI && (ichoose==1 || ichoose==3)) VNDcl(vndvphase,1);
}
if(ichoose<5) {
/******************************************************************************/
fprintf(fpl,"sutifowler: doing inverse spatial fft's k->x\n");
/******************************************************************************/
for(it=0;it<(ntout*nv*neta);it++) {
V2Dr0(vnd,it,ccrt,71);
pfacr(-1,nxfft,crt,rt);
V2Dw0(vnd,it,ccrt,72);
}
VNDc2r(vnd);
}
/*****************************************************************/
fprintf(fpl,"sutifowler: outputting results\n");
/******************************************************************/
it=0;
for(icmp=0;icmp<ncmps;icmp++) {
key[0]=icmp;
key[1]=0;
for(ieta=0;ieta<neta;ieta++) {
for(iv=0;iv<nv;iv++) {
VNDrw('r',0,vnd,1,key,0,(char *)tr.data,
iv*ntout+ieta*nv*ntout,1,ntout,82,
"outputting all velocities for each cmp");
tr.ns=ntout;
tr.dt=1000000*dtout;
tr.cdp=icmp;
tr.tracf=iv;
tr.offset=v[iv];
tr.cdpt=iv;
tr.sx=icmp*dx;
tr.gx=icmp*dx;
it++;
tr.tracl=it;
tr.tracr=it;
tr.fldr=icmp/ngroup;
tr.ep=10+tr.fldr*ngroup;
tr.igc=ieta;
tr.igi=100*(etamin+ieta*deta);
tr.d1=dtout;
tr.f1=0.;
tr.d2=1.;
tr.f2=0.;
puttr(&tr);
}
}
}
/* close files and return */
VNDcl(vnd,1);
VNDfree(crt,"main: freeing crt");
VNDfree(ctemp,"main: freeing ctemp");
VNDfree(v,"main: freeing v");
VNDfree(p2stack,"main: freeing p2stack");
VNDfree(mute,"main: freeing mute");
VNDfree(off,"main: freeing off");
VNDfree(rindex,"main: freeing rindex");
VNDfree(w,"main: freeing w");
if(VNDtotalmem()!=0) {
fprintf(stderr,"total VND memory at end = %ld\n",
VNDtotalmem());
}
return EXIT_SUCCESS;
}
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);
}