main()
{
int i,j,*ipvt,info,n=N;
double **a,*b,*z,rcond;
a = (double**)alloc2(n,n,sizeof(double));
ipvt = (int*)alloc1(n,sizeof(int));
b = (double*)alloc1(n,sizeof(double));
z = (double*)alloc1(n,sizeof(double));
/* Examples 3.6 & 3.7 from Kahaner, Moler, and Nash */
a[0][0] = 9.7; a[1][0] = 6.6;
a[0][1] = 4.1; a[1][1] = 2.8;
b[0] = 9.70; b[1] = 4.11;
/*
dgefa(a,n,ipvt,&info);
printf("info = %d\n",info);
*/
dgeco(a,n,ipvt,&rcond,z);
printf("rcond = %g\n",rcond);
printf("condition number estimate = %g\n",1.0/rcond);
printf("number of significant figures = %d\n",
(int)log10(rcond/DBL_EPSILON));
dgesl(a,n,ipvt,b,0);
pvecd(n,b);
}
int graebner3D(Stiff2D *spar1, Stiff2D *spar2, double rho1, double rho2,
int modei, int modet, int rort, double sazi, double cazi,
double p, double *b, double **a, int *ipvt, double *z,
double *rcond)
/*****************************************************************************
Real reflection/transmission coefficients in
TIH-media with coinciding symmetry axes.
Input:
spar1 density normalized stiffness components medium 1
spar2 density normalized stiffness components medium 2
modei incident wave mode (=0 P; =1 SV; =2 SP)
modet scattered wave mode (=0 P; =1 SV; =2 SP)
rort reflection or transmission
sazi sin(azimuth from symmetry axis)
cazi cos(azimuth from symmetry axis)
p horizontal slowness component
Output:
coeff reflection/transmission coefficient
Technical references:
Sebastian Geoltrain: Asymptotic solutions to direct
and inverse scattering in anisotropic elastic media;
CWP 082.
Graebner, M.; Geophysics, Vol 57, No 11:
Plane-wave reflection and transmission coefficients
for a transversely isotropic solid.
Cerveny, V., 1972, Seismic rays and ray intensities in inhomogeneous
anisotropic media: Geophys. J. R. astr. Soc., 29, 1-13.
.. and some own derivations.
***************************************************************************
AUTHOR: Andreas Rueger, Colorado School of Mines, 01/29/95
***************************************************************************/
{
double q_in,q_Pr,q_Pt,q_SVr,q_SVt,q_SPr,q_SPt;
double c55i,c55t,c44i,c44t,c13i,c13t,c33i,c33t;
Vector3D d_in,d_Pr,d_Pt,d_SVr,d_SVt,d_SPr,d_SPt;
double p1=cazi*p;
double p2=sazi*p;
c55i=spar1->a1313 * rho1;
c55t=spar2->a1313 * rho2;
c44i=spar1->a2323 * rho1;
c44t=spar2->a2323 * rho2;
c13i=spar1->a1133 * rho1;
c13t=spar2->a1133 * rho2;
c33i=spar1->a3333 * rho1;
c33t=spar2->a3333 * rho2;
/* compute vertical slowness components and polarization vectors */
/* incident wave */
if(p_vert3DTIH(spar1,modei,p,sazi,cazi,0,&q_in,&d_in) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (incident wave) \n ");
return (-1);
}
if(test && testEikonal(spar1,modei,p1,p2,q_in,&d_in)!=1){
fprintf(stderr,"\n ERROR in testEikonal (incident wave)");
return (-1);
}
/* reflected qP */
if(p_vert3DTIH(spar1,0,p,sazi,cazi,1,&q_Pr,&d_Pr) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (reflected qP) \n ");
return (-1);
}
if(test && testEikonal(spar1,0,p1,p2,q_Pr,&d_Pr)!=1){
fprintf(stderr,"\n ERROR in testEikonal (reflected qP)");
return (-1);
}
/* reflected SV */
if(p_vert3DTIH(spar1,1,p,sazi,cazi,1,&q_SVr,&d_SVr) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (reflected SV) \n ");
return (-1);
}
if(test && testEikonal(spar1,1,p1,p2,q_SVr,&d_SVr)!=1){
fprintf(stderr,"\n ERROR in testEikonal (reflected SV) \n");
return (-1);
}
/* reflected SP */
if(p_vert3DTIH(spar1,2,p,sazi,cazi,1,&q_SPr,&d_SPr) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (reflected SP) \n ");
return (-1);
}
if(test && testEikonal(spar1,2,p1,p2,q_SPr,&d_SPr)!=1){
fprintf(stderr,"\n ERROR in testEikonal (reflected SP) \n");
return (-1);
}
/* transmitted qP */
if(p_vert3DTIH(spar2,0,p,sazi,cazi,0,&q_Pt,&d_Pt) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (transmitted qP) \n ");
return (-1);
}
if(test && testEikonal(spar2,0,p1,p2,q_Pt,&d_Pt)!=1){
fprintf(stderr,"\n ERROR in testEikonal (transmitted qP) \n");
return (-1);
}
/* transmitted SV */
if(p_vert3DTIH(spar2,1,p,sazi,cazi,0,&q_SVt,&d_SVt) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (transmitted SV) \n ");
return (-1);
}
if(test && testEikonal(spar2,1,p1,p2,q_SVt,&d_SVt)!=1){
fprintf(stderr,"\n ERROR in testEikonal (transmitted SV) \n");
return (-1);
}
/* transmitted SP */
if(p_vert3DTIH(spar2,2,p,sazi,cazi,0,&q_SPt,&d_SPt) !=1){
fprintf(stderr,"\n ERROR in p_vert3DTIH (transmitted SP) \n ");
return (-1);
}
if(test && testEikonal(spar2,2,p1,p2,q_SPt,&d_SPt)!=1){
fprintf(stderr,"\n ERROR in testEikonal (transmitted SP) \n");
return (-1);
}
/* compute matrix elements */
a[0][0] = d_Pr.x; a[1][0] = d_SVr.x; a[2][0] = d_SPr.x;
a[3][0] = -d_Pt.x; a[4][0] = -d_SVt.x; a[5][0] = -d_SPt.x;
a[0][1] = d_Pr.y; a[1][1] = d_SVr.y; a[2][1] = d_SPr.y;
a[3][1] = -d_Pt.y; a[4][1] = -d_SVt.y; a[5][1] = -d_SPt.y;
a[0][2] = d_Pr.z; a[1][2] = d_SVr.z; a[2][2] = d_SPr.z;
a[3][2] = -d_Pt.z; a[4][2] = -d_SVt.z; a[5][2] = -d_SPt.z;
a[0][3] = c55i*(d_Pr.z*p1 + d_Pr.x*q_Pr);
a[1][3] = c55i*(d_SVr.z*p1+d_SVr.x*q_SVr);
a[2][3] = c55i*(d_SPr.z*p1+d_SPr.x*q_SPr);
a[3][3] = -c55t*(d_Pt.z*p1 + d_Pt.x*q_Pt);
a[4][3] = -c55t*(d_SVt.z*p1+d_SVt.x*q_SVt);
a[5][3] = -c55t*(d_SPt.z*p1+d_SPt.x*q_SPt);
a[0][4] = c44i*(d_Pr.z*p2 + d_Pr.y*q_Pr);
a[1][4] = c44i*(d_SVr.z*p2+d_SVr.y*q_SVr);
a[2][4] = c44i*(d_SPr.z*p2+d_SPr.y*q_SPr);
a[3][4] = -c44t*(d_Pt.z*p2 + d_Pt.y*q_Pt);
a[4][4] = -c44t*(d_SVt.z*p2+d_SVt.y*q_SVt);
a[5][4] = -c44t*(d_SPt.z*p2+d_SPt.y*q_SPt);
a[0][5] = c13i*d_Pr.x*p1+(c33i-2*c44i)*d_Pr.y*p2+c33i*d_Pr.z*q_Pr;
a[1][5] = c13i*d_SVr.x*p1+(c33i-2*c44i)*d_SVr.y*p2+c33i*d_SVr.z*q_SVr;
a[2][5] = c13i*d_SPr.x*p1+(c33i-2*c44i)*d_SPr.y*p2+c33i*d_SPr.z*q_SPr;
a[3][5] = -c13t*d_Pt.x*p1-(c33t-2*c44t)*d_Pt.y*p2-c33t*d_Pt.z*q_Pt;
a[4][5] = -c13t*d_SVt.x*p1-(c33t-2*c44t)*d_SVt.y*p2-c33t*d_SVt.z*q_SVt;
a[5][5] = -c13t*d_SPt.x*p1-(c33t-2*c44t)*d_SPt.y*p2-c33t*d_SPt.z*q_SPt;
/* right hand side vector */
b[0] = -d_in.x;
b[1] = -d_in.y;
b[2] = -d_in.z;
b[3] = -c55i*(d_in.z*p1 + d_in.x*q_in);
b[4] = -c44i*(d_in.z*p2 + d_in.y*q_in);
b[5] = -(c13i*d_in.x*p1+(c33i-2*c44i)*d_in.y*p2+c33i*d_in.z*q_in);
if(info){
fprintf(stderr,"a00=%g a01=%g a02=%g a03=%g a04=%g a05=%g \n",
a[0][0],a[0][1],a[0][2],a[0][3],a[0][4],a[0][5]);
fprintf(stderr,"a10=%g a11=%g a12=%g a13=%g a14=%g a15=%g \n",
a[1][0],a[1][1],a[1][2],a[1][3],a[1][4],a[1][5]);
fprintf(stderr,"a20=%g a21=%g a22=%g a23=%g a24=%g a25=%g \n",
a[2][0],a[2][1],a[2][2],a[2][3],a[2][4],a[2][5]);
fprintf(stderr,"a30=%g a31=%g a32=%g a33=%g a34=%g a35=%g \n",
a[3][0],a[3][1],a[3][2],a[3][3],a[3][4],a[3][5]);
fprintf(stderr,"a40=%g a41=%g a42=%g a43=%g a44=%g a45=%g \n",
a[4][0],a[4][1],a[4][2],a[4][3],a[4][4],a[4][5]);
fprintf(stderr,"a50=%g a51=%g a52=%g a53=%g a54=%g a55=%g \n",
a[5][0],a[5][1],a[5][2],a[5][3],a[5][4],a[5][5]);
fprintf(stderr,"b1=%g b2=%g b3=%g b4=%g b5=%g b6=%g \n",
b[0],b[1],b[2],b[3],b[4],b[5]);
}
/**** solve real n=4 system *****/
dgeco(a,6,ipvt,rcond,z);
dgesl(a,6,ipvt,b,0);
if(info){
fprintf(stderr,"\n TIH Reflection/Transmission coeff\n");
fprintf(stderr,"inc polar: %g %g %g\n",d_in.x,d_in.y,d_in.z);
fprintf(stderr,"inc vert slown.: %g \n",q_in);
fprintf(stderr,"Pr polar: %g %g %g\n",d_Pr.x,d_Pr.y,d_Pr.z);
fprintf(stderr,"Pr vert slown.: %g \n",q_Pr);
fprintf(stderr,"SVr polar: %g %g %g\n",d_SVr.x,d_SVr.y,d_SVr.z);
fprintf(stderr,"SVr vert slown.: %g \n",q_SVr);
fprintf(stderr,"SPr polar: %g %g %g\n",d_SPr.x,d_SPr.y,d_SPr.z);
fprintf(stderr,"SPr vert slown.: %g \n",q_SPr);
fprintf(stderr,"Pt polar: %g %g %g\n",d_Pt.x,d_Pt.y,d_Pt.z);
fprintf(stderr,"Pt vert slown.: %g \n",q_Pt);
fprintf(stderr,"SVt polar: %g %g %g\n",d_SVt.x,d_SVt.y,d_SVt.z);
fprintf(stderr,"SVt vert slown.: %g \n",q_SVt);
fprintf(stderr,"SPt polar: %g %g %g\n",d_SPt.x,d_SPt.y,d_SPt.z);
fprintf(stderr,"SPt vert slown.: %g \n",q_SPt);
fprintf(stderr,"Pr coefficient: %g \n",b[0]);
fprintf(stderr,"SVr coefficient: %g \n",b[1]);
fprintf(stderr,"SPr coefficient: %g \n",b[2]);
fprintf(stderr,"Pt coefficient: %g \n",b[3]);
fprintf(stderr,"SVt coefficient: %g \n",b[4]);
fprintf(stderr,"SPt coefficient: %g \n",b[5]);
}
return (1);
}
