00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static integer c__1 = 1;
00019 static integer c__2 = 2;
00020
00021 int dlahd2_(integer *iounit, char *path)
00022 {
00023
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
00226 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00227 int s_copy(char *, char *, ftnlen, ftnlen);
00228
00229
00230 integer j;
00231 char c2[2];
00232 logical sord, corz;
00233 extern logical lsame_(char *, char *), lsamen_(integer *,
00234 char *, char *);
00235
00236
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
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
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
00347
00348 io___5.ciunit = *iounit;
00349 s_wsfe(&io___5);
00350 do_fio(&c__1, path, (ftnlen)3);
00351 e_wsfe();
00352
00353
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
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
00386
00387 io___12.ciunit = *iounit;
00388 s_wsfe(&io___12);
00389 do_fio(&c__1, path, (ftnlen)3);
00390 e_wsfe();
00391
00392
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
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
00428
00429 io___18.ciunit = *iounit;
00430 s_wsfe(&io___18);
00431 do_fio(&c__1, path, (ftnlen)3);
00432 e_wsfe();
00433
00434
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
00448
00449 io___22.ciunit = *iounit;
00450 s_wsfe(&io___22);
00451 e_wsfe();
00452
00453 } else {
00454
00455
00456
00457 io___23.ciunit = *iounit;
00458 s_wsfe(&io___23);
00459 do_fio(&c__1, path, (ftnlen)3);
00460 e_wsfe();
00461
00462
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
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
00487
00488 io___28.ciunit = *iounit;
00489 s_wsfe(&io___28);
00490 do_fio(&c__1, path, (ftnlen)3);
00491 e_wsfe();
00492
00493
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
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
00518
00519 io___34.ciunit = *iounit;
00520 s_wsfe(&io___34);
00521 do_fio(&c__1, path, (ftnlen)3);
00522 e_wsfe();
00523
00524
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
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
00553
00554 io___40.ciunit = *iounit;
00555 s_wsfe(&io___40);
00556 do_fio(&c__1, path, (ftnlen)3);
00557 e_wsfe();
00558
00559
00560
00561 io___41.ciunit = *iounit;
00562 s_wsfe(&io___41);
00563 e_wsfe();
00564
00565
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
00577
00578 io___44.ciunit = *iounit;
00579 s_wsfe(&io___44);
00580 do_fio(&c__1, path, (ftnlen)3);
00581 e_wsfe();
00582
00583
00584
00585 io___45.ciunit = *iounit;
00586 s_wsfe(&io___45);
00587 e_wsfe();
00588
00589
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
00605
00606 io___48.ciunit = *iounit;
00607 s_wsfe(&io___48);
00608 do_fio(&c__1, path, (ftnlen)3);
00609 e_wsfe();
00610
00611
00612
00613 io___49.ciunit = *iounit;
00614 s_wsfe(&io___49);
00615 e_wsfe();
00616
00617
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
00626
00627 io___51.ciunit = *iounit;
00628 s_wsfe(&io___51);
00629 do_fio(&c__1, path, (ftnlen)3);
00630 e_wsfe();
00631
00632
00633
00634 io___52.ciunit = *iounit;
00635 s_wsfe(&io___52);
00636 e_wsfe();
00637
00638
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
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671
00672
00673
00674
00675
00676
00677
00678 }