public static void zsisl(Complex[] a, int lda, int n, int[] ipvt,
ref Complex[] b)
//****************************************************************************80
//
// Purpose:
//
// ZSISL solves a complex symmetric system that was factored by ZSIFA.
//
// Discussion:
//
// A division by zero may occur if ZSICO has set RCOND == 0.0
// or ZSIFA has set INFO != 0.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input, Complex A[LDA*N], the output from ZSICO or ZSIFA.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZSICO or ZSIFA.
//
// Input/output, Complex B[N]. On input, the right hand side.
// On output, the solution.
//
{
int kp;
Complex t;
//
// Loop backward applying the transformations and D inverse to B.
//
int k = n;
while (0 < k)
{
switch (ipvt[k - 1])
{
//
// 1 x 1 pivot block.
//
case >= 0:
{
if (k != 1)
{
kp = ipvt[k - 1];
if (kp != k)
{
t = b[k - 1];
b[k - 1] = b[kp - 1];
b[kp - 1] = t;
}
BLAS1Z.zaxpy(k - 1, b[k - 1], a, 1, ref b, 1, xIndex: +0 + (k - 1) * lda);
}
b[k - 1] /= a[k - 1 + (k - 1) * lda];
k -= 1;
break;
}
//
default:
{
if (k != 2)
{
kp = Math.Abs(ipvt[k - 1]);
if (kp != k - 1)
{
t = b[k - 2];
b[k - 2] = b[kp - 1];
b[kp - 1] = t;
}
BLAS1Z.zaxpy(k - 2, b[k - 1], a, 1, ref b, 1, xIndex: +0 + (k - 1) * lda);
BLAS1Z.zaxpy(k - 2, b[k - 2], a, 1, ref b, 1, xIndex: +0 + (k - 2) * lda);
}
Complex ak = a[k - 1 + (k - 1) * lda] / a[k - 2 + (k - 1) * lda];
Complex akm1 = a[k - 2 + (k - 2) * lda] / a[k - 2 + (k - 1) * lda];
Complex bk = b[k - 1] / a[k - 2 + (k - 1) * lda];
Complex bkm1 = b[k - 2] / a[k - 2 + (k - 1) * lda];
Complex denom = ak * akm1 - new Complex(1.0, 0.0);
b[k - 1] = (akm1 * bk - bkm1) / denom;
b[k - 2] = (ak * bkm1 - bk) / denom;
k -= 2;
break;
}
}
}
//
// Loop forward applying the transformations.
//
k = 1;
while (k <= n)
{
switch (ipvt[k - 1])
{
case >= 0:
{
//
// 1 x 1 pivot block.
//
if (k != 1)
{
b[k - 1] += BLAS1Z.zdotu(k - 1, a, 1, b, 1, xIndex: +0 + (k - 1) * lda);
kp = ipvt[k - 1];
if (kp != k)
{
t = b[k - 1];
b[k - 1] = b[kp - 1];
b[kp - 1] = t;
}
}
k += 1;
break;
}
//
default:
{
if (k != 1)
{
b[k - 1] += BLAS1Z.zdotu(k - 1, a, 1, b, 1, xIndex: +0 + (k - 1) * lda);
b[k] += BLAS1Z.zdotu(k - 1, a, 1, b, 1, xIndex: +0 + k * lda);
kp = Math.Abs(ipvt[k - 1]);
if (kp != k)
{
t = b[k - 1];
b[k - 1] = b[kp - 1];
b[kp - 1] = t;
}
}
k += 2;
break;
}
}
}
}
public static void zspdi(ref Complex[] ap, int n, int[] ipvt, ref Complex[] det,
int job)
//****************************************************************************80
//
// Purpose:
//
// ZSPDI sets the determinant and inverse of a complex symmetric packed matrix.
//
// Discussion:
//
// ZSPDI uses the factors from ZSPFA.
//
// The matrix is stored in packed form.
//
// A division by zero will occur if the inverse is requested and ZSPCO has
// set RCOND to 0.0 or ZSPFA has set INFO nonzero.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, Complex AP[N*(N+1)/2]; on input, the matrix factors
// from ZSPFA. On output, if the inverse was requested, the upper
// triangle of the inverse of the original matrix, stored in packed
// form. The columns of the upper triangle are stored sequentially
// in a one-dimensional array.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZSPFA.
//
// Output, Complex DET[2], the determinant of the original matrix.
// Determinant = DET(1) * 10.0**DET(2) with 1.0 <= abs ( DET(1) ) < 10.0
// or DET(1) = 0.0. Also, DET(2) is strictly real.
//
// Input, int JOB, has the decimal expansion AB where
// if B != 0, the inverse is computed,
// if A != 0, the determinant is computed,
// For example, JOB = 11 gives both.
//
{
Complex d;
int ik;
int ikp1;
int k;
int kk;
int kkp1 = 0;
Complex t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
switch (nodet)
{
case false:
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
t = new Complex(0.0, 0.0);
ik = 0;
for (k = 1; k <= n; k++)
{
kk = ik + k;
d = ap[kk - 1];
switch (ipvt[k - 1])
{
//
// 2 by 2 block
// Use det (D T) = ( D / T * C - T ) * T
// (T C)
// to avoid underflow/overflow troubles.
// Take two passes through scaling. Use T for flag.
//
case <= 0 when typeMethods.zabs1(t) == 0.0:
ikp1 = ik + k;
kkp1 = ikp1 + k;
t = ap[kkp1 - 1];
d = d / t * ap[kkp1] - t;
break;
case <= 0:
d = t;
t = new Complex(0.0, 0.0);
break;
}
switch (nodet)
{
case false:
{
det[0] *= d;
if (typeMethods.zabs1(det[0]) != 0.0)
{
while (typeMethods.zabs1(det[0]) < 1.0)
{
det[0] *= new Complex(10.0, 0.0);
det[1] -= new Complex(1.0, 0.0);
}
while (10.0 <= typeMethods.zabs1(det[0]))
{
det[0] /= new Complex(10.0, 0.0);
det[1] += new Complex(1.0, 0.0);
}
}
break;
}
}
ik += k;
}
break;
}
}
switch (noinv)
{
//
// Compute inverse ( A ).
//
case false:
{
Complex[] work = new Complex[n];
k = 1;
ik = 0;
while (k <= n)
{
int km1 = k - 1;
kk = ik + k;
ikp1 = ik + k;
int j;
int jk;
int i;
int ij;
int kstep;
switch (ipvt[k - 1])
{
case >= 0:
{
//
// 1 by 1
//
ap[kk - 1] = new Complex(1.0, 0.0) / ap[kk - 1];
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ik + i - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 1;
break;
}
//
default:
{
kkp1 = ikp1 + k;
t = ap[kkp1 - 1];
Complex ak = ap[kk - 1] / t;
Complex akp1 = ap[kkp1] / t;
Complex akkp1 = ap[kkp1 - 1] / t;
d = t * (ak * akp1 - new Complex(1.0, 0.0));
ap[kk - 1] = akp1 / d;
ap[kkp1] = ak / d;
ap[kkp1 - 1] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ikp1 - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
int jkp1 = ikp1 + j;
ap[jkp1 - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ikp1);
ij += j;
}
ap[kkp1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ikp1);
ap[kkp1 - 1] += BLAS1Z.zdotu(km1, ap, 1, ap, 1, xIndex: +ik, yIndex: +ikp1);
for (i = 1; i <= km1; i++)
{
work[i - 1] = ap[ik + i - 1];
}
ij = 0;
for (j = 1; j <= km1; j++)
{
jk = ik + j;
ap[jk - 1] = BLAS1Z.zdotu(j, ap, 1, work, 1, xIndex: +ij);
BLAS1Z.zaxpy(j - 1, work[j - 1], ap, 1, ref ap, 1, xIndex: +ij, yIndex: +ik);
ij += j;
}
ap[kk - 1] += BLAS1Z.zdotu(km1, work, 1, ap, 1, yIndex: +ik);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap.
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
int iks = ks * (ks - 1) / 2;
BLAS1Z.zswap(ks, ref ap, 1, ref ap, 1, xIndex: +iks, yIndex: +ik);
int ksj = ik + ks;
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
jk = ik + j;
t = ap[jk - 1];
ap[jk - 1] = ap[ksj - 1];
ap[ksj - 1] = t;
ksj -= j - 1;
}
if (kstep != 1)
{
int kskp1 = ikp1 + ks;
t = ap[kskp1 - 1];
ap[kskp1 - 1] = ap[kkp1 - 1];
ap[kkp1 - 1] = t;
}
}
ik += k;
ik = kstep switch
{
2 => ik + k + 1,
_ => ik
};
k += kstep;
}
break;
}
}
}
}
public static void zsidi(ref Complex[] a, int lda, int n, int[] ipvt,
ref Complex[] det, int job)
//****************************************************************************80
//
// Purpose:
//
// ZSIDI computes the determinant and inverse of a matrix factored by ZSIFA.
//
// Discussion:
//
// It is assumed the complex symmetric matrix has already been factored
// by ZSIFA.
//
// A division by zero may occur if the inverse is requested
// and ZSICO set RCOND == 0.0 or ZSIFA set INFO nonzero.
//
// Licensing:
//
// This code is distributed under the GNU LGPL license.
//
// Modified:
//
// 21 May 2006
//
// Author:
//
// C++ version by John Burkardt
//
// Reference:
//
// Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
// LINPACK User's Guide,
// SIAM, (Society for Industrial and Applied Mathematics),
// 3600 University City Science Center,
// Philadelphia, PA, 19104-2688.
//
// Parameters:
//
// Input/output, Complex A[LDA*N]; on input, the output from ZSIFA.
// If the inverse was requested, then on output, A contains the upper triangle
// of the inverse of the original matrix. The strict lower triangle
// is never referenced.
//
// Input, int LDA, the leading dimension of A.
//
// Input, int N, the order of the matrix.
//
// Input, int IPVT[N], the pivot vector from ZSIFA.
//
// Output, Complex DET[2], if requested, the determinant of the matrix.
// Determinant = DET(1) * 10.0**DET(2) with 1.0 <= abs ( DET(1) ) < 10.0
// or DET(1) = 0.0. Also, DET(2) is strictly real.
//
// Input, int JOB, has the decimal expansion AB where
// if B != 0, the inverse is computed,
// if A != 0, the determinant is computed,
// For example, JOB = 11 gives both.
//
{
Complex d;
int k;
Complex t;
bool noinv = job % 10 == 0;
bool nodet = job % 100 / 10 == 0;
switch (nodet)
{
case false:
{
det[0] = new Complex(1.0, 0.0);
det[1] = new Complex(0.0, 0.0);
t = new Complex(0.0, 0.0);
for (k = 1; k <= n; k++)
{
d = a[k - 1 + (k - 1) * lda];
switch (ipvt[k - 1])
{
//
// 2 by 2 block.
// Use det ( D T ) = ( D / T * C - T ) * T
// ( T C )
// to avoid underflow/overflow troubles.
// Take two passes through scaling. Use T for flag.
//
case <= 0 when typeMethods.zabs1(t) == 0.0:
t = a[k - 1 + k * lda];
d = d / t * a[k + k * lda] - t;
break;
case <= 0:
d = t;
t = new Complex(0.0, 0.0);
break;
}
det[0] *= d;
if (typeMethods.zabs1(det[0]) == 0.0)
{
continue;
}
while (typeMethods.zabs1(det[0]) < 1.0)
{
det[0] *= new Complex(10.0, 0.0);
det[1] -= new Complex(1.0, 0.0);
}
while (10.0 <= typeMethods.zabs1(det[0]))
{
det[0] /= new Complex(10.0, 0.0);
det[1] += new Complex(1.0, 0.0);
}
}
break;
}
}
switch (noinv)
{
//
// Compute inverse ( A ).
//
case false:
{
Complex[] work = new Complex [n];
k = 1;
while (k <= n)
{
int km1 = k - 1;
int kstep;
int j;
int i;
switch (ipvt[k - 1])
{
//
// 1 by 1
//
case >= 0:
{
a[k - 1 + (k - 1) * lda] = new Complex(1.0, 0.0) / a[k - 1 + (k - 1) * lda];
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
break;
}
}
kstep = 1;
break;
}
//
default:
{
t = a[k - 1 + k * lda];
Complex ak = a[k - 1 + (k - 1) * lda] / t;
Complex akp1 = a[k + k * lda] / t;
Complex akkp1 = a[k - 1 + k * lda] / t;
d = t * (ak * akp1 - new Complex(1.0, 0.0));
a[k - 1 + (k - 1) * lda] = akp1 / d;
a[k + k * lda] = ak / d;
a[k - 1 + k * lda] = -akkp1 / d;
switch (km1)
{
case >= 1:
{
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + k * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + k * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + k * lda);
}
a[k + k * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + k * lda);
a[k - 1 + k * lda] += BLAS1Z.zdotu(km1, a, 1, a, 1, xIndex: +0 + (k - 1) * lda,
yIndex: +0 + k * lda);
for (i = 1; i <= km1; i++)
{
work[i - 1] = a[i - 1 + (k - 1) * lda];
}
for (j = 1; j <= km1; j++)
{
a[j - 1 + (k - 1) * lda] = BLAS1Z.zdotu(j, a, 1, work, 1, xIndex: +0 + (j - 1) * lda);
BLAS1Z.zaxpy(j - 1, work[j - 1], a, 1, ref a, 1, xIndex: +0 + (j - 1) * lda,
yIndex: +0 + (k - 1) * lda);
}
a[k - 1 + (k - 1) * lda] += BLAS1Z.zdotu(km1, work, 1, a, 1, yIndex: +0 + (k - 1) * lda);
break;
}
}
kstep = 2;
break;
}
}
//
// Swap.
//
int ks = Math.Abs(ipvt[k - 1]);
if (ks != k)
{
BLAS1Z.zswap(ks, ref a, 1, ref a, 1, xIndex: +0 + (ks - 1) * lda, yIndex: +0 + (k - 1) * lda);
int jb;
for (jb = ks; jb <= k; jb++)
{
j = k + ks - jb;
t = a[j - 1 + (k - 1) * lda];
a[j - 1 + (k - 1) * lda] = a[ks - 1 + (j - 1) * lda];
a[ks - 1 + (j - 1) * lda] = t;
}
if (kstep != 1)
{
t = a[ks - 1 + k * lda];
a[ks - 1 + k * lda] = a[k - 1 + k * lda];
a[k - 1 + k * lda] = t;
}
}
k += kstep;
}
break;
}
}
}