void fdmig( complex **cp, int nx, int nw, float *v,float fw,float
dw,float dz,float dx,float dt,int dip,float para)
{
int iw,ix,step=1;
float *s1,*s2,w,coefa[5],coefb[5],v1,vn,trick=0.1,ccx;
complex cp2,cp3,cpnm1,cpnm2;
complex a1,a2,b1,b2;
complex endl,endr;
complex *data,*d,*a,*b,*c;
float aaa=-8.0*para*dt/PI;
ccx=-aaa/(2.0*dx*dx);
s1=alloc1float(nx);
s2=alloc1float(nx);
data=alloc1complex(nx);
d=alloc1complex(nx);
a=alloc1complex(nx);
b=alloc1complex(nx);
c=alloc1complex(nx);
if(dip==45){
coefa[0]=0.5;coefb[0]=0.25;
step=1;
}
if(dip==65){
coefa[0]=0.478242060;coefb[0]=0.376369527;
step=1;
}
if(dip==79){
coefa[0]=coefb[0]=0.4575;
step=1;
}
if(dip==80){
coefa[1]=0.040315157;coefb[1]=0.873981642;
coefa[0]=0.457289566;coefb[0]=0.222691983;
step=2;
}
if(dip==87){
coefa[2]=0.00421042;coefb[2]=0.972926132;
coefa[1]=0.081312882;coefb[1]=0.744418059;
coefa[0]=0.414236605;coefb[0]=0.150843924;
step=3;
}
if(dip==89){
coefa[3]=0.000523275;coefb[3]=0.994065088;
coefa[2]=0.014853510;coefb[2]=0.919432661;
coefa[1]=0.117592008;coefb[1]=0.614520676;
coefa[0]=0.367013245;coefb[0]=0.105756624;
step=4;
}
if(dip==90){
coefa[4]=0.000153427;coefb[4]=0.997370236;
coefa[3]=0.004172967;coefb[3]=0.964827992;
coefa[2]=0.033860918;coefb[2]=0.824918565;
coefa[1]=0.143798076;coefb[1]=0.483340757;
coefa[0]=0.318013812;coefb[0]=0.073588213;
step=5;
}
v1=v[0];vn=v[nx-1];
loop:
step--;
for(iw=0,w=fw;iw<nw;iw++,w+=dw){
float tmp1=0.0,tmp2=0.0;
if(fabs(w)<=1.0e-10)w=1.0e-10/dt;
for(ix=0;ix<nx;ix++){
s1[ix]=(v[ix]*v[ix])*coefb[step]/(dx*dx*w*w)+trick;
s2[ix]=-v[ix]*dz*coefa[step]/(w*dx*dx)*0.5;
}
for(ix=0;ix<nx;ix++){
data[ix]=cp[iw][ix];
}
cp2=data[0];
cp3=data[1];
cpnm1=data[nx-1];
cpnm2=data[nx-2];
a1=cmul(cp2,conjg(cp3));
/*
b1=cadd(cmul(cp2,conjg(cp2)),cmul(cp3,conjg(cp3)));
*/
b1=cmul(cp3,conjg(cp3));
if(b1.r==0.0 && b1.i==0.0)
a1=cexp(cmplx(0.0,-w*dx*0.5/v1));
else
a1=cdiv(a1,b1);
if(a1.i>0.0)a1=cexp(cmplx(0.0,-w*dx*0.5/v1));
a2=cmul(cpnm1,conjg(cpnm2));
b2=cmul(cpnm2,conjg(cpnm2));
if(b2.r==0.0 && b2.i==0.0)
a2=cexp(cmplx(0.0,-w*dx*0.5/vn));
else
a2=cdiv(a2,b2);
if(a2.i>0.0)a2=cexp(cmplx(0.0,-w*dx*0.5/vn));
for(ix=0;ix<nx;ix++){
a[ix]=cmplx(s1[ix],s2[ix]+ccx*v[ix]*v[ix]/w);
b[ix]=cmplx(1.0-2.0*s1[ix],-2.0*s2[ix]-2.0*ccx*v[ix]*v[ix]/w);
}
for(ix=1;ix<nx-1;ix++){
d[ix]=cadd(cadd(cmul(data[ix+1],a[ix+1]),cmul(data[ix-1],a[ix-1])),cmul(data[ix],b[ix]));
}
d[0]=cadd(cmul(cadd(b[0],cmul(a[0],a1)),data[0]),cmul(data[1],a[1]));
d[nx-1]=cadd(cmul(cadd(b[nx-1],cmul(a[nx-1],a2)),data[nx-1]),cmul(data[nx-2],a[nx-2]));
for(ix=0;ix<nx;ix++){
data[ix]=cmplx(s1[ix],-s2[ix]+ccx*v[ix]*v[ix]/w);
b[ix]=cmplx(1.0-2.0*s1[ix],2.0*s2[ix]-2.0*ccx*v[ix]*v[ix]/w);
}
endl=cadd(b[0],cmul(data[0],a1));
endr=cadd(b[nx-1],cmul(data[nx-1],a2));
for(ix=1;ix<nx-1;ix++){
a[ix]=data[ix+1];
c[ix]=data[ix-1];
}
a[0]=data[1];
c[nx-1]=data[nx-2];
retris(data,a,c,b,endl,endr,nx,d);
for(ix=0;ix<nx;ix++){
cp[iw][ix]=data[ix];
}
}
if(step) goto loop;
free1complex(data);
free1complex(d);
free1complex(b);
free1complex(c);
free1complex(a);
free1float(s1);
free1float(s2);
return;
}
void vsm3d(float ***v,int n3,int n2,int n1,int iter,int depth,
float r3,float r2,float r1,float mu,int sl,float vmin,float vmax)
/***************************************************************************
Smooth 3d-velocity.
*************************************************************************/
{
int i2, i1, i3, i;
float **d=NULL, **e=NULL, **f=NULL, *w, ww=1.0;
/* compute the weight function */
w = alloc1float(n1+n2+n3-2);
if(depth==1){
mu = (mu*mu-1.0)/(n1*n1);
for(i1=0; i1<n1; ++i1) w[i1] = 1.0/(1+i1*i1*mu);
}
if(depth==2){
mu = (mu*mu-1.0)/(n2*n2);
for(i2=0; i2<n2; ++i2) w[i2] = 1.0/(1+i2*i2*mu);
}
if(depth==3){
mu = (mu*mu-1.0)/(n3*n3);
for(i3=0; i3<n3; ++i3) w[i3] = 1.0/(1+i3*i3*mu);
}
/* scale smoothing parameters according to the iteration number */
if(iter==1) {
r1 /= 3.39*3.39;
r2 /= 3.39*3.39;
r3 /= 3.39*3.39;
} else if(iter==2){
r1 /= 5.19*5.19;
r2 /= 5.19*5.19;
r3 /= 5.19*5.19;
} else {
r1 /= 6.60*6.60;
r2 /= 6.60*6.60;
r3 /= 6.60*6.60;
}
/* clip velocity */
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1){
if(v[i3][i2][i1] >vmax) v[i3][i2][i1] = vmax;
if(v[i3][i2][i1] <vmin) v[i3][i2][i1] = vmin;
}
if(sl) {
/* smoothing on slowness */
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2][i1] = 1.0/v[i3][i2][i1];
}
if(r2>0.) {
/* smoothing velocity in the second direction */
/* allocate space */
d = alloc2float(n1,n2);
e = alloc2float(n1,n2);
f = alloc2float(n1,n2);
for(i3=0; i3<n3; ++i3){
if(depth==3) ww = w[i3];
for(i2=0; i2<n2-1; ++i2){
if(depth==2) ww = w[i2+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i2][i1] = ww+r2*2.0;
e[i2][i1] = -r2;
f[i2][i1] = ww*v[i3][i2+1][i1];
}
}
for(i1=0; i1<n1; ++i1){
d[n2-2][i1] -= r2;
f[0][i1] += r2*v[i3][0][i1];
}
tripd2(d,e,f,n2-1,n1);
for(i=1; i<iter; ++i) {
for(i2=0; i2<n2-1; ++i2){
if(depth==2) ww = w[i2+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i2][i1] = ww+r2*2.0;
e[i2][i1] = -r2;
f[i2][i1] *= ww;
}
}
for(i1=0; i1<n1; ++i1){
d[n2-2][i1] -= r2;
f[0][i1] += r2*v[i3][0][i1];
}
tripd2(d,e,f,n2-1,n1);
}
for(i2=0; i2<n2-1; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2+1][i1] = f[i2][i1];
}
}
if(r3>0.) {
/* smooth velocity in the third direction */
/* allocate space */
d = alloc2float(n1,n3);
e = alloc2float(n1,n3);
f = alloc2float(n1,n3);
for(i2=0; i2<n2; ++i2){
if(depth==2) ww = w[i2];
for(i3=0; i3<n3-1; ++i3){
if(depth==3) ww = w[i3+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i3][i1] = ww+2.*r3;
e[i3][i1] = -r3;
f[i3][i1] = ww*v[i3+1][i2][i1];
}
}
for(i1=0; i1<n1; ++i1){
d[n3-2][i1] -= r3;
f[0][i1] += r3*v[0][i2][i1];
}
tripd2(d,e,f,n3-1,n1);
for(i=1; i<iter; ++i){
for(i3=0; i3<n3-1; ++i3){
if(depth==3) ww = w[i3+1];
for(i1=0; i1<n1; ++i1){
if(depth==1) ww = w[i1];
d[i3][i1] = ww+2.*r3;
e[i3][i1] = -r3;
f[i3][i1] *= ww;
}
}
for(i1=0; i1<n1; ++i1){
d[n3-2][i1] -= r3;
f[0][i1] += r3*v[0][i2][i1];
}
tripd2(d,e,f,n3-1,n1);
}
for(i3=0; i3<n3-1; ++i3)
for(i1=0; i1<n1; ++i1)
v[i3+1][i2][i1] = f[i3][i1];
}
}
if(r1>0.) {
/* smooth velocity in the first direction */
/* allocate space */
d = alloc2float(1,n1);
e = alloc2float(1,n1);
f = alloc2float(1,n1);
for(i3=0; i3<n3; ++i3){
if(depth==3) ww = w[i3];
for(i2=0; i2<n2; ++i2){
if(depth==2) ww = w[i2];
for(i1=0; i1<n1-1; ++i1){
if(depth==1) ww = w[i1+1];
d[i1][0] = ww+r1*2.0;
e[i1][0] = -r1;
f[i1][0] = ww*v[i3][i2][i1+1];
}
d[n1-2][0] -= r1;
f[0][0] += r1*v[i3][i2][0];
tripd2(d,e,f,n1-1,1);
for(i=1; i<iter; ++i) {
for(i1=0; i1<n1-1; ++i1){
if(depth==1) ww = w[i1+1];
d[i1][0] = ww+r1*2.0;
e[i1][0] = -r1;
f[i1][0] *= ww;
}
d[n1-2][0] -= r1;
f[0][0] += r1*v[i3][i2][0];
tripd2(d,e,f,n1-1,1);
}
for(i1=0; i1<n1-1; ++i1)
v[i3][i2][i1+1] = f[i1][0];
}
}
}
if(sl) {
for(i3=0; i3<n3; ++i3)
for(i2=0; i2<n2; ++i2)
for(i1=0; i1<n1; ++i1)
v[i3][i2][i1] = 1.0/v[i3][i2][i1];
}
free1float(w);
if(r1>0. || r2>0. || r3>0.) {
free2float(d);
free2float(e);
free2float(f);
}
}
void ray_theoretic_sigma (int na, float da, float r, float dr,
float uc[], float wc[], float sc[],
float un[], float wn[], float sn[])
/*****************************************************************************
ray_theoretic_sigma - difference equation extrapolation of "ray_theoretic_sigma" in polar coordinates
******************************************************************************
Input:
na number of a samples
da a sampling interval
r current radial distance r
dr radial distance to extrapolate
uc array[na] of dt/dr at current r
wc array[na] of dt/da at current r
sc array[na] of ray_theoretic_sigma at current r
un array[na] of dt/dr at next r
wn array[na] of dt/da at next r
Output:
sn array[na] of ray_theoretic_sigma at next r
******************************************************************************
This function implements the Crank-Nicolson finite-difference method with
boundary conditions dray_theoretic_sigma/da=0.
******************************************************************************
Author: Zhenyue Liu, Colorado School of Mines, 07/8/92
******************************************************************************/
{
int i;
float r1,*d,*b,*c,*e;
/* allocate workspace */
d = alloc1float(na-2);
b = alloc1float(na-2);
c = alloc1float(na-2);
e = alloc1float(na-2);
r1 = r+dr;
/* Crank-Nicolson */
for (i=0; i<na-2; ++i) {
d[i] = (uc[i+1]+un[i+1])/(2.0*dr);
e[i] = (wn[i+1]/(r1*r1)+wc[i+1]/(r*r))/(8.0*da);
b[i] = 1.0-(sc[i+2]-sc[i])*e[i]
+d[i]*sc[i+1];
c[i] = -e[i];
}
d[0] += c[0];
d[na-3] += e[na-3];
tripp(na-2,d,e,c,b);
for(i=0;i<na-2; ++i) sn[i+1]=b[i];
sn[0] = sn[1];
sn[na-1] = sn[na-2];
/* free workspace */
free1float(d);
free1float(c);
free1float(e);
free1float(b);
}
void ray_theoretic_beta (int na, float da, float r, float dr,
float uc[], float wc[], float bc[],
float un[], float wn[], float bn[])
/*****************************************************************************
ray_theoretic_beta - difference equation extrapolation of "ray_theoretic_beta" in polar coordinates
******************************************************************************
Input:
na number of a samples
da a sampling interval
r current radial distance r
dr radial distance to extrapolate
uc array[na] of dt/dr at current r
wc array[na] of dt/da at current r
bc array[na] of ray_theoretic_beta at current r
un array[na] of dt/dr at next r
wn array[na] of dt/da at next r
Output:
bn array[na] of ray_theoretic_beta at next r
******************************************************************************
Notes: This function implements the Crank-Nicolson finite-difference
method, with boundary conditions dray_theoretic_beta/da=1.
******************************************************************************
author: Zhenyue Liu, Colorado School of Mines, 07/8/92
******************************************************************************/
{
int i;
float r1,*d,*b,*c,*e;
/* allocate workspace */
d = alloc1float(na-2);
b = alloc1float(na-2);
c = alloc1float(na-2);
e = alloc1float(na-2);
r1 = r+dr;
/* Crank-Nicolson */
for (i=0; i<na-2; ++i) {
d[i] = uc[i+1]*r*r+un[i+1]*r1*r1;
e[i] = (wn[i+1]+wc[i+1])*dr/(4.0*da);
b[i] = -(bc[i+2]-bc[i])*e[i]
+d[i]*bc[i+1];
c[i] = -e[i];
}
d[0] += c[0];
d[na-3] += e[na-3];
b[0] += da*c[0];
b[na-3] -= da*e[na-3];
tripp(na-2,d,e,c,b);
for(i=0;i<na-2; ++i) bn[i+1]=b[i];
bn[0] = bn[1]-da;
bn[na-1] = bn[na-2]+da;
/* free workspace */
free1float(d);
free1float(c);
free1float(e);
free1float(b);
}
void antialias (float frac, int phase, int n, float p[], float q[])
/*****************************************************************************
Anti-alias filter - use before increasing the sampling interval (sub-sampling)
******************************************************************************
Input:
frac current sampling interval / future interval (should be <= 1)
phase =0 for zero-phase filter; =1 for minimum-phase filter
n number of samples
p array[n] of input samples
Output:
q array[n] of output (anti-alias filtered) samples
******************************************************************************
Notes:
The anti-alias filter is a recursive (Butterworth) filter. For zero-phase
anti-alias filtering, the recursive filter is applied forwards and backwards.
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 06/06/90
*****************************************************************************/
{
int i,j,npoles,ntemp;
float fnyq,fpass,apass,fstop,astop,f3db,*ptemp,ptempi;
/* if no anti-alias filter need be applied, then simply copy input */
if (ABS(frac)>=1.0) {
for (i=0; i<n; ++i)
q[i] = p[i];
return;
}
/* determine number of poles and -3db point for filter */
fnyq = 0.5*ABS(frac);
fpass = 0.6*fnyq;
apass = 0.99;
fstop = fnyq;
astop = 0.01;
bfdesign(fpass,apass,fstop,astop,&npoles,&f3db);
/* if minimum-phase, then use npoles*2 poles in one direction only */
if (phase!=0) {
bflowpass(npoles*2,f3db,n,p,q);
/* else, if zero-phase, use npoles in both directions */
} else {
/* pad input with zeros to catch recursive filter tail */
ntemp = n+100;
ptemp = alloc1float(ntemp);
for (i=0; i<n; ++i)
ptemp[i] = p[i];
for (i=n; i<ntemp; ++i)
ptemp[i] = 0.0;
/* filter zero-padded input */
bflowpass(npoles,f3db,ntemp,ptemp,ptemp);
/* reverse filtered input and filter again */
for (i=0,j=ntemp-1; i<j; ++i,--j) {
ptempi = ptemp[i];
ptemp[i] = ptemp[j];
ptemp[j] = ptempi;
}
bflowpass(npoles,f3db,ntemp,ptemp,ptemp);
/* undo the reverse while copying to output */
for (i=0,j=ntemp-1; i<n; ++i,--j)
q[i] = ptemp[j];
free1float(ptemp);
}
}
void eikpex (int na, float da, float r, float dr,
float sc[], float uc[], float wc[], float tc[],
float sn[], float un[], float wn[], float tn[])
/*****************************************************************************
eikpex - Eikonal equation extrapolation of times and derivatives in
polar coordinates
******************************************************************************
Input:
na number of a samples
da a sampling interval
r current radial distance r
dr radial distance to extrapolate
sc array[na] of slownesses at current r
uc array[na] of dt/dr at current r
wc array[na] of dt/da at current r
tc array[na] of times t at current r
sn array[na] of slownesses at next r
Output:
un array[na] of dt/dr at next r (may be equivalenced to uc)
wn array[na] of dt/da at next r (may be equivalenced to wc)
tn array[na] of times t at next r (may be equivalenced to tc)
******************************************************************************
Notes:
If na*da==2*PI, then the angular coordinate is wrapped around (periodic).
This function implements the finite-difference method described by Bill
Symes (Rice University) and Jos van Trier (Stanford University) in a
(1990) preprint of a paper submitted to Geophysics.
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 07/16/90
******************************************************************************/
{
int i,wrap;
float drleft,drorig,frac,cmax,umaxl,uminr,uminm,umaxm,
uu,unew,uold,ueol,ueor,wor,or,*wtemp,*s;
/* allocate workspace */
wtemp = alloc1float(na);
s = alloc1float(na);
/* remember the step size */
drleft = drorig = dr;
/* initialize slownesses to values at current r */
for (i=0; i<na; ++i)
s[i] = sc[i];
/* copy inputs to output */
for (i=0; i<na; ++i) {
un[i] = uc[i];
wn[i] = wc[i];
tn[i] = tc[i];
}
/* determine if angular coordinate wraps around */
wrap = ABS(na*da-2.0*PI)<0.01*ABS(da);
/* loop over intermediate steps with adaptive stepsize */
while (drleft>0.0) {
/* determine adaptive step size according to CFL condition */
for (i=0,cmax=TINY; i<na; ++i) {
if (r*ABS(un[i])<TINY*ABS(wn[i]))
cmax = 1.0/TINY;
else
cmax = MAX(cmax,ABS(wn[i]/(r*un[i])));
}
dr = MIN(drleft,CFL/cmax*r*da);
/* if angles wrap around */
if (wrap) {
umaxl = (wn[na-1]>0.0 ? un[na-1] : s[0]);
if (wn[0]>0.0) {
uminm = s[0];
umaxm = un[0];
} else {
uminm = un[0];
umaxm = s[0];
}
uminr = (wn[1]>0.0 ? s[0] : un[1]);
ueol = uminm+umaxl;
ueor = uminr+umaxm;
wtemp[0] = wn[0]+dr*(ueor-ueol)/da;
umaxl = (wn[na-2]>0.0 ? un[na-2] : s[na-1]);
if (wn[na-1]>0.0) {
uminm = s[na-1];
umaxm = un[na-1];
} else {
uminm = un[na-1];
umaxm = s[na-1];
}
uminr = (wn[0]>0.0 ? s[na-1] : un[0]);
ueol = uminm+umaxl;
ueor = uminr+umaxm;
wtemp[na-1] = wn[na-1]+dr*(ueor-ueol)/da;
/* else, if angles do not wrap around */
} else {
if (wn[0]<=0.0)
wtemp[0] = wn[0] +
dr*(un[1]-un[0])/da;
else
wtemp[0] = 0.0;
if (wn[na-1]>=0.0)
wtemp[na-1] = wn[na-1] +
dr*(un[na-1]-un[na-2])/da;
else
wtemp[na-1] = 0.0;
}
/* update interior w values via Enquist/Osher scheme */
for (i=1; i<na-1; ++i) {
umaxl = (wn[i-1]>0.0 ? un[i-1] : s[i]);
if (wn[i]>0.0) {
uminm = s[i];
umaxm = un[i];
} else {
uminm = un[i];
umaxm = s[i];
}
uminr = (wn[i+1]>0.0 ? s[i] : un[i+1]);
ueol = uminm+umaxl;
ueor = uminr+umaxm;
wtemp[i] = wn[i]+dr*(ueor-ueol)/da;
}
/* decrement the size of step left to do */
drleft -= dr;
/* update radial coordinate and its inverse */
r += dr;
or = 1.0/r;
/* linearly interpolate slowness for new r */
frac = drleft/drorig;
for (i=0; i<na; ++i)
s[i] = frac*sc[i]+(1.0-frac)*sn[i];
/* update w and u; integrate u to get t */
for (i=0; i<na; i++) {
wn[i] = wtemp[i];
wor = wn[i]*or;
uu = (s[i]-wor)*(s[i]+wor);
if(uu<=0) err("\tRaypath has a too large curvature!\n\t A smoother velocity is required. \n");
unew = sqrt(uu);
uold = un[i];
un[i] = unew;
tn[i] += 0.5*dr*(unew+uold);
}
}
/* free workspace */
free1float(wtemp);
free1float(s);
}
main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp; /* file pointer */
char *auxChar; /* auxiliar character */
char *modelFile = " "; /* elastic model file */
/* THICK - RHO - VP - QP - VS - QS */
int i, k, iProc, iR; /* counters */
int initF, lastF; /* initial and final frequencies */
int apl_pid; /* PVM process id control */
int nSamplesOrig; /* time series length */
int die; /* flag used to kill processes */
int pid; /* process id */
int nProc; /* number of processes */
int processControl; /* monitoring PVM start */
int *processes; /* array with process ids */
int FReceived; /* number of frequencies processed */
int nFreqProc; /* number of frequencies per process */
int nFreqPart; /* number of frequency partitions */
int **statusFreq; /* monitors processed frequencies */
int FInfo[2]; /* frequency delimiters */
int **procInfo; /* frequency limits for each processor */
float wallcpu; /* wall clock time */
float dt; /* time sampling interval */
float f; /* current frequency */
float fR; /* reference frequency */
float tMax; /* maximum recording time */
float *thick, *alpha, *beta,
*rho, *qP, *qS; /* elastic constants and thickness */
complex **freqPart; /* frequency arrays sent by the slaves */
complex **uRF, **uZF; /* final frequency components */
INFO info[1]; /* basic information for slaves */
/* Logging information */
/* CleanLog(); */
/* getting input */
initargs(argc, argv);
requestdoc(0);
if (!getparstring("model", &modelFile)) modelFile = "model";
if (!getparstring("recfile", &auxChar)) auxChar = " ";
sprintf(info->recFile, "%s", auxChar);
if (!getparint("directwave", &info->directWave)) info->directWave = 1;
if (!getparfloat("r1", &info->r1)) info->r1 = 0;
if (!getparint("nr", &info->nR)) info->nR = 148;
if (!getparfloat("dr", &info->dR)) info->dR = .025;
if (!getparfloat("zs", &info->zs)) info->zs = 0.001;
if (info->zs <= 0) info->zs = 0.001;
if (!getparfloat("u1", &info->u1)) info->u1 = 0.0002;
if (!getparfloat("u2", &info->u2)) info->u2 = 1.;
if (!getparint("nu", &info->nU)) info->nU = 1000;
if (!getparfloat("f1", &info->f1)) info->f1 = 2;
if (!getparfloat("f2", &info->f2)) info->f2 = 50;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("tmax", &tMax)) tMax = 8;
if (!getparfloat("F1", &info->F1)) info->F1 = 0;
if (!getparfloat("F2", &info->F2)) info->F2 = 0;
if (!getparfloat("F3", &info->F3)) info->F3 = 1;
if (!getparint("hanning", &info->hanningFlag)) info->hanningFlag = 0;
if (!getparfloat("wu", &info->percU)) info->percU = 5; info->percU /= 100;
if (!getparfloat("ww", &info->percW)) info->percW = 5; info->percW /= 100;
if (!getparfloat("fr", &fR)) fR = 1; info->wR = 2 * PI * fR;
if (!getparfloat("tau", &info->tau)) info->tau = 50;
if (!getparint("nproc", &nProc)) nProc = 1;
if (!getparint("nfreqproc", &nFreqProc) || nProc == 1) nFreqProc = 0;
if (!getparint("verbose", &info->verbose)) info->verbose = 0;
/* how many layers */
fp = fopen(modelFile,"r");
if (fp == NULL)
err("No model file!\n");
info->nL = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&f, &f, &f, &f, &f, &f) != EOF)
info->nL++;
info->nL--;
fclose(fp);
if (info->verbose)
fprintf(stderr,"Number of layers in model %s : %d\n",
modelFile, info->nL + 1);
/* if specific geometry, count number of receivers */
fp = fopen(info->recFile, "r");
if (fp != NULL)
{
info->nR = 0;
while (fscanf(fp, "%f\n", &f) != EOF)
info->nR++;
}
fclose(fp);
/* memory allocation */
alpha = alloc1float(info->nL + 1);
beta = alloc1float(info->nL + 1);
rho = alloc1float(info->nL + 1);
qP = alloc1float(info->nL + 1);
qS = alloc1float(info->nL + 1);
thick = alloc1float(info->nL + 1);
processes = alloc1int(nProc);
procInfo = alloc2int(2, nProc);
/* reading the file */
fp = fopen(modelFile,"r");
if (info->verbose)
fprintf(stderr,"Thickness rho vP qP vS qS\n");
for (i = 0; i < info->nL + 1; i++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[i], &rho[i], &alpha[i],
&qP[i], &beta[i], &qS[i]);
if (info->verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[i], rho[i], alpha[i], qP[i], beta[i], qS[i]);
}
fclose(fp);
/* computing frequency interval */
info->nSamples = NINT(tMax / dt) + 1;
nSamplesOrig = info->nSamples;
info->nSamples = npfar(info->nSamples);
/* slowness increment */
info->dU = (info->u2 - info->u1) / (float) info->nU;
/* computing more frequency related quatities */
tMax = dt * (info->nSamples - 1);
info->dF = 1. / (tMax);
f = info->dF;
while (f < info->f1) f += info->dF;
info->f1 = f;
while (f < info->f2) f += info->dF;
info->f2 = f;
initF = NINT(info->f1 / info->dF);
lastF = NINT(info->f2 / info->dF);
info->nF = lastF - initF + 1;
if (info->nF%2 == 0)
{
info->nF++;
lastF++;
}
/* attenuation of wrap-around */
info->tau = log(info->tau) / tMax;
if (info->tau > TAUMAX)
info->tau = TAUMAX;
if (info->verbose)
fprintf(stderr, "Discrete frequency range to model: [%d, %d]\n",
initF, lastF);
if (nFreqProc == 0)
nFreqProc = NINT((float) info->nF / (float) nProc + .5);
else
while (nFreqProc > info->nF) nFreqProc /= 2;
nFreqPart = NINT((float) info->nF / (float) nFreqProc + .5);
/* memory allocation for frequency arrays */
uRF = alloc2complex(info->nSamples / 2 + 1, info->nR);
uZF = alloc2complex(info->nSamples / 2 + 1, info->nR);
freqPart = alloc2complex(nFreqProc, info->nR);
statusFreq = alloc2int(3, nFreqPart);
/* defining frequency partitions */
for (k = initF, i = 0; i < nFreqPart; i++, k += nFreqProc)
{
statusFreq[i][0] = k;
statusFreq[i][1] = MIN(k + nFreqProc - 1, lastF);
statusFreq[i][2] = 0;
}
if (info->verbose)
fprintf(stderr, "Starting communication with PVM\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
err("Error enrolling master process");
/* exit(-1); */
}
fprintf(stderr, "Starting %d slaves ... ", nProc);
processControl = CreateSlaves(processes, PROCESS, nProc);
if (processControl != nProc)
{
err("Problem starting Slaves (%s)\n", PROCESS);
/* exit(-1); */
}
fprintf(stderr, " Ready \n");
info->nFreqProc = nFreqProc;
/* Broadcasting all processes common information */
BroadINFO(info, 1, processes, nProc, GENERAL_INFORMATION);
if (info->verbose) {
fprintf(stderr, "Broadcasting model information to all slaves\n");
fflush(stderr);
}
/* sending all profiles */
BroadFloat(thick, info->nL + 1, processes, nProc, THICKNESS);
BroadFloat(rho, info->nL + 1, processes, nProc, DENSITY);
BroadFloat(alpha, info->nL + 1, processes, nProc, ALPHA);
BroadFloat(qP, info->nL + 1, processes, nProc, QALPHA);
BroadFloat(beta, info->nL + 1, processes, nProc, BETA);
BroadFloat(qS, info->nL + 1, processes, nProc, QBETA);
/* freeing memory */
free1float(thick);
free1float(rho);
free1float(alpha);
free1float(qP);
free1float(beta);
free1float(qS);
/* sending frequency partitions for each process */
for (iProc = 0; iProc < nProc; iProc++)
{
FInfo[0] = statusFreq[iProc][0];
FInfo[1] = statusFreq[iProc][1];
if (info->verbose) {
fprintf(stderr,
"Master sending frequencies [%d, %d] out of %d to slave %d [id:%d]\n"
,FInfo[0], FInfo[1], info->nF, iProc, processes[iProc]);
fflush(stderr);
}
procInfo[iProc][0] = FInfo[0]; procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[iProc][2] = 1;
}
/* waiting modelled frequencies */
/* master process will send more frequencies if there's more work to do */
/* measuring elapsed time */
wallcpu = walltime();
/* reseting frequency counter */
FReceived = 0;
while (FOREVER)
{
pid = RecvCplx(freqPart[0], info->nR * nFreqProc, -1,
FREQUENCY_PARTITION_VERTICAL);
/* finding the frequency limits of this process */
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* copying into proper place of the total frequency array */
for (iR = 0; iR < info->nR; iR++)
{
for (k = 0, i = procInfo[iProc][0]; i <= procInfo[iProc][1]; i++, k++)
{
uZF[iR][i] = freqPart[iR][k];
}
}
pid = RecvCplx(freqPart[0], info->nR * nFreqProc, -1,
FREQUENCY_PARTITION_RADIAL);
/* finding the frequency limits of this process */
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* copying into proper place of the total frequency array */
for (iR = 0; iR < info->nR; iR++)
{
for (k = 0, i = procInfo[iProc][0]; i <= procInfo[iProc][1]; i++, k++)
{
uRF[iR][i] = freqPart[iR][k];
}
}
/* summing frequencies that are done */
FReceived += procInfo[iProc][1] - procInfo[iProc][0] + 1;
if (info->verbose)
fprintf(stderr, "Master received %d frequencies, remaining %d\n",
FReceived, info->nF - FReceived);
/* if (FReceived >= info->nF) break; */
/* defining new frequency limits */
i = 0;
while (i < nFreqPart && statusFreq[i][2])
i++;
if (i < nFreqPart)
{
/* there is still more work to be done */
/* tell this process to not die */
die = 0;
SendInt(&die, 1, processes[iProc], DIE);
FInfo[0] = statusFreq[i][0];
FInfo[1] = statusFreq[i][1];
if (info->verbose)
fprintf(stderr,
"Master sending frequencies [%d, %d] to slave %d\n",
FInfo[0], FInfo[1], processes[iProc]);
procInfo[iProc][0] = FInfo[0]; procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[i][2] = 1;
}
else
{
/* tell this process to die since there is no more work to do */
if (info->verbose)
fprintf(stderr, "Master ''killing'' slave %d\n", processes[iProc]);
die = 1;
SendInt(&die, 1, processes[iProc], DIE);
}
/* a check to get out the loop */
if (FReceived >= info->nF) break;
}
if (info->verbose)
fprintf(stderr, "Master ''killing'' remaining slaves\n");
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Wall clock time = %f seconds\n", wallcpu);
/* going to time domain */
memset( (void *) &trZ, (int) '\0', sizeof(trZ));
memset( (void *) &trR, (int) '\0', sizeof(trR));
trZ.dt = dt * 1000000;
trZ.ns = nSamplesOrig;
trR.dt = dt * 1000000;
trR.ns = nSamplesOrig;
/* z component */
for (iR = 0; iR < info->nR; iR++)
{
trZ.tracl = iR + 1;
/* inverse FFT */
pfacr(1, info->nSamples, uZF[iR], trZ.data);
for (i = 0; i < info->nSamples; i++)
{
/* compensating for the complex frequency */
trZ.data[i] *= exp(info->tau * i * dt);
}
puttr(&trZ);
}
/* r component */
for (iR = 0; iR < info->nR; iR++)
{
trR.tracl = info->nR + iR + 1;
/* inverse FFT */
pfacr(1, info->nSamples, uRF[iR], trR.data);
for (i = 0; i < info->nSamples; i++)
{
/* compensating for the complex frequency */
trR.data[i] *= exp(info->tau * i * dt);
}
puttr(&trR);
}
return(EXIT_SUCCESS);
}
/************************ end self doc ***********************************/
void main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp, *gp; /* file pointers */
char *orientation = " "; /* orientation of recordings */
char *recFile = " "; /* receiver location file */
char *postFile = " "; /* posteriori file */
char *modelFile = " "; /* elastic model file */
char *corrDataFile = " "; /* data covariance file */
char *corrModelFile[3]; /* model covariance file */
char *frechetFile = " "; /* frechet derivative file */
int verbose; /* verbose flag */
int noFrechet; /* if 1 don't store Frechet derivatives */
int i, j, k, iU, iParam, offset, iR, shift;
/* counters */
int wL; /* taper length */
int nParam; /* number of parameters altogether */
int numberParImp; /* number of distinct parameters in */
/* impedance inversion */
float dZ; /* layer thickness within target zone */
float F1, F2, F3; /* source components */
float depth; /* current depth used in defining limits */
/* for Frechet derivatives */
float fR; /* reference frequency */
float percU; /* amount of slowness windowing */
float percW; /* amount of frequency windowing */
float limZ[2]; /* target interval (Km) */
float tMod; /* maximum modeling time */
float phi; /* azimuth angle */
float *buffer1, *buffer2; /* auxiliary buffers */
float **CmPost; /* posteriori model covariance */
float **CmPostInv; /* posteriori model covariance - inverse */
/* allocing for orientation */
orientation = malloc(1);
/* complex Zero */
zeroC = cmplx(0, 0);
/* getting input parameters */
initargs(argc, argv);
requestdoc(0);
/* seismic data and model parameters */
if (!getparstring("model", &modelFile)) modelFile = "model";
if (!getparstring("postfile", &postFile)) postFile = "posteriori";
if (!getparstring("corrData", &corrDataFile)) corrDataFile = "corrdata";
if (!getparint("impedance", &IMPEDANCE)) IMPEDANCE = 0;
if (!getparstring("frechetfile", &frechetFile)) noFrechet = 0;
else noFrechet = 1;
if (!getparint("prior", &PRIOR)) PRIOR = 1;
if (IMPEDANCE)
{
if (!getparint("p", &ipFrechet)) vpFrechet = 1;
if (!getparint("s", &isFrechet)) vsFrechet = 1;
if (!getparint("r", &rhoFrechet)) rhoFrechet = 1;
}
else
{
if (!getparint("p", &vpFrechet)) vpFrechet = 1;
if (!getparint("s", &vsFrechet)) vsFrechet = 1;
if (!getparint("rho", &rhoFrechet)) rhoFrechet = 1;
}
/* a couple of things to use later in chain rule */
if (!IMPEDANCE)
{
ipFrechet = 0; isFrechet = 0;
}
else
{
if (ipFrechet && !isFrechet)
{
vpFrechet = 1; vsFrechet = 0;
}
if (!ipFrechet && isFrechet)
{
vpFrechet = 0; vsFrechet = 1;
}
if (!ipFrechet && !isFrechet)
{
vpFrechet = 0; vsFrechet = 0;
}
if (ipFrechet && isFrechet)
{
vpFrechet = 1; vsFrechet = 1;
}
if (rhoFrechet)
{
vpFrechet = 1; vsFrechet = 1; rhoFrechet = 1;
}
}
if (!ipFrechet && ! isFrechet && !rhoFrechet && !vpFrechet && !vsFrechet)
err("No inverse unknowns to work with!\n");
numberPar = vpFrechet + vsFrechet + rhoFrechet;
numberParImp = ipFrechet + isFrechet + rhoFrechet;
if (PRIOR)
{
if (vpFrechet || ipFrechet)
{
if (!getparstring("corrP", &corrModelFile[0]))
corrModelFile[0] = "covP";
}
if (vsFrechet || isFrechet)
{
if (!getparstring("corrS", &corrModelFile[1]))
corrModelFile[1] = "covS";
}
if (rhoFrechet)
{
if (!getparstring("corrR", &corrModelFile[2]))
corrModelFile[2] = "covR";
}
}
if (!getparstring("orientation", &orientation)) orientation[0] = 'Z';
if (orientation[0] == 'z' || orientation[0] == 'Z')
{
VERTICAL = 1; RADIAL = 0;
}
else
{
VERTICAL = 0; RADIAL = 1;
}
if (!getparfloat("dz", &dZ)) dZ = .5;
if (!getparfloat("targetbeg", &limZ[0])) limZ[0] = 0.5;
if (!getparfloat("targetend", &limZ[1])) limZ[1] = 1.0;
/* geometry */
if (!getparfloat("r1", &r1)) r1 = 0.25;
if (!getparint("nr", &nR)) nR = 48;
if (!getparfloat("dr", &dR)) dR = .025;
if (!getparfloat("zs", &zs)) zs = .001;
if (!getparfloat("F1", &F1)) F1 = 0;
if (!getparfloat("F2", &F2)) F2 = 0;
if (!getparfloat("F3", &F3)) F3 = 1;
/* modeling */
if (!getparstring("receiverfile", &recFile)) recFile = " ";
if (!getparfloat("u1", &u1)) u1 = 0.0;
if (!getparfloat("u2", &u2)) u2 = 1.;
if (!getparint("directwave", &directWave)) directWave = 1;
if (!getparfloat("tau", &tau)) err("Specify tau!\n");
if (!getparint("nu", &nU)) nU = 1000;
if (!getparfloat("f1", &f1)) f1 = 2;
if (!getparfloat("f2", &f2)) f2 = 50;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("tmod", &tMod)) tMod = 8;
if (!getparfloat("t1", &t1)) t1 = 0;
if (!getparfloat("t2", &t2)) t2 = tMod;
if (!getparint("hanning", &hanningFlag)) hanningFlag = 1;
if (!getparfloat("wu", &percU)) percU = 10; percU /= 100;
if (!getparfloat("ww", &percW)) percW = 25; percW /= 100;
/* dialogue */
if (!getparint("verbose", &verbose)) verbose = 0;
/* checking number of receivers */
fp = fopen(recFile, "r");
if (fp != NULL)
{
nR = 0;
while (fscanf(fp, "%f\n", &auxm1) != EOF) nR++;
}
fclose(fp);
/* some hard-coded parameters */
fR = 1; wR = 2 * PI * fR; /* reference frequency */
/* how many layers */
fp = fopen(modelFile,"r");
if (fp == NULL)
err("No model file!\n");
nL = 0;
depth = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&aux, &aux, &aux, &aux, &aux, &aux) != EOF)
nL++;
nL--;
/* considering the unknown layers */
limRange = NINT((limZ[1] - limZ[0]) / dZ);
if (verbose)
{
fprintf(stderr,"Number of layers: %d\n", nL + 1);
fprintf(stderr,"Number of layers in target zone: %d\n", limRange);
}
if (IMPEDANCE)
{
nParam = numberParImp * limRange;
}
else
{
nParam = numberPar * limRange;
}
/* basic time-frequency stuff */
nSamples = NINT(tMod / dt) + 1;
nSamples = npfar(nSamples);
/* length of time misfit */
nDM = NINT((t2 - t1) / dt) + 1;
/* maximum time for modeling */
tMod = dt * (nSamples - 1);
dF = 1. / (tMod);
/* adjusting f1 and f2 */
aux = dF;
while (aux < f1)
aux += dF;
f1 = aux;
while (aux < f2)
aux += dF;
f2 = aux;
nF = NINT((f2 - f1) / dF);
if (nF%2 == 0)
{
f2 += dF;
nF++;
}
/* memory allocation */
alpha = alloc1float(nL + 1);
beta = alloc1float(nL + 1);
rho = alloc1float(nL + 1);
qP = alloc1float(nL + 1);
qS = alloc1float(nL + 1);
thick = alloc1float(nL + 1);
recArray = alloc1float(nR);
PSlowness = alloc2complex(2, nL + 1);
SSlowness = alloc2complex(2, nL + 1);
S2Velocity = alloc2complex(2, nL + 1);
CD = alloc1float(nDM * (nDM + 1) / 2);
if (PRIOR)
{
if(vpFrechet || ipFrechet)
CMP = alloc1float(limRange * (limRange + 1) / 2);
if(vsFrechet || isFrechet)
CMS = alloc1float(limRange * (limRange + 1) / 2);
if(rhoFrechet)
CMrho = alloc1float(limRange * (limRange + 1) / 2);
}
/* FRECHET derivative operator F */
F = alloc2float(nR * nDM, numberPar * limRange);
if (IMPEDANCE)
CmPostInv =
alloc2float(numberParImp * limRange, numberParImp * limRange);
else
CmPostInv = alloc2float(numberPar * limRange, numberPar * limRange);
v1 = alloc2complex(2, numberPar * limRange + 1);
v2 = alloc2complex(2, numberPar * limRange + 1);
DmB = alloc3complex(4, numberPar * (limRange + 2), nL);
derFactor = alloc2complex(2, nL + 1);
aux11 = alloc2complex(nR, numberPar * limRange);
aux12 = alloc2complex(nR, numberPar * limRange);
aux21 = alloc2complex(nR, numberPar * limRange);
aux22 = alloc2complex(nR, numberPar * limRange);
aux11Old = alloc2complex(nR, numberPar * limRange);
aux12Old = alloc2complex(nR, numberPar * limRange);
aux21Old = alloc2complex(nR, numberPar * limRange);
aux22Old = alloc2complex(nR, numberPar * limRange);
/* reading receiver configuration */
fp = fopen(recFile, "r");
if (fp == NULL)
{
/* standard end-on */
if (verbose) fprintf(stderr, "No receiver file available\n");
for (i = 0; i < nR; i++)
{
recArray[i] = r1 + i * dR;
}
}
else
{
if (verbose) fprintf(stderr, "Reading receiver file %s\n", recFile);
for (i = 0; i < nR; i++)
{
fscanf(fp, "%f\n", &recArray[i]);
}
}
fclose(fp);
/* reading the model file */
fp = fopen(modelFile,"r");
if (verbose)
fprintf(stderr," Thickness rho vP qP vS qS\n");
for (k = 0; k < nL + 1; k++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[k], &rho[k], &alpha[k],
&qP[k], &beta[k], &qS[k]);
if (verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[k], rho[k], alpha[k], qP[k], beta[k], qS[k]);
}
fclose(fp);
/* setting lim[0] and lim[1] */
for (depth = thick[0], i = 1; i <= nL; depth += thick[i], i++)
{
if (NINT(depth / dZ) <= NINT(limZ[0] / dZ)) lim[0] = i;
if (NINT(depth / dZ) < NINT(limZ[1] / dZ)) lim[1] = i;
}
lim[1]++;
/* some modeling parameters */
/* slowness increment */
dU = (u2 - u1) / (float) nU;
/* computing the window length for the slowness domain */
epslon1 = (u2 - u1) * percU;
wL = NINT(epslon1 / dU);
wL = 2 * wL + 1;
u2 += epslon1;
nU = NINT((u2 - u1) / dU); /* new nU to preserve last slowness */
/* w/o being windowed */
taper = alloc1float(nU);
/* building window for slowness integration */
for (i = (wL - 1) / 2, iU = 0; iU < nU; iU++)
{
taper[iU] = 1;
if (iU >= nU - (wL - 1) / 2)
{
i++;
taper[iU] =
.42 - .5 * cos(2 * PI * (float) i / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) i / ((float) (wL - 1)));
}
}
/* filtering in frequency domain */
filter(percW);
/* building frequency filtering */
/* I will assume that the receivers are in line (at z = 0) so phi = 0 */
phi = 0;
epslon1 = F3;
epslon2 = F1 * cos(phi) + F2 * sin(phi);
/* correction for the 1st layer */
thick[0] -= zs;
/* imaginary part of frequency for damping wrap-around */
tau = log(tau) / tMod;
if (tau > TAUMAX)
tau = TAUMAX;
/* normalization for the complex slowness */
if (f1 > 7.5)
wRef = f1 * 2 * PI;
else
wRef = 7.5 * 2 * PI;
/* reading data and model covariance matrixes */
inputCovar(corrDataFile, corrModelFile);
/* starting inverse procedure */
/* FRECHET derivative matrix */
gradient();
if (!noFrechet)
{
fp = fopen(frechetFile, "w");
for (i = 0; i < numberPar * limRange; i++)
{
fwrite(&F[i][0], sizeof(float), nR * nDM, fp);
}
fclose(fp);
}
/* building a-posteriori model covariance matrix */
/* prior information is used */
buffer1 = alloc1float(nDM);
buffer2 = alloc1float(nDM * nR);
if (verbose) fprintf(stderr, "Building posteriori covariance...\n");
for (iParam = 0; iParam < nParam; iParam++)
{
for (i = 0; i < nDM; i++)
{
for (offset = i, k = 0; k < nDM; k++)
{
buffer1[k] = CD[offset];
offset += MAX(SGN0(i - k) * (nDM - 1 - k), 1);
}
/* doing the product CD F */
for (iR = 0; iR < nR; iR++)
{
buffer2[iR * nDM + i] = 0;
for (k = 0; k < nDM; k++)
{
buffer2[iR * nDM + i] += buffer1[k] *
F[iParam][iR * nDM + k];
}
}
}
for (j = 0; j < nParam; j++)
{
CmPostInv[j][iParam] = 0;
for (k = 0; k < nDM * nR; k++)
{
CmPostInv[j][iParam] += buffer2[k] * F[j][k];
}
}
}
if (verbose)
fprintf(stderr, "Posteriori covariance built. Including prior...\n");
free1float(buffer1);
buffer1 = alloc1float(nParam);
/* including prior covariance matrix */
if (PRIOR)
{
shift = 0;
if (IMPEDANCE)
{
if (ipFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vpFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
if (IMPEDANCE)
{
if (isFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vsFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
if (rhoFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMrho[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
}
}
if (verbose) fprintf(stderr, "Prior included. Inverting matrix...\n");
/* freeing memory */
free1float(buffer1);
free1float(buffer2);
free1float(alpha);
free1float(beta);
free1float(rho);
free1float(qP);
free1float(qS);
free1float(thick);
free2complex(PSlowness);
free2complex(SSlowness);
free2complex(S2Velocity);
free1float(CD);
free1float(CMP);
free1float(CMS);
free1float(CMrho);
free2float(F);
free2complex(v1);
free2complex(v2);
free3complex(DmB);
free2complex(derFactor);
free2complex(aux11);
free2complex(aux12);
free2complex(aux21);
free2complex(aux22);
free2complex(aux11Old);
free2complex(aux12Old);
free2complex(aux21Old);
free2complex(aux22Old);
/* inverting the matrix */
CmPost = alloc2float(nParam, nParam);
for (i = 0; i < nParam; i++) for (j = 0; j < nParam; j++)
CmPostInv[i][j] = CmPost[i][j];
inverse_matrix(nParam, CmPostInv);
if (verbose) fprintf(stderr, "Done with inverse matrix routine.\n");
buffer1 = alloc1float(nParam);
gp = fopen(postFile, "w");
for (i = 0; i < nParam; i++)
{
fwrite(CmPostInv[i], sizeof(float), nParam, gp);
}
fclose(fp);
}
/************************ end self doc ***********************************/
void main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp; /* file pointer */
char *covarFile = " "; /* covariance file */
char *MAPFile = " "; /* MAP model file */
int i, j, k; /* counters */
int nL; /* number of layers */
int cl; /* correlation length */
int pWave; /* P-wave flag */
int sWave; /* S-wave flag */
int density; /* density flag */
int nVar; /* dimension of the problem */
int seed; /* input seed */
int lim[2]; /* integer limits for target zone */
int exponential; /* exponential flag */
int impedance; /* impedance flag */
int verbose; /* dialogue flag */
int nPar; /* number of active parameters */
int shift, shift1; /* used in simulation of more than one */
/* parameter */
long seed1, seed2; /* seed for random generator */
float limZ[2]; /* depth limits of target zone */
float *thick, *alpha, *beta, *rho;
/* medium parameters */
float *buffer; /* working buffer */
float aux1, aux2; /* auxiliar variables */
float *parm; /* paramter vector */
float *mean; /* mean vector */
float *work; /* working area */
float **covar; /* correlation matrix */
float **covarExp; /* exponential correlation matrix */
float *deviate; /* random gaussian realization */
float dz; /* depth discretization level */
float depth; /* current depth */
/* input parameters */
initargs(argc, argv);
requestdoc(0);
/* dimension of the problem */
if (!getparstring("covariance", &covarFile)) covarFile = "covar";
if (!getparstring("mean", &MAPFile)) MAPFile = "mean";
if (!getparint("exponential", &exponential)) exponential = 0;
if (!getparint("impedance", &impedance)) impedance = 0;
if (!getparint("p", &pWave)) pWave = 1;
if (!getparint("s", &sWave)) sWave = 1;
if (!getparint("r", &density)) density = 1;
if (!getparfloat("dz", &dz)) dz = .5;
nPar = pWave + sWave + density;
if (!getparfloat("targetbeg", &limZ[0])) limZ[0] = 0.5;
if (!getparfloat("targetend", &limZ[1])) limZ[1] = 1.0;
if (!getparint("verbose", &verbose)) verbose = 0;
/* random generator seeding */
seed = getpid();
fp = fopen(MAPFile, "r");
if (fp == NULL) err("No model file!\n");
nL = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&aux1, &aux1, &aux1, &aux1, &aux1, &aux1) != EOF)
nL++;
nL--;
rewind(fp);
/* memory allocation */
alpha = alloc1float(nL + 1);
beta = alloc1float(nL + 1);
rho = alloc1float(nL + 1);
thick = alloc1float(nL + 1);
if (verbose)
fprintf(stderr," Thickness rho vP qP vS qS\n");
for (k = 0; k < nL + 1; k++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[k], &rho[k], &alpha[k],
&aux1, &beta[k], &aux2);
if (verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[k], rho[k], alpha[k], aux1, beta[k], aux2);
if (impedance)
{
alpha[k] *= rho[k];
beta[k] *= rho[k];
}
}
fclose(fp);
/* setting lim[0] and lim[1] */
for (depth = thick[0], i = 1; i <= nL; depth += thick[i], i++)
{
if (NINT(depth / dz) <= NINT(limZ[0] / dz)) lim[0] = i;
if (NINT(depth / dz) < NINT(limZ[1] / dz)) lim[1] = i;
}
/* total dimension */
nVar = nPar * (lim[1] - lim[0] + 1);
if (verbose)
fprintf(stderr, "Total dimension of the problem: %d\n", nVar);
/* more memory allocation */
covar = alloc2float(nVar, nVar);
covarExp = alloc2float(nVar, nVar);
parm = alloc1float(nVar * (nVar + 3) / 2 + 1);
work = alloc1float(nVar);
mean = alloc1float(nVar);
deviate = alloc1float(nVar);
buffer = alloc1float(nPar * (nL + 1));
fp = fopen(covarFile, "r");
if (fp == NULL) err("No covariance file!\n");
fread(&covar[0][0], sizeof(float), nVar * nVar, fp);
fclose(fp);
/* building the mean */
shift = 0;
if (pWave)
{
for (k = 0, i = lim[0]; i <= lim[1]; i++, k++)
mean[k] = alpha[i];
shift = nVar / nPar;
}
if (sWave)
{
for (k = 0, i = lim[0]; i <= lim[1]; i++, k++)
mean[k + shift] = beta[i];
shift += nVar / nPar;
}
if (density)
{
for (k = 0, i = lim[0]; i <= lim[1]; i++, k++)
mean[k + shift] = beta[i];
}
/* fitting an exponential model */
if (exponential)
{
for (i = 0; i < nVar; i++)
for (j = 0; j < nVar; j++)
covarExp[i][j] = 0;
for (i = 0; i < nVar; i++)
{
for (cl = 0, j = i; j < nVar; j++, cl++)
{
if (covar[i][j] / covar[i][i] < 1. / EULER) break;
}
for (j = 0; j < nVar; j++)
{
covarExp[i][j] += .5 * covar[i][i] *
exp(-(float) ABS(i - j) / (float) cl);
}
for (j = 0; j < nVar; j++)
{
covarExp[j][i] += .5 * covar[i][i] *
exp(-(float) ABS(i - j) / (float) cl);
}
}
for (i = 0; i < nVar; i++)
for (j = 0; j < nVar; j++)
covar[i][j] = covarExp[i][j];
}
/* reseting */
for (i = 0; i < nVar * (nVar + 3) / 2 + 1; i++)
{
parm[i] = 0;
if (i < nVar)
{
work[i] = 0;
deviate[i] = 0;
}
}
/* input data for generating realization of the multivariate */
/* gaussian */
setgmn(mean, covar[0], nVar, parm);
seed1 = (long) seed; seed2 = (long) seed * seed;
setall(seed1, seed2);
/* generating the realization */
genmn(parm, deviate, work);
/* copying to buffer */
shift = 0;
shift1 = 0;
if (pWave)
{
for (j = 0; j < lim[0]; j++)
buffer[j] = alpha[j];
for (k = 0, j = lim[0]; j <= lim[1]; j++, k++)
buffer[j] = deviate[k];
for (j = lim[1]; j < nL + 1; j++)
buffer[j] = alpha[j];
shift = nL;
shift1 = nVar / nPar;
}
if (sWave)
{
for (j = 0; j < lim[0]; j++)
buffer[j + shift] = beta[j];
for (k = 0, j = lim[0]; j <= lim[1]; j++, k++)
buffer[j + shift] = deviate[k + shift1];
for (j = lim[1]; j < nL + 1; j++)
buffer[j + shift] = beta[j];
shift += nL;
shift1 += nVar / nPar;
}
if (density)
{
for (j = 0; j < lim[0]; j++)
buffer[j + shift] = rho[j];
for (k = 0, j = lim[0]; j <= lim[1]; j++, k++)
buffer[j + shift] = deviate[k + shift1];
for (j = lim[1]; j < nL + 1; j++)
buffer[j + shift] = rho[j];
}
/* outputting */
fwrite(buffer, sizeof(float), nPar * (nL + 1), stdout);
}
void uniQuant(float *x, int n, float error,
float *ave, float *step, int *qx)
/******************************************************************************
uniform quantization with a given relative RMS error
*******************************************************************************
x array[] of input signal
n length of the signal
error relative RMS error
ave average of the input signal
step stepsize used in quantization
qx array[] output integers
******************************************************************************/
{
int i;
float rn, atmp, dev, lave, lstep;
float *g;
/* allocate temporary space */
g = alloc1float(n);
rn = 1./n;
lave = 0.;
/* average, or mean-value */
for(i=0; i<n; i++) lave += x[i];
lave *= rn;
lstep = *step;
/*
fprintf(stderr,"average=%f\n", lave);
for(i=0; i<n; i++)
fprintf(stderr,"f[%d]=%f\n", i, x[i]);
*/
/* if no deviation calculated */
if(lstep < 0.)
{
dev = 0.;
/* standard deviation, or RMS */
for(i=0; i<n; i++)
{
g[i] = x[i] - lave;
atmp = ABS(g[i]);
dev += atmp*atmp;
}
dev *= rn;
dev = sqrt(dev);
}
/* else */
else{
for(i=0; i<n; i++)
g[i] = x[i] - lave;
dev = lstep;
}
/* stepsize used in quantization */
lstep = dev*error*ERRATIO;
lstep = 1./lstep;
fprintf(stderr,"lstep=%f\n", lstep);
/* uniform quantization */
for(i=0; i<n; i++)
{
atmp = g[i]*lstep;
/*
qx[i] = NINT(atmp);
*/
qx[i] = (atmp > 0.)? ((int) (atmp+.5)) : ((int) (atmp-.5));
}
fprintf(stderr,"after quantization\n");
/* average and stepsize */
*ave = lave;
*step = lstep;
/* free the workspace */
free1float(g);
}
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());
}
void gradient()
{
/* declaration of variables */
int i, indexF, iF, iR, iU, iDer, iL, iT, iT1;
/* counters */
float f; /* temporal frequency */
float w; /* radian frequency */
float u; /* slowness */
float cte; /* a constant */
float *buffer; /* auxiliary buffer */
complex dUCEp1, dUCEp2; /* dUC * epslon1 and dUC * epslon2 */
complex wCCte; /* auxiliar variable */
complex am; /* vertical P-wave slownesses */
complex amInv; /* 1. / am */
complex amI; /* amI = am * I */
complex bm; /* vertical S-wave slownesses */
complex bmInv; /* 1. / bm */
complex bmI; /* bmI = bm * I */
complex As1, As2; /* amplitudes of plane wave components (P)*/
complex Cs1, Cs2; /* amplitudes of plane wave components (S)*/
/* downgoing waves */
complex Bs1, Bs2; /* amplitudes of plane wave components (P)*/
complex Ds1, Ds2; /* amplitudes of plane wave components (S)*/
/* upgoing waves */
complex g[2]; /* phase-shift vector */
complex ***displ; /* Frechet derivative of the */
/* displacements in the frequency domain */
complex dpl; /* auxiliary variable */
/* allocating memory */
displ = alloc3complex(nSamples / 2 + 1, nR, numberPar * limRange);
buffer = alloc1float(nSamples);
/* auxiliar constant */
cte = 1. / (4 * PI * rho[0]);
/* reseting displ */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
for (iR = 0; iR < nR; iR++)
for (iF = 0; iF < nSamples / 2 + 1; iF++)
displ[iDer][iR][iF] = zeroC;
for (indexF = NINT(f1 / dF), f = f1, iF = 0; iF < nF; iF++,
f += dF, indexF++)
{
fprintf(stderr,"FRECHET derivatives at frequency (Hz): %f\n", f);
/* reseting */
for (i = 0; i < numberPar * limRange; i++)
{
for (iR = 0; iR < nR; iR++)
{
aux11[i][iR] = zeroC; aux12[i][iR] = zeroC;
aux21[i][iR] = zeroC; aux22[i][iR] = zeroC;
aux11Old[i][iR] = zeroC; aux12Old[i][iR] = zeroC;
aux21Old[i][iR] = zeroC; aux22Old[i][iR] = zeroC;
}
}
w = 2 * PI * f;
wC.r = w; wC.i = -tau;
/* module and phase of complex frequency */
wCR = sqrt(wC.r * wC.r + wC.i * wC.i);
wCP = atan2(wC.i, wC.r);
/* complex slowness step */
dUC.r = w * dU / wCR;
dUC.i = tau * dU / wCR;
/* wCR / wR */
wCRwR = wCR / wR;
/* auxiliary variable */
wCCte.r = wC.r * cte;
wCCte.i = wC.i * cte;
/* compute frequency-dependent horizontal slownesses (squared) */
/* and also the s-wave VELOCITIES (squared) for all layers */
horSlownessFrechet();
for (u = u1, iU = 0; iU < nU; iU++,
u += dU, uC.r += dUC.r, uC.i += dUC.i)
{
uC.r = u;
uC.i = u * tau / wRef;
uC2.r = 2 * uC.r;
uC2.i = 2 * uC.i;
aux = uC.r * uC.r - uC.i * uC.i;
uuC.i = 2 * uC.r * uC.i;
uuC.r = aux;
uuC2.r = 2 * uuC.r;
uuC2.i = 2 * uuC.i;
muC.r = uC.r * -1;
muC.i = uC.i * -1;
/* building reflectivity matrices */
RmFrechet();
Rp();
/* reseting */
As1 = zeroC; As2 = zeroC; /* downgoing waves */
Cs1 = zeroC; Cs2 = zeroC; /* downgoing waves */
Bs1 = zeroC; Bs2 = zeroC; /* upgoing waves */
Ds1 = zeroC; Ds2 = zeroC; /* upgoing waves */
/* P-wave potential */
/* PSlowness^2 - uuC */
auxm1 = PSlowness[0][0].r - uuC.r;
auxm2 = PSlowness[0][0].i - uuC.i;
auxm3 = sqrt(auxm1 * auxm1 + auxm2 * auxm2);
auxm3 = sqrt(auxm3);
angle = atan2(auxm2, auxm1) / 2;
am.r = auxm3 * cos(angle);
am.i = auxm3 * sin(angle);
/* am * I */
amI.r = -am.i;
amI.i = am.r;
As1 = uC;
if (directWave) Bs1 = muC;
/* 1 / am */
aux = am.r * am.r + am.i * am.i;
amInv.r = am.r / aux;
amInv.i = -am.i / aux;
/* amInv * uuC */
aux2.r = amInv.r * uuC.r - uuC.i * amInv.i;
aux2.i = amInv.r * uuC.i + amInv.i * uuC.r;
/* aux2 * -I */
As2.r = aux2.i;
As2.i = -aux2.r;
/* notice that Bs2 = As2 */
if (directWave) Bs2 = As2;
/* S-wave potential */
/* SSlowness^2 - uuC */
auxm1 = SSlowness[0][0].r - uuC.r;
auxm2 = SSlowness[0][0].i - uuC.i;
/* computing bm */
auxm3 = sqrt(auxm1 * auxm1 + auxm2 * auxm2);
auxm3 = sqrt(auxm3);
angle = atan2(auxm2, auxm1) / 2;
bm.r = auxm3 * cos(angle);
bm.i = auxm3 * sin(angle);
/* bm * I */
bmI.r = -bm.i;
bmI.i = bm.r;
/* 1 / bm */
aux = bm.r * bm.r + bm.i * bm.i;
bmInv.r = bm.r / aux;
bmInv.i = -bm.i / aux;
/* 1. / bm * uuC */
aux1.r = bmInv.r * uuC.r - bmInv.i * uuC.i;
aux1.i = bmInv.r * uuC.i + bmInv.i * uuC.r;
/* notice that Cs1 = Ds1 */
Cs1 = aux1;
if (directWave) Ds1 = aux1;
Cs2.r = -uC.i;
Cs2.i = uC.r;
if (directWave)
{
Ds2.r = -Cs2.r;
Ds2.i = -Cs2.i;
}
/* computing compensation for free-surface */
buildFreeSurfaceCompensation(am, bm);
/* computing phase shift (that's the matrix G in Muller's */
/* paper eq. (87) */
/* exp(j * am * wC * (-zs)) */
auxm1 = zs * (- amI.r * wC.r + amI.i * wC.i);
auxm2 = -zs * (amI.r * wC.i + amI.i * wC.r);
g[0].r = exp(auxm1) * cos(auxm2);
g[0].i = exp(auxm1) * sin(auxm2);
/* exp(j * bm * wC * (-zs)) */
auxm1 = zs * (- bmI.r * wC.r + bmI.i * wC.i);
auxm2 = -zs * (bmI.r * wC.i + bmI.i * wC.r);
g[1].r = exp(auxm1) * cos(auxm2);
g[1].i = exp(auxm1) * sin(auxm2);
/* computing the product I - R-R+ */
auxm1 = rm[0][0].r * rp[0][0].r - rm[0][0].i * rp[0][0].i;
auxm2 = rm[0][0].r * rp[0][0].i + rm[0][0].i * rp[0][0].r;
auxm3 = rm[0][1].r * rp[1][0].r - rm[0][1].i * rp[1][0].i;
auxm4 = rm[0][1].r * rp[1][0].i + rm[0][1].i * rp[1][0].r;
irr[0][0].r = 1 - (auxm1 + auxm3);
irr[0][0].i = - (auxm2 + auxm4);
auxm1 = rm[0][0].r * rp[0][1].r - rm[0][0].i * rp[0][1].i;
auxm2 = rm[0][0].r * rp[0][1].i + rm[0][0].i * rp[0][1].r;
auxm3 = rm[0][1].r * rp[1][1].r - rm[0][1].i * rp[1][1].i;
auxm4 = rm[0][1].r * rp[1][1].i + rm[0][1].i * rp[1][1].r;
irr[0][1].r = - (auxm1 + auxm3);
irr[0][1].i = - (auxm2 + auxm4);
auxm1 = rm[1][0].r * rp[0][0].r - rm[1][0].i * rp[0][0].i;
auxm2 = rm[1][0].r * rp[0][0].i + rm[1][0].i * rp[0][0].r;
auxm3 = rm[1][1].r * rp[1][0].r - rm[1][1].i * rp[1][0].i;
auxm4 = rm[1][1].r * rp[1][0].i + rm[1][1].i * rp[1][0].r;
irr[1][0].r = - (auxm1 + auxm3);
irr[1][0].i = - (auxm2 + auxm4);
auxm1 = rm[1][0].r * rp[0][1].r - rm[1][0].i * rp[0][1].i;
auxm2 = rm[1][0].r * rp[0][1].i + rm[1][0].i * rp[0][1].r;
auxm3 = rm[1][1].r * rp[1][1].r - rm[1][1].i * rp[1][1].i;
auxm4 = rm[1][1].r * rp[1][1].i + rm[1][1].i * rp[1][1].r;
irr[1][1].r = 1 - (auxm1 + auxm3);
irr[1][1].i = - (auxm2 + auxm4);
/* inverting irr explicitly */
auxm1 = irr[0][0].r * irr[1][1].r - irr[0][0].i * irr[1][1].i;
auxm2 = irr[0][0].r * irr[1][1].i + irr[0][0].i * irr[1][1].r;
auxm3 = irr[0][1].r * irr[1][0].r - irr[0][1].i * irr[1][0].i;
auxm4 = irr[0][1].r * irr[1][0].i + irr[0][1].i * irr[1][0].r;
aux1.r = auxm1 - auxm3;
aux1.i = auxm2 - auxm4;
/* 1 / aux1 */
aux = aux1.r * aux1.r + aux1.i * aux1.i;
aux1.r = aux1.r / aux;
aux1.i = -aux1.i / aux;
/* Inverse of irr */
irrI[0][0].r = irr[1][1].r * aux1.r - irr[1][1].i * aux1.i;
irrI[0][0].i = irr[1][1].r * aux1.i + irr[1][1].i * aux1.r;
irrI[0][1].r = -(irr[0][1].r * aux1.r - irr[0][1].i * aux1.i);
irrI[0][1].i = -(irr[0][1].r * aux1.i + irr[0][1].i * aux1.r);
irrI[1][0].r = -(irr[1][0].r * aux1.r - irr[1][0].i * aux1.i);
irrI[1][0].i = -(irr[1][0].r * aux1.i + irr[1][0].i * aux1.r);
irrI[1][1].r = irr[0][0].r * aux1.r - irr[0][0].i * aux1.i;
irrI[1][1].i = irr[0][0].r * aux1.i + irr[0][0].i * aux1.r;
/* computing vectors V1,2, check eq (76) Muller's paper */
auxm1 = As1.r * rm[0][0].r - As1.i * rm[0][0].i;
auxm2 = As1.r * rm[0][0].i + As1.i * rm[0][0].r;
auxm3 = Cs1.r * rm[0][1].r - Cs1.i * rm[0][1].i;
auxm4 = Cs1.r * rm[0][1].i + Cs1.i * rm[0][1].r;
aux1.r = Bs1.r + (auxm1 + auxm3);
aux1.i = Bs1.i + (auxm2 + auxm4);
auxm1 = As1.r * rm[1][0].r - As1.i * rm[1][0].i;
auxm2 = As1.r * rm[1][0].i + As1.i * rm[1][0].r;
auxm3 = Cs1.r * rm[1][1].r - Cs1.i * rm[1][1].i;
auxm4 = Cs1.r * rm[1][1].i + Cs1.i * rm[1][1].r;
aux2.r = Ds1.r + (auxm1 + auxm3);
aux2.i = Ds1.i + (auxm2 + auxm4);
auxm1 = aux1.r * irrI[0][0].r - aux1.i * irrI[0][0].i;
auxm2 = aux1.r * irrI[0][0].i + aux1.i * irrI[0][0].r;
auxm3 = aux2.r * irrI[0][1].r - aux2.i * irrI[0][1].i;
auxm4 = aux2.r * irrI[0][1].i + aux2.i * irrI[0][1].r;
v1[0][0].r = auxm1 + auxm3;
v1[0][0].i = auxm2 + auxm4;
auxm1 = aux1.r * irrI[1][0].r - aux1.i * irrI[1][0].i;
auxm2 = aux1.r * irrI[1][0].i + aux1.i * irrI[1][0].r;
auxm3 = aux2.r * irrI[1][1].r - aux2.i * irrI[1][1].i;
auxm4 = aux2.r * irrI[1][1].i + aux2.i * irrI[1][1].r;
v1[0][1].r = auxm1 + auxm3;
v1[0][1].i = auxm2 + auxm4;
/* loop over "active" layers */
for (iDer = 1, i = 0; i < numberPar; i++)
{
/* i = 0 -> Vp */
/* i = 1 -> Vs */
/* i = 2 -> rho */
for (iL = MIN(lim[0], 2); iL < MIN(lim[0], 2) + limRange;
iL++, iDer++)
{
/* rp * [v1[0], v1[1]] + (As1, Cs1)*/
auxm1 = rp[0][0].r * v1[0][0].r - rp[0][0].i * v1[0][0].i;
auxm2 = rp[0][0].r * v1[0][0].i + rp[0][0].i * v1[0][0].r;
auxm1 += rp[0][1].r * v1[0][1].r - rp[0][1].i * v1[0][1].i
+ As1.r;
auxm2 += rp[0][1].r * v1[0][1].i + rp[0][1].i * v1[0][1].r
+ As1.i;
auxm3 = rp[1][0].r * v1[0][0].r - rp[1][0].i * v1[0][0].i;
auxm4 = rp[1][0].r * v1[0][0].i + rp[1][0].i * v1[0][0].r;
auxm3 += rp[1][1].r * v1[0][1].r - rp[1][1].i * v1[0][1].i
+ Cs1.r;
auxm4 += rp[1][1].r * v1[0][1].i + rp[1][1].i * v1[0][1].r
+ Cs1.i;
/* DmB[0][active layers][0 1 2 3] * */
/* ((auxm1, auxm2), (auxm3, auxm4)) */
aux1.r = auxm1 * DmB[0][i * limRange + iL][0].r
- auxm2 * DmB[0][i * limRange + iL][0].i
+ auxm3 * DmB[0][i * limRange + iL][1].r
- auxm4 * DmB[0][i * limRange + iL][1].i;
aux1.i = auxm1 * DmB[0][i * limRange + iL][0].i
+ auxm2 * DmB[0][i * limRange + iL][0].r
+ auxm3 * DmB[0][i * limRange + iL][1].i
+ auxm4 * DmB[0][i * limRange + iL][1].r;
aux2.r = auxm1 * DmB[0][i * limRange + iL][2].r
- auxm2 * DmB[0][i * limRange + iL][2].i
+ auxm3 * DmB[0][i * limRange + iL][3].r
- auxm4 * DmB[0][i * limRange + iL][3].i;
aux2.i = auxm1 * DmB[0][i * limRange + iL][2].i
+ auxm2 * DmB[0][i * limRange + iL][2].r
+ auxm3 * DmB[0][i * limRange + iL][3].i
+ auxm4 * DmB[0][i * limRange + iL][3].r;
/* irrI * (aux1, aux2) */
auxm1 = irrI[0][0].r * aux1.r - irrI[0][0].i * aux1.i;
auxm2 = irrI[0][0].r * aux1.i + irrI[0][0].i * aux1.r;
auxm3 = irrI[0][1].r * aux2.r - irrI[0][1].i * aux2.i;
auxm4 = irrI[0][1].r * aux2.i + irrI[0][1].i * aux2.r;
v1[iDer][0].r = auxm1 + auxm3;
v1[iDer][0].i = auxm2 + auxm4;
auxm1 = irrI[1][0].r * aux1.r - irrI[1][0].i * aux1.i;
auxm2 = irrI[1][0].r * aux1.i + irrI[1][0].i * aux1.r;
auxm3 = irrI[1][1].r * aux2.r - irrI[1][1].i * aux2.i;
auxm4 = irrI[1][1].r * aux2.i + irrI[1][1].i * aux2.r;
v1[iDer][1].r = auxm1 + auxm3;
v1[iDer][1].i = auxm2 + auxm4;
}
}
auxm1 = As2.r * rm[0][0].r - As2.i * rm[0][0].i;
auxm2 = As2.r * rm[0][0].i + As2.i * rm[0][0].r;
auxm3 = Cs2.r * rm[0][1].r - Cs2.i * rm[0][1].i;
auxm4 = Cs2.r * rm[0][1].i + Cs2.i * rm[0][1].r;
aux1.r = Bs2.r + (auxm1 + auxm3);
aux1.i = Bs2.i + (auxm2 + auxm4);
auxm1 = As2.r * rm[1][0].r - As2.i * rm[1][0].i;
auxm2 = As2.r * rm[1][0].i + As2.i * rm[1][0].r;
auxm3 = Cs2.r * rm[1][1].r - Cs2.i * rm[1][1].i;
auxm4 = Cs2.r * rm[1][1].i + Cs2.i * rm[1][1].r;
aux2.r = Ds2.r + (auxm1 + auxm3);
aux2.i = Ds2.i + (auxm2 + auxm4);
auxm1 = aux1.r * irrI[0][0].r - aux1.i * irrI[0][0].i;
auxm2 = aux1.r * irrI[0][0].i + aux1.i * irrI[0][0].r;
auxm3 = aux2.r * irrI[0][1].r - aux2.i * irrI[0][1].i;
auxm4 = aux2.r * irrI[0][1].i + aux2.i * irrI[0][1].r;
v2[0][0].r = auxm1 + auxm3;
v2[0][0].i = auxm2 + auxm4;
auxm1 = aux1.r * irrI[1][0].r - aux1.i * irrI[1][0].i;
auxm2 = aux1.r * irrI[1][0].i + aux1.i * irrI[1][0].r;
auxm3 = aux2.r * irrI[1][1].r - aux2.i * irrI[1][1].i;
auxm4 = aux2.r * irrI[1][1].i + aux2.i * irrI[1][1].r;
v2[0][1].r = auxm1 + auxm3;
v2[0][1].i = auxm2 + auxm4;
/* loop over "active" layers */
for (iDer = 1, i = 0; i < numberPar; i++)
{
/* i = 0 -> Vp */
/* i = 1 -> Vs */
/* i = 2 -> rho */
for (iL = MIN(lim[0], 2); iL < MIN(lim[0], 2) + limRange;
iL++, iDer++)
{
/* rp * [v2[0], v2[1]] + (As2, Bs2) */
auxm1 = rp[0][0].r * v2[0][0].r - rp[0][0].i * v2[0][0].i;
auxm2 = rp[0][0].r * v2[0][0].i + rp[0][0].i * v2[0][0].r;
auxm1 += rp[0][1].r * v2[0][1].r - rp[0][1].i * v2[0][1].i
+ As2.r;
auxm2 += rp[0][1].r * v2[0][1].i + rp[0][1].i * v2[0][1].r
+ As2.i;
auxm3 = rp[1][0].r * v2[0][0].r - rp[1][0].i * v2[0][0].i;
auxm4 = rp[1][0].r * v2[0][0].i + rp[1][0].i * v2[0][0].r;
auxm3 += rp[1][1].r * v2[0][1].r - rp[1][1].i * v2[0][1].i
+ Cs2.r;
auxm4 += rp[1][1].r * v2[0][1].i + rp[1][1].i * v2[0][1].r
+ Cs2.i;
/* DmB[0][active layers][0 1 2 3] * */
/* ((auxm1, auxm2), (auxm3, auxm4)) */
aux1.r = auxm1 * DmB[0][i * limRange + iL][0].r
- auxm2 * DmB[0][i * limRange + iL][0].i
+ auxm3 * DmB[0][i * limRange + iL][1].r
- auxm4 * DmB[0][i * limRange + iL][1].i;
aux1.i = auxm1 * DmB[0][i * limRange + iL][0].i
+ auxm2 * DmB[0][i * limRange + iL][0].r
+ auxm3 * DmB[0][i * limRange + iL][1].i
+ auxm4 * DmB[0][i * limRange + iL][1].r;
aux2.r = auxm1 * DmB[0][i * limRange + iL][2].r
- auxm2 * DmB[0][i * limRange + iL][2].i
+ auxm3 * DmB[0][i * limRange + iL][3].r
- auxm4 * DmB[0][i * limRange + iL][3].i;
aux2.i = auxm1 * DmB[0][i * limRange + iL][2].i
+ auxm2 * DmB[0][i * limRange + iL][2].r
+ auxm3 * DmB[0][i * limRange + iL][3].i
+ auxm4 * DmB[0][i * limRange + iL][3].r;
/* irrI * (aux1, aux2) */
auxm1 = irrI[0][0].r * aux1.r - irrI[0][0].i * aux1.i;
auxm2 = irrI[0][0].r * aux1.i + irrI[0][0].i * aux1.r;
auxm3 = irrI[0][1].r * aux2.r - irrI[0][1].i * aux2.i;
auxm4 = irrI[0][1].r * aux2.i + irrI[0][1].i * aux2.r;
v2[iDer][0].r = auxm1 + auxm3;
v2[iDer][0].i = auxm2 + auxm4;
auxm1 = irrI[1][0].r * aux1.r - irrI[1][0].i * aux1.i;
auxm2 = irrI[1][0].r * aux1.i + irrI[1][0].i * aux1.r;
auxm3 = irrI[1][1].r * aux2.r - irrI[1][1].i * aux2.i;
auxm4 = irrI[1][1].r * aux2.i + irrI[1][1].i * aux2.r;
v2[iDer][1].r = auxm1 + auxm3;
v2[iDer][1].i = auxm2 + auxm4;
}
}
/* applying phase-shift to FRECHET derivatives */
/* loop over "active" layers */
for (iDer = 1; iDer <= numberPar * limRange; iDer++)
{
aux = v1[iDer][0].r * g[0].r - v1[iDer][0].i * g[0].i;
v1[iDer][0].i = v1[iDer][0].r * g[0].i +
v1[iDer][0].i * g[0].r;
v1[iDer][0].r = aux;
aux = v1[iDer][1].r * g[1].r - v1[iDer][1].i * g[1].i;
v1[iDer][1].i = v1[iDer][1].r * g[1].i +
v1[iDer][1].i * g[1].r;
v1[iDer][1].r = aux;
aux = v2[iDer][0].r * g[0].r - v2[iDer][0].i * g[0].i;
v2[iDer][0].i = v2[iDer][0].r * g[0].i +
v2[iDer][0].i * g[0].r;
v2[iDer][0].r = aux;
aux = v2[iDer][1].r * g[1].r - v2[iDer][1].i * g[1].i;
v2[iDer][1].i = v2[iDer][1].r * g[1].i +
v2[iDer][1].i * g[1].r;
v2[iDer][1].r = aux;
}
/* compensating for free surface */
freeSurfaceFrechet(v1, v2);
/* loop over offsets for computing the displacements */
displacementsFrechet(iU);
}
/* displacements in the radial or vertical direction */
/* (frequency domain) */
/* there's a 2 (free surface) / 2 (trapezoidal integration) */
/* simplified in the equation below */
dUCEp1.r = epslon1 * dUC.r;
dUCEp1.i = epslon1 * dUC.i;
dUCEp2.r = epslon2 * dUC.r;
dUCEp2.i = epslon2 * dUC.i;
/* loop over "active" layers */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
{
/* loop over offsets */
for (iR = 0; iR < nR; iR++)
{
/* radial ? */
if (RADIAL)
{
auxm1 = aux11[iDer][iR].r * dUCEp1.r -
aux11[iDer][iR].i * dUCEp1.i;
auxm2 = aux11[iDer][iR].r * dUCEp1.i +
aux11[iDer][iR].i * dUCEp1.r;
auxm3 = aux21[iDer][iR].r * dUCEp2.r -
aux21[iDer][iR].i * dUCEp2.i;
auxm4 = aux21[iDer][iR].r * dUCEp2.i +
aux21[iDer][iR].i * dUCEp2.r;
dpl.i = (auxm1 + auxm3) * wCCte.r - (auxm2 + auxm4) * wCCte.i;
dpl.i = (auxm1 + auxm3) * wCCte.i + (auxm2 + auxm4) * wCCte.r;
/* filtering */
dpl.r *= window[indexF] * SGN(recArray[iR]);
dpl.i *= window[indexF] * SGN(recArray[iR]);
}
if (VERTICAL)
{
auxm1 = aux12[iDer][iR].r * dUCEp1.r -
aux12[iDer][iR].i * dUCEp1.i;
auxm2 = aux12[iDer][iR].r * dUCEp1.i +
aux12[iDer][iR].i * dUCEp1.r;
auxm3 = aux22[iDer][iR].r * dUCEp2.r -
aux22[iDer][iR].i * dUCEp2.i;
auxm4 = aux22[iDer][iR].r * dUCEp2.i +
aux22[iDer][iR].i * dUCEp2.r;
dpl.r = (auxm1 + auxm3) * wCCte.r - (auxm2 + auxm4) * wCCte.i;
dpl.i = (auxm1 + auxm3) * wCCte.i + (auxm2 + auxm4) * wCCte.r;
/* filtering */
dpl.r *= window[indexF];
dpl.i *= window[indexF];
}
/* storing displacements in matrix displ */
displ[iDer][iR][indexF] = dpl;
}
}
}
/* going to time domain and correctig for tau */
for (iDer = 0; iDer < numberPar; iDer++)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
pfacr(1, nSamples, displ[iDer * limRange + iL][iR], buffer);
/* correcting for tau */
for (iT = 0; iT < nSamples; iT++)
{
buffer[iT] *= exp(tau * iT * dt);
}
/* copying to operator F */
iT1 = NINT(t1 / dt);
for (iT = 0; iT < nDM; iT++)
{
if (IMPEDANCE && vpFrechet && iDer == 0)
{
F[iDer * limRange + iL][iR * nDM + iT] =
buffer[iT1 + iT] / rho[iL + lim[0]];
}
else if (IMPEDANCE && vsFrechet && (iDer == 0 || iDer == 1))
{
F[iDer * limRange + iL][iR * nDM + iT] =
buffer[iT1 + iT] / rho[iL + lim[0]];
}
else if (IMPEDANCE && rhoFrechet && iDer == 2)
{
F[iDer * limRange + iL][iR * nDM + iT] =
- alpha[iL + lim[0]] * F[iL][iR * nDM + iT]
- beta[iL + lim[0]] * F[iL + limRange][iR * nDM + iT]
+ buffer[iT1 + iT];
}
else if (!IMPEDANCE)
{
F[iDer * limRange + iL][iR * nDM + iT] = buffer[iT1 + iT] ;
}
}
}
}
}
/* if in the IMPEDANCE domain rearrange matrix F */
if (IMPEDANCE)
{
if (rhoFrechet && !ipFrechet && !isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL][iR * nDM + iT] = F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
else if (rhoFrechet && ipFrechet && !isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL + limRange][iR * nDM + iT] =
F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
else if (rhoFrechet && !ipFrechet && isFrechet)
{
for (iL = 0; iL < limRange; iL++)
{
for (iR = 0; iR < nR; iR++)
{
for (iT = 0; iT < nDM; iT++)
{
F[iL][iR * nDM + iT] = F[iL + limRange][iR * nDM + iT];
F[iL + limRange][iR * nDM + iT] =
F[iL + 2 * limRange][iR * nDM + iT];
}
}
}
}
}
/* freeing memory */
free3complex(displ);
free1float(buffer);
}
int
main(int argc, char **argv)
{
int nt; /* number of samples on output trace */
float dt; /* sample rate on outpu trace */
int itime; /* counter */
float tmin; /* first time sample on output trace */
float tsd=0.0; /* time to move source to datum */
float trd=0.0; /* time to move 0 offset receiver */
float v0; /* weathering velocity */
float v1; /* subweathering velocity */
int hdrs; /* flag to read statics from headers */
float *t; /* array of output times */
float tstat; /* total (source and receiver) statics */
int sign; /* to add (+) or subtract (-) statics */
int no; /* number of offsets per shot */
int io; /* offset counter */
int is; /* source counter */
int ir; /* receiver counter */
int ns; /* number of sources = number of source statics */
int nr; /* number of receiver = number of rec. statics */
float *sou_statics=NULL; /* array of source statics */
float *rec_statics=NULL; /* array of receiver statics */
FILE *fps, *fpr; /* file pointers for statics input */
cwp_String sou_file, rec_file; /* statics filenames */
/* Hook up getpar */
initargs(argc, argv);
requestdoc(1);
/* Get information from first trace */
if (!gettr(&intrace)) err("can't get first trace");
nt = intrace.ns;
tmin = intrace.delrt/1000.0;
dt = ((double) intrace.dt)/1000000.0;
/* Get parameters */
if (!getparfloat("v1", &v1)) v1 = (float) intrace.swevel;
if (!getparfloat("v0", &v0))
v0 = (float) ((intrace.wevel) ? intrace.wevel : v1);
if (!getparint("hdrs", &hdrs)) hdrs = 0;
if (!getparint("sign", &sign)) sign = 1;
/* Allocate vector of output times */
t = ealloc1float(nt);
/* reading source and receiver statics from files */
if ((hdrs == 2) || (hdrs == 3)){
/* getpar statics file related parameters */
if (!getparint("ns", &ns)) ns = 240;
if (!getparint("nr", &nr)) nr = 335;
if (!getparint("no", &no)) no = 96;
/* getpar statics file names */
getparstring("sou_file",&sou_file);
getparstring("rec_file",&rec_file);
/* allocate space */
rec_statics = alloc1float(nr);
sou_statics = alloc1float(ns);
/* open and read from receiver statics file */
if((fpr=efopen(rec_file,"rb"))==NULL)
err("cannot open stat_file=%s\n",rec_file);
efread(rec_statics, sizeof(float),nr,fpr);
efclose(fpr);
/* open and read from source statics file */
if((fps=efopen(sou_file,"rb"))==NULL)
err("cannot open stat_file=%s\n",sou_file);
efread(sou_statics, sizeof(float),ns,fps);
efclose(fps);
}
/* Initialize tstat */
tstat = 0.0;
/* Loop on traces */
io = 0; is = 0;
do {
int temp = SGN(intrace.scalel)*log10(abs((int) intrace.scalel));
float scale;
scale = pow(10., (float)temp);
/* copy and adjust header */
memcpy( (void *) &outtrace, (const void *) &intrace, HDRBYTES);
/* compute static correction if necessary */
if(!hdrs) {
tsd = scale *
(-intrace.selev + intrace.sdel + intrace.sdepth)/v1;
trd = tsd - intrace.sut/1000.0;
tstat = tsd + trd +
scale * (intrace.selev - intrace.gelev)/v0;
/* else, read statics from headers */
} else {
/* Initialize header field for output trace */
outtrace.sstat = intrace.sstat;
outtrace.gstat = intrace.gstat;
outtrace.tstat = intrace.sstat+intrace.gstat;
if (hdrs == 1) {
tstat = outtrace.tstat/1000.0;
}
if (hdrs == 2) {
ir = is + io;
if (is <= ns) tsd = sou_statics[is]/1000.0;
if (ir > 0 && ir <= nr)
trd = rec_statics[ir]/1000.0;
tstat = tsd + trd;
io ++;
if (io > no-1) {
io = 0; is++;
}
}
if (hdrs == 3) {
tsd = sou_statics[intrace.fldr]/1000.0;
trd = rec_statics[intrace.tracf]/1000.0;
tstat = tsd + trd;
}
}
/* Compute output times */
for (itime=0; itime<nt; ++itime)
t[itime] = tmin + itime*dt + sign*tstat;
/* sinc interpolate new data */
ints8r(nt, dt, tmin, intrace.data,
0.0, 0.0, nt, t, outtrace.data);
/* set header field for output trace */
if(hdrs == 0 || hdrs == 2 || hdrs == 3){
/* value is added to existing header values */
/* this permits multiple static corrections */
outtrace.sstat += (1000.0 * tsd);
outtrace.gstat += (1000.0 * trd);
outtrace.tstat += (1000.0 * tstat);
}
puttr(&outtrace);
} while (gettr(&intrace));
return(CWP_Exit());
}
main(int argc, char **argv)
{
int nt; /* number of time samples */
float dt; /* time sampling interval */
int ntr; /* number of traces */
float dx; /* trace spacing (spatial sampling interval) */
int nslopes; /* number of slopes specified */
float *slopes; /* slopes at which amplitudes are specified */
int namps; /* number of amplitudes specified */
float *amps; /* amplitudes corresponding to slopes */
float bias; /* slope bias */
FILE *hdrfp; /* fp for header storage file */
FILE *datafp; /* fp for trace storage file */
/* Hook up getpar to handle the parameters */
initargs(argc,argv);
askdoc(1);
/* Get info from first trace */
if (!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
/* Get parameters */
dt = (float) tr.dt/1000000.0;
if (!dt) getparfloat("dt", &dt);
if (!dt) dt = 1.0;
if (!getparfloat("dx", &dx)) dx = 1.0;
slopes = alloc1float(countparval("slopes"));
amps = alloc1float(countparval("amps"));
if (!(nslopes = getparfloat("slopes", slopes))) {
nslopes = 1;
slopes[0] = 0.0;
}
if (!(namps = getparfloat("amps", amps))) {
namps = 1;
amps[0] = 1.0;
}
if (!getparfloat("bias", &bias)) bias = 0.0;
/* Check parameters */
if (nslopes != namps)
err("number of slopes (%d) must equal number of amps(%d)",
nslopes, namps);
{ register int i;
for (i=1; i<nslopes; ++i)
if (slopes[i] <= slopes[i-1])
err("slopes must be monotonically increasing");
}
/* Store traces and headers in tmpfile while getting a count */
hdrfp = etmpfile();
datafp = etmpfile();
ntr = 0;
do {
++ntr;
efwrite(&tr, 1, HDRBYTES, hdrfp);
efwrite(tr.data, FSIZE, nt, datafp);
} while (gettr(&tr));
/* Apply slope filter */
slopefilter(nslopes,slopes,amps,bias,nt,dt,ntr,dx,datafp);
/* Output filtered traces */
rewind(hdrfp);
rewind(datafp);
{ register int itr;
for (itr = 0; itr < ntr; ++itr) {
efread(&tr, 1, HDRBYTES, hdrfp);
efread(tr.data, FSIZE, nt, datafp);
puttr(&tr);
}
}
}
int
main(int argc, char **argv)
{
int nt; /* number of time samples per trace */
float dt; /* time sampling interval */
float ft; /* time of first sample */
int it; /* time sample index */
int cdpmin; /* minimum cdp to process */
int cdpmax; /* maximum cdp to process */
float dx; /* cdp sampling interval */
int nx; /* number of cdps to process */
int nxfft; /* number of cdps after zero padding for fft */
int nxpad; /* minimum number of cdps for zero padding */
int ix; /* cdp index, starting with ix=0 */
int noffmix; /* number of offsets to mix */
float *tdmo; /* times at which rms velocities are specified */
float *vdmo; /* rms velocities at times specified in tdmo */
float gamma; /* upgoing to downging velocity ratio */
float *zoh=NULL;/* tabulated z/h */
float *boh=NULL;/* tabulated b/h */
int ntable; /* number of tabulated zoh and boh */
float sdmo; /* DMO stretch factor */
float s1; /* DMO stretch factor */
float s2; /* DMO stretch factor */
float temps; /* temp value used in excahnging s1 and s2 */
int flip; /* apply negative shifts and exchange s1 and s2 */
float sign; /* + if flip=0, negative if flip=1 */
int ntdmo; /* number tnmo values specified */
int itdmo; /* index into tnmo array */
int nvdmo; /* number vnmo values specified */
float fmax; /* maximum frequency */
float *vrms; /* uniformly sampled vrms(t) */
float **p; /* traces for one offset - common-offset gather */
float **q; /* DMO-corrected and mixed traces to be output */
float offset; /* source-receiver offset of current trace */
float oldoffset;/* offset of previous trace */
int noff; /* number of offsets processed in current mix */
int ntrace; /* number of traces processed in current mix */
int itrace; /* trace index */
int gottrace; /* non-zero if an input trace was read */
int done; /* non-zero if done */
int verbose; /* =1 for diagnostic print */
FILE *hfp; /* file pointer for temporary header file */
/* 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;
ft = tr.delrt/1000.0;
offset = tr.offset;
/* get parameters */
if (!getparint("cdpmin",&cdpmin)) err("must specify cdpmin");
if (!getparint("cdpmax",&cdpmax)) err("must specify cdpmax");
if (cdpmin>cdpmax) err("cdpmin must not be greater than cdpmax");
if (!getparfloat("dxcdp",&dx)) err("must specify dxcdp");
if (!getparint("noffmix",&noffmix)) err("must specify noffmix");
ntdmo = countparval("tdmo");
if (ntdmo==0) ntdmo = 1;
tdmo = ealloc1float(ntdmo);
if (!getparfloat("tdmo",tdmo)) tdmo[0] = 0.0;
nvdmo = countparval("vdmo");
if (nvdmo==0) nvdmo = 1;
if (nvdmo!=ntdmo) err("number of tdmo and vdmo must be equal");
vdmo = ealloc1float(nvdmo);
if (!getparfloat("vdmo",vdmo)) vdmo[0] = 1500.0;
for (itdmo=1; itdmo<ntdmo; ++itdmo)
if (tdmo[itdmo]<=tdmo[itdmo-1])
err("tdmo must increase monotonically");
if (!getparfloat("gamma",&gamma)) gamma = 0.5;
if (!getparint("ntable",&ntable)) ntable = 1000;
if (!getparfloat("sdmo",&sdmo)) sdmo = 1.0;
if (!getparint("flip",&flip)) flip=0;
if (flip)
sign = -1.0;
else
sign = 1.0;
if (!getparfloat("fmax",&fmax)) fmax = 0.5/dt;
if (!getparint("verbose",&verbose)) verbose=0;
checkpars();
/* allocate and generate tables of b/h and z/h if gamma not equal 1 */
if(gamma != 1.0){
zoh=alloc1float(ntable);
boh=alloc1float(ntable);
table(ntable, gamma, zoh, boh);
}
/* make uniformly sampled rms velocity function of time */
vrms = ealloc1float(nt);
mkvrms(ntdmo,tdmo,vdmo,nt,dt,ft,vrms);
/* determine number of cdps to process */
nx = cdpmax-cdpmin+1;
/* allocate and zero common-offset gather p(t,x) */
nxpad = 0.5*ABS(offset/dx);
nxfft = npfar(nx+nxpad);
p = ealloc2float(nt,nxfft+2);
for (ix=0; ix<nxfft; ++ix)
for (it=0; it<nt; ++it)
p[ix][it] = 0.0;
/* allocate and zero offset mix accumulator q(t,x) */
q = ealloc2float(nt,nx);
for (ix=0; ix<nx; ++ix)
for (it=0; it<nt; ++it)
q[ix][it] = 0.0;
/* open temporary file for headers */
hfp = tmpfile();
/* initialize */
oldoffset = offset;
gottrace = 1;
done = 0;
ntrace = 0;
noff = 0;
/* get DMO stretch/squeeze factors s1 and s2 */
stretchfactor (sdmo,gamma,&s1,&s2);
if(flip) {
temps = s1;
s1 = s2;
s2 = temps;
}
/* print useful information if requested */
if (verbose)fprintf(stderr,"stretching factors: s1=%f s2=%f\n",s1,s2);
/* loop over traces */
do {
/* if got a trace, determine offset */
if (gottrace) offset = tr.offset;
/* if an offset is complete */
if ((gottrace && offset!=oldoffset) || !gottrace) {
/* do dmo for old common-offset gather */
dmooff(oldoffset,fmax,nx,dx,nt,dt,ft,vrms,p,
gamma,boh,zoh,ntable,s1,s2,sign);
/* add dmo-corrected traces to mix */
for (ix=0; ix<nx; ++ix)
for (it=0; it<nt; ++it)
q[ix][it] += p[ix][it];
/* count offsets in mix */
noff++;
/* free space for old common-offset gather */
free2float(p);
/* if beginning a new offset */
if (offset!=oldoffset) {
/* allocate space for new offset */
nxpad = 0.5*ABS(offset/dx);
nxfft = npfar(nx+nxpad);
p = ealloc2float(nt,nxfft+2);
for (ix=0; ix<nxfft; ++ix)
for (it=0; it<nt; ++it)
p[ix][it] = 0.0;
}
}
/* if a mix of offsets is complete */
if (noff==noffmix || !gottrace) {
/* rewind trace header file */
efseeko(hfp, (off_t) 0,SEEK_SET);
/* loop over all output traces */
for (itrace=0; itrace<ntrace; ++itrace) {
/* read trace header and determine cdp index */
efread(&tro,HDRBYTES,1,hfp);
/* get dmo-corrected data */
memcpy((void *) tro.data,
(const void *) q[tro.cdp-cdpmin],
nt*sizeof(float));
/* write output trace */
puttr(&tro);
}
/* report */
if (verbose)
fprintf(stderr,"\tCompleted mix of "
"%d offsets with %d traces\n",
noff,ntrace);
/* if no more traces, break */
if (!gottrace) break;
/* rewind trace header file */
efseeko(hfp, (off_t) 0,SEEK_SET);
/* reset number of offsets and traces in mix */
noff = 0;
ntrace = 0;
/* zero offset mix accumulator */
for (ix=0; ix<nx; ++ix)
for (it=0; it<nt; ++it)
q[ix][it] = 0.0;
}
/* if cdp is within range to process */
if (tr.cdp>=cdpmin && tr.cdp<=cdpmax) {
/* save trace header and update number of traces */
efwrite(&tr,HDRBYTES,1,hfp);
ntrace++;
/* remember offset */
oldoffset = offset;
/* get trace samples */
memcpy((void *) p[tr.cdp-cdpmin],
(const void *) tr.data, nt*sizeof(float));
}
/* get next trace (if there is one) */
if (!gettr(&tr)) gottrace = 0;
} while (!done);
return(CWP_Exit());
}