int msgefa2 ( float a[], int lda, int n, int ipvt[] )
/******************************************************************************/
/*
Purpose:
MSGEFA2 factors a matrix by gaussian elimination.
Discussion:
Matrix references which would, mathematically, be written A(I,J)
must be written here as:
* A[I+J*LDA], when the value is needed, or
* A+I+J*LDA, when the address is needed.
This variant of SGEFA uses OpenMP for improved parallel execution.
The step in which multiples of the pivot row are added to individual
rows has been replaced by a single call which updates the entire
matrix sub-block.
Modified:
07 March 2008
Author:
FORTRAN77 original version by Cleve Moler.
C version by Wesley Petersen.
Reference:
Jack Dongarra, Jim Bunch, Cleve Moler, Pete Stewart,
LINPACK User's Guide,
SIAM, 1979,
ISBN13: 978-0-898711-72-1,
LC: QA214.L56.
Parameters:
Input/output, float A[LDA*N]. On input, the matrix to be factored.
On output, an upper triangular matrix and the multipliers which were
used to obtain it. The factorization can be written A = L * U where
L is a product of permutation and unit lower triangular matrices and
U is upper triangular.
Input, int LDA, the leading dimension of the matrix.
Input, int N, the order of the matrix.
Output, int IPVT[N], the pivot indices.
Output, int MSGEFA, indicates singularity.
If 0, this is the normal value, and the algorithm succeeded.
If K, then on the K-th elimination step, a zero pivot was encountered.
The matrix is numerically not invertible.
*/
{
int info;
int k,kp1,l,nm1;
float t;
info = 0;
nm1 = n - 1;
for ( k = 0; k < nm1; k++ )
{
kp1 = k + 1;
l = isamax ( n-k, a+k+k*lda, 1 ) + k - 1;
ipvt[k] = l + 1;
if ( a[l+k*lda] == 0.0 )
{
info = k + 1;
return info;
}
if ( l != k )
{
t = a[l+k*lda];
a[l+k*lda] = a[k+k*lda];
a[k+k*lda] = t;
}
t = -1.0 / a[k+k*lda];
sscal ( n-k-1, t, a+kp1+k*lda, 1 );
/*
Interchange the pivot row and the K-th row.
*/
if ( l != k )
{
sswap ( n-k-1, a+l+kp1*lda, lda, a+k+kp1*lda, lda );
}
/*
Add multiples of the K-th row to rows K+1 through N.
*/
msaxpy2 ( n-k-1, n-k-1, a+k+kp1*lda, n, a+kp1+k*lda, a+kp1+kp1*lda );
}
ipvt[n-1] = n;
if ( a[n-1+(n-1)*lda] == 0.0 )
{
info = n;
}
return info;
}
void do_minphdec(float *tr,int nt, float *filter,int fnl,int fnr,float prw)
{
float *rtr;
float *rtx;
complex *f;
complex *w;
complex a;
int iamp;
float amp;
float ampm=-1.0e+20;
float amps;
float *am;
float *ph;
float mean=0.0;
float sum=0.0;
int nfftc;
int nf;
int i,j; /* counter */
float snfftc;
/* Set up pfa fft */
nfftc = npfao(nt,LOOKFAC*nt);
if (nfftc >= SU_NFLTS || nfftc >= PFA_MAX)
err("Padded nt=%d--too big", nfftc);
nf = nfftc/2 + 1;
snfftc=1.0/nfftc;
rtr = ealloc1float(nfftc);
rtx = ealloc1float(nf);
f = ealloc1complex(nfftc);
w = ealloc1complex(nfftc);
am = ealloc1float(nf);
ph = ealloc1float(nf);
/* clean the arrays */
memset( (void *) w, (int) '\0', nfftc*sizeof(complex));
memset( (void *) rtr, (int) '\0', nfftc*FSIZE);
/* Cross correlation */
xcor(nt,0,tr,nt,0,tr,nf,0,rtr);
/* FFT */
pfarc(1, nfftc,rtr,w);
/* stabilize */
for(i=0;i<nf;i++) {
am[i] += am[i]*prw;
}
/* Normalize */
for(i=0;i<nf;i++) {
a=w[i];
am[i]= sqrt(a.r*a.r+a.i*a.i);
sum += am[i];
if(am[i]!=0) ph[i] = atan2(a.i,a.r);
else ph[i]=0;
}
sum *= 1.0/nf;
sum = 1.0/sum;
sscal(nf,sum,am,1);
/* Smooth the apmlitude spectra */
if(fnl!=0) conv (fnl+fnr+1,-fnl,filter,nf,0,am,nf,0,am);
fprintf(stderr," %f\n",sum);
for(i=0;i<nf;i++) {
w[i].r = am[i]*cos(ph[i]);
w[i].i = am[i]*sin(ph[i]);
}
for(i=nf,j=nf-1;i<nfftc;i++,j--) {
w[i].r = am[j]*cos(ph[j]);
w[i].i = am[j]*sin(ph[j]);
}
/* log spectra */
for (i = 0; i < nfftc; ++i) w[i] =
crmul(clog(cmul(w[i],conjg(w[i]))),0.5);
/* Hilbert transform */
pfacc(-1,nfftc,w);
for (i=0; i<nfftc; ++i) {
w[i].r *=snfftc;
w[i].i *=snfftc;
}
for(i=1;i<nfftc/2;i++) w[i] = cadd(w[i],w[i]);
for(i=nfftc/2;i<nfftc;i++) w[i] = cmplx(0,0);
pfacc(1,nfftc,w);
/* end of Hilbert transform */
/* exponentiate */
for(i=0;i<nfftc;i++) w[i] = cexp(w[i]);
/* inverse filter */
for(i=0;i<nfftc;i++) f[i] = cdiv(cmplx(1.0,0),w[i]);
/* Load trace into tr (zero-padded) */
memset( (void *) w, (int) '\0',nfftc*sizeof(complex));
for(i=0;i<nt;i++) w[i].r = tr[i];
/* Trace to frequency domain */
pfacc(1,nfftc,w);
/* apply filter */
for(i=0;i<nfftc;i++) w[i] = cmul(w[i],f[i]);
/* Time domain */
pfacr(-1, nfftc,w,rtr);
for(i=0;i<nt;i++) rtr[i] *=snfftc;
memcpy( (void *) tr, (const void *) rtr, nt*FSIZE);
free1float(rtr);
free1float(am);
free1float(ph);
free1complex(f);
free1complex(w);
}
int sgefa ( float a[], int lda, int n, int ipvt[] )
/*******************************************************************************/
/*
Purpose:
SGEFA factors a matrix by gaussian elimination.
Discussion:
Matrix references which would, mathematically, be written A(I,J)
must be written here as:
* A[I+J*LDA], when the value is needed, or
* A+I+J*LDA, when the address is needed.
Modified:
07 March 2008
Author:
FORTRAN77 original version by Cleve Moler.
C version by John Burkardt.
Reference:
Jack Dongarra, Jim Bunch, Cleve Moler, Pete Stewart,
LINPACK User's Guide,
SIAM, 1979,
ISBN13: 978-0-898711-72-1,
LC: QA214.L56.
Parameters:
Input/output, float A[LDA*N]. On input, the matrix to be factored.
On output, an upper triangular matrix and the multipliers which were
used to obtain it. The factorization can be written A = L * U where
L is a product of permutation and unit lower triangular matrices and
U is upper triangular.
Input, int LDA, the leading dimension of the matrix.
Input, int N, the order of the matrix.
Output, int IPVT[N], the pivot indices.
Output, int SGEFA, indicates singularity.
If 0, this is the normal value, and the algorithm succeeded.
If K, then on the K-th elimination step, a zero pivot was encountered.
The matrix is numerically not invertible.
*/
{
int j;
int info;
int k;
int kp1;
int l;
int nm1;
float t;
info = 0;
for ( k = 1; k <= n - 1; k++ )
{
/*
Find l = pivot index.
*/
l = isamax ( n-k+1, &a[k-1+(k-1)*lda], 1 ) + k - 1;
ipvt[k-1] = l;
/*
Zero pivot implies this column already triangularized.
*/
if ( a[l-1+(k-1)*lda] != 0.0 )
{
/*
Interchange if necessary.
*/
if ( l != k )
{
t = a[l-1+(k-1)*lda];
a[l-1+(k-1)*lda] = a[k-1+(k-1)*lda];
a[k-1+(k-1)*lda] = t;
}
/*
Compute multipliers.
*/
t = - 1.0 / a[k-1+(k-1)*lda];
sscal ( n-k, t, &a[k+(k-1)*lda], 1 );
/*
Row elimination with column indexing.
*/
for ( j = k + 1; j <= n; j++ )
{
t = a[l-1+(j-1)*lda];
if (l != k)
{
a[l-1+(j-1)*lda] = a[k-1+(j-1)*lda];
a[k-1+(j-1)*lda] = t;
}
saxpy ( n-k, t, &a[k+(k-1)*lda], 1, &a[k+(j-1)*lda], 1 );
}
}
else
{
info = k;
}
}
ipvt[n-1] = n;
if (a[n-1+(n-1)*lda] == 0.0 )
{
info = n - 1;
}
return info;
}
