void
regress(float *b, float **x, float *y, int n, int dim)
{
float d;
float **xt, **xx;
int *indx;
xt = matrix(1,dim,1,n);
transpose(xt,x,n,dim); // X'
xx = matrix(1,dim,1,dim);
multiply(xx,xt,x,dim,n,dim); // X'*X
// b = vector(1,dim);
multiply(b,xt,y,dim,n); // X'*Y
// From NR:
// "To summarize, this is the preferred way to solve the linear set of equations A . x = b:
// float **a,*b,d;
// int n,*indx;
// ...
// ludcmp(a,n,indx,&d);
// lubksb(a,n,indx,b);
//
// The answer x will be given back in b. Your original matrix A will have been destroyed."
//
// In our case, we have (X'X) b = (X'Y)
indx=ivector(1,n);
ludcmp(xx,dim,indx,&d);
lubksb(xx,dim,indx,b);
}
double determinant(double *A[],int n)
/*
compute determinant of a n x n matrix A.
Return value: the determinant
*/
{
double d, **tmpA;
int i,j,*indx;
tmpA=dmatrix(n,n);
for (j=0;j<n;j++)
for (i=0;i<n;i++)
tmpA[j][i]=A[j][i];
indx=ivector(n);
ludcmp(tmpA,n,indx,&d);
for (j=0;j<n;j++)
d *= tmpA[j][j];
free_ivector(indx);
free_dmatrix(tmpA,n,n);
return(d);
}
int main()
{
int i, j, nmax = 50, n = 5, chkerr;
long int /* eps, */ w;
/* eps = 1.0e-6; */
/* Init loop */
/* for(i = 0; i <= n; i++) */
/* { */
/* w = 0.0; /\* data to fill in cells *\/ */
/* for(j = 0; j <= n; j++) */
/* { */
/* a[i][j] = (i + 1) + (j + 1); */
/* if(i == j) /\* only once per loop pass *\/ */
/* a[i][j] *= 2.0; */
/* w += a[i][j]; */
/* } */
/* b[i] = w; */
/* } */
klee_make_symbolic(a, 50 * 50 * sizeof(long int), "a");
klee_make_symbolic(b, 50 * sizeof(long int), "b");
klee_make_symbolic(x, 50 * sizeof(long int), "x");
/* chkerr = ludcmp(nmax, n, eps); */
chkerr = ludcmp(nmax,n);
}
// Return det|a| and leave matrix a constant(complex version)
dcomplex Determinant(const Array2 <dcomplex> & a, const int n)
{
Array2 <dcomplex> temp(n,n);
temp.Resize(n,n);
Array1 <int>& indx(itmp1);
indx.Resize(n);
dcomplex d;
// a(i,j) first index i is row index (convention)
// elements of column vectors are stored contiguous in memory in C style arrays
// a(i) refers to a column vector
// calculate the inverse of the transposed matrix because this
// allows to pass a column vector to lubksb() instead of a row
// put the transposed matrix in temp
for(int i=0;i<n;++i)
{
for(int j=0;j<n;++j)
{
temp(i,j)=a(i,j);
}
}
doublevar det_sign;
ludcmp(temp,n,indx,det_sign);
d=det_sign;
for(int j=0;j<n;++j)
{
d *= temp(j,j);
}
return d;
}
int ns1__ludcmp(struct soap *soap, matrix *a, struct ns1__ludcmpResponse &result)
{ result.a = a;
result.i = soap_new_ivector(soap, -1);
if (ludcmp(soap, *result.a, *result.i, result.d))
return soap_sender_fault(soap, "Singular matrix in routine ludcmp", NULL);
return SOAP_OK;
}
void savgol(float c[], int np, int nl, int nr, int ld, int m)
{
void lubksb(float **a, int n, int *indx, float b[]);
void ludcmp(float **a, int n, int *indx, float *d);
int imj,ipj,j,k,kk,mm,*indx;
float d,fac,sum,**a,*b;
if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m)
nrerror("bad args in savgol");
indx=ivector(1,m+1);
a=matrix(1,m+1,1,m+1);
b=vector(1,m+1);
for (ipj=0;ipj<=(m << 1);ipj++) {
sum=(ipj ? 0.0 : 1.0);
for (k=1;k<=nr;k++) sum += pow((double)k,(double)ipj);
for (k=1;k<=nl;k++) sum += pow((double)-k,(double)ipj);
mm=FMIN(ipj,2*m-ipj);
for (imj = -mm;imj<=mm;imj+=2) a[1+(ipj+imj)/2][1+(ipj-imj)/2]=sum;
}
ludcmp(a,m+1,indx,&d);
for (j=1;j<=m+1;j++) b[j]=0.0;
b[ld+1]=1.0;
lubksb(a,m+1,indx,b);
for (kk=1;kk<=np;kk++) c[kk]=0.0;
for (k = -nl;k<=nr;k++) {
sum=b[1];
fac=1.0;
for (mm=1;mm<=m;mm++) sum += b[mm+1]*(fac *= k);
kk=((np-k) % np)+1;
c[kk]=sum;
}
free_vector(b,1,m+1);
free_matrix(a,1,m+1,1,m+1);
free_ivector(indx,1,m+1);
}
// Return det|a| and leave matrix a constant
doublevar Determinant(const Array2 <doublevar> & a, const int n)
{
Array2 <doublevar>& temp(tmp2);
temp.Resize(n,n);
Array1 <int>& indx(itmp1);
indx.Resize(n);
doublevar d;
// a(i,j) first index i is row index (convention)
// elements of column vectors are stored contiguous in memory in C style arrays
// a(i) refers to a column vector
// calculate the inverse of the transposed matrix because this
// allows to pass a column vector to lubksb() instead of a row
// put the transposed matrix in temp
//#ifdef USE_LAPACK
/* if(n==0) return 1;
for(int i=0; i < n;++i) {
for(int j=0; j< n; ++j) {
temp(i,j)=a(i,j);
}
}
dgetrf(n, n, temp.v, n, indx.v);
double det=1;
for(int i=0; i< n; i++) {
if(indx(i) != i+1)
det*= -temp(i,i);
else det*=temp(i,i);
}
return det;
*/
/*
for(int i=0; i< n; i++) {
if(indx(i)!=i+1) logdet.sign*=-1;
logdet.logval+=log(fabs(temp(i,i)));
if(temp(i,i) <0) logdet.sign*=-1;
}
//cout << " det " << det << " logval " << logdet.val() << endl;
//return det;
return logdet;
*/
//#endif
//#else
for(int i=0;i<n;++i) {
for(int j=0;j<n;++j) {
temp(i,j)=a(i,j);
}
}
ludcmp(temp,n,indx,d);
for(int j=0;j<n;++j) {
d *= temp(j,j);
}
return d;
//#endif
}
//---------------------------------------------------------------------------
Matrix invert(const Matrix& A)
{
Matrix y(A.numRows(), A.numRows(), false);
// Make sure A is square!
if (A.numRows() != A.numCols())
{
std::cerr << "ERROR! A must be square matrix!\n";
return y;
}
const int N = A.numRows();
// Make a copy of A since it gets modified
Matrix Acopy(A);
// y.setSize(N,N);
Matrix col(N,1);
Matrix indx(N,1);
double d;
int i,j;
ludcmp(Acopy,indx,d);
for (j = 0; j < N; j++)
{
for (i = 0; i < N; i++) col(i,0) = 0.0;
col(j,0) = 1.0;
lubksb(Acopy,indx,col);
for (i = 0; i < N; i++) y(i,j) = col(i,0);
}
std::cout.flush();
// Return result
return y;
}
int
regress(float *b, float **x, float *y, float *w, int n, int dim)
{
float d;
float **xt, **xx;
int *indx,i,j;
xt = matrix(1,dim,1,n);
transpose(xt,x,n,dim); // X'
for(i=1;i<=dim;i++)
for(j=1;j<=n;j++)
xt[i][j] *= w[j]; // X'*W
xx = matrix(1,dim,1,dim);
multiply(xx,xt,x,dim,n,dim); // X'*W*X
// b = vector(1,dim);
multiply(b,xt,y,dim,n); // X'*W*Y
// Here we have (X'*W*X) b = (X'*W*Y)
// where W is diagonal matrix with diagonal elements w
indx=ivector(1,n);
if( ludcmp(xx,dim,indx,&d) ) return 1;
lubksb(xx,dim,indx,b);
free_matrix(xt,1,dim,1,n);
free_matrix(xx,1,dim,1,dim);
free_ivector(indx,1,n);
return 0;
}
int invm (const double *a, int N, double *y) {
/* Inverse of a real matrix a[0..N-1][0..N-1].
Input:
a[0..N-1][0..N-1] - given matrix (saved on exit)
N - number of rows and columns of a
Output:
y[0..N-1][0..N-1] - inverse of a
*/
double d, *col, *al;
int i, j, *indx;
al = (double *) calloc (sqr(N), sizeof (double));
indx = (int *) calloc (N, sizeof (int));
col = (double *) calloc (N, sizeof (double));
for (i=0; i<sqr(N); i++)
al[i] = a[i];
if (ludcmp (al, N, indx, &d))
return 1;
for (j=0; j<N; j++) {
for (i=0; i<N; i++)
col[i] = 0.0;
col[j] = 1.0;
lubksb (al, N, indx, col);
for (i=0; i<N; i++)
y[N*i+j] = col[i];
}
free (col);
free (indx);
free (al);
return 0;
} /* invm() */
//---------------------------------------------------------------------------
Matrix solveLinearSystem(const Matrix& A, const Matrix& b)
{
Matrix x;
// Make sure A is square!
if (A.numRows() != A.numCols())
{
std::cerr << "ERROR! A must be square matrix!\n";
return x;
}
// Make sure b is a column vector with the same dimensions
// as A
if (b.numRows() != A.numRows())
{
std::cerr << "ERROR! b must be a column vector with the same dimensions as square matrix A!\n";
return x;
}
// Make a copy of A since it gets modified
Matrix Acopy(A);
const int N = Acopy.numRows();
Matrix indx(N,1);
double d;
ludcmp(Acopy,indx,d);
x = b; // x will contain solution
lubksb(Acopy,indx,x);
// Return solution column vector
return x;
}
NUMERICS_EXPORT BOOL inverse(double **a, int n)
{
double d;
int i, j;
BOOL ret = FALSE;
double** ai = dmatrix(0, n - 1, 0, n - 1);
double* col = dvector(0, n - 1);
int* indx = ivector(0, n - 1);
if(ludcmp(a, n, indx, &d)){
for(j = 0; j < n; j++){
for(i = 0; i < n; i++) col[i] = 0.0;
col[j] = 1.0;
lubksb(a, n, indx, col);
for(i = 0; i < n; i++) ai[i][j] = col[i];
}
for(i = 0; i < n; i++){
for(j = 0; j < n; j++){
a[i][j] = ai[i][j];
}
}
ret = TRUE;
}
free_dmatrix(ai, 0, n - 1, 0);
free_dvector(col, 0);
free_ivector(indx, 0);
return ret;
}
/* Invert a double matrix, 1-indexed of size dim
* from Numerical Recipes. Input matrix is destroyed.
*/
int
invert_matrix(double **in, double **out,
int dim)
{
extern void ludcmp(double **a, int n, int *indx, double *d);
extern void ludcmp(double **a, int n, int *indx, double *d);
int *indx,i,j;
double *tvec,det;
tvec = dvector(1,dim);
indx = ivector(1,dim);
ludcmp(in,dim,indx,&det);
for (j=1; j<=dim; j++) {
for (i=1; i<=dim; i++) tvec[i]=0.;
tvec[j] = 1.0;
lubksb(in,dim,indx,tvec);
for (i=1; i<=dim; i++) out[i][j]=tvec[i];
}
free_ivector(indx,1,6);
free_dvector(tvec,1,6);
return(0);
}
void
avtMatrix::Inverse()
{
avtMatrix n, y;
int i, j, indx[4];
double d, col[4];
n=*this;
if (ludcmp(&n, indx, &d)) {
MakeIdentity();
return;
}
for (j=0; j<4; j++) {
for (i=0; i<4; i++) {
col[i] = 0.0f;
}
col[j] = 1.0f;
lubksb(&n, indx, col);
for (i=0; i<4; i++) {
y.m[i][j] = col[i];
}
}
*this = y;
return;
}
int main()
{
int i, j, nmax = 50, n = 5, chkerr;
long int /* eps, */ w;
/* eps = 1.0e-6; */
/* Init loop */
for(i = 0; i <= n; i++)
{
w = 0; /* data to fill in cells */
for(j = 0; j <= n; j++)
{
a[i][j] = (i + 1) + (j + 1);
if(i == j) /* only once per loop pass */
a[i][j] *= 2;
w += a[i][j];
}
b[i] = w;
}
/* chkerr = ludcmp(nmax, n, eps); */
chkerr = ludcmp(nmax,n);
return 0;
}
/////////////// MATRIX INVERSE!!
int
inverse(float **ainv, float **a, int n)
{
float d;
int j,i,*indx;
float *colum;
colum=vector(1,n);
indx=ivector(1,n);
// ainv=matrix(1,n,1,n);
if( ludcmp(a,n,indx,&d) ) return 1;
for(j=1;j<=n;j++)
{
for(i=1;i<=n;i++) colum[i]=0.0;
colum[j]=1.0;
lubksb(a,n,indx,colum);
for(i=1;i<=n;i++) ainv[i][j]=colum[i];
}
free_vector(colum,1,n);
free_ivector(indx,1,n);
return 0;
}
int ns1__luinv(struct soap *soap, matrix *a, matrix *b)
{ vector col(soap);
ivector indx(soap);
double d;
int i, j, k, n;
if (ludcmp(soap, *a, indx, d))
return soap_sender_fault(soap, "Singular matrix in routine ludcmp", NULL);
n = a->size();
col.resize(n);
b->resize(n, n);
for (j = 1; j <= n; j++)
{ for (i = 1; i <= n; i++)
col[i] = 0.0;
col[j] = 1.0;
lubksb(*a, indx, col);
for (i = 1; i <= n; i++)
(*b)[i][j] = col[i];
}
for (i = 1; i <= n; i++)
{ for (j = 1; j <= n; j++)
if (fabs((*b)[i][j]) > 1.0e-15)
break;
for (k = n; k > j; k--)
if (fabs((*b)[i][k]) > 1.0e-15)
break;
(*b)[i].resize(j, k);
}
return SOAP_OK;
}
int
main(void)
{
int i, j/*, nmax = 50*/, n = 5, chkerr;
double eps, w;
eps = 1.0e-6;
for (i = 0; i <= n; i++) {
w = 0.0;
for (j = 0; j <= n; j++) {
a[i][j] = (i + 1) + (j + 1);
if (i == j)
a[i][j] *= 10.0;
w += a[i][j];
}
b[i] = w;
}
chkerr = ludcmp( /* nmax, */ n, eps);
return 0;
}
void Matrix_Inverse( double **invMat, double **Mat, int nn)
{
int i, j;
double ger;
int *p= ivector( 1, nn);
double **LU = dmatrix( 1, nn, 1, nn);
for( i=0; i<=nn-1; i++)
for( j=0; j<=nn-1; j++)
LU[i+1][j+1] = Mat[i][j];
double *col = dvector( 1, nn);
ludcmp( LU, nn, p, &ger);
for( j=1; j<=nn; j++) {
for( i=1; i<=nn; i++) col[i] = 0.0;
col[j] = 1.0;
lubksb( LU, nn, p, col );
for( i=1; i<=nn; i++) invMat[i-1][j-1] = (double) col[i];
};
free_dvector( col, 1, nn);
free_ivector( p, 1, nn);
free_dmatrix( LU, 1, nn, 1, nn);
}
void Newton_Solver( double * x1, double ** A, double * b, int vn)
{
int i, j;
double ger;
int *p = ivector( 1, vn);
double **LU = dmatrix( 1, vn, 1, vn);
for( i=0; i<=vn-1; i++)
for( j=0; j<=vn-1; j++)
LU[i+1][j+1] = A[i][j];
double *X = dvector( 1, vn);
for( i=0; i<=vn-1; i++)
X[i+1] = b[i];
ludcmp( LU, vn, p, &ger);
lubksb( LU, vn, p, X );
for( i=0; i<=vn-1; i++)
x1[i] = X[i+1];
}
void NR::voltra(const DP t0, const DP h, Vec_O_DP &t, Mat_O_DP &f,
DP g(const int, const DP),
DP ak(const int, const int, const DP, const DP))
{
int i,j,k,l;
DP d,sum;
int m=f.nrows();
int n=f.ncols();
Vec_INT indx(m);
Vec_DP b(m);
Mat_DP a(m,m);
t[0]=t0;
for (k=0;k<m;k++) f[k][0]=g(k,t[0]);
for (i=1;i<n;i++) {
t[i]=t[i-1]+h;
for (k=0;k<m;k++) {
sum=g(k,t[i]);
for (l=0;l<m;l++) {
sum += 0.5*h*ak(k,l,t[i],t[0])*f[l][0];
for (j=1;j<i;j++)
sum += h*ak(k,l,t[i],t[j])*f[l][j];
if (k == l)
a[k][l]=1.0-0.5*h*ak(k,l,t[i],t[i]);
else
a[k][l] = -0.5*h*ak(k,l,t[i],t[i]);
}
b[k]=sum;
}
ludcmp(a,indx,d);
lubksb(a,indx,b);
for (k=0;k<m;k++) f[k][i]=b[k];
}
}
int main()
{
int i, j, nmax = 50, n = 5, chkerr;
double eps, w;
eps = 1.0e-6;
for(i = 0; i <= n; i++)
{
w = 0.0;
for(j = 0; j <= n; j++)
{
a[i][j] = (i + 1) + (j + 1);
if(i == j) a[i][j] *= 10.0;
w += a[i][j];
}
b[i] = w;
}
#ifdef KLEE
klee_make_symbolic(a, sizeof(a), "a");
#endif
chkerr = ludcmp(nmax, n, eps);
}
void savgol(double *c, int np, int nl, int nr, int ld, int m) {
/*-------------------------------------------------------------------------------------------
USES lubksb,ludcmp given below.
Returns in c(np), in wrap-around order (see reference) consistent with the argument respns
in routine convlv, a set of Savitzky-Golay filter coefficients. nl is the number of leftward
(past) data points used, while nr is the number of rightward (future) data points, making
the total number of data points used nl+nr+1. ld is the order of the derivative desired
(e.g., ld = 0 for smoothed function). m is the order of the smoothing polynomial, also
equal to the highest conserved moment; usual values are m = 2 or m = 4.
-------------------------------------------------------------------------------------------*/
int imj,ipj,j,k,kk,mm;
double d,fac,sum,**a,*b;
if (np < nl+nr+1 || nl < 0 || nr < 0 || ld > m || nl+nr < m)
nrerror("bad args in savgol");
int *indx= intvector(1,m+1);
a=matrix(1,m+1,1,m+1);
b=vector(1,m+1);
for (ipj=0;ipj<=(m << 1);ipj++)
{//Set up the normal equations of the desired least-squares fit
sum=(ipj ? 0.0 : 1.0);
for (k=1;k<=nr;k++)
sum += pow((double)k,(double)ipj);
for (k=1;k<=nl;k++)
sum += pow((double)-k,(double)ipj);
mm=IMIN(ipj,2*m-ipj);
for (imj = -mm;imj<=mm;imj+=2)
a[1+(ipj+imj)/2][1+(ipj-imj)/2]=sum;
}
ludcmp(a, m+1, indx, &d); //Solve them: LU decomposition.
for (j=1;j<=m+1;j++)
b[j]=0.0;
b[ld+1]=1.0; //Right-hand side vector is unit vector, depending on which derivative we want.
lubksb(a,m+1,indx,b); //Get one row of the inverse matrix.
for (kk=1;kk<=np;kk++)
c[kk]=0.0; //Zero the output array (it may be bigger than number of coefficients).
for (k = -nl;k<=nr;k++)
{
sum=b[1]; //Each Savitzky-Golay coefficient is the dot product
//of powers of an integer with the inverse matrix row.
fac=1.0;
for (mm=1;mm<=m;mm++)
sum += b[mm+1]*(fac *= k);
kk=((np-k) % np)+1; //Store in wrap-around order.
c[kk]=sum;
}
free_vector(b,1,m+1);
free_matrix(a,1,m+1,1,m+1);
free_intvector(indx,1,m+1);
}
int ns1__ludet(struct soap *soap, matrix *a, double &d)
{ ivector indx(soap);
if (ludcmp(soap, *a, indx, d))
return soap_sender_fault(soap, "Singular matrix in routine ludcmp", NULL);
for (int i = 1; i <= a->__size; i++)
d *= (*a)[i][i];
return SOAP_OK;
}
double lik(POPROT *pop)
{/* Function to compute the inverse of the Fisher information matrix of the
population protocol pop. Returns the determinant of the matrix, also stored in
pop->det. The Fisher information matrix of the population protocol is stored
in pop->fisher and the inverse is stored in pop->finv
*/
int ndim = pop->ndim;
int ncase = (int)(ndim*(ndim+1)/2);
int i,j,jj,ifail;
int *indx;
double *col;
matrix *xa;
double cri;
/* POPROT_print(pop,1);
PROTOC_print(&prot[7]);
*/
indx = (int *)calloc(ndim,sizeof(int));
col = (double *)calloc(ndim,sizeof(double));
xa = matrix_create(ndim,ndim);
for(i = 0;i<ncase;i++)
{
pop->fisher[i] = 0;
for(j = 0;j<pop->np;j++)
{
pop->fisher[i] = pop->fisher[i]+pop->freq[j]*pop->pind[j].fisher[i];
}
}
jj = 0;
for(i = 0;i<ndim;i++)
{
for(j = 0;j<=i;j++)
{
xa->m[i][j] = pop->fisher[jj];
xa->m[j][i] = pop->fisher[jj];
jj++;
}
}
ifail = ludcmp(xa->m,ndim,indx,&cri);
if(ifail==1) return CRI_MAX;
for(i = 0;i<ndim;i++) cri = cri*xa->m[i][i];
pop->det = cri;
for(i = 0;i<ndim;i++)
{
for(j = 0;j<ndim;j++) col[j] = 0.0;
col[i] = 1.0;
lubksb(xa->m,ndim,indx,col);
for(j = 0;j<ndim;j++)
{
jj = i*(i+1)/2+j;
pop->finv[jj] = col[j]; /*=xb[j][i] using another matrix*/
}
}
/* desallocation */
matrix_destroy(xa);
free(indx);
return cri;
}
int ns1__lusol(struct soap *soap, matrix *a, vector *b, vector *x)
{ ivector indx(soap);
double d;
if (ludcmp(soap, *a, indx, d))
return soap_sender_fault(soap, "Singular matrix in routine ludcmp", NULL);
lubksb(*a, indx, *b);
*x = *b;
return SOAP_OK;
}
double
cmat_invert(double**a, int sym, int dim)
{
int i,j;
double det=0;
double **y;
double *b;
b = (double*) malloc(sizeof(double)*dim);
y = cmat_new_square_matrix(dim);
if (sym) {
symm_lu_decomp(a,dim,&det);
if (fabs(det) < 1.0e-16) return 0;
for (i=0; i < dim; i++) det *= a[i][i];
if (fabs(det) < 1.0e-16) return 0;
for (i=0; i < dim; i++) {
for (j=0; j < dim; j++) b[j]=0;
b[i]=1;
symm_lu_back_sub(a,dim,b);
for (j=0; j < dim; j++) y[j][i]=b[j];
}
for (i=0; i < dim; i++)
for (j=0; j <= i; j++)
a[i][j] = y[i][j];
} else {
int *indx= (int*) malloc(sizeof(int)*dim);
ludcmp(a,dim,indx,&det);
if (fabs(det) < 1.0e-16) return 0;
for (i=0; i < dim; i++) det *= a[i][i];
if (fabs(det) < 1.0e-16) return 0;
for (i=0; i < dim; i++) {
memset(b,0,sizeof(double)*dim);
b[i]=1;
lubksb(a,dim,indx,b);
for (j=0; j < dim; j++) y[j][i]=b[j];
}
for (i=0; i < dim; i++)
for (j=0; j < dim; j++)
a[i][j] = y[i][j];
free(indx);
}
free(b);
cmat_delete_matrix(y);
return det;
}
int ns1__lusols(struct soap *soap, matrix *a, matrix *b, matrix *x)
{ ivector indx(soap);
double d;
if (ludcmp(soap, *a, indx, d))
return soap_sender_fault(soap, "Singular matrix in routine ludcmp", NULL);
for (int i = 1; i <= b->size(); i++)
lubksb(*a, indx, (*b)[i]);
*x = *b;
return SOAP_OK;
}
log_value<dcomplex>
TransposeInverseMatrix(const Array2 < complex <doublevar> > & a,
Array2 < complex <doublevar> > & a1,
const int n)
{
Array2 <complex <doublevar> > temp(n,n);
Array1 <int> indx(n);
doublevar d;
// a(i,j) first index i is row index (convention)
// elements of column vectors are stored contiguous in memory in C style arrays
// a(i) refers to a column vector
// calculate the inverse of the transposed matrix because this
// allows to pass a column vector to lubksb() instead of a row
// put the transposed matrix in temp
//cout << "temp " << endl;
for(int i=0;i<n;++i)
{
for(int j=0;j<n;++j)
{
temp(i,j)=a(i,j);
a1(i,j)=complex <doublevar> (0.0,0.0);
}
a1(i,i)=complex <doublevar> (1.0,0.0);
}
//cout << "ludcmp" << endl;
//if the matrix is singular, the determinant is zero.
if(ludcmp(temp,n,indx,d)==0) {
#ifdef SUPERDEBUG
cout << "log_value<dcomplex>TransposeInverseMatrix:zero determinant " << endl;
#endif
return dcomplex(0.0,0.0);
}
//cout << "lubksb" << endl;
for(int j=0;j<n;++j)
{
// get column vector
Array1 <complex <doublevar> > yy;//(a1(j));
yy.refer(a1(j));
lubksb(temp,n,indx,yy);
}
//complex <doublevar> det(d,0);
log_value<dcomplex> det=dcomplex(d,0);
for(int j=0;j<n;++j) {
det *= temp(j,j);
}
return det;
}
int new_linearisation(struct jacobian *jac,double hinvGak,int neq,ErrorMsg error_message){
double luparity, *Ax;
int i,j,*Ap,*Ai,funcreturn;
if(jac->use_sparse==1){
Ap = jac->spJ->Ap; Ai = jac->spJ->Ai; Ax = jac->spJ->Ax;
/* Construct jac->spJ->Ax from jac->xjac, the jacobian:*/
for(j=0;j<neq;j++){
for(i=Ap[j];i<Ap[j+1];i++){
if(Ai[i]==j){
/* I'm at the diagonal */
Ax[i] = 1.0-hinvGak*jac->xjac[i];
}
else{
Ax[i] = -hinvGak*jac->xjac[i];
}
}
}
/* Matrix constructed... */
if(jac->new_jacobian==_TRUE_){
/*I have a new pattern, and I have not done a LU decomposition
since the last jacobian calculation, so I need to do a full
sparse LU-decomposition: */
/* Find the sparsity pattern C = J + J':*/
calc_C(jac);
/* Calculate the optimal ordering: */
sp_amd(jac->Cp, jac->Ci, neq, jac->cnzmax,
jac->Numerical->q,jac->Numerical->wamd);
/* if the next line is uncomented, the code uses natural ordering instead of AMD ordering */
/*jac->Numerical->q = NULL;*/
funcreturn = sp_ludcmp(jac->Numerical, jac->spJ, 1e-3);
class_test(funcreturn == _FAILURE_,error_message,
"Failure in sp_ludcmp. Possibly singular matrix!");
jac->new_jacobian = _FALSE_;
}
else{
/* I have a repeated pattern, so I can just refactor:*/
sp_refactor(jac->Numerical, jac->spJ);
}
}
else{
/* Normal calculation: */
for(i=1;i<=neq;i++){
for(j=1;j<=neq;j++){
jac->LU[i][j] = - hinvGak * jac->dfdy[i][j];
if(i==j) jac->LU[i][j] +=1.0;
}
}
/*Dense LU decomposition: */
funcreturn = ludcmp(jac->LU,neq,jac->luidx,&luparity,jac->LUw);
class_test(funcreturn == _FAILURE_,error_message,
"Failure in ludcmp. Possibly singular matrix!");
}
return _SUCCESS_;
}
