Exemplo n.º 1
0
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;  
}
Exemplo n.º 2
0
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);
 	}

}
Exemplo n.º 3
0
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);
}
Exemplo n.º 4
0
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);
}
Exemplo n.º 5
0
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);
	}
}
Exemplo n.º 6
0
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);
}
Exemplo n.º 7
0
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);
}   
Exemplo n.º 8
0
/************************ 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);
}
Exemplo n.º 9
0
/************************ 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);
}
Exemplo n.º 10
0
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);
}
Exemplo n.º 11
0
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());
}
Exemplo n.º 12
0
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);
}
Exemplo n.º 13
0
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());
}
Exemplo n.º 14
0
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);
	  }
	}

}
Exemplo n.º 15
0
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());
}