/// <summary>
/// Purpose
/// =======
///
/// ILAENV is called from the LAPACK routines to choose problem-dependent
/// parameters for the local environment. See ISPEC for a description of
/// the parameters.
///
/// ILAENV returns an INTEGER
/// if ILAENV .GE. 0: ILAENV returns the value of the parameter specified by ISPEC
/// if ILAENV .LT. 0: if ILAENV = -k, the k-th argument had an illegal value.
///
/// This version provides a set of parameters which should give good,
/// but not optimal, performance on many of the currently available
/// computers. Users are encouraged to modify this subroutine to set
/// the tuning parameters for their particular machine using the option
/// and problem size information in the arguments.
///
/// This routine will not function correctly if it is converted to all
/// lower case. Converting it to all upper case is allowed.
///
///</summary>
/// <param name="ISPEC">
/// (input) INTEGER
/// Specifies the parameter to be returned as the value of
/// ILAENV.
/// = 1: the optimal blocksize; if this value is 1, an unblocked
/// algorithm will give the best performance.
/// = 2: the minimum block size for which the block routine
/// should be used; if the usable block size is less than
/// this value, an unblocked routine should be used.
/// = 3: the crossover point (in a block routine, for N less
/// than this value, an unblocked routine should be used)
/// = 4: the number of shifts, used in the nonsymmetric
/// eigenvalue routines (DEPRECATED)
/// = 5: the minimum column dimension for blocking to be used;
/// rectangular blocks must have dimension at least k by m,
/// where k is given by ILAENV(2,...) and m by ILAENV(5,...)
/// = 6: the crossover point for the SVD (when reducing an m by n
/// matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
/// this value, a QR factorization is used first to reduce
/// the matrix to a triangular form.)
/// = 7: the number of processors
/// = 8: the crossover point for the multishift QR method
/// for nonsymmetric eigenvalue problems (DEPRECATED)
/// = 9: maximum size of the subproblems at the bottom of the
/// computation tree in the divide-and-conquer algorithm
/// (used by xGELSD and xGESDD)
/// =10: ieee NaN arithmetic can be trusted not to trap
/// =11: infinity arithmetic can be trusted not to trap
/// 12 .LE. ISPEC .LE. 16:
/// xHSEQR or one of its subroutines,
/// see IPARMQ for detailed explanation
///</param>
/// <param name="NAME">
/// (input) CHARACTER*(*)
/// The name of the calling subroutine, in either upper case or
/// lower case.
///</param>
/// <param name="OPTS">
/// (input) CHARACTER*(*)
/// The character options to the subroutine NAME, concatenated
/// into a single character string. For example, UPLO = 'U',
/// TRANS = 'T', and DIAG = 'N' for a triangular routine would
/// be specified as OPTS = 'UTN'.
///</param>
/// <param name="N1">
/// (input) INTEGER
///</param>
/// <param name="N2">
/// (input) INTEGER
///</param>
/// <param name="N3">
/// (input) INTEGER
///</param>
/// <param name="N4">
/// (input) INTEGER
/// Problem dimensions for the subroutine NAME; these may not all
/// be required.
///</param>
public int Run(int ISPEC, string NAME, string OPTS, int N1, int N2, int N3
, int N4)
{
int ilaenv = 0;
#region Variables
int I = 0; int IC = 0; int IZ = 0; int NB = 0; int NBMIN = 0; int NX = 0; bool CNAME = false; bool SNAME = false;
string C1 = new string(' ', 1); string C2 = new string(' ', 2); string C4 = new string(' ', 2);
string C3 = new string(' ', 3); string SUBNAM = new string(' ', 6);
#endregion
#region Prolog
// *
// * -- LAPACK auxiliary routine (version 3.1.1) --
// * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
// * January 2007
// *
// * .. Scalar Arguments ..
// * ..
// *
// * Purpose
// * =======
// *
// * ILAENV is called from the LAPACK routines to choose problem-dependent
// * parameters for the local environment. See ISPEC for a description of
// * the parameters.
// *
// * ILAENV returns an INTEGER
// * if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC
// * if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value.
// *
// * This version provides a set of parameters which should give good,
// * but not optimal, performance on many of the currently available
// * computers. Users are encouraged to modify this subroutine to set
// * the tuning parameters for their particular machine using the option
// * and problem size information in the arguments.
// *
// * This routine will not function correctly if it is converted to all
// * lower case. Converting it to all upper case is allowed.
// *
// * Arguments
// * =========
// *
// * ISPEC (input) INTEGER
// * Specifies the parameter to be returned as the value of
// * ILAENV.
// * = 1: the optimal blocksize; if this value is 1, an unblocked
// * algorithm will give the best performance.
// * = 2: the minimum block size for which the block routine
// * should be used; if the usable block size is less than
// * this value, an unblocked routine should be used.
// * = 3: the crossover point (in a block routine, for N less
// * than this value, an unblocked routine should be used)
// * = 4: the number of shifts, used in the nonsymmetric
// * eigenvalue routines (DEPRECATED)
// * = 5: the minimum column dimension for blocking to be used;
// * rectangular blocks must have dimension at least k by m,
// * where k is given by ILAENV(2,...) and m by ILAENV(5,...)
// * = 6: the crossover point for the SVD (when reducing an m by n
// * matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
// * this value, a QR factorization is used first to reduce
// * the matrix to a triangular form.)
// * = 7: the number of processors
// * = 8: the crossover point for the multishift QR method
// * for nonsymmetric eigenvalue problems (DEPRECATED)
// * = 9: maximum size of the subproblems at the bottom of the
// * computation tree in the divide-and-conquer algorithm
// * (used by xGELSD and xGESDD)
// * =10: ieee NaN arithmetic can be trusted not to trap
// * =11: infinity arithmetic can be trusted not to trap
// * 12 <= ISPEC <= 16:
// * xHSEQR or one of its subroutines,
// * see IPARMQ for detailed explanation
// *
// * NAME (input) CHARACTER*(*)
// * The name of the calling subroutine, in either upper case or
// * lower case.
// *
// * OPTS (input) CHARACTER*(*)
// * The character options to the subroutine NAME, concatenated
// * into a single character string. For example, UPLO = 'U',
// * TRANS = 'T', and DIAG = 'N' for a triangular routine would
// * be specified as OPTS = 'UTN'.
// *
// * N1 (input) INTEGER
// * N2 (input) INTEGER
// * N3 (input) INTEGER
// * N4 (input) INTEGER
// * Problem dimensions for the subroutine NAME; these may not all
// * be required.
// *
// * Further Details
// * ===============
// *
// * The following conventions have been used when calling ILAENV from the
// * LAPACK routines:
// * 1) OPTS is a concatenation of all of the character options to
// * subroutine NAME, in the same order that they appear in the
// * argument list for NAME, even if they are not used in determining
// * the value of the parameter specified by ISPEC.
// * 2) The problem dimensions N1, N2, N3, N4 are specified in the order
// * that they appear in the argument list for NAME. N1 is used
// * first, N2 second, and so on, and unused problem dimensions are
// * passed a value of -1.
// * 3) The parameter value returned by ILAENV is checked for validity in
// * the calling subroutine. For example, ILAENV is used to retrieve
// * the optimal blocksize for STRTRI as follows:
// *
// * NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
// * IF( NB.LE.1 ) NB = MAX( 1, N )
// *
// * =====================================================================
// *
// * .. Local Scalars ..
// * ..
// * .. Intrinsic Functions ..
// INTRINSIC CHAR, ICHAR, INT, MIN, REAL;
// * ..
// * .. External Functions ..
// * ..
// * .. Executable Statements ..
// *
#endregion
#region Body
switch (ISPEC)
{
case 1: goto LABEL10;
case 2: goto LABEL10;
case 3: goto LABEL10;
case 4: goto LABEL80;
case 5: goto LABEL90;
case 6: goto LABEL100;
case 7: goto LABEL110;
case 8: goto LABEL120;
case 9: goto LABEL130;
case 10: goto LABEL140;
case 11: goto LABEL150;
case 12: goto LABEL160;
case 13: goto LABEL160;
case 14: goto LABEL160;
case 15: goto LABEL160;
case 16: goto LABEL160;
}
// *
// * Invalid value for ISPEC
// *
ilaenv = -1;
return(ilaenv);
// *
LABEL10 :;
// *
// * Convert NAME to upper case if the first character is lower case.
// *
ilaenv = 1;
FortranLib.Copy(ref SUBNAM, NAME);
IC = Convert.ToInt32(Convert.ToChar(FortranLib.Substring(SUBNAM, 1, 1)));
IZ = Convert.ToInt32('Z');
if (IZ == 90 || IZ == 122)
{
// *
// * ASCII character set
// *
if (IC >= 97 && IC <= 122)
{
FortranLib.Copy(ref SUBNAM, 1, 1, Convert.ToChar(IC - 32));
for (I = 2; I <= 6; I++)
{
IC = Convert.ToInt32(Convert.ToChar(FortranLib.Substring(SUBNAM, I, I)));
if (IC >= 97 && IC <= 122)
{
FortranLib.Copy(ref SUBNAM, I, I, Convert.ToChar(IC - 32));
}
}
}
// *
}
else
{
if (IZ == 233 || IZ == 169)
{
// *
// * EBCDIC character set
// *
if ((IC >= 129 && IC <= 137) || (IC >= 145 && IC <= 153) || (IC >= 162 && IC <= 169))
{
FortranLib.Copy(ref SUBNAM, 1, 1, Convert.ToChar(IC + 64));
for (I = 2; I <= 6; I++)
{
IC = Convert.ToInt32(Convert.ToChar(FortranLib.Substring(SUBNAM, I, I)));
if ((IC >= 129 && IC <= 137) || (IC >= 145 && IC <= 153) || (IC >= 162 && IC <= 169))
{
FortranLib.Copy(ref SUBNAM, I, I, Convert.ToChar(IC + 64));
}
}
}
// *
}
else
{
if (IZ == 218 || IZ == 250)
{
// *
// * Prime machines: ASCII+128
// *
if (IC >= 225 && IC <= 250)
{
FortranLib.Copy(ref SUBNAM, 1, 1, Convert.ToChar(IC - 32));
for (I = 2; I <= 6; I++)
{
IC = Convert.ToInt32(Convert.ToChar(FortranLib.Substring(SUBNAM, I, I)));
if (IC >= 225 && IC <= 250)
{
FortranLib.Copy(ref SUBNAM, I, I, Convert.ToChar(IC - 32));
}
}
}
}
}
}
// *
FortranLib.Copy(ref C1, FortranLib.Substring(SUBNAM, 1, 1));
SNAME = C1 == "S" || C1 == "D";
CNAME = C1 == "C" || C1 == "Z";
if (!(CNAME || SNAME))
{
return(ilaenv);
}
FortranLib.Copy(ref C2, FortranLib.Substring(SUBNAM, 2, 3));
FortranLib.Copy(ref C3, FortranLib.Substring(SUBNAM, 4, 6));
FortranLib.Copy(ref C4, FortranLib.Substring(C3, 2, 3));
// *
switch (ISPEC)
{
case 1: goto LABEL50;
case 2: goto LABEL60;
case 3: goto LABEL70;
}
// *
LABEL50 :;
// *
// * ISPEC = 1: block size
// *
// * In these examples, separate code is provided for setting NB for
// * real and complex. We assume that NB will take the same value in
// * single or double precision.
// *
NB = 1;
// *
if (C2 == "GE")
{
if (C3 == "TRF")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
else
{
if (C3 == "QRF" || C3 == "RQF" || C3 == "LQF" || C3 == "QLF")
{
if (SNAME)
{
NB = 32;
}
else
{
NB = 32;
}
}
else
{
if (C3 == "HRD")
{
if (SNAME)
{
NB = 32;
}
else
{
NB = 32;
}
}
else
{
if (C3 == "BRD")
{
if (SNAME)
{
NB = 32;
}
else
{
NB = 32;
}
}
else
{
if (C3 == "TRI")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
}
}
}
}
}
else
{
if (C2 == "PO")
{
if (C3 == "TRF")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
}
else
{
if (C2 == "SY")
{
if (C3 == "TRF")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
else
{
if (SNAME && C3 == "TRD")
{
NB = 32;
}
else
{
if (SNAME && C3 == "GST")
{
NB = 64;
}
}
}
}
else
{
if (CNAME && C2 == "HE")
{
if (C3 == "TRF")
{
NB = 64;
}
else
{
if (C3 == "TRD")
{
NB = 32;
}
else
{
if (C3 == "GST")
{
NB = 64;
}
}
}
}
else
{
if (SNAME && C2 == "OR")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NB = 32;
}
}
else
{
if (FortranLib.Substring(C3, 1, 1) == "M")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NB = 32;
}
}
}
}
else
{
if (CNAME && C2 == "UN")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NB = 32;
}
}
else
{
if (FortranLib.Substring(C3, 1, 1) == "M")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NB = 32;
}
}
}
}
else
{
if (C2 == "GB")
{
if (C3 == "TRF")
{
if (SNAME)
{
if (N4 <= 64)
{
NB = 1;
}
else
{
NB = 32;
}
}
else
{
if (N4 <= 64)
{
NB = 1;
}
else
{
NB = 32;
}
}
}
}
else
{
if (C2 == "PB")
{
if (C3 == "TRF")
{
if (SNAME)
{
if (N2 <= 64)
{
NB = 1;
}
else
{
NB = 32;
}
}
else
{
if (N2 <= 64)
{
NB = 1;
}
else
{
NB = 32;
}
}
}
}
else
{
if (C2 == "TR")
{
if (C3 == "TRI")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
}
else
{
if (C2 == "LA")
{
if (C3 == "UUM")
{
if (SNAME)
{
NB = 64;
}
else
{
NB = 64;
}
}
}
else
{
if (SNAME && C2 == "ST")
{
if (C3 == "EBZ")
{
NB = 1;
}
}
}
}
}
}
}
}
}
}
}
}
ilaenv = NB;
return(ilaenv);
// *
LABEL60 :;
// *
// * ISPEC = 2: minimum block size
// *
NBMIN = 2;
if (C2 == "GE")
{
if (C3 == "QRF" || C3 == "RQF" || C3 == "LQF" || C3 == "QLF")
{
if (SNAME)
{
NBMIN = 2;
}
else
{
NBMIN = 2;
}
}
else
{
if (C3 == "HRD")
{
if (SNAME)
{
NBMIN = 2;
}
else
{
NBMIN = 2;
}
}
else
{
if (C3 == "BRD")
{
if (SNAME)
{
NBMIN = 2;
}
else
{
NBMIN = 2;
}
}
else
{
if (C3 == "TRI")
{
if (SNAME)
{
NBMIN = 2;
}
else
{
NBMIN = 2;
}
}
}
}
}
}
else
{
if (C2 == "SY")
{
if (C3 == "TRF")
{
if (SNAME)
{
NBMIN = 8;
}
else
{
NBMIN = 8;
}
}
else
{
if (SNAME && C3 == "TRD")
{
NBMIN = 2;
}
}
}
else
{
if (CNAME && C2 == "HE")
{
if (C3 == "TRD")
{
NBMIN = 2;
}
}
else
{
if (SNAME && C2 == "OR")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NBMIN = 2;
}
}
else
{
if (FortranLib.Substring(C3, 1, 1) == "M")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NBMIN = 2;
}
}
}
}
else
{
if (CNAME && C2 == "UN")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NBMIN = 2;
}
}
else
{
if (FortranLib.Substring(C3, 1, 1) == "M")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NBMIN = 2;
}
}
}
}
}
}
}
}
ilaenv = NBMIN;
return(ilaenv);
// *
LABEL70 :;
// *
// * ISPEC = 3: crossover point
// *
NX = 0;
if (C2 == "GE")
{
if (C3 == "QRF" || C3 == "RQF" || C3 == "LQF" || C3 == "QLF")
{
if (SNAME)
{
NX = 128;
}
else
{
NX = 128;
}
}
else
{
if (C3 == "HRD")
{
if (SNAME)
{
NX = 128;
}
else
{
NX = 128;
}
}
else
{
if (C3 == "BRD")
{
if (SNAME)
{
NX = 128;
}
else
{
NX = 128;
}
}
}
}
}
else
{
if (C2 == "SY")
{
if (SNAME && C3 == "TRD")
{
NX = 32;
}
}
else
{
if (CNAME && C2 == "HE")
{
if (C3 == "TRD")
{
NX = 32;
}
}
else
{
if (SNAME && C2 == "OR")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NX = 128;
}
}
}
else
{
if (CNAME && C2 == "UN")
{
if (FortranLib.Substring(C3, 1, 1) == "G")
{
if (C4 == "QR" || C4 == "RQ" || C4 == "LQ" || C4 == "QL" || C4 == "HR" || C4 == "TR" || C4 == "BR")
{
NX = 128;
}
}
}
}
}
}
}
ilaenv = NX;
return(ilaenv);
// *
LABEL80 :;
// *
// * ISPEC = 4: number of shifts (used by xHSEQR)
// *
ilaenv = 6;
return(ilaenv);
// *
LABEL90 :;
// *
// * ISPEC = 5: minimum column dimension (not used)
// *
ilaenv = 2;
return(ilaenv);
// *
LABEL100 :;
// *
// * ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD)
// *
ilaenv = Convert.ToInt32(Math.Truncate(Convert.ToSingle(Math.Min(N1, N2)) * 1.6E0));
return(ilaenv);
// *
LABEL110 :;
// *
// * ISPEC = 7: number of processors (not used)
// *
ilaenv = 1;
return(ilaenv);
// *
LABEL120 :;
// *
// * ISPEC = 8: crossover point for multishift (used by xHSEQR)
// *
ilaenv = 50;
return(ilaenv);
// *
LABEL130 :;
// *
// * ISPEC = 9: maximum size of the subproblems at the bottom of the
// * computation tree in the divide-and-conquer algorithm
// * (used by xGELSD and xGESDD)
// *
ilaenv = 25;
return(ilaenv);
// *
LABEL140 :;
// *
// * ISPEC = 10: ieee NaN arithmetic can be trusted not to trap
// *
// * ILAENV = 0
ilaenv = 1;
if (ilaenv == 1)
{
ilaenv = this._ieeeck.Run(0, 0.0, 1.0);
}
return(ilaenv);
// *
LABEL150 :;
// *
// * ISPEC = 11: infinity arithmetic can be trusted not to trap
// *
// * ILAENV = 0
ilaenv = 1;
if (ilaenv == 1)
{
ilaenv = this._ieeeck.Run(1, 0.0, 1.0);
}
return(ilaenv);
// *
LABEL160 :;
// *
// * 12 <= ISPEC <= 16: xHSEQR or one of its subroutines.
// *
ilaenv = this._iparmq.Run(ISPEC, NAME, OPTS, N1, N2, N3, N4);
return(ilaenv);
// *
// * End of ILAENV
// *
#endregion
}
/// <summary>
/// Purpose
/// =======
///
/// DHSEQR computes the eigenvalues of a Hessenberg matrix H
/// and, optionally, the matrices T and Z from the Schur decomposition
/// H = Z T Z**T, where T is an upper quasi-triangular matrix (the
/// Schur form), and Z is the orthogonal matrix of Schur vectors.
///
/// Optionally Z may be postmultiplied into an input orthogonal
/// matrix Q so that this routine can give the Schur factorization
/// of a matrix A which has been reduced to the Hessenberg form H
/// by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
///
///</summary>
/// <param name="JOB">
/// (input) CHARACTER*1
/// = 'E': compute eigenvalues only;
/// = 'S': compute eigenvalues and the Schur form T.
///</param>
/// <param name="COMPZ">
/// (input) CHARACTER*1
/// = 'N': no Schur vectors are computed;
/// = 'I': Z is initialized to the unit matrix and the matrix Z
/// of Schur vectors of H is returned;
/// = 'V': Z must contain an orthogonal matrix Q on entry, and
/// the product Q*Z is returned.
///</param>
/// <param name="N">
/// (input) INTEGER
/// The order of the matrix H. N .GE. 0.
///</param>
/// <param name="ILO">
/// (input) INTEGER
///</param>
/// <param name="IHI">
/// (input) INTEGER
/// It is assumed that H is already upper triangular in rows
/// and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
/// set by a previous call to DGEBAL, and then passed to DGEHRD
/// when the matrix output by DGEBAL is reduced to Hessenberg
/// form. Otherwise ILO and IHI should be set to 1 and N
/// respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
/// If N = 0, then ILO = 1 and IHI = 0.
///</param>
/// <param name="H">
/// (input/output) DOUBLE PRECISION array, dimension (LDH,N)
/// On entry, the upper Hessenberg matrix H.
/// On exit, if INFO = 0 and JOB = 'S', then H contains the
/// upper quasi-triangular matrix T from the Schur decomposition
/// (the Schur form); 2-by-2 diagonal blocks (corresponding to
/// complex conjugate pairs of eigenvalues) are returned in
/// standard form, with H(i,i) = H(i+1,i+1) and
/// H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
/// contents of H are unspecified on exit. (The output value of
/// H when INFO.GT.0 is given under the description of INFO
/// below.)
///
/// Unlike earlier versions of DHSEQR, this subroutine may
/// explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
/// or j = IHI+1, IHI+2, ... N.
///</param>
/// <param name="LDH">
/// (input) INTEGER
/// The leading dimension of the array H. LDH .GE. max(1,N).
///</param>
/// <param name="WR">
/// (output) DOUBLE PRECISION array, dimension (N)
///</param>
/// <param name="WI">
/// (output) DOUBLE PRECISION array, dimension (N)
/// The real and imaginary parts, respectively, of the computed
/// eigenvalues. If two eigenvalues are computed as a complex
/// conjugate pair, they are stored in consecutive elements of
/// WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
/// WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
/// the same order as on the diagonal of the Schur form returned
/// in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
/// diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
/// WI(i+1) = -WI(i).
///</param>
/// <param name="Z">
/// (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
/// If COMPZ = 'N', Z is not referenced.
/// If COMPZ = 'I', on entry Z need not be set and on exit,
/// if INFO = 0, Z contains the orthogonal matrix Z of the Schur
/// vectors of H. If COMPZ = 'V', on entry Z must contain an
/// N-by-N matrix Q, which is assumed to be equal to the unit
/// matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
/// if INFO = 0, Z contains Q*Z.
/// Normally Q is the orthogonal matrix generated by DORGHR
/// after the call to DGEHRD which formed the Hessenberg matrix
/// H. (The output value of Z when INFO.GT.0 is given under
/// the description of INFO below.)
///</param>
/// <param name="LDZ">
/// (input) INTEGER
/// The leading dimension of the array Z. if COMPZ = 'I' or
/// COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
///</param>
/// <param name="WORK">
/// (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
/// On exit, if INFO = 0, WORK(1) returns an estimate of
/// the optimal value for LWORK.
///</param>
/// <param name="LWORK">
/// (input) INTEGER
/// The dimension of the array WORK. LWORK .GE. max(1,N)
/// is sufficient, but LWORK typically as large as 6*N may
/// be required for optimal performance. A workspace query
/// to determine the optimal workspace size is recommended.
///
/// If LWORK = -1, then DHSEQR does a workspace query.
/// In this case, DHSEQR checks the input parameters and
/// estimates the optimal workspace size for the given
/// values of N, ILO and IHI. The estimate is returned
/// in WORK(1). No error message related to LWORK is
/// issued by XERBLA. Neither H nor Z are accessed.
///
///</param>
/// <param name="INFO">
/// (output) INTEGER
/// = 0: successful exit
/// .LT. 0: if INFO = -i, the i-th argument had an illegal
/// value
/// .GT. 0: if INFO = i, DHSEQR failed to compute all of
/// the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
/// and WI contain those eigenvalues which have been
/// successfully computed. (Failures are rare.)
///
/// If INFO .GT. 0 and JOB = 'E', then on exit, the
/// remaining unconverged eigenvalues are the eigen-
/// values of the upper Hessenberg matrix rows and
/// columns ILO through INFO of the final, output
/// value of H.
///
/// If INFO .GT. 0 and JOB = 'S', then on exit
///
/// (*) (initial value of H)*U = U*(final value of H)
///
/// where U is an orthogonal matrix. The final
/// value of H is upper Hessenberg and quasi-triangular
/// in rows and columns INFO+1 through IHI.
///
/// If INFO .GT. 0 and COMPZ = 'V', then on exit
///
/// (final value of Z) = (initial value of Z)*U
///
/// where U is the orthogonal matrix in (*) (regard-
/// less of the value of JOB.)
///
/// If INFO .GT. 0 and COMPZ = 'I', then on exit
/// (final value of Z) = U
/// where U is the orthogonal matrix in (*) (regard-
/// less of the value of JOB.)
///
/// If INFO .GT. 0 and COMPZ = 'N', then Z is not
/// accessed.
///</param>
public void Run(string JOB, string COMPZ, int N, int ILO, int IHI, ref double[] H, int offset_h
, int LDH, ref double[] WR, int offset_wr, ref double[] WI, int offset_wi, ref double[] Z, int offset_z, int LDZ, ref double[] WORK, int offset_work
, int LWORK, ref int INFO)
{
#region Variables
int offset_hl = 0; int o_hl = -1 - NL; int offset_workl = 0; int I = 0; int KBOT = 0; int NMIN = 0;
bool INITZ = false; bool LQUERY = false; bool WANTT = false; bool WANTZ = false;
#endregion
#region Array Index Correction
int o_h = -1 - LDH + offset_h; int o_wr = -1 + offset_wr; int o_wi = -1 + offset_wi;
int o_z = -1 - LDZ + offset_z; int o_work = -1 + offset_work;
#endregion
#region Strings
JOB = JOB.Substring(0, 1); COMPZ = COMPZ.Substring(0, 1);
#endregion
#region Prolog
// *
// * -- LAPACK driver routine (version 3.1) --
// * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
// * November 2006
// *
// * .. Scalar Arguments ..
// * ..
// * .. Array Arguments ..
// * ..
// * Purpose
// * =======
// *
// * DHSEQR computes the eigenvalues of a Hessenberg matrix H
// * and, optionally, the matrices T and Z from the Schur decomposition
// * H = Z T Z**T, where T is an upper quasi-triangular matrix (the
// * Schur form), and Z is the orthogonal matrix of Schur vectors.
// *
// * Optionally Z may be postmultiplied into an input orthogonal
// * matrix Q so that this routine can give the Schur factorization
// * of a matrix A which has been reduced to the Hessenberg form H
// * by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T.
// *
// * Arguments
// * =========
// *
// * JOB (input) CHARACTER*1
// * = 'E': compute eigenvalues only;
// * = 'S': compute eigenvalues and the Schur form T.
// *
// * COMPZ (input) CHARACTER*1
// * = 'N': no Schur vectors are computed;
// * = 'I': Z is initialized to the unit matrix and the matrix Z
// * of Schur vectors of H is returned;
// * = 'V': Z must contain an orthogonal matrix Q on entry, and
// * the product Q*Z is returned.
// *
// * N (input) INTEGER
// * The order of the matrix H. N .GE. 0.
// *
// * ILO (input) INTEGER
// * IHI (input) INTEGER
// * It is assumed that H is already upper triangular in rows
// * and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
// * set by a previous call to DGEBAL, and then passed to DGEHRD
// * when the matrix output by DGEBAL is reduced to Hessenberg
// * form. Otherwise ILO and IHI should be set to 1 and N
// * respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
// * If N = 0, then ILO = 1 and IHI = 0.
// *
// * H (input/output) DOUBLE PRECISION array, dimension (LDH,N)
// * On entry, the upper Hessenberg matrix H.
// * On exit, if INFO = 0 and JOB = 'S', then H contains the
// * upper quasi-triangular matrix T from the Schur decomposition
// * (the Schur form); 2-by-2 diagonal blocks (corresponding to
// * complex conjugate pairs of eigenvalues) are returned in
// * standard form, with H(i,i) = H(i+1,i+1) and
// * H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the
// * contents of H are unspecified on exit. (The output value of
// * H when INFO.GT.0 is given under the description of INFO
// * below.)
// *
// * Unlike earlier versions of DHSEQR, this subroutine may
// * explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
// * or j = IHI+1, IHI+2, ... N.
// *
// * LDH (input) INTEGER
// * The leading dimension of the array H. LDH .GE. max(1,N).
// *
// * WR (output) DOUBLE PRECISION array, dimension (N)
// * WI (output) DOUBLE PRECISION array, dimension (N)
// * The real and imaginary parts, respectively, of the computed
// * eigenvalues. If two eigenvalues are computed as a complex
// * conjugate pair, they are stored in consecutive elements of
// * WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and
// * WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in
// * the same order as on the diagonal of the Schur form returned
// * in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2
// * diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and
// * WI(i+1) = -WI(i).
// *
// * Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
// * If COMPZ = 'N', Z is not referenced.
// * If COMPZ = 'I', on entry Z need not be set and on exit,
// * if INFO = 0, Z contains the orthogonal matrix Z of the Schur
// * vectors of H. If COMPZ = 'V', on entry Z must contain an
// * N-by-N matrix Q, which is assumed to be equal to the unit
// * matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
// * if INFO = 0, Z contains Q*Z.
// * Normally Q is the orthogonal matrix generated by DORGHR
// * after the call to DGEHRD which formed the Hessenberg matrix
// * H. (The output value of Z when INFO.GT.0 is given under
// * the description of INFO below.)
// *
// * LDZ (input) INTEGER
// * The leading dimension of the array Z. if COMPZ = 'I' or
// * COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1.
// *
// * WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK)
// * On exit, if INFO = 0, WORK(1) returns an estimate of
// * the optimal value for LWORK.
// *
// * LWORK (input) INTEGER
// * The dimension of the array WORK. LWORK .GE. max(1,N)
// * is sufficient, but LWORK typically as large as 6*N may
// * be required for optimal performance. A workspace query
// * to determine the optimal workspace size is recommended.
// *
// * If LWORK = -1, then DHSEQR does a workspace query.
// * In this case, DHSEQR checks the input parameters and
// * estimates the optimal workspace size for the given
// * values of N, ILO and IHI. The estimate is returned
// * in WORK(1). No error message related to LWORK is
// * issued by XERBLA. Neither H nor Z are accessed.
// *
// *
// * INFO (output) INTEGER
// * = 0: successful exit
// * .LT. 0: if INFO = -i, the i-th argument had an illegal
// * value
// * .GT. 0: if INFO = i, DHSEQR failed to compute all of
// * the eigenvalues. Elements 1:ilo-1 and i+1:n of WR
// * and WI contain those eigenvalues which have been
// * successfully computed. (Failures are rare.)
// *
// * If INFO .GT. 0 and JOB = 'E', then on exit, the
// * remaining unconverged eigenvalues are the eigen-
// * values of the upper Hessenberg matrix rows and
// * columns ILO through INFO of the final, output
// * value of H.
// *
// * If INFO .GT. 0 and JOB = 'S', then on exit
// *
// * (*) (initial value of H)*U = U*(final value of H)
// *
// * where U is an orthogonal matrix. The final
// * value of H is upper Hessenberg and quasi-triangular
// * in rows and columns INFO+1 through IHI.
// *
// * If INFO .GT. 0 and COMPZ = 'V', then on exit
// *
// * (final value of Z) = (initial value of Z)*U
// *
// * where U is the orthogonal matrix in (*) (regard-
// * less of the value of JOB.)
// *
// * If INFO .GT. 0 and COMPZ = 'I', then on exit
// * (final value of Z) = U
// * where U is the orthogonal matrix in (*) (regard-
// * less of the value of JOB.)
// *
// * If INFO .GT. 0 and COMPZ = 'N', then Z is not
// * accessed.
// *
// * ================================================================
// * Default values supplied by
// * ILAENV(ISPEC,'DHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
// * It is suggested that these defaults be adjusted in order
// * to attain best performance in each particular
// * computational environment.
// *
// * ISPEC=1: The DLAHQR vs DLAQR0 crossover point.
// * Default: 75. (Must be at least 11.)
// *
// * ISPEC=2: Recommended deflation window size.
// * This depends on ILO, IHI and NS. NS is the
// * number of simultaneous shifts returned
// * by ILAENV(ISPEC=4). (See ISPEC=4 below.)
// * The default for (IHI-ILO+1).LE.500 is NS.
// * The default for (IHI-ILO+1).GT.500 is 3*NS/2.
// *
// * ISPEC=3: Nibble crossover point. (See ILAENV for
// * details.) Default: 14% of deflation window
// * size.
// *
// * ISPEC=4: Number of simultaneous shifts, NS, in
// * a multi-shift QR iteration.
// *
// * If IHI-ILO+1 is ...
// *
// * greater than ...but less ... the
// * or equal to ... than default is
// *
// * 1 30 NS - 2(+)
// * 30 60 NS - 4(+)
// * 60 150 NS = 10(+)
// * 150 590 NS = **
// * 590 3000 NS = 64
// * 3000 6000 NS = 128
// * 6000 infinity NS = 256
// *
// * (+) By default some or all matrices of this order
// * are passed to the implicit double shift routine
// * DLAHQR and NS is ignored. See ISPEC=1 above
// * and comments in IPARM for details.
// *
// * The asterisks (**) indicate an ad-hoc
// * function of N increasing from 10 to 64.
// *
// * ISPEC=5: Select structured matrix multiply.
// * (See ILAENV for details.) Default: 3.
// *
// * ================================================================
// * Based on contributions by
// * Karen Braman and Ralph Byers, Department of Mathematics,
// * University of Kansas, USA
// *
// * ================================================================
// * References:
// * K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
// * Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
// * Performance, SIAM Journal of Matrix Analysis, volume 23, pages
// * 929--947, 2002.
// *
// * K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
// * Algorithm Part II: Aggressive Early Deflation, SIAM Journal
// * of Matrix Analysis, volume 23, pages 948--973, 2002.
// *
// * ================================================================
// * .. Parameters ..
// *
// * ==== Matrices of order NTINY or smaller must be processed by
// * . DLAHQR because of insufficient subdiagonal scratch space.
// * . (This is a hard limit.) ====
// *
// * ==== NL allocates some local workspace to help small matrices
// * . through a rare DLAHQR failure. NL .GT. NTINY = 11 is
// * . required and NL .LE. NMIN = ILAENV(ISPEC=1,...) is recom-
// * . mended. (The default value of NMIN is 75.) Using NL = 49
// * . allows up to six simultaneous shifts and a 16-by-16
// * . deflation window. ====
// *
// * ..
// * .. Local Arrays ..
// * ..
// * .. Local Scalars ..
// * ..
// * .. External Functions ..
// * ..
// * .. External Subroutines ..
// * ..
// * .. Intrinsic Functions ..
// INTRINSIC DBLE, MAX, MIN;
// * ..
// * .. Executable Statements ..
// *
// * ==== Decode and check the input parameters. ====
// *
#endregion
#region Body
WANTT = this._lsame.Run(JOB, "S");
INITZ = this._lsame.Run(COMPZ, "I");
WANTZ = INITZ || this._lsame.Run(COMPZ, "V");
WORK[1 + o_work] = Convert.ToDouble(Math.Max(1, N));
LQUERY = LWORK == -1;
// *
INFO = 0;
if (!this._lsame.Run(JOB, "E") && !WANTT)
{
INFO = -1;
}
else
{
if (!this._lsame.Run(COMPZ, "N") && !WANTZ)
{
INFO = -2;
}
else
{
if (N < 0)
{
INFO = -3;
}
else
{
if (ILO < 1 || ILO > Math.Max(1, N))
{
INFO = -4;
}
else
{
if (IHI < Math.Min(ILO, N) || IHI > N)
{
INFO = -5;
}
else
{
if (LDH < Math.Max(1, N))
{
INFO = -7;
}
else
{
if (LDZ < 1 || (WANTZ && LDZ < Math.Max(1, N)))
{
INFO = -11;
}
else
{
if (LWORK < Math.Max(1, N) && !LQUERY)
{
INFO = -13;
}
}
}
}
}
}
}
}
// *
if (INFO != 0)
{
// *
// * ==== Quick return in case of invalid argument. ====
// *
this._xerbla.Run("DHSEQR", -INFO);
return;
// *
}
else
{
if (N == 0)
{
// *
// * ==== Quick return in case N = 0; nothing to do. ====
// *
return;
// *
}
else
{
if (LQUERY)
{
// *
// * ==== Quick return in case of a workspace query ====
// *
this._dlaqr0.Run(WANTT, WANTZ, N, ILO, IHI, ref H, offset_h
, LDH, ref WR, offset_wr, ref WI, offset_wi, ILO, IHI, ref Z, offset_z
, LDZ, ref WORK, offset_work, LWORK, ref INFO);
// * ==== Ensure reported workspace size is backward-compatible with
// * . previous LAPACK versions. ====
WORK[1 + o_work] = Math.Max(Convert.ToDouble(Math.Max(1, N)), WORK[1 + o_work]);
return;
// *
}
else
{
// *
// * ==== copy eigenvalues isolated by DGEBAL ====
// *
for (I = 1; I <= ILO - 1; I++)
{
WR[I + o_wr] = H[I + I * LDH + o_h];
WI[I + o_wi] = ZERO;
}
for (I = IHI + 1; I <= N; I++)
{
WR[I + o_wr] = H[I + I * LDH + o_h];
WI[I + o_wi] = ZERO;
}
// *
// * ==== Initialize Z, if requested ====
// *
if (INITZ)
{
this._dlaset.Run("A", N, N, ZERO, ONE, ref Z, offset_z
, LDZ);
}
// *
// * ==== Quick return if possible ====
// *
if (ILO == IHI)
{
WR[ILO + o_wr] = H[ILO + ILO * LDH + o_h];
WI[ILO + o_wi] = ZERO;
return;
}
// *
// * ==== DLAHQR/DLAQR0 crossover point ====
// *
NMIN = this._ilaenv.Run(12, "DHSEQR", FortranLib.Substring(JOB, 1, 1) + FortranLib.Substring(COMPZ, 1, 1), N, ILO, IHI, LWORK);
NMIN = Math.Max(NTINY, NMIN);
// *
// * ==== DLAQR0 for big matrices; DLAHQR for small ones ====
// *
if (N > NMIN)
{
this._dlaqr0.Run(WANTT, WANTZ, N, ILO, IHI, ref H, offset_h
, LDH, ref WR, offset_wr, ref WI, offset_wi, ILO, IHI, ref Z, offset_z
, LDZ, ref WORK, offset_work, LWORK, ref INFO);
}
else
{
// *
// * ==== Small matrix ====
// *
this._dlahqr.Run(WANTT, WANTZ, N, ILO, IHI, ref H, offset_h
, LDH, ref WR, offset_wr, ref WI, offset_wi, ILO, IHI, ref Z, offset_z
, LDZ, ref INFO);
// *
if (INFO > 0)
{
// *
// * ==== A rare DLAHQR failure! DLAQR0 sometimes succeeds
// * . when DLAHQR fails. ====
// *
KBOT = INFO;
// *
if (N >= NL)
{
// *
// * ==== Larger matrices have enough subdiagonal scratch
// * . space to call DLAQR0 directly. ====
// *
this._dlaqr0.Run(WANTT, WANTZ, N, ILO, KBOT, ref H, offset_h
, LDH, ref WR, offset_wr, ref WI, offset_wi, ILO, IHI, ref Z, offset_z
, LDZ, ref WORK, offset_work, LWORK, ref INFO);
// *
}
else
{
// *
// * ==== Tiny matrices don't have enough subdiagonal
// * . scratch space to benefit from DLAQR0. Hence,
// * . tiny matrices must be copied into a larger
// * . array before calling DLAQR0. ====
// *
this._dlacpy.Run("A", N, N, H, offset_h, LDH, ref HL, offset_hl
, NL);
HL[N + 1 + N * NL + o_hl] = ZERO;
this._dlaset.Run("A", NL, NL - N, ZERO, ZERO, ref HL, 1 + (N + 1) * NL + o_hl
, NL);
this._dlaqr0.Run(WANTT, WANTZ, NL, ILO, KBOT, ref HL, offset_hl
, NL, ref WR, offset_wr, ref WI, offset_wi, ILO, IHI, ref Z, offset_z
, LDZ, ref WORKL, offset_workl, NL, ref INFO);
if (WANTT || INFO != 0)
{
this._dlacpy.Run("A", N, N, HL, offset_hl, NL, ref H, offset_h
, LDH);
}
}
}
}
// *
// * ==== Clear out the trash, if necessary. ====
// *
if ((WANTT || INFO != 0) && N > 2)
{
this._dlaset.Run("L", N - 2, N - 2, ZERO, ZERO, ref H, 3 + 1 * LDH + o_h
, LDH);
}
// *
// * ==== Ensure reported workspace size is backward-compatible with
// * . previous LAPACK versions. ====
// *
WORK[1 + o_work] = Math.Max(Convert.ToDouble(Math.Max(1, N)), WORK[1 + o_work]);
}
}
}
// *
// * ==== End of DHSEQR ====
// *
#endregion
}