inline gsl_lapack_svd_workspace*
gsl_lapack_svd_simple(gsl_matrix *A)
{
gsl_lapack_svd_workspace *Wo = gsl_alloc_lapack_svd_workspace(A);
int info, lwork;
double wkopt;
double* work;
/* Query and allocate the optimal workspace */
lwork = -1;
dgesvd( "All", "All", &(A->size1), &(A->size2),
A->data, &(A->size1),
Wo->diagD->data,
Wo->U_matrix->data, &(Wo->U_matrix->size1),
Wo->Vt_matrix->data, &(Wo->Vt_matrix->size1),
&wkopt, &lwork, &info );
lwork = (int)wkopt;
work = (double*)malloc( lwork*sizeof(double) );
printf("alloc ok\n");
/* Compute SVD */
dgesvd( "All", "All", &(A->size1), &(A->size2),
A->data, &(A->size1),
Wo->diagD->data,
Wo->U_matrix->data, &(Wo->U_matrix->size1),
Wo->Vt_matrix->data, &(Wo->Vt_matrix->size1),
work, &lwork, &info );
/* Check for convergence */
if( info > 0 ) {
printf( "The algorithm computing SVD failed to converge.\n" );
exit( 1 );
}
return Wo;
}
/* Main program */
int main() {
/* Locals */
int m = M, n = N, lda = LDA, ldu = LDU, ldvt = LDVT, info, lwork;
double wkopt;
double* work;
/* Local arrays */
double s[N], u[LDU*M], vt[LDVT*N];
double a[LDA*N] = {
8.79, 6.11, -9.15, 9.57, -3.49, 9.84,
9.93, 6.91, -7.93, 1.64, 4.02, 0.15,
9.83, 5.04, 4.86, 8.83, 9.80, -8.99,
5.45, -0.27, 4.85, 0.74, 10.00, -6.02,
3.16, 7.98, 3.01, 5.80, 4.27, -5.31
};
/* Executable statements */
printf( " DGESVD Example Program Results\n" );
/* Query and allocate the optimal workspace */
lwork = -1;
dgesvd( "All", "All", &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, &wkopt, &lwork,
&info );
lwork = (int)wkopt;
work = (double*)malloc( lwork*sizeof(double) );
/* Compute SVD */
dgesvd( "All", "All", &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork,
&info );
/* Check for convergence */
if( info > 0 ) {
printf( "The algorithm computing SVD failed to converge.\n" );
exit( 1 );
}
/* Print singular values */
print_matrix( "Singular values", 1, n, s, 1 );
/* Print left singular vectors */
print_matrix( "Left singular vectors (stored columnwise)", m, n, u, ldu );
/* Print right singular vectors */
print_matrix( "Right singular vectors (stored rowwise)", n, n, vt, ldvt );
/* Free workspace */
free( (void*)work );
exit( 0 );
} /* End of DGESVD Example */
/* This function computes a covariance estimate for slowness
vector estimates computed by mwap. It is very specialized
in that it contains hard wired 3 dimensions for the number
of unknowns in this problem. This estimate is not at all the same
as that proposed in Bear and Pavlis (1997). They used variations in
estimates made in semblance/slowness space. Here we use the estimated
uncertainties in the static estimates as estimates of the data covariance
that is scaled by the inverse of the slowness estimation matrix to
produce a covariance estimate for the slowness vector.
This routine is confused greatly by being forced to use FORTRAN
indexing to mesh with sunperf. This leads to some very messy
indexing in a somewhat tricky algorithm I use to compute the
covariance with the SVD components.
Arguments:
stations - associative array of station objects
statics - associative array of MWstatic objects
c - 3x3 covariance estimate (result) in order of
ux, uy, dt
Normal return is 0. Postive returns mean a nonfatal problem
occurred that will be posted to elog. The routine dies only
from malloc errors.
Author: G Pavlis
Written: March 2000
Modified: March 2002
Removed the sample interval floor on the error. Previously this
function did not allow the error for a single station to drop
below the one sample lever. This was done to be conservative
but the new algorithm seems capable of resolving subsample
timing. Hence, I removed this feature.
*/
int compute_slowness_covariance(Arr *stations,Arr *statics,
double *c)
{
double *A;
double vt[9];
double svalue[3];
double work[9];
double *Cd1_2; /* holds vector of diagonal elements of
data covariance to 1/2 power (useful for scaling)*/
int nsta; /* number of stations = rows in A */
int nsta_used; /*actual value when problems happen */
MWstatic *mws;
MWstation *s;
Tbl *t; /* tbl of keys used to parse statics arr */
char *sta;
int i,j,ii;
int errcount=0;
int info;
for(i=0;i<9;++i) c[i] = 0.0;
t = keysarr(statics);
nsta = maxtbl(t);
allot(double *,A,3*nsta);
allot(double *,Cd1_2,nsta);
for(i=0,ii=0;i<nsta;++i)
{
sta = gettbl(t,i);
mws = (MWstatic *)getarr(statics,sta);
s = (MWstation *)getarr(stations,sta);
if(s==NULL)
{
elog_notify(0,"Station %s has a computed MWstatic but is not in station table\nStation array may be corrupted\n",sta);
++errcount;
}
else
{
A[ii] = s->deast;
A[ii+nsta] = s->dnorth;
A[ii+2*nsta] = 1.0;
Cd1_2[ii] = (mws->sigma_t);
++ii;
}
}
nsta_used = ii;
dgesvd('o','a',nsta,3,A,nsta_used,svalue,NULL,nsta,vt,3,&info);
/* Now we just compute covariance as C=A+(Cd)(A+)T
A+ = VS+UT. We first replace A by U*S+ */
for(i=0;i<3;++i)
{
dscal(nsta_used,1.0/svalue[i],A+i*nsta,1);
}
/* Another devious trick -- row scaling by Cd1_2 elements
forms proto form of V [ S+UT]Cd[US+T] VT */
for(i=0;i<nsta_used;++i) dscal(3,Cd1_2[i],A+i,nsta);
/* Now compute the term in brackets above = [ S+UT]Cd[US+T] */
for(i=0;i<3;++i)
{
for(j=0;j<3;++j)
c[i+3*j] = ddot(nsta_used,A+i,1,A+j,1);
}
/* Now we have to complete the products with V and VT.
First VT */
for(i=0;i<3;++i)
for(j=0;j<3;++j)
work[i+3*j] = ddot(3,c+i,3,vt+j*3,1);
/* then V */
for(i=0;i<3;++i)
for(j=0;j<3;++j)
c[i+3*j] = ddot(3,vt+i*3,1,work+j*3,1);
free(A);
free(Cd1_2);
return(errcount);
}