dlahd2.c
Go to the documentation of this file.
00001 /* dlahd2.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static integer c__1 = 1;
00019 static integer c__2 = 2;
00020 
00021 /* Subroutine */ int dlahd2_(integer *iounit, char *path)
00022 {
00023     /* Format strings */
00024     static char fmt_9999[] = "(1x,a3,\002:  no header available\002)";
00025     static char fmt_9998[] = "(/1x,a3,\002 -- Real Non-symmetric eigenvalue "
00026             "problem\002)";
00027     static char fmt_9988[] = "(\002 Matrix types (see xCHKHS for details):"
00028             " \002)";
00029     static char fmt_9987[] = "(/\002 Special Matrices:\002,/\002  1=Zero mat"
00030             "rix.             \002,\002           \002,\002  5=Diagonal: geom"
00031             "etr. spaced entries.\002,/\002  2=Identity matrix.              "
00032             "      \002,\002  6=Diagona\002,\002l: clustered entries.\002,"
00033             "/\002  3=Transposed Jordan block.  \002,\002          \002,\002 "
00034             " 7=Diagonal: large, evenly spaced.\002,/\002  \002,\0024=Diagona"
00035             "l: evenly spaced entries.    \002,\002  8=Diagonal: s\002,\002ma"
00036             "ll, evenly spaced.\002)";
00037     static char fmt_9986[] = "(\002 Dense, Non-Symmetric Matrices:\002,/\002"
00038             "  9=Well-cond., ev\002,\002enly spaced eigenvals.\002,\002 14=Il"
00039             "l-cond., geomet. spaced e\002,\002igenals.\002,/\002 10=Well-con"
00040             "d., geom. spaced eigenvals. \002,\002 15=Ill-conditioned, cluste"
00041             "red e.vals.\002,/\002 11=Well-cond\002,\002itioned, clustered e."
00042             "vals. \002,\002 16=Ill-cond., random comp\002,\002lex \002,a6,"
00043             "/\002 12=Well-cond., random complex \002,a6,\002   \002,\002 17="
00044             "Ill-cond., large rand. complx \002,a4,/\002 13=Ill-condi\002,"
00045             "\002tioned, evenly spaced.     \002,\002 18=Ill-cond., small ran"
00046             "d.\002,\002 complx \002,a4)";
00047     static char fmt_9985[] = "(\002 19=Matrix with random O(1) entries.   "
00048             " \002,\002 21=Matrix \002,\002with small random entries.\002,"
00049             "/\002 20=Matrix with large ran\002,\002dom entries.   \002)";
00050     static char fmt_9984[] = "(/\002 Tests performed:   \002,\002(H is Hesse"
00051             "nberg, T is Schur,\002,\002 U and Z are \002,a,\002,\002,/20x,a"
00052             ",\002, W is a diagonal matr\002,\002ix of eigenvalues,\002,/20x"
00053             ",\002L and R are the left and rig\002,\002ht eigenvector matrice"
00054             "s)\002,/\002  1 = | A - U H U\002,a1,\002 |\002,\002 / ( |A| n u"
00055             "lp )         \002,\002  2 = | I - U U\002,a1,\002 | / \002,\002("
00056             " n ulp )\002,/\002  3 = | H - Z T Z\002,a1,\002 | / ( |H| n ulp"
00057             " \002,\002)         \002,\002  4 = | I - Z Z\002,a1,\002 | / ( n"
00058             " ulp )\002,/\002  5 = | A - UZ T (UZ)\002,a1,\002 | / ( |A| n ul"
00059             "p )     \002,\002  6 = | I - UZ (UZ)\002,a1,\002 | / ( n ulp "
00060             ")\002,/\002  7 = | T(\002,\002e.vects.) - T(no e.vects.) | / ( |"
00061             "T| ulp )\002,/\002  8 = | W\002,\002(e.vects.) - W(no e.vects.) "
00062             "| / ( |W| ulp )\002,/\002  9 = | \002,\002TR - RW | / ( |T| |R| "
00063             "ulp )     \002,\002 10 = | LT - WL | / (\002,\002 |T| |L| ulp "
00064             ")\002,/\002 11= |HX - XW| / (|H| |X| ulp)  (inv.\002,\002it)\002,"
00065             "\002 12= |YH - WY| / (|H| |Y| ulp)  (inv.it)\002)";
00066     static char fmt_9997[] = "(/1x,a3,\002 -- Complex Non-symmetric eigenval"
00067             "ue problem\002)";
00068     static char fmt_9996[] = "(/1x,a3,\002 -- Real Symmetric eigenvalue prob"
00069             "lem\002)";
00070     static char fmt_9983[] = "(\002 Matrix types (see xDRVST for details):"
00071             " \002)";
00072     static char fmt_9982[] = "(/\002 Special Matrices:\002,/\002  1=Zero mat"
00073             "rix.             \002,\002           \002,\002  5=Diagonal: clus"
00074             "tered entries.\002,/\002  2=\002,\002Identity matrix.           "
00075             "         \002,\002  6=Diagonal: lar\002,\002ge, evenly spaced"
00076             ".\002,/\002  3=Diagonal: evenly spaced entri\002,\002es.    \002,"
00077             "\002  7=Diagonal: small, evenly spaced.\002,/\002  4=D\002,\002i"
00078             "agonal: geometr. spaced entries.\002)";
00079     static char fmt_9981[] = "(\002 Dense \002,a,\002 Matrices:\002,/\002  8"
00080             "=Evenly spaced eigen\002,\002vals.            \002,\002 12=Small"
00081             ", evenly spaced eigenvals.\002,/\002  9=Geometrically spaced eig"
00082             "envals.     \002,\002 13=Matrix \002,\002with random O(1) entrie"
00083             "s.\002,/\002 10=Clustered eigenvalues.\002,\002              "
00084             "\002,\002 14=Matrix with large random entries.\002,/\002 11=Larg"
00085             "e, evenly spaced eigenvals.     \002,\002 15=Matrix \002,\002wit"
00086             "h small random entries.\002)";
00087     static char fmt_9968[] = "(/\002 Tests performed:  See sdrvst.f\002)";
00088     static char fmt_9995[] = "(/1x,a3,\002 -- Complex Hermitian eigenvalue p"
00089             "roblem\002)";
00090     static char fmt_9967[] = "(/\002 Tests performed:  See cdrvst.f\002)";
00091     static char fmt_9992[] = "(/1x,a3,\002 -- Real Symmetric Generalized eig"
00092             "envalue \002,\002problem\002)";
00093     static char fmt_9980[] = "(\002 Matrix types (see xDRVSG for details):"
00094             " \002)";
00095     static char fmt_9979[] = "(/\002 Special Matrices:\002,/\002  1=Zero mat"
00096             "rix.             \002,\002           \002,\002  5=Diagonal: clus"
00097             "tered entries.\002,/\002  2=\002,\002Identity matrix.           "
00098             "         \002,\002  6=Diagonal: lar\002,\002ge, evenly spaced"
00099             ".\002,/\002  3=Diagonal: evenly spaced entri\002,\002es.    \002,"
00100             "\002  7=Diagonal: small, evenly spaced.\002,/\002  4=D\002,\002i"
00101             "agonal: geometr. spaced entries.\002)";
00102     static char fmt_9978[] = "(\002 Dense or Banded \002,a,\002 Matrices:"
00103             " \002,/\002  8=Evenly spaced eigenvals.         \002,\002 15=Mat"
00104             "rix with small random entries.\002,/\002  9=Geometrically spaced"
00105             " eigenvals.  \002,\002 16=Evenly spaced eigenvals, KA=1, KB=1"
00106             ".\002,/\002 10=Clustered eigenvalues.           \002,\002 17=Eve"
00107             "nly spaced eigenvals, KA=2, KB=1.\002,/\002 11=Large, evenly spa"
00108             "ced eigenvals.  \002,\002 18=Evenly spaced eigenvals, KA=2, KB=2."
00109             "\002,/\002 12=Small, evenly spaced eigenvals.  \002,\002 19=Even"
00110             "ly spaced eigenvals, KA=3, KB=1.\002,/\002 13=Matrix with random"
00111             " O(1) entries. \002,\002 20=Evenly spaced eigenvals, KA=3, KB=2"
00112             ".\002,/\002 14=Matrix with large random entries.\002,\002 21=Eve"
00113             "nly spaced eigenvals, KA=3, KB=3.\002)";
00114     static char fmt_9977[] = "(/\002 Tests performed:   \002,/\002( For each"
00115             " pair (A,B), where A is of the given type \002,/\002 and B is a "
00116             "random well-conditioned matrix. D is \002,/\002 diagonal, and Z "
00117             "is orthogonal. )\002,/\002 1 = DSYGV, with ITYPE=1 and UPLO='U'"
00118             ":\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     \002,/\002 2"
00119             " = DSPGV, with ITYPE=1 and UPLO='U':\002,\002  | A Z - B Z D | /"
00120             " ( |A| |Z| n ulp )     \002,/\002 3 = DSBGV, with ITYPE=1 and UP"
00121             "LO='U':\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     \002,"
00122             "/\002 4 = DSYGV, with ITYPE=1 and UPLO='L':\002,\002  | A Z - B "
00123             "Z D | / ( |A| |Z| n ulp )     \002,/\002 5 = DSPGV, with ITYPE=1"
00124             " and UPLO='L':\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     "
00125             "\002,/\002 6 = DSBGV, with ITYPE=1 and UPLO='L':\002,\002  | A Z"
00126             " - B Z D | / ( |A| |Z| n ulp )     \002)";
00127     static char fmt_9976[] = "(\002 7 = DSYGV, with ITYPE=2 and UPLO='U':"
00128             "\002,\002  | A B Z - Z D | / ( |A| |Z| n ulp )     \002,/\002 8 "
00129             "= DSPGV, with ITYPE=2 and UPLO='U':\002,\002  | A B Z - Z D | / "
00130             "( |A| |Z| n ulp )     \002,/\002 9 = DSPGV, with ITYPE=2 and UPL"
00131             "O='L':\002,\002  | A B Z - Z D | / ( |A| |Z| n ulp )     \002,"
00132             "/\00210 = DSPGV, with ITYPE=2 and UPLO='L':\002,\002  | A B Z - "
00133             "Z D | / ( |A| |Z| n ulp )     \002,/\00211 = DSYGV, with ITYPE=3"
00134             " and UPLO='U':\002,\002  | B A Z - Z D | / ( |A| |Z| n ulp )     "
00135             "\002,/\00212 = DSPGV, with ITYPE=3 and UPLO='U':\002,\002  | B A"
00136             " Z - Z D | / ( |A| |Z| n ulp )     \002,/\00213 = DSYGV, with IT"
00137             "YPE=3 and UPLO='L':\002,\002  | B A Z - Z D | / ( |A| |Z| n ulp "
00138             ")     \002,/\00214 = DSPGV, with ITYPE=3 and UPLO='L':\002,\002 "
00139             " | B A Z - Z D | / ( |A| |Z| n ulp )     \002)";
00140     static char fmt_9991[] = "(/1x,a3,\002 -- Complex Hermitian Generalized "
00141             "eigenvalue \002,\002problem\002)";
00142     static char fmt_9975[] = "(/\002 Tests performed:   \002,/\002( For each"
00143             " pair (A,B), where A is of the given type \002,/\002 and B is a "
00144             "random well-conditioned matrix. D is \002,/\002 diagonal, and Z "
00145             "is unitary. )\002,/\002 1 = ZHEGV, with ITYPE=1 and UPLO='U':"
00146             "\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     \002,/\002 2 "
00147             "= ZHPGV, with ITYPE=1 and UPLO='U':\002,\002  | A Z - B Z D | / "
00148             "( |A| |Z| n ulp )     \002,/\002 3 = ZHBGV, with ITYPE=1 and UPL"
00149             "O='U':\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     \002,"
00150             "/\002 4 = ZHEGV, with ITYPE=1 and UPLO='L':\002,\002  | A Z - B "
00151             "Z D | / ( |A| |Z| n ulp )     \002,/\002 5 = ZHPGV, with ITYPE=1"
00152             " and UPLO='L':\002,\002  | A Z - B Z D | / ( |A| |Z| n ulp )     "
00153             "\002,/\002 6 = ZHBGV, with ITYPE=1 and UPLO='L':\002,\002  | A Z"
00154             " - B Z D | / ( |A| |Z| n ulp )     \002)";
00155     static char fmt_9974[] = "(\002 7 = ZHEGV, with ITYPE=2 and UPLO='U':"
00156             "\002,\002  | A B Z - Z D | / ( |A| |Z| n ulp )     \002,/\002 8 "
00157             "= ZHPGV, with ITYPE=2 and UPLO='U':\002,\002  | A B Z - Z D | / "
00158             "( |A| |Z| n ulp )     \002,/\002 9 = ZHPGV, with ITYPE=2 and UPL"
00159             "O='L':\002,\002  | A B Z - Z D | / ( |A| |Z| n ulp )     \002,"
00160             "/\00210 = ZHPGV, with ITYPE=2 and UPLO='L':\002,\002  | A B Z - "
00161             "Z D | / ( |A| |Z| n ulp )     \002,/\00211 = ZHEGV, with ITYPE=3"
00162             " and UPLO='U':\002,\002  | B A Z - Z D | / ( |A| |Z| n ulp )     "
00163             "\002,/\00212 = ZHPGV, with ITYPE=3 and UPLO='U':\002,\002  | B A"
00164             " Z - Z D | / ( |A| |Z| n ulp )     \002,/\00213 = ZHEGV, with IT"
00165             "YPE=3 and UPLO='L':\002,\002  | B A Z - Z D | / ( |A| |Z| n ulp "
00166             ")     \002,/\00214 = ZHPGV, with ITYPE=3 and UPLO='L':\002,\002 "
00167             " | B A Z - Z D | / ( |A| |Z| n ulp )     \002)";
00168     static char fmt_9994[] = "(/1x,a3,\002 -- Real Singular Value Decomposit"
00169             "ion\002)";
00170     static char fmt_9973[] = "(\002 Matrix types (see xCHKBD for details)"
00171             ":\002,/\002 Diagonal matrices:\002,/\002   1: Zero\002,28x,\002 "
00172             "5: Clustered entries\002,/\002   2: Identity\002,24x,\002 6: Lar"
00173             "ge, evenly spaced entries\002,/\002   3: Evenly spaced entrie"
00174             "s\002,11x,\002 7: Small, evenly spaced entries\002,/\002   4: Ge"
00175             "ometrically spaced entries\002,/\002 General matrices:\002,/\002"
00176             "   8: Evenly spaced sing. vals.\002,7x,\00212: Small, evenly spa"
00177             "ced sing vals\002,/\002   9: Geometrically spaced sing vals  "
00178             "\002,\00213: Random, O(1) entries\002,/\002  10: Clustered sing."
00179             " vals.\002,11x,\00214: Random, scaled near overflow\002,/\002  1"
00180             "1: Large, evenly spaced sing vals  \002,\00215: Random, scaled n"
00181             "ear underflow\002)";
00182     static char fmt_9972[] = "(/\002 Test ratios:  \002,\002(B: bidiagonal, "
00183             "S: diagonal, Q, P, U, and V: \002,a10,/16x,\002X: m x nrhs, Y = "
00184             "Q' X, and Z = U' Y)\002,/\002   1: norm( A - Q B P' ) / ( norm(A"
00185             ") max(m,n) ulp )\002,/\002   2: norm( I - Q' Q )   / ( m ulp "
00186             ")\002,/\002   3: norm( I - P' P )   / ( n ulp )\002,/\002   4: n"
00187             "orm( B - U S V' ) / ( norm(B) min(m,n) ulp )\002,/\002   5: norm"
00188             "( Y - U Z )    / ( norm(Z) max(min(m,n),k) ulp )\002,/\002   6: "
00189             "norm( I - U' U )   / ( min(m,n) ulp )\002,/\002   7: norm( I - V"
00190             "' V )   / ( min(m,n) ulp )\002)";
00191     static char fmt_9971[] = "(\002   8: Test ordering of S  (0 if nondecrea"
00192             "sing, 1/ulp \002,\002 otherwise)\002,/\002   9: norm( S - S2 )  "
00193             "   / ( norm(S) ulp ),\002,\002 where S2 is computed\002,/44x,"
00194             "\002without computing U and V'\002,/\002  10: Sturm sequence tes"
00195             "t \002,\002(0 if sing. vals of B within THRESH of S)\002,/\002  "
00196             "11: norm( A - (QU) S (V' P') ) / \002,\002( norm(A) max(m,n) ulp"
00197             " )\002,/\002  12: norm( X - (QU) Z )         / ( |X| max(M,k) ul"
00198             "p )\002,/\002  13: norm( I - (QU)'(QU) )      / ( M ulp )\002,"
00199             "/\002  14: norm( I - (V' P') (P V) )  / ( N ulp )\002)";
00200     static char fmt_9993[] = "(/1x,a3,\002 -- Complex Singular Value Decompo"
00201             "sition\002)";
00202     static char fmt_9990[] = "(/1x,a3,\002 -- Real Band reduc. to bidiagonal"
00203             " form\002)";
00204     static char fmt_9970[] = "(\002 Matrix types (see xCHKBB for details)"
00205             ":\002,/\002 Diagonal matrices:\002,/\002   1: Zero\002,28x,\002 "
00206             "5: Clustered entries\002,/\002   2: Identity\002,24x,\002 6: Lar"
00207             "ge, evenly spaced entries\002,/\002   3: Evenly spaced entrie"
00208             "s\002,11x,\002 7: Small, evenly spaced entries\002,/\002   4: Ge"
00209             "ometrically spaced entries\002,/\002 General matrices:\002,/\002"
00210             "   8: Evenly spaced sing. vals.\002,7x,\00212: Small, evenly spa"
00211             "ced sing vals\002,/\002   9: Geometrically spaced sing vals  "
00212             "\002,\00213: Random, O(1) entries\002,/\002  10: Clustered sing."
00213             " vals.\002,11x,\00214: Random, scaled near overflow\002,/\002  1"
00214             "1: Large, evenly spaced sing vals  \002,\00215: Random, scaled n"
00215             "ear underflow\002)";
00216     static char fmt_9969[] = "(/\002 Test ratios:  \002,\002(B: upper bidiag"
00217             "onal, Q and P: \002,a10,/16x,\002C: m x nrhs, PT = P', Y = Q' C"
00218             ")\002,/\002 1: norm( A - Q B PT ) / ( norm(A) max(m,n) ulp )\002"
00219             ",/\002 2: norm( I - Q' Q )   / ( m ulp )\002,/\002 3: norm( I - "
00220             "PT PT' )   / ( n ulp )\002,/\002 4: norm( Y - Q' C )   / ( norm("
00221             "Y) max(m,nrhs) ulp )\002)";
00222     static char fmt_9989[] = "(/1x,a3,\002 -- Complex Band reduc. to bidiago"
00223             "nal form\002)";
00224 
00225     /* Builtin functions */
00226     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00227     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00228 
00229     /* Local variables */
00230     integer j;
00231     char c2[2];
00232     logical sord, corz;
00233     extern logical lsame_(char *, char *), lsamen_(integer *, 
00234             char *, char *);
00235 
00236     /* Fortran I/O blocks */
00237     static cilist io___3 = { 0, 0, 0, fmt_9999, 0 };
00238     static cilist io___5 = { 0, 0, 0, fmt_9998, 0 };
00239     static cilist io___6 = { 0, 0, 0, fmt_9988, 0 };
00240     static cilist io___7 = { 0, 0, 0, fmt_9987, 0 };
00241     static cilist io___8 = { 0, 0, 0, fmt_9986, 0 };
00242     static cilist io___9 = { 0, 0, 0, fmt_9985, 0 };
00243     static cilist io___10 = { 0, 0, 0, fmt_9984, 0 };
00244     static cilist io___12 = { 0, 0, 0, fmt_9997, 0 };
00245     static cilist io___13 = { 0, 0, 0, fmt_9988, 0 };
00246     static cilist io___14 = { 0, 0, 0, fmt_9987, 0 };
00247     static cilist io___15 = { 0, 0, 0, fmt_9986, 0 };
00248     static cilist io___16 = { 0, 0, 0, fmt_9985, 0 };
00249     static cilist io___17 = { 0, 0, 0, fmt_9984, 0 };
00250     static cilist io___18 = { 0, 0, 0, fmt_9996, 0 };
00251     static cilist io___19 = { 0, 0, 0, fmt_9983, 0 };
00252     static cilist io___20 = { 0, 0, 0, fmt_9982, 0 };
00253     static cilist io___21 = { 0, 0, 0, fmt_9981, 0 };
00254     static cilist io___22 = { 0, 0, 0, fmt_9968, 0 };
00255     static cilist io___23 = { 0, 0, 0, fmt_9995, 0 };
00256     static cilist io___24 = { 0, 0, 0, fmt_9983, 0 };
00257     static cilist io___25 = { 0, 0, 0, fmt_9982, 0 };
00258     static cilist io___26 = { 0, 0, 0, fmt_9981, 0 };
00259     static cilist io___27 = { 0, 0, 0, fmt_9967, 0 };
00260     static cilist io___28 = { 0, 0, 0, fmt_9992, 0 };
00261     static cilist io___29 = { 0, 0, 0, fmt_9980, 0 };
00262     static cilist io___30 = { 0, 0, 0, fmt_9979, 0 };
00263     static cilist io___31 = { 0, 0, 0, fmt_9978, 0 };
00264     static cilist io___32 = { 0, 0, 0, fmt_9977, 0 };
00265     static cilist io___33 = { 0, 0, 0, fmt_9976, 0 };
00266     static cilist io___34 = { 0, 0, 0, fmt_9991, 0 };
00267     static cilist io___35 = { 0, 0, 0, fmt_9980, 0 };
00268     static cilist io___36 = { 0, 0, 0, fmt_9979, 0 };
00269     static cilist io___37 = { 0, 0, 0, fmt_9978, 0 };
00270     static cilist io___38 = { 0, 0, 0, fmt_9975, 0 };
00271     static cilist io___39 = { 0, 0, 0, fmt_9974, 0 };
00272     static cilist io___40 = { 0, 0, 0, fmt_9994, 0 };
00273     static cilist io___41 = { 0, 0, 0, fmt_9973, 0 };
00274     static cilist io___42 = { 0, 0, 0, fmt_9972, 0 };
00275     static cilist io___43 = { 0, 0, 0, fmt_9971, 0 };
00276     static cilist io___44 = { 0, 0, 0, fmt_9993, 0 };
00277     static cilist io___45 = { 0, 0, 0, fmt_9973, 0 };
00278     static cilist io___46 = { 0, 0, 0, fmt_9972, 0 };
00279     static cilist io___47 = { 0, 0, 0, fmt_9971, 0 };
00280     static cilist io___48 = { 0, 0, 0, fmt_9990, 0 };
00281     static cilist io___49 = { 0, 0, 0, fmt_9970, 0 };
00282     static cilist io___50 = { 0, 0, 0, fmt_9969, 0 };
00283     static cilist io___51 = { 0, 0, 0, fmt_9989, 0 };
00284     static cilist io___52 = { 0, 0, 0, fmt_9970, 0 };
00285     static cilist io___53 = { 0, 0, 0, fmt_9969, 0 };
00286     static cilist io___54 = { 0, 0, 0, fmt_9999, 0 };
00287 
00288 
00289 
00290 /*  -- LAPACK auxiliary test routine (version 2.0) -- */
00291 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00292 /*     November 2006 */
00293 
00294 /*     .. Scalar Arguments .. */
00295 /*     .. */
00296 
00297 /*  Purpose */
00298 /*  ======= */
00299 
00300 /*  DLAHD2 prints header information for the different test paths. */
00301 
00302 /*  Arguments */
00303 /*  ========= */
00304 
00305 /*  IOUNIT  (input) INTEGER. */
00306 /*          On entry, IOUNIT specifies the unit number to which the */
00307 /*          header information should be printed. */
00308 
00309 /*  PATH    (input) CHARACTER*3. */
00310 /*          On entry, PATH contains the name of the path for which the */
00311 /*          header information is to be printed.  Current paths are */
00312 
00313 /*             DHS, ZHS:  Non-symmetric eigenproblem. */
00314 /*             DST, ZST:  Symmetric eigenproblem. */
00315 /*             DSG, ZSG:  Symmetric Generalized eigenproblem. */
00316 /*             DBD, ZBD:  Singular Value Decomposition (SVD) */
00317 /*             DBB, ZBB:  General Banded reduction to bidiagonal form */
00318 
00319 /*          These paths also are supplied in double precision (replace */
00320 /*          leading S by D and leading C by Z in path names). */
00321 
00322 /*  ===================================================================== */
00323 
00324 /*     .. Local Scalars .. */
00325 /*     .. */
00326 /*     .. External Functions .. */
00327 /*     .. */
00328 /*     .. Executable Statements .. */
00329 
00330     if (*iounit <= 0) {
00331         return 0;
00332     }
00333     sord = lsame_(path, "S") || lsame_(path, "D");
00334     corz = lsame_(path, "C") || lsame_(path, "Z");
00335     if (! sord && ! corz) {
00336         io___3.ciunit = *iounit;
00337         s_wsfe(&io___3);
00338         do_fio(&c__1, path, (ftnlen)3);
00339         e_wsfe();
00340     }
00341     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00342 
00343     if (lsamen_(&c__2, c2, "HS")) {
00344         if (sord) {
00345 
00346 /*           Real Non-symmetric Eigenvalue Problem: */
00347 
00348             io___5.ciunit = *iounit;
00349             s_wsfe(&io___5);
00350             do_fio(&c__1, path, (ftnlen)3);
00351             e_wsfe();
00352 
00353 /*           Matrix types */
00354 
00355             io___6.ciunit = *iounit;
00356             s_wsfe(&io___6);
00357             e_wsfe();
00358             io___7.ciunit = *iounit;
00359             s_wsfe(&io___7);
00360             e_wsfe();
00361             io___8.ciunit = *iounit;
00362             s_wsfe(&io___8);
00363             do_fio(&c__1, "pairs ", (ftnlen)6);
00364             do_fio(&c__1, "pairs ", (ftnlen)6);
00365             do_fio(&c__1, "prs.", (ftnlen)4);
00366             do_fio(&c__1, "prs.", (ftnlen)4);
00367             e_wsfe();
00368             io___9.ciunit = *iounit;
00369             s_wsfe(&io___9);
00370             e_wsfe();
00371 
00372 /*           Tests performed */
00373 
00374             io___10.ciunit = *iounit;
00375             s_wsfe(&io___10);
00376             do_fio(&c__1, "orthogonal", (ftnlen)10);
00377             do_fio(&c__1, "'=transpose", (ftnlen)11);
00378             for (j = 1; j <= 6; ++j) {
00379                 do_fio(&c__1, "'", (ftnlen)1);
00380             }
00381             e_wsfe();
00382 
00383         } else {
00384 
00385 /*           Complex Non-symmetric Eigenvalue Problem: */
00386 
00387             io___12.ciunit = *iounit;
00388             s_wsfe(&io___12);
00389             do_fio(&c__1, path, (ftnlen)3);
00390             e_wsfe();
00391 
00392 /*           Matrix types */
00393 
00394             io___13.ciunit = *iounit;
00395             s_wsfe(&io___13);
00396             e_wsfe();
00397             io___14.ciunit = *iounit;
00398             s_wsfe(&io___14);
00399             e_wsfe();
00400             io___15.ciunit = *iounit;
00401             s_wsfe(&io___15);
00402             do_fio(&c__1, "e.vals", (ftnlen)6);
00403             do_fio(&c__1, "e.vals", (ftnlen)6);
00404             do_fio(&c__1, "e.vs", (ftnlen)4);
00405             do_fio(&c__1, "e.vs", (ftnlen)4);
00406             e_wsfe();
00407             io___16.ciunit = *iounit;
00408             s_wsfe(&io___16);
00409             e_wsfe();
00410 
00411 /*           Tests performed */
00412 
00413             io___17.ciunit = *iounit;
00414             s_wsfe(&io___17);
00415             do_fio(&c__1, "unitary", (ftnlen)7);
00416             do_fio(&c__1, "*=conj.transp.", (ftnlen)14);
00417             for (j = 1; j <= 6; ++j) {
00418                 do_fio(&c__1, "*", (ftnlen)1);
00419             }
00420             e_wsfe();
00421         }
00422 
00423     } else if (lsamen_(&c__2, c2, "ST")) {
00424 
00425         if (sord) {
00426 
00427 /*           Real Symmetric Eigenvalue Problem: */
00428 
00429             io___18.ciunit = *iounit;
00430             s_wsfe(&io___18);
00431             do_fio(&c__1, path, (ftnlen)3);
00432             e_wsfe();
00433 
00434 /*           Matrix types */
00435 
00436             io___19.ciunit = *iounit;
00437             s_wsfe(&io___19);
00438             e_wsfe();
00439             io___20.ciunit = *iounit;
00440             s_wsfe(&io___20);
00441             e_wsfe();
00442             io___21.ciunit = *iounit;
00443             s_wsfe(&io___21);
00444             do_fio(&c__1, "Symmetric", (ftnlen)9);
00445             e_wsfe();
00446 
00447 /*           Tests performed */
00448 
00449             io___22.ciunit = *iounit;
00450             s_wsfe(&io___22);
00451             e_wsfe();
00452 
00453         } else {
00454 
00455 /*           Complex Hermitian Eigenvalue Problem: */
00456 
00457             io___23.ciunit = *iounit;
00458             s_wsfe(&io___23);
00459             do_fio(&c__1, path, (ftnlen)3);
00460             e_wsfe();
00461 
00462 /*           Matrix types */
00463 
00464             io___24.ciunit = *iounit;
00465             s_wsfe(&io___24);
00466             e_wsfe();
00467             io___25.ciunit = *iounit;
00468             s_wsfe(&io___25);
00469             e_wsfe();
00470             io___26.ciunit = *iounit;
00471             s_wsfe(&io___26);
00472             do_fio(&c__1, "Hermitian", (ftnlen)9);
00473             e_wsfe();
00474 
00475 /*           Tests performed */
00476 
00477             io___27.ciunit = *iounit;
00478             s_wsfe(&io___27);
00479             e_wsfe();
00480         }
00481 
00482     } else if (lsamen_(&c__2, c2, "SG")) {
00483 
00484         if (sord) {
00485 
00486 /*           Real Symmetric Generalized Eigenvalue Problem: */
00487 
00488             io___28.ciunit = *iounit;
00489             s_wsfe(&io___28);
00490             do_fio(&c__1, path, (ftnlen)3);
00491             e_wsfe();
00492 
00493 /*           Matrix types */
00494 
00495             io___29.ciunit = *iounit;
00496             s_wsfe(&io___29);
00497             e_wsfe();
00498             io___30.ciunit = *iounit;
00499             s_wsfe(&io___30);
00500             e_wsfe();
00501             io___31.ciunit = *iounit;
00502             s_wsfe(&io___31);
00503             do_fio(&c__1, "Symmetric", (ftnlen)9);
00504             e_wsfe();
00505 
00506 /*           Tests performed */
00507 
00508             io___32.ciunit = *iounit;
00509             s_wsfe(&io___32);
00510             e_wsfe();
00511             io___33.ciunit = *iounit;
00512             s_wsfe(&io___33);
00513             e_wsfe();
00514 
00515         } else {
00516 
00517 /*           Complex Hermitian Generalized Eigenvalue Problem: */
00518 
00519             io___34.ciunit = *iounit;
00520             s_wsfe(&io___34);
00521             do_fio(&c__1, path, (ftnlen)3);
00522             e_wsfe();
00523 
00524 /*           Matrix types */
00525 
00526             io___35.ciunit = *iounit;
00527             s_wsfe(&io___35);
00528             e_wsfe();
00529             io___36.ciunit = *iounit;
00530             s_wsfe(&io___36);
00531             e_wsfe();
00532             io___37.ciunit = *iounit;
00533             s_wsfe(&io___37);
00534             do_fio(&c__1, "Hermitian", (ftnlen)9);
00535             e_wsfe();
00536 
00537 /*           Tests performed */
00538 
00539             io___38.ciunit = *iounit;
00540             s_wsfe(&io___38);
00541             e_wsfe();
00542             io___39.ciunit = *iounit;
00543             s_wsfe(&io___39);
00544             e_wsfe();
00545 
00546         }
00547 
00548     } else if (lsamen_(&c__2, c2, "BD")) {
00549 
00550         if (sord) {
00551 
00552 /*           Real Singular Value Decomposition: */
00553 
00554             io___40.ciunit = *iounit;
00555             s_wsfe(&io___40);
00556             do_fio(&c__1, path, (ftnlen)3);
00557             e_wsfe();
00558 
00559 /*           Matrix types */
00560 
00561             io___41.ciunit = *iounit;
00562             s_wsfe(&io___41);
00563             e_wsfe();
00564 
00565 /*           Tests performed */
00566 
00567             io___42.ciunit = *iounit;
00568             s_wsfe(&io___42);
00569             do_fio(&c__1, "orthogonal", (ftnlen)10);
00570             e_wsfe();
00571             io___43.ciunit = *iounit;
00572             s_wsfe(&io___43);
00573             e_wsfe();
00574         } else {
00575 
00576 /*           Complex Singular Value Decomposition: */
00577 
00578             io___44.ciunit = *iounit;
00579             s_wsfe(&io___44);
00580             do_fio(&c__1, path, (ftnlen)3);
00581             e_wsfe();
00582 
00583 /*           Matrix types */
00584 
00585             io___45.ciunit = *iounit;
00586             s_wsfe(&io___45);
00587             e_wsfe();
00588 
00589 /*           Tests performed */
00590 
00591             io___46.ciunit = *iounit;
00592             s_wsfe(&io___46);
00593             do_fio(&c__1, "unitary   ", (ftnlen)10);
00594             e_wsfe();
00595             io___47.ciunit = *iounit;
00596             s_wsfe(&io___47);
00597             e_wsfe();
00598         }
00599 
00600     } else if (lsamen_(&c__2, c2, "BB")) {
00601 
00602         if (sord) {
00603 
00604 /*           Real General Band reduction to bidiagonal form: */
00605 
00606             io___48.ciunit = *iounit;
00607             s_wsfe(&io___48);
00608             do_fio(&c__1, path, (ftnlen)3);
00609             e_wsfe();
00610 
00611 /*           Matrix types */
00612 
00613             io___49.ciunit = *iounit;
00614             s_wsfe(&io___49);
00615             e_wsfe();
00616 
00617 /*           Tests performed */
00618 
00619             io___50.ciunit = *iounit;
00620             s_wsfe(&io___50);
00621             do_fio(&c__1, "orthogonal", (ftnlen)10);
00622             e_wsfe();
00623         } else {
00624 
00625 /*           Complex Band reduction to bidiagonal form: */
00626 
00627             io___51.ciunit = *iounit;
00628             s_wsfe(&io___51);
00629             do_fio(&c__1, path, (ftnlen)3);
00630             e_wsfe();
00631 
00632 /*           Matrix types */
00633 
00634             io___52.ciunit = *iounit;
00635             s_wsfe(&io___52);
00636             e_wsfe();
00637 
00638 /*           Tests performed */
00639 
00640             io___53.ciunit = *iounit;
00641             s_wsfe(&io___53);
00642             do_fio(&c__1, "unitary   ", (ftnlen)10);
00643             e_wsfe();
00644         }
00645 
00646     } else {
00647 
00648         io___54.ciunit = *iounit;
00649         s_wsfe(&io___54);
00650         do_fio(&c__1, path, (ftnlen)3);
00651         e_wsfe();
00652         return 0;
00653     }
00654 
00655     return 0;
00656 
00657 
00658 
00659 
00660 /*     Symmetric/Hermitian eigenproblem */
00661 
00662 
00663 
00664 /*     Symmetric/Hermitian Generalized eigenproblem */
00665 
00666 
00667 
00668 /*     Singular Value Decomposition */
00669 
00670 
00671 
00672 /*     Band reduction to bidiagonal form */
00673 
00674 
00675 
00676 /*     End of DLAHD2 */
00677 
00678 } /* dlahd2_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:46