/*************************************************************************
* Application of an elementary reflection to a rectangular matrix of size MxN
*
* The algorithm post-multiplies the matrix by an elementary reflection
* transformation which is given by column V and scalar Tau (see the
* description of the GenerateReflection). Not the whole matrix but only a
* part of it is transformed (rows from M1 to M2, columns from N1 to N2).
* Only the elements of this submatrix are changed.
*
* Input parameters:
* C - matrix to be transformed.
* Tau - scalar defining transformation.
* V - column defining transformation.
* Array whose index ranges within [1..N2-N1+1]
* M1, M2 - range of rows to be transformed.
* N1, N2 - range of columns to be transformed.
* WORK - working array whose index goes from M1 to M2.
*
* Output parameters:
* C - the result of multiplying the input matrix C by the
* transformation matrix which is given by Tau and V.
* If N1>N2 or M1>M2, C is not modified.
*
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* September 30, 1994
*************************************************************************/
public static void complexapplyreflectionfromtheright(ref AP.Complex[,] c,
AP.Complex tau,
ref AP.Complex[] v,
int m1,
int m2,
int n1,
int n2,
ref AP.Complex[] work)
{
AP.Complex t = 0;
int i = 0;
int vm = 0;
int i_ = 0;
int i1_ = 0;
if (tau == 0 | n1 > n2 | m1 > m2)
{
return;
}
//
// w := C * v
//
vm = n2 - n1 + 1;
for (i = m1; i <= m2; i++)
{
i1_ = (1) - (n1);
t = 0.0;
for (i_ = n1; i_ <= n2; i_++)
{
t += c[i, i_] * v[i_ + i1_];
}
work[i] = t;
}
//
// C := C - w * conj(v^T)
//
for (i_ = 1; i_ <= vm; i_++)
{
v[i_] = AP.Math.Conj(v[i_]);
}
for (i = m1; i <= m2; i++)
{
t = work[i] * tau;
i1_ = (1) - (n1);
for (i_ = n1; i_ <= n2; i_++)
{
c[i, i_] = c[i, i_] - t * v[i_ + i1_];
}
}
for (i_ = 1; i_ <= vm; i_++)
{
v[i_] = AP.Math.Conj(v[i_]);
}
}
/*************************************************************************
* Obsolete 1-based subroutine, left for backward compatibility.
* See CMatrixLU for 0-based replacement.
*************************************************************************/
public static void complexludecompositionunpacked(AP.Complex[,] a,
int m,
int n,
ref AP.Complex[,] l,
ref AP.Complex[,] u,
ref int[] pivots)
{
int i = 0;
int j = 0;
int minmn = 0;
a = (AP.Complex[, ])a.Clone();
if (m == 0 | n == 0)
{
return;
}
minmn = Math.Min(m, n);
l = new AP.Complex[m + 1, minmn + 1];
u = new AP.Complex[minmn + 1, n + 1];
complexludecomposition(ref a, m, n, ref pivots);
for (i = 1; i <= m; i++)
{
for (j = 1; j <= minmn; j++)
{
if (j > i)
{
l[i, j] = 0;
}
if (j == i)
{
l[i, j] = 1;
}
if (j < i)
{
l[i, j] = a[i, j];
}
}
}
for (i = 1; i <= minmn; i++)
{
for (j = 1; j <= n; j++)
{
if (j < i)
{
u[i, j] = 0;
}
if (j >= i)
{
u[i, j] = a[i, j];
}
}
}
}
/*************************************************************************
* Obsolete 1-based subroutine.
*************************************************************************/
public static AP.Complex complexdeterminant(AP.Complex[,] a,
int n)
{
AP.Complex result = 0;
int[] pivots = new int[0];
a = (AP.Complex[, ])a.Clone();
clu.complexludecomposition(ref a, n, n, ref pivots);
result = complexdeterminantlu(ref a, ref pivots, n);
return(result);
}
/*************************************************************************
* Calculation of the determinant of a general matrix
*
* Input parameters:
* A - matrix, array[0..N-1, 0..N-1]
* N - size of matrix A.
*
* Result: determinant of matrix A.
*
* -- ALGLIB --
* Copyright 2005 by Bochkanov Sergey
*************************************************************************/
public static AP.Complex cmatrixdet(AP.Complex[,] a,
int n)
{
AP.Complex result = 0;
int[] pivots = new int[0];
a = (AP.Complex[, ])a.Clone();
clu.cmatrixlu(ref a, n, n, ref pivots);
result = cmatrixludet(ref a, ref pivots, n);
return(result);
}
/*************************************************************************
* Application of an elementary reflection to a rectangular matrix of size MxN
*
* The algorithm pre-multiplies the matrix by an elementary reflection
* transformation which is given by column V and scalar Tau (see the
* description of the GenerateReflection). Not the whole matrix but only a
* part of it is transformed (rows from M1 to M2, columns from N1 to N2). Only
* the elements of this submatrix are changed.
*
* Note: the matrix is multiplied by H, not by H'. If it is required to
* multiply the matrix by H', it is necessary to pass Conj(Tau) instead of Tau.
*
* Input parameters:
* C - matrix to be transformed.
* Tau - scalar defining transformation.
* V - column defining transformation.
* Array whose index ranges within [1..M2-M1+1]
* M1, M2 - range of rows to be transformed.
* N1, N2 - range of columns to be transformed.
* WORK - working array whose index goes from N1 to N2.
*
* Output parameters:
* C - the result of multiplying the input matrix C by the
* transformation matrix which is given by Tau and V.
* If N1>N2 or M1>M2, C is not modified.
*
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* September 30, 1994
*************************************************************************/
public static void complexapplyreflectionfromtheleft(ref AP.Complex[,] c,
AP.Complex tau,
ref AP.Complex[] v,
int m1,
int m2,
int n1,
int n2,
ref AP.Complex[] work)
{
AP.Complex t = 0;
int i = 0;
int vm = 0;
int i_ = 0;
if (tau == 0 | n1 > n2 | m1 > m2)
{
return;
}
//
// w := C^T * conj(v)
//
vm = m2 - m1 + 1;
for (i = n1; i <= n2; i++)
{
work[i] = 0;
}
for (i = m1; i <= m2; i++)
{
t = AP.Math.Conj(v[i + 1 - m1]);
for (i_ = n1; i_ <= n2; i_++)
{
work[i_] = work[i_] + t * c[i, i_];
}
}
//
// C := C - tau * v * w^T
//
for (i = m1; i <= m2; i++)
{
t = v[i - m1 + 1] * tau;
for (i_ = n1; i_ <= n2; i_++)
{
c[i, i_] = c[i, i_] - t * work[i_];
}
}
}
/*************************************************************************
* Determinant calculation of the matrix given by its LU decomposition.
*
* Input parameters:
* A - LU decomposition of the matrix (output of
* RMatrixLU subroutine).
* Pivots - table of permutations which were made during
* the LU decomposition.
* Output of RMatrixLU subroutine.
* N - size of matrix A.
*
* Result: matrix determinant.
*
* -- ALGLIB --
* Copyright 2005 by Bochkanov Sergey
*************************************************************************/
public static AP.Complex cmatrixludet(ref AP.Complex[,] a,
ref int[] pivots,
int n)
{
AP.Complex result = 0;
int i = 0;
int s = 0;
result = 1;
s = 1;
for (i = 0; i <= n - 1; i++)
{
result = result * a[i, i];
if (pivots[i] != i)
{
s = -s;
}
}
result = result * s;
return(result);
}
/*************************************************************************
* Estimate of the condition number of a matrix given by its LU decomposition (1-norm)
*
* The algorithm calculates a lower bound of the condition number. In this case,
* the algorithm does not return a lower bound of the condition number, but an
* inverse number (to avoid an overflow in case of a singular matrix).
*
* Input parameters:
* LUDcmp - LU decomposition of a matrix in compact form. Output of
* the CMatrixLU subroutine.
* N - size of matrix A.
*
* Result: 1/LowerBound(cond(A))
*************************************************************************/
public static double cmatrixlurcond1(ref AP.Complex[,] ludcmp,
int n)
{
double result = 0;
int i = 0;
AP.Complex[,] a1 = new AP.Complex[0, 0];
int i_ = 0;
int i1_ = 0;
System.Diagnostics.Debug.Assert(n >= 1, "CMatrixLURCond1: N<1!");
a1 = new AP.Complex[n + 1, n + 1];
for (i = 1; i <= n; i++)
{
i1_ = (0) - (1);
for (i_ = 1; i_ <= n; i_++)
{
a1[i, i_] = ludcmp[i - 1, i_ + i1_];
}
}
result = complexrcond1lu(ref a1, n);
return(result);
}
/*************************************************************************
* Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian
* matrix in a given half-interval (A, B] by using a bisection and inverse
* iteration
*
* Input parameters:
* A - Hermitian matrix which is given by its upper or lower
* triangular part. Array whose indexes range within
* [0..N-1, 0..N-1].
* N - size of matrix A.
* ZNeeded - flag controlling whether the eigenvectors are needed or
* not. If ZNeeded is equal to:
* 0, the eigenvectors are not returned;
* 1, the eigenvectors are returned.
* IsUpperA - storage format of matrix A.
* B1, B2 - half-interval (B1, B2] to search eigenvalues in.
*
* Output parameters:
* M - number of eigenvalues found in a given half-interval, M>=0
* W - array of the eigenvalues found.
* Array whose index ranges within [0..M-1].
* Z - if ZNeeded is equal to:
* 0, Z hasn’t changed;
* 1, Z contains eigenvectors.
* Array whose indexes range within [0..N-1, 0..M-1].
* The eigenvectors are stored in the matrix columns.
*
* Result:
* True, if successful. M contains the number of eigenvalues in the given
* half-interval (could be equal to 0), W contains the eigenvalues,
* Z contains the eigenvectors (if needed).
*
* False, if the bisection method subroutine wasn't able to find the
* eigenvalues in the given interval or if the inverse iteration
* subroutine wasn't able to find all the corresponding eigenvectors.
* In that case, the eigenvalues and eigenvectors are not returned, M is
* equal to 0.
*
* Note:
* eigen vectors of Hermitian matrix are defined up to multiplication by
* a complex number L, such as |L|=1.
*
* -- ALGLIB --
* Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey.
*************************************************************************/
public static bool hmatrixevdr(AP.Complex[,] a,
int n,
int zneeded,
bool isupper,
double b1,
double b2,
ref int m,
ref double[] w,
ref AP.Complex[,] z)
{
bool result = new bool();
AP.Complex[,] q = new AP.Complex[0, 0];
double[,] t = new double[0, 0];
AP.Complex[] tau = new AP.Complex[0];
double[] e = new double[0];
double[] work = new double[0];
int i = 0;
int k = 0;
double v = 0;
int i_ = 0;
a = (AP.Complex[, ])a.Clone();
System.Diagnostics.Debug.Assert(zneeded == 0 | zneeded == 1, "HermitianEigenValuesAndVectorsInInterval: incorrect ZNeeded");
//
// Reduce to tridiagonal form
//
htridiagonal.hmatrixtd(ref a, n, isupper, ref tau, ref w, ref e);
if (zneeded == 1)
{
htridiagonal.hmatrixtdunpackq(ref a, n, isupper, ref tau, ref q);
zneeded = 2;
}
//
// Bisection and inverse iteration
//
result = tdbisinv.smatrixtdevdr(ref w, ref e, n, zneeded, b1, b2, ref m, ref t);
//
// Eigenvectors are needed
// Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
//
if (result & zneeded != 0 & m != 0)
{
work = new double[m - 1 + 1];
z = new AP.Complex[n - 1 + 1, m - 1 + 1];
for (i = 0; i <= n - 1; i++)
{
//
// Calculate real part
//
for (k = 0; k <= m - 1; k++)
{
work[k] = 0;
}
for (k = 0; k <= n - 1; k++)
{
v = q[i, k].x;
for (i_ = 0; i_ <= m - 1; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 0; k <= m - 1; k++)
{
z[i, k].x = work[k];
}
//
// Calculate imaginary part
//
for (k = 0; k <= m - 1; k++)
{
work[k] = 0;
}
for (k = 0; k <= n - 1; k++)
{
v = q[i, k].y;
for (i_ = 0; i_ <= m - 1; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 0; k <= m - 1; k++)
{
z[i, k].y = work[k];
}
}
}
return(result);
}
/*************************************************************************
* Utility subroutine performing the "safe" solution of a system of linear
* equations with triangular complex coefficient matrices.
*
* The feature of an algorithm is that it could not cause an overflow or a
* division by zero regardless of the matrix used as the input. If an overflow
* is possible, an error code is returned.
*
* The algorithm can solve systems of equations with upper/lower triangular
* matrices, with/without unit diagonal, and systems of types A*x=b, A^T*x=b,
* A^H*x=b.
*
* Input parameters:
* A - system matrix.
* Array whose indexes range within [1..N, 1..N].
* N - size of matrix A.
* X - right-hand member of a system.
* Array whose index ranges within [1..N].
* IsUpper - matrix type. If it is True, the system matrix is the upper
* triangular matrix and is located in the corresponding part
* of matrix A.
* Trans - problem type.
* If Trans is:
* 0, A*x=b
* 1, A^T*x=b
* 2, A^H*x=b
* IsUnit - matrix type. If it is True, the system matrix has a unit
* diagonal (the elements on the main diagonal are not used
* in the calculation process), otherwise the matrix is
* considered to be a general triangular matrix.
* CNORM - array which is stored in norms of rows and columns of the
* matrix. If the array hasn't been filled up during previous
* executions of an algorithm with the same matrix as the
* input, it will be filled up by the subroutine. If the
* array is filled up, the subroutine uses it without filling
* it up again.
* NORMIN - flag defining the state of column norms array. If True, the
* array is filled up.
* WORKA - working array whose index ranges within [1..N].
* WORKX - working array whose index ranges within [1..N].
*
* Output parameters (if the result is True):
* X - solution. Array whose index ranges within [1..N].
* CNORM - array of column norms whose index ranges within [1..N].
*
* Result:
* True, if the matrix is not singular and the algorithm finished its
* work correctly without causing an overflow.
* False, if the matrix is singular or the algorithm was cancelled
* because of an overflow possibility.
*
* Note:
* The disadvantage of an algorithm is that sometimes it overestimates
* an overflow probability. This is not a problem when solving ordinary
* systems. If the elements of the matrix used as the input are close to
* MaxRealNumber, a false overflow detection is possible, but in practice
* such matrices can rarely be found.
* You can find more reliable subroutines in the LAPACK library
* (xLATRS subroutine ).
*
* -- ALGLIB --
* Copyright 31.03.2006 by Bochkanov Sergey
*************************************************************************/
public static bool complexsafesolvetriangular(ref AP.Complex[,] a,
int n,
ref AP.Complex[] x,
bool isupper,
int trans,
bool isunit,
ref AP.Complex[] worka,
ref AP.Complex[] workx)
{
bool result = new bool();
int i = 0;
int l = 0;
int j = 0;
bool dolswp = new bool();
double ma = 0;
double mx = 0;
double v = 0;
AP.Complex t = 0;
AP.Complex r = 0;
int i_ = 0;
int i1_ = 0;
System.Diagnostics.Debug.Assert(trans >= 0 & trans <= 2, "ComplexSafeSolveTriangular: incorrect parameters!");
result = true;
//
// Quick return if possible
//
if (n <= 0)
{
return(result);
}
//
// Main cycle
//
for (l = 1; l <= n; l++)
{
//
// Prepare subtask L
//
dolswp = false;
if (trans == 0)
{
if (isupper)
{
i = n + 1 - l;
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = a[i, i_ + i1_];
}
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_ + i1_];
}
dolswp = true;
}
if (!isupper)
{
i = l;
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = a[i, i_];
}
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_];
}
}
}
if (trans == 1)
{
if (isupper)
{
i = l;
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = a[i_, i];
}
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_];
}
}
if (!isupper)
{
i = n + 1 - l;
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = a[i_ + i1_, i];
}
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_ + i1_];
}
dolswp = true;
}
}
if (trans == 2)
{
if (isupper)
{
i = l;
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = AP.Math.Conj(a[i_, i]);
}
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_];
}
}
if (!isupper)
{
i = n + 1 - l;
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
worka[i_] = AP.Math.Conj(a[i_ + i1_, i]);
}
i1_ = (i) - (1);
for (i_ = 1; i_ <= l; i_++)
{
workx[i_] = x[i_ + i1_];
}
dolswp = true;
}
}
if (dolswp)
{
t = workx[l];
workx[l] = workx[1];
workx[1] = t;
t = worka[l];
worka[l] = worka[1];
worka[1] = t;
}
if (isunit)
{
worka[l] = 1;
}
//
// Test if workA[L]=0
//
if (worka[l] == 0)
{
result = false;
return(result);
}
//
// Now we have:
//
// workA[1:L]*workX[1:L] = b[I]
//
// with known workA[1:L] and workX[1:L-1]
// and unknown workX[L]
//
t = 0;
if (l >= 2)
{
ma = 0;
for (j = 1; j <= l - 1; j++)
{
ma = Math.Max(ma, AP.Math.AbsComplex(worka[j]));
}
mx = 0;
for (j = 1; j <= l - 1; j++)
{
mx = Math.Max(mx, AP.Math.AbsComplex(workx[j]));
}
if (Math.Max(ma, mx) > 1)
{
v = AP.Math.MaxRealNumber / Math.Max(ma, mx);
v = v / (l - 1);
if (v < Math.Min(ma, mx))
{
result = false;
return(result);
}
}
t = 0.0;
for (i_ = 1; i_ <= l - 1; i_++)
{
t += worka[i_] * workx[i_];
}
}
//
// Now we have:
//
// workA[L]*workX[L] + T = b[I]
//
if (Math.Max(AP.Math.AbsComplex(t), AP.Math.AbsComplex(x[i])) >= 0.5 * AP.Math.MaxRealNumber)
{
result = false;
return(result);
}
r = x[i] - t;
//
// Now we have:
//
// workA[L]*workX[L] = R
//
if (r != 0)
{
if (Math.Log(AP.Math.AbsComplex(r)) - Math.Log(AP.Math.AbsComplex(worka[l])) >= Math.Log(AP.Math.MaxRealNumber))
{
result = false;
return(result);
}
}
//
// X[I]
//
x[i] = r / worka[l];
}
return(result);
}
public static void complexmatrixvectormultiply(ref AP.Complex[,] a,
int i1,
int i2,
int j1,
int j2,
bool transa,
bool conja,
ref AP.Complex[] x,
int ix1,
int ix2,
AP.Complex alpha,
ref AP.Complex[] y,
int iy1,
int iy2,
AP.Complex beta,
ref AP.Complex[] t)
{
int i = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
if (!transa)
{
//
// y := alpha*A*x + beta*y
//
// or
//
// y := alpha*conj(A)*x + beta*y
//
if (i1 > i2 | j1 > j2)
{
return;
}
System.Diagnostics.Debug.Assert(j2 - j1 == ix2 - ix1, "ComplexMatrixVectorMultiply: A and X dont match!");
System.Diagnostics.Debug.Assert(i2 - i1 == iy2 - iy1, "ComplexMatrixVectorMultiply: A and Y dont match!");
//
// beta*y
//
if (beta == 0)
{
for (i = iy1; i <= iy2; i++)
{
y[i] = 0;
}
}
else
{
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = beta * y[i_];
}
}
//
// conj?
//
if (conja)
{
for (i_ = ix1; i_ <= ix2; i_++)
{
t[i_] = AP.Math.Conj(x[i_]);
}
alpha = AP.Math.Conj(alpha);
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = AP.Math.Conj(y[i_]);
}
}
else
{
for (i_ = ix1; i_ <= ix2; i_++)
{
t[i_] = x[i_];
}
}
//
// alpha*A*x
//
for (i = i1; i <= i2; i++)
{
i1_ = (ix1) - (j1);
v = 0.0;
for (i_ = j1; i_ <= j2; i_++)
{
v += a[i, i_] * x[i_ + i1_];
}
y[iy1 + i - i1] = y[iy1 + i - i1] + alpha * v;
}
//
// conj?
//
if (conja)
{
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = AP.Math.Conj(y[i_]);
}
}
}
else
{
//
// y := alpha*A'*x + beta*y;
//
// or
//
// y := alpha*conj(A')*x + beta*y;
//
if (i1 > i2 | j1 > j2)
{
return;
}
System.Diagnostics.Debug.Assert(i2 - i1 == ix2 - ix1, "ComplexMatrixVectorMultiply: A and X dont match!");
System.Diagnostics.Debug.Assert(j2 - j1 == iy2 - iy1, "ComplexMatrixVectorMultiply: A and Y dont match!");
//
// beta*y
//
if (beta == 0)
{
for (i = iy1; i <= iy2; i++)
{
y[i] = 0;
}
}
else
{
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = beta * y[i_];
}
}
//
// conj?
//
if (conja)
{
for (i_ = ix1; i_ <= ix2; i_++)
{
t[i_] = AP.Math.Conj(x[i_]);
}
alpha = AP.Math.Conj(alpha);
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = AP.Math.Conj(y[i_]);
}
}
else
{
for (i_ = ix1; i_ <= ix2; i_++)
{
t[i_] = x[i_];
}
}
//
// alpha*A'*x
//
for (i = i1; i <= i2; i++)
{
v = alpha * x[ix1 + i - i1];
i1_ = (j1) - (iy1);
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = y[i_] + v * a[i, i_ + i1_];
}
}
//
// conj?
//
if (conja)
{
for (i_ = iy1; i_ <= iy2; i_++)
{
y[i_] = AP.Math.Conj(y[i_]);
}
}
}
}
/*************************************************************************
* Solving a system of linear equations with a system matrix given by its
* LU decomposition.
*
* The algorithm solves a system of linear equations whose matrix is given by
* its LU decomposition. In case of a singular matrix, the algorithm returns
* False.
*
* The algorithm solves systems with a square matrix only.
*
* Input parameters:
* A - LU decomposition of a system matrix in compact form (the
* result of the RMatrixLU subroutine).
* Pivots - row permutation table (the result of a
* RMatrixLU subroutine).
* B - right side of a system.
* Array whose index ranges within [0..N-1].
* N - size of matrix A.
*
* Output parameters:
* X - solution of a system.
* Array whose index ranges within [0..N-1].
*
* Result:
* True, if the matrix is not singular.
* False, if the matrux is singular. In this case, X doesn't contain a
* solution.
*
* -- ALGLIB --
* Copyright 2005-2008 by Bochkanov Sergey
*************************************************************************/
public static bool cmatrixlusolve(ref AP.Complex[,] a,
ref int[] pivots,
AP.Complex[] b,
int n,
ref AP.Complex[] x)
{
bool result = new bool();
AP.Complex[] y = new AP.Complex[0];
int i = 0;
//int j = 0;
AP.Complex v = 0;
int i_ = 0;
b = (AP.Complex[])b.Clone();
y = new AP.Complex[n - 1 + 1];
x = new AP.Complex[n - 1 + 1];
result = true;
for (i = 0; i <= n - 1; i++)
{
if (a[i, i] == 0)
{
result = false;
return(result);
}
}
//
// pivots
//
for (i = 0; i <= n - 1; i++)
{
if (pivots[i] != i)
{
v = b[i];
b[i] = b[pivots[i]];
b[pivots[i]] = v;
}
}
//
// Ly = b
//
y[0] = b[0];
for (i = 1; i <= n - 1; i++)
{
v = 0.0;
for (i_ = 0; i_ <= i - 1; i_++)
{
v += a[i, i_] * y[i_];
}
y[i] = b[i] - v;
}
//
// Ux = y
//
x[n - 1] = y[n - 1] / a[n - 1, n - 1];
for (i = n - 2; i >= 0; i--)
{
v = 0.0;
for (i_ = i + 1; i_ <= n - 1; i_++)
{
v += a[i, i_] * x[i_];
}
x[i] = (y[i] - v) / a[i, i];
}
return(result);
}
/*************************************************************************
* Generation of an elementary complex reflection transformation
*
* The subroutine generates elementary complex reflection H of order N, so
* that, for a given X, the following equality holds true:
*
* ( X(1) ) ( Beta )
* H' * ( .. ) = ( 0 ), H'*H = I, Beta is a real number
* ( X(n) ) ( 0 )
*
* where
*
* ( V(1) )
* H = 1 - Tau * ( .. ) * ( conj(V(1)), ..., conj(V(n)) )
* ( V(n) )
*
* where the first component of vector V equals 1.
*
* Input parameters:
* X - vector. Array with elements [1..N].
* N - reflection order.
*
* Output parameters:
* X - components from 2 to N are replaced by vector V.
* The first component is replaced with parameter Beta.
* Tau - scalar value Tau.
*
* This subroutine is the modification of CLARFG subroutines from the LAPACK
* library. It has similar functionality except for the fact that it doesn’t
* handle errors when intermediate results cause an overflow.
*
* -- LAPACK auxiliary routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* September 30, 1994
*************************************************************************/
public static void complexgeneratereflection(ref AP.Complex[] x,
int n,
ref AP.Complex tau)
{
int j = 0;
//int knt = 0;
AP.Complex alpha = 0;
double alphi = 0;
double alphr = 0;
double beta = 0;
double xnorm = 0;
double mx = 0;
AP.Complex t = 0;
int i_ = 0;
if (n <= 0)
{
tau = 0;
return;
}
alpha = x[1];
mx = 0;
for (j = 2; j <= n; j++)
{
mx = Math.Max(AP.Math.AbsComplex(x[j]), mx);
}
xnorm = 0;
if (mx != 0)
{
for (j = 2; j <= n; j++)
{
t = x[j] / mx;
xnorm = xnorm + (t * AP.Math.Conj(t)).x;
}
xnorm = Math.Sqrt(xnorm) * mx;
}
alphr = alpha.x;
alphi = alpha.y;
if (xnorm == 0 & alphi == 0)
{
tau = 0;
return;
}
mx = Math.Max(Math.Abs(alphr), Math.Abs(alphi));
mx = Math.Max(mx, Math.Abs(xnorm));
beta = -(mx * Math.Sqrt(AP.Math.Sqr(alphr / mx) + AP.Math.Sqr(alphi / mx) + AP.Math.Sqr(xnorm / mx)));
if (alphr < 0)
{
beta = -beta;
}
tau.x = (beta - alphr) / beta;
tau.y = -(alphi / beta);
alpha = 1 / (alpha - beta);
if (n > 1)
{
for (i_ = 2; i_ <= n; i_++)
{
x[i_] = alpha * x[i_];
}
}
alpha = beta;
x[1] = alpha;
}
private static void testcomplexsolvesystemlu()
{
int i = 0;
int j = 0;
double err = 0;
AP.Complex v = 0;
AP.Complex[,] a = new AP.Complex[0, 0];
AP.Complex[] tx = new AP.Complex[0];
AP.Complex[] x = new AP.Complex[0];
AP.Complex[] b = new AP.Complex[0];
int n = 0;
int pass = 0;
int passcount = 0;
int i_ = 0;
err = 0;
passcount = 1000;
for (pass = 1; pass <= passcount; pass++)
{
n = 1 + AP.Math.RandomInteger(20);
a = new AP.Complex[n + 1, n + 1];
tx = new AP.Complex[n + 1];
b = new AP.Complex[n + 1];
//
// init A, TX
//
for (i = 1; i <= n; i++)
{
for (j = 1; j <= n; j++)
{
a[i, j].x = 2 * AP.Math.RandomReal() - 1;
a[i, j].y = 2 * AP.Math.RandomReal() - 1;
}
}
a[1 + AP.Math.RandomInteger(n), 1 + AP.Math.RandomInteger(n)] = 10;
a[1 + AP.Math.RandomInteger(n), 1 + AP.Math.RandomInteger(n)] = 7;
for (i = 1; i <= n; i++)
{
tx[i].x = 2 * AP.Math.RandomReal() - 1;
tx[i].y = 2 * AP.Math.RandomReal() - 1;
}
for (i = 1; i <= n; i++)
{
v = 0.0;
for (i_ = 1; i_ <= n; i_++)
{
v += a[i, i_] * tx[i_];
}
b[i] = v;
}
//
// solve
//
complexsolvesystem(a, b, n, ref x);
//
// test
//
for (i = 1; i <= n; i++)
{
err = Math.Max(err, AP.Math.AbsComplex(tx[i] - x[i]));
}
}
System.Console.Write("TESTING COMPLEX SOLVE SYSTEM");
System.Console.WriteLine();
System.Console.Write("Pass count is ");
System.Console.Write("{0,0:d}", passcount);
System.Console.WriteLine();
System.Console.Write("SolveSystem absolute error is ");
System.Console.Write("{0,5:E3}", err);
System.Console.WriteLine();
}
public static void hermitianrank2update(ref AP.Complex[,] a,
bool isupper,
int i1,
int i2,
ref AP.Complex[] x,
ref AP.Complex[] y,
ref AP.Complex[] t,
AP.Complex alpha)
{
int i = 0;
int tp1 = 0;
int tp2 = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
if (isupper)
{
for (i = i1; i <= i2; i++)
{
tp1 = i + 1 - i1;
tp2 = i2 - i1 + 1;
v = alpha * x[i + 1 - i1];
for (i_ = tp1; i_ <= tp2; i_++)
{
t[i_] = v * AP.Math.Conj(y[i_]);
}
v = AP.Math.Conj(alpha) * y[i + 1 - i1];
for (i_ = tp1; i_ <= tp2; i_++)
{
t[i_] = t[i_] + v * AP.Math.Conj(x[i_]);
}
i1_ = (tp1) - (i);
for (i_ = i; i_ <= i2; i_++)
{
a[i, i_] = a[i, i_] + t[i_ + i1_];
}
}
}
else
{
for (i = i1; i <= i2; i++)
{
tp1 = 1;
tp2 = i + 1 - i1;
v = alpha * x[i + 1 - i1];
for (i_ = tp1; i_ <= tp2; i_++)
{
t[i_] = v * AP.Math.Conj(y[i_]);
}
v = AP.Math.Conj(alpha) * y[i + 1 - i1];
for (i_ = tp1; i_ <= tp2; i_++)
{
t[i_] = t[i_] + v * AP.Math.Conj(x[i_]);
}
i1_ = (tp1) - (i1);
for (i_ = i1; i_ <= i; i_++)
{
a[i, i_] = a[i, i_] + t[i_ + i1_];
}
}
}
}
/*************************************************************************
* Complex triangular matrix inversion
*
* The subroutine inverts the following types of matrices:
* upper triangular
* upper triangular with unit diagonal
* lower triangular
* lower triangular with unit diagonal
*
* In case of an upper (lower) triangular matrix, the inverse matrix will
* also be upper (lower) triangular, and after the end of the algorithm,
* the inverse matrix replaces the source matrix. The elements below (above)
* the main diagonal are not changed by the algorithm.
*
* If the matrix has a unit diagonal, the inverse matrix also has a unit
* diagonal, the diagonal elements are not passed to the algorithm, they are
* not changed by the algorithm.
*
* Input parameters:
* A - matrix.
* Array whose indexes range within [0..N-1,0..N-1].
* N - size of matrix A.
* IsUpper - True, if the matrix is upper triangular.
* IsUnitTriangular
* - True, if the matrix has a unit diagonal.
*
* Output parameters:
* A - inverse matrix (if the problem is not degenerate).
*
* Result:
* True, if the matrix is not singular.
* False, if the matrix is singular.
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* February 29, 1992
*************************************************************************/
public static bool cmatrixtrinverse(ref AP.Complex[,] a,
int n,
bool isupper,
bool isunittriangular)
{
bool result = new bool();
bool nounit = new bool();
int i = 0;
int j = 0;
AP.Complex v = 0;
AP.Complex ajj = 0;
AP.Complex[] t = new AP.Complex[0];
int i_ = 0;
result = true;
t = new AP.Complex[n - 1 + 1];
//
// Test the input parameters.
//
nounit = !isunittriangular;
if (isupper)
{
//
// Compute inverse of upper triangular matrix.
//
for (j = 0; j <= n - 1; j++)
{
if (nounit)
{
if (a[j, j] == 0)
{
result = false;
return(result);
}
a[j, j] = 1 / a[j, j];
ajj = -a[j, j];
}
else
{
ajj = -1;
}
//
// Compute elements 1:j-1 of j-th column.
//
if (j > 0)
{
for (i_ = 0; i_ <= j - 1; i_++)
{
t[i_] = a[i_, j];
}
for (i = 0; i <= j - 1; i++)
{
if (i + 1 < j)
{
v = 0.0;
for (i_ = i + 1; i_ <= j - 1; i_++)
{
v += a[i, i_] * t[i_];
}
}
else
{
v = 0;
}
if (nounit)
{
a[i, j] = v + a[i, i] * t[i];
}
else
{
a[i, j] = v + t[i];
}
}
for (i_ = 0; i_ <= j - 1; i_++)
{
a[i_, j] = ajj * a[i_, j];
}
}
}
}
else
{
//
// Compute inverse of lower triangular matrix.
//
for (j = n - 1; j >= 0; j--)
{
if (nounit)
{
if (a[j, j] == 0)
{
result = false;
return(result);
}
a[j, j] = 1 / a[j, j];
ajj = -a[j, j];
}
else
{
ajj = -1;
}
if (j + 1 < n)
{
//
// Compute elements j+1:n of j-th column.
//
for (i_ = j + 1; i_ <= n - 1; i_++)
{
t[i_] = a[i_, j];
}
for (i = j + 1; i <= n - 1; i++)
{
if (i > j + 1)
{
v = 0.0;
for (i_ = j + 1; i_ <= i - 1; i_++)
{
v += a[i, i_] * t[i_];
}
}
else
{
v = 0;
}
if (nounit)
{
a[i, j] = v + a[i, i] * t[i];
}
else
{
a[i, j] = v + t[i];
}
}
for (i_ = j + 1; i_ <= n - 1; i_++)
{
a[i_, j] = ajj * a[i_, j];
}
}
}
}
return(result);
}
/*************************************************************************
* Obsolete 1-based subroutine
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* October 31, 1992
*************************************************************************/
public static void hermitiantotridiagonal(ref AP.Complex[,] a,
int n,
bool isupper,
ref AP.Complex[] tau,
ref double[] d,
ref double[] e)
{
int i = 0;
AP.Complex alpha = 0;
AP.Complex taui = 0;
AP.Complex v = 0;
AP.Complex[] t = new AP.Complex[0];
AP.Complex[] t2 = new AP.Complex[0];
AP.Complex[] t3 = new AP.Complex[0];
int i_ = 0;
int i1_ = 0;
if (n <= 0)
{
return;
}
for (i = 1; i <= n; i++)
{
System.Diagnostics.Debug.Assert(a[i, i].y == 0);
}
tau = new AP.Complex[Math.Max(1, n - 1) + 1];
d = new double[n + 1];
e = new double[Math.Max(1, n - 1) + 1];
t = new AP.Complex[n + 1];
t2 = new AP.Complex[n + 1];
t3 = new AP.Complex[n + 1];
if (isupper)
{
//
// Reduce the upper triangle of A
//
a[n, n] = a[n, n].x;
for (i = n - 1; i >= 1; i--)
{
//
// Generate elementary reflector H(i) = I - tau * v * v'
// to annihilate A(1:i-1,i+1)
//
alpha = a[i, i + 1];
t[1] = alpha;
if (i >= 2)
{
i1_ = (1) - (2);
for (i_ = 2; i_ <= i; i_++)
{
t[i_] = a[i_ + i1_, i + 1];
}
}
creflections.complexgeneratereflection(ref t, i, ref taui);
if (i >= 2)
{
i1_ = (2) - (1);
for (i_ = 1; i_ <= i - 1; i_++)
{
a[i_, i + 1] = t[i_ + i1_];
}
}
alpha = t[1];
e[i] = alpha.x;
if (taui != 0)
{
//
// Apply H(i) from both sides to A(1:i,1:i)
//
a[i, i + 1] = 1;
//
// Compute x := tau * A * v storing x in TAU(1:i)
//
for (i_ = 1; i_ <= i; i_++)
{
t[i_] = a[i_, i + 1];
}
hblas.hermitianmatrixvectormultiply(ref a, isupper, 1, i, ref t, taui, ref tau);
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
v = 0.0;
for (i_ = 1; i_ <= i; i_++)
{
v += AP.Math.Conj(tau[i_]) * a[i_, i + 1];
}
alpha = -(0.5 * taui * v);
for (i_ = 1; i_ <= i; i_++)
{
tau[i_] = tau[i_] + alpha * a[i_, i + 1];
}
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
for (i_ = 1; i_ <= i; i_++)
{
t[i_] = a[i_, i + 1];
}
hblas.hermitianrank2update(ref a, isupper, 1, i, ref t, ref tau, ref t2, -1);
}
else
{
a[i, i] = a[i, i].x;
}
a[i, i + 1] = e[i];
d[i + 1] = a[i + 1, i + 1].x;
tau[i] = taui;
}
d[1] = a[1, 1].x;
}
else
{
//
// Reduce the lower triangle of A
//
a[1, 1] = a[1, 1].x;
for (i = 1; i <= n - 1; i++)
{
//
// Generate elementary reflector H(i) = I - tau * v * v'
// to annihilate A(i+2:n,i)
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i; i_++)
{
t[i_] = a[i_ + i1_, i];
}
creflections.complexgeneratereflection(ref t, n - i, ref taui);
i1_ = (1) - (i + 1);
for (i_ = i + 1; i_ <= n; i_++)
{
a[i_, i] = t[i_ + i1_];
}
e[i] = a[i + 1, i].x;
if (taui != 0)
{
//
// Apply H(i) from both sides to A(i+1:n,i+1:n)
//
a[i + 1, i] = 1;
//
// Compute x := tau * A * v storing y in TAU(i:n-1)
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i; i_++)
{
t[i_] = a[i_ + i1_, i];
}
hblas.hermitianmatrixvectormultiply(ref a, isupper, i + 1, n, ref t, taui, ref t2);
i1_ = (1) - (i);
for (i_ = i; i_ <= n - 1; i_++)
{
tau[i_] = t2[i_ + i1_];
}
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
i1_ = (i + 1) - (i);
v = 0.0;
for (i_ = i; i_ <= n - 1; i_++)
{
v += AP.Math.Conj(tau[i_]) * a[i_ + i1_, i];
}
alpha = -(0.5 * taui * v);
i1_ = (i + 1) - (i);
for (i_ = i; i_ <= n - 1; i_++)
{
tau[i_] = tau[i_] + alpha * a[i_ + i1_, i];
}
//
// Apply the transformation as a rank-2 update:
// A := A - v * w' - w * v'
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i; i_++)
{
t[i_] = a[i_ + i1_, i];
}
i1_ = (i) - (1);
for (i_ = 1; i_ <= n - i; i_++)
{
t2[i_] = tau[i_ + i1_];
}
hblas.hermitianrank2update(ref a, isupper, i + 1, n, ref t, ref t2, ref t3, -1);
}
else
{
a[i + 1, i + 1] = a[i + 1, i + 1].x;
}
a[i + 1, i] = e[i];
d[i] = a[i, i].x;
tau[i] = taui;
}
d[n] = a[n, n].x;
}
}
/*************************************************************************
* LU decomposition of a complex general matrix of size MxN
*
* The subroutine calculates the LU decomposition of a rectangular general
* matrix with partial pivoting (with row permutations).
*
* Input parameters:
* A - matrix A whose indexes range within [0..M-1, 0..N-1].
* M - number of rows in matrix A.
* N - number of columns in matrix A.
*
* Output parameters:
* A - matrices L and U in compact form (see below).
* Array whose indexes range within [0..M-1, 0..N-1].
* Pivots - permutation matrix in compact form (see below).
* Array whose index ranges within [0..Min(M-1,N-1)].
*
* Matrix A is represented as A = P * L * U, where P is a permutation matrix,
* matrix L - lower triangular (or lower trapezoid, if M>N) matrix,
* U - upper triangular (or upper trapezoid, if M<N) matrix.
*
* Let M be equal to 4 and N be equal to 3:
*
* ( 1 ) ( U11 U12 U13 )
* A = P1 * P2 * P3 * ( L21 1 ) * ( U22 U23 )
* ( L31 L32 1 ) ( U33 )
* ( L41 L42 L43 )
*
* Matrix L has size MxMin(M,N), matrix U has size Min(M,N)xN, matrix P(i) is
* a permutation of the identity matrix of size MxM with numbers I and Pivots[I].
*
* The algorithm returns array Pivots and the following matrix which replaces
* matrix A and contains matrices L and U in compact form (the example applies
* to M=4, N=3).
*
* ( U11 U12 U13 )
* ( L21 U22 U23 )
* ( L31 L32 U33 )
* ( L41 L42 L43 )
*
* As we can see, the unit diagonal isn't stored.
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1992
*************************************************************************/
public static void cmatrixlu(ref AP.Complex[,] a,
int m,
int n,
ref int[] pivots)
{
int i = 0;
int j = 0;
int jp = 0;
AP.Complex[] t1 = new AP.Complex[0];
AP.Complex s = 0;
int i_ = 0;
pivots = new int[Math.Min(m - 1, n - 1) + 1];
t1 = new AP.Complex[Math.Max(m - 1, n - 1) + 1];
System.Diagnostics.Debug.Assert(m >= 0 & n >= 0, "Error in LUDecomposition: incorrect function arguments");
//
// Quick return if possible
//
if (m == 0 | n == 0)
{
return;
}
for (j = 0; j <= Math.Min(m - 1, n - 1); j++)
{
//
// Find pivot and test for singularity.
//
jp = j;
for (i = j + 1; i <= m - 1; i++)
{
if (AP.Math.AbsComplex(a[i, j]) > AP.Math.AbsComplex(a[jp, j]))
{
jp = i;
}
}
pivots[j] = jp;
if (a[jp, j] != 0)
{
//
//Apply the interchange to rows
//
if (jp != j)
{
for (i_ = 0; i_ <= n - 1; i_++)
{
t1[i_] = a[j, i_];
}
for (i_ = 0; i_ <= n - 1; i_++)
{
a[j, i_] = a[jp, i_];
}
for (i_ = 0; i_ <= n - 1; i_++)
{
a[jp, i_] = t1[i_];
}
}
//
//Compute elements J+1:M of J-th column.
//
if (j < m)
{
jp = j + 1;
s = 1 / a[j, j];
for (i_ = jp; i_ <= m - 1; i_++)
{
a[i_, j] = s * a[i_, j];
}
}
}
if (j < Math.Min(m, n) - 1)
{
//
//Update trailing submatrix.
//
jp = j + 1;
for (i = j + 1; i <= m - 1; i++)
{
s = a[i, j];
for (i_ = jp; i_ <= n - 1; i_++)
{
a[i, i_] = a[i, i_] - s * a[j, i_];
}
}
}
}
}
/*************************************************************************
* Obsolete 1-based subroutine
*************************************************************************/
public static bool hermitianeigenvaluesandvectorsbyindexes(AP.Complex[,] a,
int n,
int zneeded,
bool isupper,
int i1,
int i2,
ref double[] w,
ref AP.Complex[,] z)
{
bool result = new bool();
AP.Complex[,] q = new AP.Complex[0, 0];
double[,] t = new double[0, 0];
AP.Complex[] tau = new AP.Complex[0];
double[] e = new double[0];
double[] work = new double[0];
int i = 0;
int k = 0;
double v = 0;
int m = 0;
int i_ = 0;
a = (AP.Complex[, ])a.Clone();
System.Diagnostics.Debug.Assert(zneeded == 0 | zneeded == 1, "HermitianEigenValuesAndVectorsByIndexes: incorrect ZNeeded");
//
// Reduce to tridiagonal form
//
htridiagonal.hermitiantotridiagonal(ref a, n, isupper, ref tau, ref w, ref e);
if (zneeded == 1)
{
htridiagonal.unpackqfromhermitiantridiagonal(ref a, n, isupper, ref tau, ref q);
zneeded = 2;
}
//
// Bisection and inverse iteration
//
result = tdbisinv.tridiagonaleigenvaluesandvectorsbyindexes(ref w, ref e, n, zneeded, i1, i2, ref t);
//
// Eigenvectors are needed
// Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
//
m = i2 - i1 + 1;
if (result & zneeded != 0)
{
work = new double[m + 1];
z = new AP.Complex[n + 1, m + 1];
for (i = 1; i <= n; i++)
{
//
// Calculate real part
//
for (k = 1; k <= m; k++)
{
work[k] = 0;
}
for (k = 1; k <= n; k++)
{
v = q[i, k].x;
for (i_ = 1; i_ <= m; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 1; k <= m; k++)
{
z[i, k].x = work[k];
}
//
// Calculate imaginary part
//
for (k = 1; k <= m; k++)
{
work[k] = 0;
}
for (k = 1; k <= n; k++)
{
v = q[i, k].y;
for (i_ = 1; i_ <= m; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 1; k <= m; k++)
{
z[i, k].y = work[k];
}
}
}
return(result);
}
public static void hermitianmatrixvectormultiply(ref AP.Complex[,] a,
bool isupper,
int i1,
int i2,
ref AP.Complex[] x,
AP.Complex alpha,
ref AP.Complex[] y)
{
int i = 0;
int ba1 = 0;
int ba2 = 0;
int by1 = 0;
int by2 = 0;
int bx1 = 0;
int bx2 = 0;
int n = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
n = i2 - i1 + 1;
if (n <= 0)
{
return;
}
//
// Let A = L + D + U, where
// L is strictly lower triangular (main diagonal is zero)
// D is diagonal
// U is strictly upper triangular (main diagonal is zero)
//
// A*x = L*x + D*x + U*x
//
// Calculate D*x first
//
for (i = i1; i <= i2; i++)
{
y[i - i1 + 1] = a[i, i] * x[i - i1 + 1];
}
//
// Add L*x + U*x
//
if (isupper)
{
for (i = i1; i <= i2 - 1; i++)
{
//
// Add L*x to the result
//
v = x[i - i1 + 1];
by1 = i - i1 + 2;
by2 = n;
ba1 = i + 1;
ba2 = i2;
i1_ = (ba1) - (by1);
for (i_ = by1; i_ <= by2; i_++)
{
y[i_] = y[i_] + v * AP.Math.Conj(a[i, i_ + i1_]);
}
//
// Add U*x to the result
//
bx1 = i - i1 + 2;
bx2 = n;
ba1 = i + 1;
ba2 = i2;
i1_ = (ba1) - (bx1);
v = 0.0;
for (i_ = bx1; i_ <= bx2; i_++)
{
v += x[i_] * a[i, i_ + i1_];
}
y[i - i1 + 1] = y[i - i1 + 1] + v;
}
}
else
{
for (i = i1 + 1; i <= i2; i++)
{
//
// Add L*x to the result
//
bx1 = 1;
bx2 = i - i1;
ba1 = i1;
ba2 = i - 1;
i1_ = (ba1) - (bx1);
v = 0.0;
for (i_ = bx1; i_ <= bx2; i_++)
{
v += x[i_] * a[i, i_ + i1_];
}
y[i - i1 + 1] = y[i - i1 + 1] + v;
//
// Add U*x to the result
//
v = x[i - i1 + 1];
by1 = 1;
by2 = i - i1;
ba1 = i1;
ba2 = i - 1;
i1_ = (ba1) - (by1);
for (i_ = by1; i_ <= by2; i_++)
{
y[i_] = y[i_] + v * AP.Math.Conj(a[i, i_ + i1_]);
}
}
}
for (i_ = 1; i_ <= n; i_++)
{
y[i_] = alpha * y[i_];
}
}
/*************************************************************************
* Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal
* form.
*
* Input parameters:
* A - the result of a HMatrixTD subroutine
* N - size of matrix A.
* IsUpper - storage format (a parameter of HMatrixTD subroutine)
* Tau - the result of a HMatrixTD subroutine
*
* Output parameters:
* Q - transformation matrix.
* array with elements [0..N-1, 0..N-1].
*
* -- ALGLIB --
* Copyright 2005, 2007, 2008 by Bochkanov Sergey
*************************************************************************/
public static void hmatrixtdunpackq(ref AP.Complex[,] a,
int n,
bool isupper,
ref AP.Complex[] tau,
ref AP.Complex[,] q)
{
int i = 0;
int j = 0;
AP.Complex[] v = new AP.Complex[0];
AP.Complex[] work = new AP.Complex[0];
int i_ = 0;
int i1_ = 0;
if (n == 0)
{
return;
}
//
// init
//
q = new AP.Complex[n - 1 + 1, n - 1 + 1];
v = new AP.Complex[n + 1];
work = new AP.Complex[n - 1 + 1];
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= n - 1; j++)
{
if (i == j)
{
q[i, j] = 1;
}
else
{
q[i, j] = 0;
}
}
}
//
// unpack Q
//
if (isupper)
{
for (i = 0; i <= n - 2; i++)
{
//
// Apply H(i)
//
i1_ = (0) - (1);
for (i_ = 1; i_ <= i + 1; i_++)
{
v[i_] = a[i_ + i1_, i + 1];
}
v[i + 1] = 1;
creflections.complexapplyreflectionfromtheleft(ref q, tau[i], ref v, 0, i, 0, n - 1, ref work);
}
}
else
{
for (i = n - 2; i >= 0; i--)
{
//
// Apply H(i)
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i - 1; i_++)
{
v[i_] = a[i_ + i1_, i];
}
v[1] = 1;
creflections.complexapplyreflectionfromtheleft(ref q, tau[i], ref v, i + 1, n - 1, 0, n - 1, ref work);
}
}
}
/*************************************************************************
* Cholesky decomposition
*
* The algorithm computes Cholesky decomposition of a Hermitian positive-
* definite matrix.
*
* The result of an algorithm is a representation of matrix A as A = U'*U or
* A = L*L' (here X' detones conj(X^T)).
*
* Input parameters:
* A - upper or lower triangle of a factorized matrix.
* array with elements [0..N-1, 0..N-1].
* N - size of matrix A.
* IsUpper - if IsUpper=True, then A contains an upper triangle of
* a symmetric matrix, otherwise A contains a lower one.
*
* Output parameters:
* A - the result of factorization. If IsUpper=True, then
* the upper triangle contains matrix U, so that A = U'*U,
* and the elements below the main diagonal are not modified.
* Similarly, if IsUpper = False.
*
* Result:
* If the matrix is positive-definite, the function returns True.
* Otherwise, the function returns False. This means that the
* factorization could not be carried out.
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* February 29, 1992
*************************************************************************/
public static bool hmatrixcholesky(ref AP.Complex[,] a,
int n,
bool isupper)
{
bool result = new bool();
int j = 0;
double ajj = 0;
AP.Complex v = 0;
double r = 0;
AP.Complex[] t = new AP.Complex[0];
AP.Complex[] t2 = new AP.Complex[0];
AP.Complex[] t3 = new AP.Complex[0];
int i = 0;
AP.Complex[,] a1 = new AP.Complex[0, 0];
int i_ = 0;
if (!isupper)
{
a1 = new AP.Complex[n + 1, n + 1];
for (i = 1; i <= n; i++)
{
for (j = 1; j <= n; j++)
{
a1[i, j] = a[i - 1, j - 1];
}
}
result = hermitiancholeskydecomposition(ref a1, n, isupper);
for (i = 1; i <= n; i++)
{
for (j = 1; j <= n; j++)
{
a[i - 1, j - 1] = a1[i, j];
}
}
return(result);
}
t = new AP.Complex[n - 1 + 1];
t2 = new AP.Complex[n - 1 + 1];
t3 = new AP.Complex[n - 1 + 1];
result = true;
if (n < 0)
{
result = false;
return(result);
}
if (n == 0)
{
return(result);
}
if (isupper)
{
for (j = 0; j <= n - 1; j++)
{
v = 0.0;
for (i_ = 0; i_ <= j - 1; i_++)
{
v += AP.Math.Conj(a[i_, j]) * a[i_, j];
}
ajj = (a[j, j] - v).x;
if (ajj <= 0)
{
a[j, j] = ajj;
result = false;
return(result);
}
ajj = Math.Sqrt(ajj);
a[j, j] = ajj;
if (j < n - 1)
{
for (i_ = 0; i_ <= j - 1; i_++)
{
t2[i_] = AP.Math.Conj(a[i_, j]);
}
for (i_ = j + 1; i_ <= n - 1; i_++)
{
t3[i_] = a[j, i_];
}
cblas.complexmatrixvectormultiply(ref a, 0, j - 1, j + 1, n - 1, true, false, ref t2, 0, j - 1, -1.0, ref t3, j + 1, n - 1, 1.0, ref t);
for (i_ = j + 1; i_ <= n - 1; i_++)
{
a[j, i_] = t3[i_];
}
r = 1 / ajj;
for (i_ = j + 1; i_ <= n - 1; i_++)
{
a[j, i_] = r * a[j, i_];
}
}
}
}
else
{
for (j = 0; j <= n - 1; j++)
{
v = 0.0;
for (i_ = 0; i_ <= j - 1; i_++)
{
v += AP.Math.Conj(a[j, i_]) * a[j, i_];
}
ajj = (a[j, j] - v).x;
if (ajj <= 0)
{
a[j, j] = ajj;
result = false;
return(result);
}
ajj = Math.Sqrt(ajj);
a[j, j] = ajj;
if (j < n - 1)
{
for (i_ = 0; i_ <= j - 1; i_++)
{
t2[i_] = AP.Math.Conj(a[j, i_]);
}
for (i_ = j + 1; i_ <= n - 1; i_++)
{
t3[i_] = a[i_, j];
}
cblas.complexmatrixvectormultiply(ref a, j + 1, n - 1, 0, j - 1, false, false, ref t2, 0, j - 1, -1.0, ref t3, j + 1, n - 1, 1.0, ref t);
for (i_ = j + 1; i_ <= n - 1; i_++)
{
a[i_, j] = t3[i_];
}
r = 1 / ajj;
for (i_ = j + 1; i_ <= n - 1; i_++)
{
a[i_, j] = r * a[i_, j];
}
}
}
}
return(result);
}
/*************************************************************************
* Obsolete 1-based subroutine
*
* -- ALGLIB --
* Copyright 2005, 2007 by Bochkanov Sergey
*************************************************************************/
public static void unpackqfromhermitiantridiagonal(ref AP.Complex[,] a,
int n,
bool isupper,
ref AP.Complex[] tau,
ref AP.Complex[,] q)
{
int i = 0;
int j = 0;
AP.Complex[] v = new AP.Complex[0];
AP.Complex[] work = new AP.Complex[0];
int i_ = 0;
int i1_ = 0;
if (n == 0)
{
return;
}
//
// init
//
q = new AP.Complex[n + 1, n + 1];
v = new AP.Complex[n + 1];
work = new AP.Complex[n + 1];
for (i = 1; i <= n; i++)
{
for (j = 1; j <= n; j++)
{
if (i == j)
{
q[i, j] = 1;
}
else
{
q[i, j] = 0;
}
}
}
//
// unpack Q
//
if (isupper)
{
for (i = 1; i <= n - 1; i++)
{
//
// Apply H(i)
//
for (i_ = 1; i_ <= i; i_++)
{
v[i_] = a[i_, i + 1];
}
v[i] = 1;
creflections.complexapplyreflectionfromtheleft(ref q, tau[i], ref v, 1, i, 1, n, ref work);
}
}
else
{
for (i = n - 1; i >= 1; i--)
{
//
// Apply H(i)
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i; i_++)
{
v[i_] = a[i_ + i1_, i];
}
v[1] = 1;
creflections.complexapplyreflectionfromtheleft(ref q, tau[i], ref v, i + 1, n, 1, n, ref work);
}
}
}
public static void internalestimatecomplexrcondlu(ref AP.Complex[,] lu,
int n,
bool onenorm,
bool isanormprovided,
double anorm,
ref double rcond)
{
AP.Complex[] cwork1 = new AP.Complex[0];
AP.Complex[] cwork2 = new AP.Complex[0];
AP.Complex[] cwork3 = new AP.Complex[0];
AP.Complex[] cwork4 = new AP.Complex[0];
int[] isave = new int[0];
double[] rsave = new double[0];
int kase = 0;
int kase1 = 0;
double ainvnm = 0;
//double smlnum = 0;
bool cw = new bool();
AP.Complex v = 0;
int i = 0;
int i_ = 0;
if (n <= 0)
{
return;
}
cwork1 = new AP.Complex[n + 1];
cwork2 = new AP.Complex[n + 1];
cwork3 = new AP.Complex[n + 1];
cwork4 = new AP.Complex[n + 1];
isave = new int[4 + 1];
rsave = new double[3 + 1];
rcond = 0;
if (n == 0)
{
rcond = 1;
return;
}
//smlnum = AP.Math.MinRealNumber;
//
// Estimate the norm of inv(A).
//
if (!isanormprovided)
{
anorm = 0;
if (onenorm)
{
kase1 = 1;
}
else
{
kase1 = 2;
}
kase = 0;
do
{
internalcomplexrcondestimatenorm(n, ref cwork4, ref cwork1, ref anorm, ref kase, ref isave, ref rsave);
if (kase != 0)
{
if (kase == kase1)
{
//
// Multiply by U
//
for (i = 1; i <= n; i++)
{
v = 0.0;
for (i_ = i; i_ <= n; i_++)
{
v += lu[i, i_] * cwork1[i_];
}
cwork1[i] = v;
}
//
// Multiply by L
//
for (i = n; i >= 1; i--)
{
v = 0;
if (i > 1)
{
v = 0.0;
for (i_ = 1; i_ <= i - 1; i_++)
{
v += lu[i, i_] * cwork1[i_];
}
}
cwork1[i] = v + cwork1[i];
}
}
else
{
//
// Multiply by L'
//
for (i = 1; i <= n; i++)
{
cwork2[i] = 0;
}
for (i = 1; i <= n; i++)
{
v = cwork1[i];
if (i > 1)
{
for (i_ = 1; i_ <= i - 1; i_++)
{
cwork2[i_] = cwork2[i_] + v * AP.Math.Conj(lu[i, i_]);
}
}
cwork2[i] = cwork2[i] + v;
}
//
// Multiply by U'
//
for (i = 1; i <= n; i++)
{
cwork1[i] = 0;
}
for (i = 1; i <= n; i++)
{
v = cwork2[i];
for (i_ = i; i_ <= n; i_++)
{
cwork1[i_] = cwork1[i_] + v * AP.Math.Conj(lu[i, i_]);
}
}
}
}
}while(kase != 0);
}
//
// Quick return if possible
//
if (anorm == 0)
{
return;
}
//
// Estimate the norm of inv(A).
//
ainvnm = 0;
if (onenorm)
{
kase1 = 1;
}
else
{
kase1 = 2;
}
kase = 0;
do
{
internalcomplexrcondestimatenorm(n, ref cwork4, ref cwork1, ref ainvnm, ref kase, ref isave, ref rsave);
if (kase != 0)
{
if (kase == kase1)
{
//
// Multiply by inv(L).
//
cw = ctrlinsolve.complexsafesolvetriangular(ref lu, n, ref cwork1, false, 0, true, ref cwork2, ref cwork3);
if (!cw)
{
rcond = 0;
return;
}
//
// Multiply by inv(U).
//
cw = ctrlinsolve.complexsafesolvetriangular(ref lu, n, ref cwork1, true, 0, false, ref cwork2, ref cwork3);
if (!cw)
{
rcond = 0;
return;
}
}
else
{
//
// Multiply by inv(U').
//
cw = ctrlinsolve.complexsafesolvetriangular(ref lu, n, ref cwork1, true, 2, false, ref cwork2, ref cwork3);
if (!cw)
{
rcond = 0;
return;
}
//
// Multiply by inv(L').
//
cw = ctrlinsolve.complexsafesolvetriangular(ref lu, n, ref cwork1, false, 2, true, ref cwork2, ref cwork3);
if (!cw)
{
rcond = 0;
return;
}
}
}
}while(kase != 0);
//
// Compute the estimate of the reciprocal condition number.
//
if (ainvnm != 0)
{
rcond = 1 / ainvnm;
rcond = rcond / anorm;
}
}
/*************************************************************************
* Inversion of a complex matrix given by its LU decomposition.
*
* Input parameters:
* A - LU decomposition of the matrix (output of CMatrixLU subroutine).
* Pivots - table of permutations which were made during the LU decomposition
* (the output of CMatrixLU subroutine).
* N - size of matrix A.
*
* Output parameters:
* A - inverse of matrix A.
* Array whose indexes range within [0..N-1, 0..N-1].
*
* Result:
* True, if the matrix is not singular.
* False, if the matrix is singular.
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* February 29, 1992
*************************************************************************/
public static bool cmatrixluinverse(ref AP.Complex[,] a,
ref int[] pivots,
int n)
{
bool result = new bool();
AP.Complex[] work = new AP.Complex[0];
int i = 0;
//int iws = 0;
int j = 0;
//int jb = 0;
//int jj = 0;
int jp = 0;
AP.Complex v = 0;
int i_ = 0;
result = true;
//
// Quick return if possible
//
if (n == 0)
{
return(result);
}
work = new AP.Complex[n - 1 + 1];
//
// Form inv(U)
//
if (!ctrinverse.cmatrixtrinverse(ref a, n, true, false))
{
result = false;
return(result);
}
//
// Solve the equation inv(A)*L = inv(U) for inv(A).
//
for (j = n - 1; j >= 0; j--)
{
//
// Copy current column of L to WORK and replace with zeros.
//
for (i = j + 1; i <= n - 1; i++)
{
work[i] = a[i, j];
a[i, j] = 0;
}
//
// Compute current column of inv(A).
//
if (j < n - 1)
{
for (i = 0; i <= n - 1; i++)
{
v = 0.0;
for (i_ = j + 1; i_ <= n - 1; i_++)
{
v += a[i, i_] * work[i_];
}
a[i, j] = a[i, j] - v;
}
}
}
//
// Apply column interchanges.
//
for (j = n - 2; j >= 0; j--)
{
jp = pivots[j];
if (jp != j)
{
for (i_ = 0; i_ <= n - 1; i_++)
{
work[i_] = a[i_, j];
}
for (i_ = 0; i_ <= n - 1; i_++)
{
a[i_, j] = a[i_, jp];
}
for (i_ = 0; i_ <= n - 1; i_++)
{
a[i_, jp] = work[i_];
}
}
}
return(result);
}
/*************************************************************************
* Obsolete 1-based subroutine
*************************************************************************/
public static bool complexsolvesystemlu(ref AP.Complex[,] a,
ref int[] pivots,
AP.Complex[] b,
int n,
ref AP.Complex[] x)
{
bool result = new bool();
AP.Complex[] y = new AP.Complex[0];
int i = 0;
AP.Complex v = 0;
int ip1 = 0;
int im1 = 0;
int i_ = 0;
b = (AP.Complex[])b.Clone();
y = new AP.Complex[n + 1];
x = new AP.Complex[n + 1];
result = true;
for (i = 1; i <= n; i++)
{
if (a[i, i] == 0)
{
result = false;
return(result);
}
}
//
// pivots
//
for (i = 1; i <= n; i++)
{
if (pivots[i] != i)
{
v = b[i];
b[i] = b[pivots[i]];
b[pivots[i]] = v;
}
}
//
// Ly = b
//
y[1] = b[1];
for (i = 2; i <= n; i++)
{
im1 = i - 1;
v = 0.0;
for (i_ = 1; i_ <= im1; i_++)
{
v += a[i, i_] * y[i_];
}
y[i] = b[i] - v;
}
//
// Ux = y
//
x[n] = y[n] / a[n, n];
for (i = n - 1; i >= 1; i--)
{
ip1 = i + 1;
v = 0.0;
for (i_ = ip1; i_ <= n; i_++)
{
v += a[i, i_] * x[i_];
}
x[i] = (y[i] - v) / a[i, i];
}
return(result);
}
