/*************************************************************************
Inversion of a 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:
Info - return code, same as in RMatrixLUInverse
Rep - solver report, same as in RMatrixLUInverse
A - inverse of matrix A, same as in RMatrixLUInverse
-- ALGLIB routine --
05.02.2010
Bochkanov Sergey
*************************************************************************/
public static void cmatrixluinverse(ref AP.Complex[,] a,
ref int[] pivots,
int n,
ref int info,
ref matinvreport rep)
{
AP.Complex[] work = new AP.Complex[0];
int i = 0;
int j = 0;
int k = 0;
AP.Complex v = 0;
info = 1;
//
// Quick return if possible
//
if (n == 0)
{
info = -1;
return;
}
for (i = 0; i <= n - 1; i++)
{
if (pivots[i] > n - 1 | pivots[i] < i)
{
info = -1;
return;
}
}
//
// calculate condition numbers
//
rep.r1 = rcond.cmatrixlurcond1(ref a, n);
rep.rinf = rcond.cmatrixlurcondinf(ref a, n);
if ((double)(rep.r1) < (double)(rcond.rcondthreshold()) | (double)(rep.rinf) < (double)(rcond.rcondthreshold()))
{
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= n - 1; j++)
{
a[i, j] = 0;
}
}
rep.r1 = 0;
rep.rinf = 0;
info = -3;
return;
}
//
// Call cache-oblivious code
//
work = new AP.Complex[n];
cmatrixluinverserec(ref a, 0, n, ref work, ref info, ref rep);
//
// apply permutations
//
for (i = 0; i <= n - 1; i++)
{
for (j = n - 2; j >= 0; j--)
{
k = pivots[j];
v = a[i, j];
a[i, j] = a[i, k];
a[i, k] = v;
}
}
}
private static void cmatrixestimatenorm(int n,
ref AP.Complex[] v,
ref AP.Complex[] x,
ref double est,
ref int kase,
ref int[] isave,
ref double[] rsave)
{
int itmax = 0;
int i = 0;
int iter = 0;
int j = 0;
int jlast = 0;
int jump = 0;
double absxi = 0;
double altsgn = 0;
double estold = 0;
double safmin = 0;
double temp = 0;
int i_ = 0;
//
//Executable Statements ..
//
itmax = 5;
safmin = AP.Math.MinRealNumber;
if (kase == 0)
{
v = new AP.Complex[n + 1];
x = new AP.Complex[n + 1];
isave = new int[5];
rsave = new double[4];
for (i = 1; i <= n; i++)
{
x[i] = (double)(1) / (double)(n);
}
kase = 1;
jump = 1;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
internalcomplexrcondloadall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
//
// ENTRY (JUMP = 1)
// FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
//
if (jump == 1)
{
if (n == 1)
{
v[1] = x[1];
est = AP.Math.AbsComplex(v[1]);
kase = 0;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
est = internalcomplexrcondscsum1(ref x, n);
for (i = 1; i <= n; i++)
{
absxi = AP.Math.AbsComplex(x[i]);
if ((double)(absxi) > (double)(safmin))
{
x[i] = x[i] / absxi;
}
else
{
x[i] = 1;
}
}
kase = 2;
jump = 2;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
//
// ENTRY (JUMP = 2)
// FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
//
if (jump == 2)
{
j = internalcomplexrcondicmax1(ref x, n);
iter = 2;
//
// MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
//
for (i = 1; i <= n; i++)
{
x[i] = 0;
}
x[j] = 1;
kase = 1;
jump = 3;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
//
// ENTRY (JUMP = 3)
// X HAS BEEN OVERWRITTEN BY A*X.
//
if (jump == 3)
{
for (i_ = 1; i_ <= n; i_++)
{
v[i_] = x[i_];
}
estold = est;
est = internalcomplexrcondscsum1(ref v, n);
//
// TEST FOR CYCLING.
//
if ((double)(est) <= (double)(estold))
{
//
// ITERATION COMPLETE. FINAL STAGE.
//
altsgn = 1;
for (i = 1; i <= n; i++)
{
x[i] = altsgn * (1 + ((double)(i - 1)) / ((double)(n - 1)));
altsgn = -altsgn;
}
kase = 1;
jump = 5;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
for (i = 1; i <= n; i++)
{
absxi = AP.Math.AbsComplex(x[i]);
if ((double)(absxi) > (double)(safmin))
{
x[i] = x[i] / absxi;
}
else
{
x[i] = 1;
}
}
kase = 2;
jump = 4;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
//
// ENTRY (JUMP = 4)
// X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
//
if (jump == 4)
{
jlast = j;
j = internalcomplexrcondicmax1(ref x, n);
if ((double)(AP.Math.AbsComplex(x[jlast])) != (double)(AP.Math.AbsComplex(x[j])) & iter < itmax)
{
iter = iter + 1;
//
// MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
//
for (i = 1; i <= n; i++)
{
x[i] = 0;
}
x[j] = 1;
kase = 1;
jump = 3;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
//
// ITERATION COMPLETE. FINAL STAGE.
//
altsgn = 1;
for (i = 1; i <= n; i++)
{
x[i] = altsgn * (1 + ((double)(i - 1)) / ((double)(n - 1)));
altsgn = -altsgn;
}
kase = 1;
jump = 5;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
//
// ENTRY (JUMP = 5)
// X HAS BEEN OVERWRITTEN BY A*X.
//
if (jump == 5)
{
temp = 2 * (internalcomplexrcondscsum1(ref x, n) / (3 * n));
if ((double)(temp) > (double)(est))
{
for (i_ = 1; i_ <= n; i_++)
{
v[i_] = x[i_];
}
est = temp;
}
kase = 0;
internalcomplexrcondsaveall(ref isave, ref rsave, ref i, ref iter, ref j, ref jlast, ref jump, ref absxi, ref altsgn, ref estold, ref temp);
return;
}
}
/*************************************************************************
Finding the eigenvalues and eigenvectors of a Hermitian matrix
The algorithm finds eigen pairs of a Hermitian matrix by reducing it to
real tridiagonal form and using the QL/QR algorithm.
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.
IsUpper - storage format.
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.
Output parameters:
D - eigenvalues in ascending order.
Array whose index ranges within [0..N-1].
Z - if ZNeeded is equal to:
* 0, Z hasn�t changed;
* 1, Z contains the eigenvectors.
Array whose indexes range within [0..N-1, 0..N-1].
The eigenvectors are stored in the matrix columns.
Result:
True, if the algorithm has converged.
False, if the algorithm hasn't converged (rare case).
Note:
eigenvectors of Hermitian matrix are defined up to multiplication by
a complex number L, such that |L|=1.
-- ALGLIB --
Copyright 2005, 23 March 2007 by Bochkanov Sergey
*************************************************************************/
public static bool hmatrixevd(AP.Complex[,] a,
int n,
int zneeded,
bool isupper,
ref double[] d,
ref AP.Complex[,] z)
{
bool result = new bool();
AP.Complex[] tau = new AP.Complex[0];
double[] e = new double[0];
double[] work = new double[0];
double[,] t = new double[0, 0];
AP.Complex[,] q = new AP.Complex[0, 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, "HermitianEVD: incorrect ZNeeded");
//
// Reduce to tridiagonal form
//
ortfac.hmatrixtd(ref a, n, isupper, ref tau, ref d, ref e);
if (zneeded == 1)
{
ortfac.hmatrixtdunpackq(ref a, n, isupper, ref tau, ref q);
zneeded = 2;
}
//
// TDEVD
//
result = smatrixtdevd(ref d, e, n, zneeded, ref t);
//
// Eigenvectors are needed
// Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
//
if (result & zneeded != 0)
{
work = new double[n - 1 + 1];
z = new AP.Complex[n - 1 + 1, n - 1 + 1];
for (i = 0; i <= n - 1; i++)
{
//
// Calculate real part
//
for (k = 0; k <= n - 1; k++)
{
work[k] = 0;
}
for (k = 0; k <= n - 1; k++)
{
v = q[i, k].x;
for (i_ = 0; i_ <= n - 1; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 0; k <= n - 1; k++)
{
z[i, k].x = work[k];
}
//
// Calculate imaginary part
//
for (k = 0; k <= n - 1; k++)
{
work[k] = 0;
}
for (k = 0; k <= n - 1; k++)
{
v = q[i, k].y;
for (i_ = 0; i_ <= n - 1; i_++)
{
work[i_] = work[i_] + v * t[k, i_];
}
}
for (k = 0; k <= n - 1; k++)
{
z[i, k].y = work[k];
}
}
}
return result;
}
/*************************************************************************
Internal subroutine for condition number estimation
-- 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
*************************************************************************/
private static void hpdmatrixrcondcholeskyinternal(ref AP.Complex[,] cha,
int n,
bool isupper,
bool isnormprovided,
double anorm,
ref double rc)
{
int[] isave = new int[0];
double[] rsave = new double[0];
AP.Complex[] ex = new AP.Complex[0];
AP.Complex[] ev = new AP.Complex[0];
AP.Complex[] tmp = new AP.Complex[0];
int kase = 0;
double ainvnm = 0;
AP.Complex v = 0;
int i = 0;
int j = 0;
double sa = 0;
double maxgrowth = 0;
int i_ = 0;
int i1_ = 0;
System.Diagnostics.Debug.Assert(n >= 1);
tmp = new AP.Complex[n];
//
// RC=0 if something happens
//
rc = 0;
//
// prepare parameters for triangular solver
//
maxgrowth = 1 / rcondthreshold();
sa = 0;
if (isupper)
{
for (i = 0; i <= n - 1; i++)
{
for (j = i; j <= n - 1; j++)
{
sa = Math.Max(sa, AP.Math.AbsComplex(cha[i, j]));
}
}
}
else
{
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= i; j++)
{
sa = Math.Max(sa, AP.Math.AbsComplex(cha[i, j]));
}
}
}
if ((double)(sa) == (double)(0))
{
sa = 1;
}
sa = 1 / sa;
//
// Estimate the norm of A
//
if (!isnormprovided)
{
anorm = 0;
kase = 0;
while (true)
{
cmatrixestimatenorm(n, ref ev, ref ex, ref anorm, ref kase, ref isave, ref rsave);
if (kase == 0)
{
break;
}
if (isupper)
{
//
// Multiply by U
//
for (i = 1; i <= n; i++)
{
i1_ = (i) - (i - 1);
v = 0.0;
for (i_ = i - 1; i_ <= n - 1; i_++)
{
v += cha[i - 1, i_] * ex[i_ + i1_];
}
ex[i] = v;
}
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = sa * ex[i_];
}
//
// Multiply by U'
//
for (i = 0; i <= n - 1; i++)
{
tmp[i] = 0;
}
for (i = 0; i <= n - 1; i++)
{
v = ex[i + 1];
for (i_ = i; i_ <= n - 1; i_++)
{
tmp[i_] = tmp[i_] + v * AP.Math.Conj(cha[i, i_]);
}
}
i1_ = (0) - (1);
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = tmp[i_ + i1_];
}
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = sa * ex[i_];
}
}
else
{
//
// Multiply by L'
//
for (i = 0; i <= n - 1; i++)
{
tmp[i] = 0;
}
for (i = 0; i <= n - 1; i++)
{
v = ex[i + 1];
for (i_ = 0; i_ <= i; i_++)
{
tmp[i_] = tmp[i_] + v * AP.Math.Conj(cha[i, i_]);
}
}
i1_ = (0) - (1);
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = tmp[i_ + i1_];
}
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = sa * ex[i_];
}
//
// Multiply by L
//
for (i = n; i >= 1; i--)
{
i1_ = (1) - (0);
v = 0.0;
for (i_ = 0; i_ <= i - 1; i_++)
{
v += cha[i - 1, i_] * ex[i_ + i1_];
}
ex[i] = v;
}
for (i_ = 1; i_ <= n; i_++)
{
ex[i_] = sa * ex[i_];
}
}
}
}
//
// Quick return if possible
// After this block we assume that ANORM<>0
//
if ((double)(anorm) == (double)(0))
{
return;
}
if (n == 1)
{
rc = 1;
return;
}
//
// Estimate the norm of inv(A).
//
ainvnm = 0;
kase = 0;
while (true)
{
cmatrixestimatenorm(n, ref ev, ref ex, ref ainvnm, ref kase, ref isave, ref rsave);
if (kase == 0)
{
break;
}
for (i = 0; i <= n - 1; i++)
{
ex[i] = ex[i + 1];
}
if (isupper)
{
//
// Multiply by inv(U').
//
if (!safesolve.cmatrixscaledtrsafesolve(ref cha, sa, n, ref ex, isupper, 2, false, maxgrowth))
{
return;
}
//
// Multiply by inv(U).
//
if (!safesolve.cmatrixscaledtrsafesolve(ref cha, sa, n, ref ex, isupper, 0, false, maxgrowth))
{
return;
}
}
else
{
//
// Multiply by inv(L).
//
if (!safesolve.cmatrixscaledtrsafesolve(ref cha, sa, n, ref ex, isupper, 0, false, maxgrowth))
{
return;
}
//
// Multiply by inv(L').
//
if (!safesolve.cmatrixscaledtrsafesolve(ref cha, sa, n, ref ex, isupper, 2, false, maxgrowth))
{
return;
}
}
for (i = n - 1; i >= 0; i--)
{
ex[i + 1] = ex[i];
}
}
//
// Compute the estimate of the reciprocal condition number.
//
if ((double)(ainvnm) != (double)(0))
{
rc = 1 / ainvnm;
rc = rc / anorm;
if ((double)(rc) < (double)(rcondthreshold()))
{
rc = 0;
}
}
}
/*************************************************************************
Condition number estimation
-- LAPACK routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
*************************************************************************/
private static void cmatrixrcondluinternal(ref AP.Complex[,] lua,
int n,
bool onenorm,
bool isanormprovided,
double anorm,
ref double rc)
{
AP.Complex[] ex = 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;
AP.Complex v = 0;
int i = 0;
int j = 0;
double su = 0;
double sl = 0;
double maxgrowth = 0;
int i_ = 0;
int i1_ = 0;
if (n <= 0)
{
return;
}
cwork2 = new AP.Complex[n + 1];
rc = 0;
if (n == 0)
{
rc = 1;
return;
}
//
// prepare parameters for triangular solver
//
maxgrowth = 1 / rcondthreshold();
su = 0;
sl = 1;
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= i - 1; j++)
{
sl = Math.Max(sl, AP.Math.AbsComplex(lua[i, j]));
}
for (j = i; j <= n - 1; j++)
{
su = Math.Max(su, AP.Math.AbsComplex(lua[i, j]));
}
}
if ((double)(su) == (double)(0))
{
su = 1;
}
su = 1 / su;
sl = 1 / sl;
//
// Estimate the norm of SU*SL*A.
//
if (!isanormprovided)
{
anorm = 0;
if (onenorm)
{
kase1 = 1;
}
else
{
kase1 = 2;
}
kase = 0;
do
{
cmatrixestimatenorm(n, ref cwork4, ref ex, ref anorm, ref kase, ref isave, ref rsave);
if (kase != 0)
{
if (kase == kase1)
{
//
// Multiply by U
//
for (i = 1; i <= n; i++)
{
i1_ = (i) - (i - 1);
v = 0.0;
for (i_ = i - 1; i_ <= n - 1; i_++)
{
v += lua[i - 1, i_] * ex[i_ + i1_];
}
ex[i] = v;
}
//
// Multiply by L
//
for (i = n; i >= 1; i--)
{
v = 0;
if (i > 1)
{
i1_ = (1) - (0);
v = 0.0;
for (i_ = 0; i_ <= i - 2; i_++)
{
v += lua[i - 1, i_] * ex[i_ + i1_];
}
}
ex[i] = v + ex[i];
}
}
else
{
//
// Multiply by L'
//
for (i = 1; i <= n; i++)
{
cwork2[i] = 0;
}
for (i = 1; i <= n; i++)
{
v = ex[i];
if (i > 1)
{
i1_ = (0) - (1);
for (i_ = 1; i_ <= i - 1; i_++)
{
cwork2[i_] = cwork2[i_] + v * AP.Math.Conj(lua[i - 1, i_ + i1_]);
}
}
cwork2[i] = cwork2[i] + v;
}
//
// Multiply by U'
//
for (i = 1; i <= n; i++)
{
ex[i] = 0;
}
for (i = 1; i <= n; i++)
{
v = cwork2[i];
i1_ = (i - 1) - (i);
for (i_ = i; i_ <= n; i_++)
{
ex[i_] = ex[i_] + v * AP.Math.Conj(lua[i - 1, i_ + i1_]);
}
}
}
}
}
while (kase != 0);
}
//
// Scale according to SU/SL
//
anorm = anorm * su * sl;
//
// Quick return if possible
//
if ((double)(anorm) == (double)(0))
{
return;
}
//
// Estimate the norm of inv(A).
//
ainvnm = 0;
if (onenorm)
{
kase1 = 1;
}
else
{
kase1 = 2;
}
kase = 0;
while (true)
{
cmatrixestimatenorm(n, ref cwork4, ref ex, ref ainvnm, ref kase, ref isave, ref rsave);
if (kase == 0)
{
break;
}
//
// From 1-based to 0-based
//
for (i = 0; i <= n - 1; i++)
{
ex[i] = ex[i + 1];
}
//
// multiply by inv(A) or inv(A')
//
if (kase == kase1)
{
//
// Multiply by inv(L).
//
if (!safesolve.cmatrixscaledtrsafesolve(ref lua, sl, n, ref ex, false, 0, true, maxgrowth))
{
rc = 0;
return;
}
//
// Multiply by inv(U).
//
if (!safesolve.cmatrixscaledtrsafesolve(ref lua, su, n, ref ex, true, 0, false, maxgrowth))
{
rc = 0;
return;
}
}
else
{
//
// Multiply by inv(U').
//
if (!safesolve.cmatrixscaledtrsafesolve(ref lua, su, n, ref ex, true, 2, false, maxgrowth))
{
rc = 0;
return;
}
//
// Multiply by inv(L').
//
if (!safesolve.cmatrixscaledtrsafesolve(ref lua, sl, n, ref ex, false, 2, true, maxgrowth))
{
rc = 0;
return;
}
}
//
// from 0-based to 1-based
//
for (i = n - 1; i >= 0; i--)
{
ex[i + 1] = ex[i];
}
}
//
// Compute the estimate of the reciprocal condition number.
//
if ((double)(ainvnm) != (double)(0))
{
rc = 1 / ainvnm;
rc = rc / anorm;
if ((double)(rc) < (double)(rcondthreshold()))
{
rc = 0;
}
}
}
/*************************************************************************
Cache-oblivious Cholesky decomposition
The algorithm computes Cholesky decomposition of a Hermitian positive-
definite matrix. The result of an algorithm is a representation of 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. Contents of A is not determined
in such case.
-- ALGLIB routine --
15.12.2009
Bochkanov Sergey
*************************************************************************/
public static bool hpdmatrixcholesky(ref AP.Complex[,] a,
int n,
bool isupper)
{
bool result = new bool();
AP.Complex[] tmp = new AP.Complex[0];
if (n < 1)
{
result = false;
return result;
}
tmp = new AP.Complex[2 * n];
result = hpdmatrixcholeskyrec(ref a, 0, n, isupper, ref tmp);
return result;
}
/*************************************************************************
Condition number estimation
-- LAPACK routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
March 31, 1993
*************************************************************************/
private static void cmatrixrcondtrinternal(ref AP.Complex[,] a,
int n,
bool isupper,
bool isunit,
bool onenorm,
double anorm,
ref double rc)
{
AP.Complex[] ex = 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;
AP.Complex v = 0;
int i = 0;
int j = 0;
int j1 = 0;
int j2 = 0;
double s = 0;
double maxgrowth = 0;
//
// RC=0 if something happens
//
rc = 0;
//
// init
//
if (n <= 0)
{
return;
}
if (n == 0)
{
rc = 1;
return;
}
cwork2 = new AP.Complex[n + 1];
//
// prepare parameters for triangular solver
//
maxgrowth = 1 / rcondthreshold();
s = 0;
for (i = 0; i <= n - 1; i++)
{
if (isupper)
{
j1 = i + 1;
j2 = n - 1;
}
else
{
j1 = 0;
j2 = i - 1;
}
for (j = j1; j <= j2; j++)
{
s = Math.Max(s, AP.Math.AbsComplex(a[i, j]));
}
if (isunit)
{
s = Math.Max(s, 1);
}
else
{
s = Math.Max(s, AP.Math.AbsComplex(a[i, i]));
}
}
if ((double)(s) == (double)(0))
{
s = 1;
}
s = 1 / s;
//
// Scale according to S
//
anorm = anorm * s;
//
// Quick return if possible
//
if ((double)(anorm) == (double)(0))
{
return;
}
//
// Estimate the norm of inv(A).
//
ainvnm = 0;
if (onenorm)
{
kase1 = 1;
}
else
{
kase1 = 2;
}
kase = 0;
while (true)
{
cmatrixestimatenorm(n, ref cwork4, ref ex, ref ainvnm, ref kase, ref isave, ref rsave);
if (kase == 0)
{
break;
}
//
// From 1-based to 0-based
//
for (i = 0; i <= n - 1; i++)
{
ex[i] = ex[i + 1];
}
//
// multiply by inv(A) or inv(A')
//
if (kase == kase1)
{
//
// multiply by inv(A)
//
if (!safesolve.cmatrixscaledtrsafesolve(ref a, s, n, ref ex, isupper, 0, isunit, maxgrowth))
{
return;
}
}
else
{
//
// multiply by inv(A')
//
if (!safesolve.cmatrixscaledtrsafesolve(ref a, s, n, ref ex, isupper, 2, isunit, maxgrowth))
{
return;
}
}
//
// from 0-based to 1-based
//
for (i = n - 1; i >= 0; i--)
{
ex[i + 1] = ex[i];
}
}
//
// Compute the estimate of the reciprocal condition number.
//
if ((double)(ainvnm) != (double)(0))
{
rc = 1 / ainvnm;
rc = rc / anorm;
if ((double)(rc) < (double)(rcondthreshold()))
{
rc = 0;
}
}
}
/*************************************************************************
Reduction of a Hermitian matrix which is given by its higher or lower
triangular part to a real tridiagonal matrix using unitary similarity
transformation: Q'*A*Q = T.
Input parameters:
A - matrix to be transformed
array with elements [0..N-1, 0..N-1].
N - size of matrix A.
IsUpper - storage format. If IsUpper = True, then matrix A is given
by its upper triangle, and the lower triangle is not used
and not modified by the algorithm, and vice versa
if IsUpper = False.
Output parameters:
A - matrices T and Q in compact form (see lower)
Tau - array of factors which are forming matrices H(i)
array with elements [0..N-2].
D - main diagonal of real symmetric matrix T.
array with elements [0..N-1].
E - secondary diagonal of real symmetric matrix T.
array with elements [0..N-2].
If IsUpper=True, the matrix Q is represented as a product of elementary
reflectors
Q = H(n-2) . . . H(2) H(0).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
A(0:i-1,i+1), and tau in TAU(i).
If IsUpper=False, the matrix Q is represented as a product of elementary
reflectors
Q = H(0) H(2) . . . H(n-2).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
and tau in TAU(i).
The contents of A on exit are illustrated by the following examples
with n = 5:
if UPLO = 'U': if UPLO = 'L':
( d e v1 v2 v3 ) ( d )
( d e v2 v3 ) ( e d )
( d e v3 ) ( v0 e d )
( d e ) ( v0 v1 e d )
( d ) ( v0 v1 v2 e d )
where d and e denote diagonal and off-diagonal elements of T, and vi
denotes an element of the vector defining H(i).
-- 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 hmatrixtd(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 = 0; i <= n - 1; i++)
{
System.Diagnostics.Debug.Assert((double)(a[i, i].y) == (double)(0));
}
if (n > 1)
{
tau = new AP.Complex[n - 2 + 1];
e = new double[n - 2 + 1];
}
d = new double[n - 1 + 1];
t = new AP.Complex[n - 1 + 1];
t2 = new AP.Complex[n - 1 + 1];
t3 = new AP.Complex[n - 1 + 1];
if (isupper)
{
//
// Reduce the upper triangle of A
//
a[n - 1, n - 1] = a[n - 1, n - 1].x;
for (i = n - 2; i >= 0; i--)
{
//
// Generate elementary reflector H = I+1 - tau * v * v'
//
alpha = a[i, i + 1];
t[1] = alpha;
if (i >= 1)
{
i1_ = (0) - (2);
for (i_ = 2; i_ <= i + 1; i_++)
{
t[i_] = a[i_ + i1_, i + 1];
}
}
creflections.complexgeneratereflection(ref t, i + 1, ref taui);
if (i >= 1)
{
i1_ = (2) - (0);
for (i_ = 0; i_ <= i - 1; i_++)
{
a[i_, i + 1] = t[i_ + i1_];
}
}
alpha = t[1];
e[i] = alpha.x;
if (taui != 0)
{
//
// Apply H(I+1) from both sides to A
//
a[i, i + 1] = 1;
//
// Compute x := tau * A * v storing x in TAU
//
i1_ = (0) - (1);
for (i_ = 1; i_ <= i + 1; i_++)
{
t[i_] = a[i_ + i1_, i + 1];
}
hblas.hermitianmatrixvectormultiply(ref a, isupper, 0, i, ref t, taui, ref t2);
i1_ = (1) - (0);
for (i_ = 0; i_ <= i; i_++)
{
tau[i_] = t2[i_ + i1_];
}
//
// Compute w := x - 1/2 * tau * (x'*v) * v
//
v = 0.0;
for (i_ = 0; i_ <= i; i_++)
{
v += AP.Math.Conj(tau[i_]) * a[i_, i + 1];
}
alpha = -(0.5 * taui * v);
for (i_ = 0; 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'
//
i1_ = (0) - (1);
for (i_ = 1; i_ <= i + 1; i_++)
{
t[i_] = a[i_ + i1_, i + 1];
}
i1_ = (0) - (1);
for (i_ = 1; i_ <= i + 1; i_++)
{
t3[i_] = tau[i_ + i1_];
}
hblas.hermitianrank2update(ref a, isupper, 0, i, ref t, ref t3, 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[0] = a[0, 0].x;
}
else
{
//
// Reduce the lower triangle of A
//
a[0, 0] = a[0, 0].x;
for (i = 0; i <= n - 2; i++)
{
//
// Generate elementary reflector H = I - tau * v * v'
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i - 1; i_++)
{
t[i_] = a[i_ + i1_, i];
}
creflections.complexgeneratereflection(ref t, n - i - 1, ref taui);
i1_ = (1) - (i + 1);
for (i_ = i + 1; i_ <= n - 1; 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
//
i1_ = (i + 1) - (1);
for (i_ = 1; i_ <= n - i - 1; i_++)
{
t[i_] = a[i_ + i1_, i];
}
hblas.hermitianmatrixvectormultiply(ref a, isupper, i + 1, n - 1, ref t, taui, ref t2);
i1_ = (1) - (i);
for (i_ = i; i_ <= n - 2; 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 - 2; 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 - 2; 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 - 1; i_++)
{
t[i_] = a[i_ + i1_, i];
}
i1_ = (i) - (1);
for (i_ = 1; i_ <= n - i - 1; i_++)
{
t2[i_] = tau[i_ + i1_];
}
hblas.hermitianrank2update(ref a, isupper, i + 1, n - 1, 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 - 1] = a[n - 1, n - 1].x;
}
}
/*************************************************************************
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-2010 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);
}
}
}
/*************************************************************************
Partial unpacking of matrix Q from LQ decomposition of a complex matrix A.
Input parameters:
A - matrices Q and R in compact form.
Output of CMatrixLQ subroutine .
M - number of rows in matrix A. M>=0.
N - number of columns in matrix A. N>=0.
Tau - scalar factors which are used to form Q.
Output of CMatrixLQ subroutine .
QRows - required number of rows in matrix Q. N>=QColumns>=0.
Output parameters:
Q - first QRows rows of matrix Q.
Array whose index ranges within [0..QRows-1, 0..N-1].
If QRows=0, array isn't changed.
-- ALGLIB routine --
17.02.2010
Bochkanov Sergey
*************************************************************************/
public static void cmatrixlqunpackq(ref AP.Complex[,] a,
int m,
int n,
ref AP.Complex[] tau,
int qrows,
ref AP.Complex[,] q)
{
AP.Complex[] work = new AP.Complex[0];
AP.Complex[] t = new AP.Complex[0];
AP.Complex[] taubuf = new AP.Complex[0];
int minmn = 0;
int refcnt = 0;
AP.Complex[,] tmpa = new AP.Complex[0, 0];
AP.Complex[,] tmpt = new AP.Complex[0, 0];
AP.Complex[,] tmpr = new AP.Complex[0, 0];
int blockstart = 0;
int blocksize = 0;
int columnscount = 0;
int i = 0;
int j = 0;
int k = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
if (m <= 0 | n <= 0)
{
return;
}
//
// Init
//
minmn = Math.Min(m, n);
refcnt = Math.Min(minmn, qrows);
work = new AP.Complex[Math.Max(m, n) + 1];
t = new AP.Complex[Math.Max(m, n) + 1];
taubuf = new AP.Complex[minmn];
tmpa = new AP.Complex[ablas.ablascomplexblocksize(ref a), n];
tmpt = new AP.Complex[ablas.ablascomplexblocksize(ref a), ablas.ablascomplexblocksize(ref a)];
tmpr = new AP.Complex[qrows, 2 * ablas.ablascomplexblocksize(ref a)];
q = new AP.Complex[qrows, n];
for (i = 0; i <= qrows - 1; i++)
{
for (j = 0; j <= n - 1; j++)
{
if (i == j)
{
q[i, j] = 1;
}
else
{
q[i, j] = 0;
}
}
}
//
// Blocked code
//
blockstart = ablas.ablascomplexblocksize(ref a) * (refcnt / ablas.ablascomplexblocksize(ref a));
blocksize = refcnt - blockstart;
while (blockstart >= 0)
{
columnscount = n - blockstart;
//
// LQ decomposition of submatrix.
// Matrix is copied to temporary storage to solve
// some TLB issues arising from non-contiguous memory
// access pattern.
//
ablas.cmatrixcopy(blocksize, columnscount, ref a, blockstart, blockstart, ref tmpa, 0, 0);
i1_ = (blockstart) - (0);
for (i_ = 0; i_ <= blocksize - 1; i_++)
{
taubuf[i_] = tau[i_ + i1_];
}
//
// Update matrix, choose between:
// a) Level 2 algorithm (when the rest of the matrix is small enough)
// b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
// representation for products of Householder transformations',
// by R. Schreiber and C. Van Loan.
//
if (qrows >= 2 * ablas.ablascomplexblocksize(ref a))
{
//
// Prepare block reflector
//
cmatrixblockreflector(ref tmpa, ref taubuf, false, columnscount, blocksize, ref tmpt, ref work);
//
// Multiply the rest of A by Q'.
//
// Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA
//
ablas.cmatrixgemm(qrows, blocksize, columnscount, 1.0, ref q, 0, blockstart, 0, ref tmpa, 0, 0, 2, 0.0, ref tmpr, 0, 0);
ablas.cmatrixgemm(qrows, blocksize, blocksize, 1.0, ref tmpr, 0, 0, 0, ref tmpt, 0, 0, 2, 0.0, ref tmpr, 0, blocksize);
ablas.cmatrixgemm(qrows, columnscount, blocksize, 1.0, ref tmpr, 0, blocksize, 0, ref tmpa, 0, 0, 0, 1.0, ref q, 0, blockstart);
}
else
{
//
// Level 2 algorithm
//
for (i = blocksize - 1; i >= 0; i--)
{
i1_ = (i) - (1);
for (i_ = 1; i_ <= columnscount - i; i_++)
{
t[i_] = AP.Math.Conj(tmpa[i, i_ + i1_]);
}
t[1] = 1;
creflections.complexapplyreflectionfromtheright(ref q, AP.Math.Conj(taubuf[i]), ref t, 0, qrows - 1, blockstart + i, n - 1, ref work);
}
}
//
// Advance
//
blockstart = blockstart - ablas.ablascomplexblocksize(ref a);
blocksize = ablas.ablascomplexblocksize(ref a);
}
}
/*************************************************************************
Unpacking of matrix L from the LQ decomposition of a matrix A
Input parameters:
A - matrices Q and L in compact form.
Output of CMatrixLQ subroutine.
M - number of rows in given matrix A. M>=0.
N - number of columns in given matrix A. N>=0.
Output parameters:
L - matrix L, array[0..M-1, 0..N-1].
-- ALGLIB routine --
17.02.2010
Bochkanov Sergey
*************************************************************************/
public static void cmatrixlqunpackl(ref AP.Complex[,] a,
int m,
int n,
ref AP.Complex[,] l)
{
int i = 0;
int k = 0;
int i_ = 0;
if (m <= 0 | n <= 0)
{
return;
}
l = new AP.Complex[m, n];
for (i = 0; i <= n - 1; i++)
{
l[0, i] = 0;
}
for (i = 1; i <= m - 1; i++)
{
for (i_ = 0; i_ <= n - 1; i_++)
{
l[i, i_] = l[0, i_];
}
}
for (i = 0; i <= m - 1; i++)
{
k = Math.Min(i, n - 1);
for (i_ = 0; i_ <= k; i_++)
{
l[i, i_] = a[i, i_];
}
}
}
/*************************************************************************
Unpacking of matrix R from the QR decomposition of a matrix A
Input parameters:
A - matrices Q and R in compact form.
Output of CMatrixQR subroutine.
M - number of rows in given matrix A. M>=0.
N - number of columns in given matrix A. N>=0.
Output parameters:
R - matrix R, array[0..M-1, 0..N-1].
-- ALGLIB routine --
17.02.2010
Bochkanov Sergey
*************************************************************************/
public static void cmatrixqrunpackr(ref AP.Complex[,] a,
int m,
int n,
ref AP.Complex[,] r)
{
int i = 0;
int k = 0;
int i_ = 0;
if (m <= 0 | n <= 0)
{
return;
}
k = Math.Min(m, n);
r = new AP.Complex[m, n];
for (i = 0; i <= n - 1; i++)
{
r[0, i] = 0;
}
for (i = 1; i <= m - 1; i++)
{
for (i_ = 0; i_ <= n - 1; i_++)
{
r[i, i_] = r[0, i_];
}
}
for (i = 0; i <= k - 1; i++)
{
for (i_ = i; i_ <= n - 1; i_++)
{
r[i, i_] = a[i, i_];
}
}
}
/*************************************************************************
Partial unpacking of matrix Q from QR decomposition of a complex matrix A.
Input parameters:
A - matrices Q and R in compact form.
Output of CMatrixQR subroutine .
M - number of rows in matrix A. M>=0.
N - number of columns in matrix A. N>=0.
Tau - scalar factors which are used to form Q.
Output of CMatrixQR subroutine .
QColumns - required number of columns in matrix Q. M>=QColumns>=0.
Output parameters:
Q - first QColumns columns of matrix Q.
Array whose index ranges within [0..M-1, 0..QColumns-1].
If QColumns=0, array isn't changed.
-- ALGLIB routine --
17.02.2010
Bochkanov Sergey
*************************************************************************/
public static void cmatrixqrunpackq(ref AP.Complex[,] a,
int m,
int n,
ref AP.Complex[] tau,
int qcolumns,
ref AP.Complex[,] q)
{
AP.Complex[] work = new AP.Complex[0];
AP.Complex[] t = new AP.Complex[0];
AP.Complex[] taubuf = new AP.Complex[0];
int minmn = 0;
int refcnt = 0;
AP.Complex[,] tmpa = new AP.Complex[0, 0];
AP.Complex[,] tmpt = new AP.Complex[0, 0];
AP.Complex[,] tmpr = new AP.Complex[0, 0];
int blockstart = 0;
int blocksize = 0;
int rowscount = 0;
int i = 0;
int j = 0;
int k = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
System.Diagnostics.Debug.Assert(qcolumns <= m, "UnpackQFromQR: QColumns>M!");
if (m <= 0 | n <= 0)
{
return;
}
//
// init
//
minmn = Math.Min(m, n);
refcnt = Math.Min(minmn, qcolumns);
work = new AP.Complex[Math.Max(m, n) + 1];
t = new AP.Complex[Math.Max(m, n) + 1];
taubuf = new AP.Complex[minmn];
tmpa = new AP.Complex[m, ablas.ablascomplexblocksize(ref a)];
tmpt = new AP.Complex[ablas.ablascomplexblocksize(ref a), ablas.ablascomplexblocksize(ref a)];
tmpr = new AP.Complex[2 * ablas.ablascomplexblocksize(ref a), qcolumns];
q = new AP.Complex[m, qcolumns];
for (i = 0; i <= m - 1; i++)
{
for (j = 0; j <= qcolumns - 1; j++)
{
if (i == j)
{
q[i, j] = 1;
}
else
{
q[i, j] = 0;
}
}
}
//
// Blocked code
//
blockstart = ablas.ablascomplexblocksize(ref a) * (refcnt / ablas.ablascomplexblocksize(ref a));
blocksize = refcnt - blockstart;
while (blockstart >= 0)
{
rowscount = m - blockstart;
//
// QR decomposition of submatrix.
// Matrix is copied to temporary storage to solve
// some TLB issues arising from non-contiguous memory
// access pattern.
//
ablas.cmatrixcopy(rowscount, blocksize, ref a, blockstart, blockstart, ref tmpa, 0, 0);
i1_ = (blockstart) - (0);
for (i_ = 0; i_ <= blocksize - 1; i_++)
{
taubuf[i_] = tau[i_ + i1_];
}
//
// Update matrix, choose between:
// a) Level 2 algorithm (when the rest of the matrix is small enough)
// b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
// representation for products of Householder transformations',
// by R. Schreiber and C. Van Loan.
//
if (qcolumns >= 2 * ablas.ablascomplexblocksize(ref a))
{
//
// Prepare block reflector
//
cmatrixblockreflector(ref tmpa, ref taubuf, true, rowscount, blocksize, ref tmpt, ref work);
//
// Multiply the rest of A by Q.
//
// Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
//
ablas.cmatrixgemm(blocksize, qcolumns, rowscount, 1.0, ref tmpa, 0, 0, 2, ref q, blockstart, 0, 0, 0.0, ref tmpr, 0, 0);
ablas.cmatrixgemm(blocksize, qcolumns, blocksize, 1.0, ref tmpt, 0, 0, 0, ref tmpr, 0, 0, 0, 0.0, ref tmpr, blocksize, 0);
ablas.cmatrixgemm(rowscount, qcolumns, blocksize, 1.0, ref tmpa, 0, 0, 0, ref tmpr, blocksize, 0, 0, 1.0, ref q, blockstart, 0);
}
else
{
//
// Level 2 algorithm
//
for (i = blocksize - 1; i >= 0; i--)
{
i1_ = (i) - (1);
for (i_ = 1; i_ <= rowscount - i; i_++)
{
t[i_] = tmpa[i_ + i1_, i];
}
t[1] = 1;
creflections.complexapplyreflectionfromtheleft(ref q, taubuf[i], ref t, blockstart + i, m - 1, 0, qcolumns - 1, ref work);
}
}
//
// Advance
//
blockstart = blockstart - ablas.ablascomplexblocksize(ref a);
blocksize = ablas.ablascomplexblocksize(ref a);
}
}
public static void cmatrixplu(ref AP.Complex[,] a,
int m,
int n,
ref int[] pivots)
{
AP.Complex[] tmp = new AP.Complex[0];
int i = 0;
int j = 0;
double mx = 0;
AP.Complex v = 0;
int i_ = 0;
//
// Internal LU decomposition subroutine.
// Never call it directly.
//
System.Diagnostics.Debug.Assert(m > 0, "CMatrixPLU: incorrect M!");
System.Diagnostics.Debug.Assert(n > 0, "CMatrixPLU: incorrect N!");
tmp = new AP.Complex[2 * Math.Max(m, n)];
pivots = new int[Math.Min(m, n)];
//
// Scale matrix to avoid overflows,
// decompose it, then scale back.
//
mx = 0;
for (i = 0; i <= m - 1; i++)
{
for (j = 0; j <= n - 1; j++)
{
mx = Math.Max(mx, AP.Math.AbsComplex(a[i, j]));
}
}
if ((double)(mx) != (double)(0))
{
v = 1 / mx;
for (i = 0; i <= m - 1; i++)
{
for (i_ = 0; i_ <= n - 1; i_++)
{
a[i, i_] = v * a[i, i_];
}
}
}
cmatrixplurec(ref a, 0, m, n, ref pivots, ref tmp);
if ((double)(mx) != (double)(0))
{
v = mx;
for (i = 0; i <= Math.Min(m, n) - 1; i++)
{
for (i_ = i; i_ <= n - 1; i_++)
{
a[i, i_] = v * a[i, i_];
}
}
}
}
/*************************************************************************
Inversion of a Hermitian positive definite matrix which is given
by Cholesky decomposition.
Input parameters:
A - Cholesky decomposition of the matrix to be inverted:
A=U�*U or A = L*L'.
Output of HPDMatrixCholesky subroutine.
N - size of matrix A.
IsUpper � storage format.
If IsUpper = True, then matrix A is given as A = U'*U
(matrix contains upper triangle).
Similarly, if IsUpper = False, then A = L*L'.
Output parameters:
Info - return code, same as in RMatrixLUInverse
Rep - solver report, same as in RMatrixLUInverse
A - inverse of matrix A, same as in RMatrixLUInverse
-- ALGLIB routine --
10.02.2010
Bochkanov Sergey
*************************************************************************/
public static void hpdmatrixcholeskyinverse(ref AP.Complex[,] a,
int n,
bool isupper,
ref int info,
ref matinvreport rep)
{
int i = 0;
int j = 0;
int info2 = 0;
matinvreport rep2 = new matinvreport();
AP.Complex[] tmp = new AP.Complex[0];
AP.Complex v = 0;
if (n < 1)
{
info = -1;
return;
}
info = 1;
//
// calculate condition numbers
//
rep.r1 = rcond.hpdmatrixcholeskyrcond(ref a, n, isupper);
rep.rinf = rep.r1;
if ((double)(rep.r1) < (double)(rcond.rcondthreshold()) | (double)(rep.rinf) < (double)(rcond.rcondthreshold()))
{
if (isupper)
{
for (i = 0; i <= n - 1; i++)
{
for (j = i; j <= n - 1; j++)
{
a[i, j] = 0;
}
}
}
else
{
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= i; j++)
{
a[i, j] = 0;
}
}
}
rep.r1 = 0;
rep.rinf = 0;
info = -3;
return;
}
//
// Inverse
//
tmp = new AP.Complex[n];
hpdmatrixcholeskyinverserec(ref a, 0, n, isupper, ref tmp);
}
/*************************************************************************
LQ decomposition of a rectangular complex matrix of size MxN
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 Q and L in compact form
Tau - array of scalar factors which are used to form matrix Q. Array
whose indexes range within [0.. Min(M,N)-1]
Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size
MxM, L - lower triangular (or lower trapezoid) matrix of size MxN.
-- LAPACK 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 cmatrixlq(ref AP.Complex[,] a,
int m,
int n,
ref AP.Complex[] tau)
{
AP.Complex[] work = new AP.Complex[0];
AP.Complex[] t = new AP.Complex[0];
AP.Complex[] taubuf = new AP.Complex[0];
int minmn = 0;
AP.Complex[,] tmpa = new AP.Complex[0, 0];
AP.Complex[,] tmpt = new AP.Complex[0, 0];
AP.Complex[,] tmpr = new AP.Complex[0, 0];
int blockstart = 0;
int blocksize = 0;
int columnscount = 0;
int i = 0;
int j = 0;
int k = 0;
AP.Complex v = 0;
int i_ = 0;
int i1_ = 0;
if (m <= 0 | n <= 0)
{
return;
}
minmn = Math.Min(m, n);
work = new AP.Complex[Math.Max(m, n) + 1];
t = new AP.Complex[Math.Max(m, n) + 1];
tau = new AP.Complex[minmn];
taubuf = new AP.Complex[minmn];
tmpa = new AP.Complex[ablas.ablascomplexblocksize(ref a), n];
tmpt = new AP.Complex[ablas.ablascomplexblocksize(ref a), ablas.ablascomplexblocksize(ref a)];
tmpr = new AP.Complex[m, 2 * ablas.ablascomplexblocksize(ref a)];
//
// Blocked code
//
blockstart = 0;
while (blockstart != minmn)
{
//
// Determine block size
//
blocksize = minmn - blockstart;
if (blocksize > ablas.ablascomplexblocksize(ref a))
{
blocksize = ablas.ablascomplexblocksize(ref a);
}
columnscount = n - blockstart;
//
// LQ decomposition of submatrix.
// Matrix is copied to temporary storage to solve
// some TLB issues arising from non-contiguous memory
// access pattern.
//
ablas.cmatrixcopy(blocksize, columnscount, ref a, blockstart, blockstart, ref tmpa, 0, 0);
cmatrixlqbasecase(ref tmpa, blocksize, columnscount, ref work, ref t, ref taubuf);
ablas.cmatrixcopy(blocksize, columnscount, ref tmpa, 0, 0, ref a, blockstart, blockstart);
i1_ = (0) - (blockstart);
for (i_ = blockstart; i_ <= blockstart + blocksize - 1; i_++)
{
tau[i_] = taubuf[i_ + i1_];
}
//
// Update the rest, choose between:
// a) Level 2 algorithm (when the rest of the matrix is small enough)
// b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
// representation for products of Householder transformations',
// by R. Schreiber and C. Van Loan.
//
if (blockstart + blocksize <= m - 1)
{
if (m - blockstart - blocksize >= 2 * ablas.ablascomplexblocksize(ref a))
{
//
// Prepare block reflector
//
cmatrixblockreflector(ref tmpa, ref taubuf, false, columnscount, blocksize, ref tmpt, ref work);
//
// Multiply the rest of A by Q.
//
// Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA
//
ablas.cmatrixgemm(m - blockstart - blocksize, blocksize, columnscount, 1.0, ref a, blockstart + blocksize, blockstart, 0, ref tmpa, 0, 0, 2, 0.0, ref tmpr, 0, 0);
ablas.cmatrixgemm(m - blockstart - blocksize, blocksize, blocksize, 1.0, ref tmpr, 0, 0, 0, ref tmpt, 0, 0, 0, 0.0, ref tmpr, 0, blocksize);
ablas.cmatrixgemm(m - blockstart - blocksize, columnscount, blocksize, 1.0, ref tmpr, 0, blocksize, 0, ref tmpa, 0, 0, 0, 1.0, ref a, blockstart + blocksize, blockstart);
}
else
{
//
// Level 2 algorithm
//
for (i = 0; i <= blocksize - 1; i++)
{
i1_ = (i) - (1);
for (i_ = 1; i_ <= columnscount - i; i_++)
{
t[i_] = AP.Math.Conj(tmpa[i, i_ + i1_]);
}
t[1] = 1;
creflections.complexapplyreflectionfromtheright(ref a, taubuf[i], ref t, blockstart + blocksize, m - 1, blockstart + i, n - 1, ref work);
}
}
}
//
// Advance
//
blockstart = blockstart + blocksize;
}
}
/*************************************************************************
Triangular matrix inverse (complex)
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, and the diagonal elements are not passed to the algorithm.
Input parameters:
A - matrix, array[0..N-1, 0..N-1].
N - size of A.
IsUpper - True, if the matrix is upper triangular.
IsUnit - True, if the matrix has a unit diagonal.
Output parameters:
Info - same as for RMatrixLUInverse
Rep - same as for RMatrixLUInverse
A - same as for RMatrixLUInverse.
-- ALGLIB --
Copyright 05.02.2010 by Bochkanov Sergey
*************************************************************************/
public static void cmatrixtrinverse(ref AP.Complex[,] a,
int n,
bool isupper,
bool isunit,
ref int info,
ref matinvreport rep)
{
int i = 0;
int j = 0;
AP.Complex[] tmp = new AP.Complex[0];
if (n < 1)
{
info = -1;
return;
}
info = 1;
//
// calculate condition numbers
//
rep.r1 = rcond.cmatrixtrrcond1(ref a, n, isupper, isunit);
rep.rinf = rcond.cmatrixtrrcondinf(ref a, n, isupper, isunit);
if ((double)(rep.r1) < (double)(rcond.rcondthreshold()) | (double)(rep.rinf) < (double)(rcond.rcondthreshold()))
{
for (i = 0; i <= n - 1; i++)
{
for (j = 0; j <= n - 1; j++)
{
a[i, j] = 0;
}
}
rep.r1 = 0;
rep.rinf = 0;
info = -3;
return;
}
//
// Invert
//
tmp = new AP.Complex[n];
cmatrixtrinverserec(ref a, 0, n, isupper, isunit, ref tmp, ref info, ref rep);
}
/*************************************************************************
Internal subroutine for safe solution of
SA*op(A)=b
where A is NxN upper/lower triangular/unitriangular matrix, op(A) is
either identity transform, transposition or Hermitian transposition, SA is
a scaling factor such that max(|SA*A[i,j]|) is close to 1.0 in magnutude.
This subroutine limits relative growth of solution (in inf-norm) by
MaxGrowth, returning False if growth exceeds MaxGrowth. Degenerate or
near-degenerate matrices are handled correctly (False is returned) as long
as MaxGrowth is significantly less than MaxRealNumber/norm(b).
-- ALGLIB routine --
21.01.2010
Bochkanov Sergey
*************************************************************************/
public static bool cmatrixscaledtrsafesolve(ref AP.Complex[,] a,
double sa,
int n,
ref AP.Complex[] x,
bool isupper,
int trans,
bool isunit,
double maxgrowth)
{
bool result = new bool();
double lnmax = 0;
double nrmb = 0;
double nrmx = 0;
int i = 0;
AP.Complex alpha = 0;
AP.Complex beta = 0;
AP.Complex vc = 0;
AP.Complex[] tmp = new AP.Complex[0];
int i_ = 0;
System.Diagnostics.Debug.Assert(n > 0, "CMatrixTRSafeSolve: incorrect N!");
System.Diagnostics.Debug.Assert(trans == 0 | trans == 1 | trans == 2, "CMatrixTRSafeSolve: incorrect Trans!");
result = true;
lnmax = Math.Log(AP.Math.MaxRealNumber);
//
// Quick return if possible
//
if (n <= 0)
{
return result;
}
//
// Load norms: right part and X
//
nrmb = 0;
for (i = 0; i <= n - 1; i++)
{
nrmb = Math.Max(nrmb, AP.Math.AbsComplex(x[i]));
}
nrmx = 0;
//
// Solve
//
tmp = new AP.Complex[n];
result = true;
if (isupper & trans == 0)
{
//
// U*x = b
//
for (i = n - 1; i >= 0; i--)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = a[i, i] * sa;
}
if (i < n - 1)
{
for (i_ = i + 1; i_ <= n - 1; i_++)
{
tmp[i_] = sa * a[i, i_];
}
vc = 0.0;
for (i_ = i + 1; i_ <= n - 1; i_++)
{
vc += tmp[i_] * x[i_];
}
beta = x[i] - vc;
}
else
{
beta = x[i];
}
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
}
return result;
}
if (!isupper & trans == 0)
{
//
// L*x = b
//
for (i = 0; i <= n - 1; i++)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = a[i, i] * sa;
}
if (i > 0)
{
for (i_ = 0; i_ <= i - 1; i_++)
{
tmp[i_] = sa * a[i, i_];
}
vc = 0.0;
for (i_ = 0; i_ <= i - 1; i_++)
{
vc += tmp[i_] * x[i_];
}
beta = x[i] - vc;
}
else
{
beta = x[i];
}
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
}
return result;
}
if (isupper & trans == 1)
{
//
// U^T*x = b
//
for (i = 0; i <= n - 1; i++)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = a[i, i] * sa;
}
beta = x[i];
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
//
// update the rest of right part
//
if (i < n - 1)
{
for (i_ = i + 1; i_ <= n - 1; i_++)
{
tmp[i_] = sa * a[i, i_];
}
for (i_ = i + 1; i_ <= n - 1; i_++)
{
x[i_] = x[i_] - vc * tmp[i_];
}
}
}
return result;
}
if (!isupper & trans == 1)
{
//
// L^T*x = b
//
for (i = n - 1; i >= 0; i--)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = a[i, i] * sa;
}
beta = x[i];
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
//
// update the rest of right part
//
if (i > 0)
{
for (i_ = 0; i_ <= i - 1; i_++)
{
tmp[i_] = sa * a[i, i_];
}
for (i_ = 0; i_ <= i - 1; i_++)
{
x[i_] = x[i_] - vc * tmp[i_];
}
}
}
return result;
}
if (isupper & trans == 2)
{
//
// U^H*x = b
//
for (i = 0; i <= n - 1; i++)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = AP.Math.Conj(a[i, i]) * sa;
}
beta = x[i];
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
//
// update the rest of right part
//
if (i < n - 1)
{
for (i_ = i + 1; i_ <= n - 1; i_++)
{
tmp[i_] = sa * AP.Math.Conj(a[i, i_]);
}
for (i_ = i + 1; i_ <= n - 1; i_++)
{
x[i_] = x[i_] - vc * tmp[i_];
}
}
}
return result;
}
if (!isupper & trans == 2)
{
//
// L^T*x = b
//
for (i = n - 1; i >= 0; i--)
{
//
// Task is reduced to alpha*x[i] = beta
//
if (isunit)
{
alpha = sa;
}
else
{
alpha = AP.Math.Conj(a[i, i]) * sa;
}
beta = x[i];
//
// solve alpha*x[i] = beta
//
result = cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, ref nrmx, ref vc);
if (!result)
{
return result;
}
x[i] = vc;
//
// update the rest of right part
//
if (i > 0)
{
for (i_ = 0; i_ <= i - 1; i_++)
{
tmp[i_] = sa * AP.Math.Conj(a[i, i_]);
}
for (i_ = 0; i_ <= i - 1; i_++)
{
x[i_] = x[i_] - vc * tmp[i_];
}
}
}
return result;
}
result = false;
return result;
}
