static void mkvrms (int ndmo, float *tdmo, float *vdmo,
int nt, float dt, float ft, float *vrms)
/*****************************************************************************
make uniformly sampled vrms(t) for DMO
******************************************************************************
Input:
ndmo number of tdmo,vdmo pairs
tdmo array[ndmo] of times
vdmo array[ndmo] of rms velocities
nt number of time samples
dt time sampling interval
ft first time sample
Output:
vrms array[nt] of rms velocities
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 10/03/91
*****************************************************************************/
{
int it;
float t,(*vdmod)[4];
vdmod = (float(*)[4])ealloc1float(ndmo*4);
cmonot(ndmo,tdmo,vdmo,vdmod);
for (it=0,t=ft; it<nt; ++it,t+=dt)
intcub(0,ndmo,tdmo,vdmod,1,&t,&vrms[it]);
free1float((float*)vdmod);
}
main()
{
int ixin,ixout;
float ydin[NXIN][4],xout[NXOUT],yout[NXOUT],x;
for (ixout=0,x=fxout; ixout<NXOUT; ixout++,x+=dxout)
xout[ixout] = x;
csplin(NXIN,xin,yin,ydin);
intcub(0,NXIN,xin,ydin,NXOUT,xout,yout);
/* fwrite(yout,sizeof(float),NXOUT,stdout); */
pp1d(stdout,"Cubic spline",NXOUT,0,yout);
cmonot(NXIN,xin,yin,ydin);
intcub(0,NXIN,xin,ydin,NXOUT,xout,yout);
/* fwrite(yout,sizeof(float),NXOUT,stdout); */
pp1d(stdout,"Fritsch-Carlson method",NXOUT,0,yout);
cakima(NXIN,xin,yin,ydin);
intcub(0,NXIN,xin,ydin,NXOUT,xout,yout);
/* fwrite(yout,sizeof(float),NXOUT,stdout); */
pp1d(stdout,"Akima's method",NXOUT,0,yout);
}
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;
}
void divcortable(int nt,int np,float dt,float tt[],float vt[],float
**divcor,int trans, int norm)
/********************************************************************
divergence correction for arbitrary v(z) as a function A(px,t)
*********************************************************************
Input:
nt number of time samples
np number of reflection slopes
dt time sampling interval
tt array of times at which velocity is specified
vt array of velocities
divcor divergence correction table,empty
Output:
divcor divergence correction table
*********************************************************************/
{
int it,ip,flag;
float dpx,px,px2,vel,velold,gamma,gammaold,pz,tau,alpha,v0,
denom,(*vind)[4],vel1,vel1old,vel2,vel2old,q,qold,p,pold,
sigma,pz1;
/* allocate space */
vind=(float (*)[4])ealloc1float(nt*4);
/* use v/2 to compensate for v(two-way t)*/
for (it=0; it<nt; it++)
vt[it] *= 0.0005;
/* establish spline coefficients*/
cmonot(nt,tt,vt,vind);
/* clear divergence correction array */
for (ip=0; ip<np; ip++)
for (it=0; it<nt; it++)
divcor[ip][it] = 0.0;
v0 = vind[0][0];
dpx = 1.0/v0/(np-1);
/* evaluate divergence correction */
for (ip=0; ip<np; ip++){
/* calculate px */
px = ip*dpx;
/* initialize variables */
vel = v0;
vel1 = vind[0][1];
vel2 = vind[0][2];
tau=0.0;
px2= px*px;
gamma = px2*(pow(vel1/vel,2.0) - vel2/vel);
p=1.0/v0;
q=0.0;
sigma=0.0;
if (ip==np-1) {pz=0.0; flag=0;}
else {pz = sqrt(1/vel/vel - px2); flag=1;}
/* ray tracing */
for (it=1; it<nt; it++){
tau += vel*pz*dt;
/*if (ip!=0) pz += -vel1/vel/vel*dt;*/
if (tau>=0.0){
velold = vel;
vel1old = vel1;
vel2old = vel2;
intcub(0,nt,tt,vind,1,&tau,&vel);
intcub(1,nt,tt,vind,1,&tau,&vel1);
intcub(2,nt,tt,vind,1,&tau,&vel2);
/*if (ip==0) pz=1.0/vel;*/
if (flag==1) {
/* pz1(it=1) from oldvel oldpz*/
pz1 = pz-vel1old/velold/velold*dt;
/* pz(it=1) based on vel */
pz = sqrt(1/vel/vel - px2);
if (pz1<0.0 || (px*vel>1.0)) {
flag=0; pz = pz1;}
}
else pz += -vel1old/velold/velold*dt;
sigma += velold*velold*dt;
/* Crank-Nicolson on p&q */
gammaold = gamma;
gamma = px2*(pow(vel1/vel,2.0) - vel2/vel);
alpha = 1.0 - gamma*pow((dt/2*vel),2.0);
qold = q;
pold = p;
q = pold*(dt/2/alpha)*(vel*vel + velold*velold) + qold/alpha*(1.0 + pow((dt*vel/2),2.0)*gammaold);
p = qold*(dt/2/alpha)*(gamma + gammaold) + pold/alpha*(1.0 + pow((dt*velold/2),2.0)*gamma);
/*factor of 4 for vrms agreement */
/*correct zero-offset to exp. reflector; one-way w/transmission */
if (trans==1){
divcor[ip][it] =sqrt(2*sigma*ABS(q)/vel);
} else {
divcor[ip][it]=sqrt(2*sigma*ABS(q)/v0);
}
} else{
vel = v0;
sigma += vel*vel*dt;
gammaold = gamma;
gamma = 0.0;
alpha = 1.0;
qold = q;
pold = p;
q = pold*(dt*vel*vel)
+ qold*(1.0
+ pow((dt*vel/2),2.0)*gammaold);
p = qold*dt/2*gammaold + pold;
if (trans==1){
divcor[ip][it]=sqrt(2*sigma*ABS(q)/vel);
} else {
divcor[ip][it]=sqrt(2*sigma*ABS(q)/v0);
}
}
}/* end t*/
} /* end p */
/* normalize dip-dependent correction */
if (norm==1){
denom=1.0/divcor[0][1];
for (ip=np-1; ip>=0; ip--)
for (it=1; it<nt; it++)
divcor[ip][it] *= denom;
}
}
void makeref (float dsmax, int nr, float *ar,
int *nu, float **xu, float **zu, Reflector **r)
/*****************************************************************************
Make piecewise cubic reflectors
******************************************************************************
Input:
dsmax maximum length of reflector segment
nr number of reflectors
ar array[nr] of reflector amplitudes
nu array[nr] of numbers of (x,z) pairs; u = 0, 1, ..., nu[ir]
xu array[nr][nu[ir]] of reflector x coordinates x(u)
zu array[nr][nu[ir]] of reflector z coordinates z(u)
Output:
r array[nr] of reflectors
******************************************************************************
Notes:
Space for the ar, nu, xu, and zu arrays is freed by this function, since
they are only used to construct the reflectors.
This function is meant to be called only once, so it need not be very
efficient. Once made, the reflectors are likely to be used many times,
so the cost of making them is insignificant.
*****************************************************************************/
{
int ir,iu,nuu,iuu,ns,is;
float x,z,xlast,zlast,dx,dz,duu,uu,ds,fs,rsx,rsz,rsxd,rszd,
*u,*s,(*xud)[4],(*zud)[4],*us;
ReflectorSegment *rs;
Reflector *rr;
/* allocate space for reflectors */
*r = rr = ealloc1(nr,sizeof(Reflector));
/* loop over reflectors */
for (ir=0; ir<nr; ++ir) {
/* compute cubic spline coefficients for uniformly sampled u */
u = ealloc1float(nu[ir]);
for (iu=0; iu<nu[ir]; ++iu)
u[iu] = iu;
xud = (float(*)[4])ealloc1float(4*nu[ir]);
csplin(nu[ir],u,xu[ir],xud);
zud = (float(*)[4])ealloc1float(4*nu[ir]);
csplin(nu[ir],u,zu[ir],zud);
/* finely sample x(u) and z(u) and compute length s(u) */
nuu = 20*nu[ir];
duu = (u[nu[ir]-1]-u[0])/(nuu-1);
s = ealloc1float(nuu);
s[0] = 0.0;
xlast = xu[ir][0];
zlast = zu[ir][0];
for (iuu=1,uu=duu; iuu<nuu; ++iuu,uu+=duu) {
intcub(0,nu[ir],u,xud,1,&uu,&x);
intcub(0,nu[ir],u,zud,1,&uu,&z);
dx = x-xlast;
dz = z-zlast;
s[iuu] = s[iuu-1]+sqrt(dx*dx+dz*dz);
xlast = x;
zlast = z;
}
/* compute u(s) from s(u) */
ns = 1+s[nuu-1]/dsmax;
ds = s[nuu-1]/ns;
fs = 0.5*ds;
us = ealloc1float(ns);
yxtoxy(nuu,duu,0.0,s,ns,ds,fs,0.0,(float)(nu[ir]-1),us);
/* compute reflector segments uniformly sampled in s */
rs = ealloc1(ns,sizeof(ReflectorSegment));
for (is=0; is<ns; ++is) {
intcub(0,nu[ir],u,xud,1,&us[is],&rsx);
intcub(0,nu[ir],u,zud,1,&us[is],&rsz);
intcub(1,nu[ir],u,xud,1,&us[is],&rsxd);
intcub(1,nu[ir],u,zud,1,&us[is],&rszd);
rs[is].x = rsx;
rs[is].z = rsz;
rs[is].c = rsxd/sqrt(rsxd*rsxd+rszd*rszd);
rs[is].s = -rszd/sqrt(rsxd*rsxd+rszd*rszd);
}
/* fill in reflector structure */
rr[ir].ns = ns;
rr[ir].ds = ds;
rr[ir].a = ar[ir];
rr[ir].rs = rs;
/* free workspace */
free1float(us);
free1float(s);
free1float(u);
free1float((float*)xud);
free1float((float*)zud);
/* free space replaced by reflector segments */
free1(xu[ir]);
free1(zu[ir]);
}
/* free space replaced by reflector segments */
free1(nu);
free1(xu);
free1(zu);
}
