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