aladhd.c
Go to the documentation of this file.
00001 /* aladhd.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__2 = 2;
00019 static integer c__1 = 1;
00020 static integer c__3 = 3;
00021 static integer c__4 = 4;
00022 static integer c__5 = 5;
00023 static integer c__6 = 6;
00024 static integer c__7 = 7;
00025 
00026 /* Subroutine */ int aladhd_(integer *iounit, char *path)
00027 {
00028     /* Format strings */
00029     static char fmt_9999[] = "(/1x,a3,\002 drivers:  General dense matrice"
00030             "s\002)";
00031     static char fmt_9989[] = "(4x,\0021. Diagonal\002,24x,\0027. Last n/2 co"
00032             "lumns zero\002,/4x,\0022. Upper triangular\002,16x,\0028. Random"
00033             ", CNDNUM = sqrt(0.1/EPS)\002,/4x,\0023. Lower triangular\002,16x,"
00034             "\0029. Random, CNDNUM = 0.1/EPS\002,/4x,\0024. Random, CNDNUM = 2"
00035             "\002,13x,\00210. Scaled near underflow\002,/4x,\0025. First colu"
00036             "mn zero\002,14x,\00211. Scaled near overflow\002,/4x,\0026. Last"
00037             " column zero\002)";
00038     static char fmt_9981[] = "(3x,i2,\002: norm( L * U - A )  / ( N * norm(A"
00039             ") * EPS )\002)";
00040     static char fmt_9980[] = "(3x,i2,\002: norm( B - A * X )  / \002,\002( n"
00041             "orm(A) * norm(X) * EPS )\002)";
00042     static char fmt_9979[] = "(3x,i2,\002: norm( X - XACT )   / \002,\002( n"
00043             "orm(XACT) * CNDNUM * EPS )\002)";
00044     static char fmt_9978[] = "(3x,i2,\002: norm( X - XACT )   / \002,\002( n"
00045             "orm(XACT) * (error bound) )\002)";
00046     static char fmt_9977[] = "(3x,i2,\002: (backward error)   / EPS\002)";
00047     static char fmt_9976[] = "(3x,i2,\002: RCOND * CNDNUM - 1.0\002)";
00048     static char fmt_9972[] = "(3x,i2,\002: abs( WORK(1) - RPVGRW ) /\002,"
00049             "\002 ( max( WORK(1), RPVGRW ) * EPS )\002)";
00050     static char fmt_9998[] = "(/1x,a3,\002 drivers:  General band matrice"
00051             "s\002)";
00052     static char fmt_9988[] = "(4x,\0021. Random, CNDNUM = 2\002,14x,\0025. R"
00053             "andom, CNDNUM = sqrt(0.1/EPS)\002,/4x,\0022. First column zer"
00054             "o\002,15x,\0026. Random, CNDNUM = 0.1/EPS\002,/4x,\0023. Last co"
00055             "lumn zero\002,16x,\0027. Scaled near underflow\002,/4x,\0024. La"
00056             "st n/2 columns zero\002,11x,\0028. Scaled near overflow\002)";
00057     static char fmt_9997[] = "(/1x,a3,\002 drivers:  General tridiagonal\002)"
00058             ;
00059     static char fmt_9987[] = "(\002 Matrix types (1-6 have specified conditi"
00060             "on numbers):\002,/4x,\0021. Diagonal\002,24x,\0027. Random, unsp"
00061             "ecified CNDNUM\002,/4x,\0022. Random, CNDNUM = 2\002,14x,\0028. "
00062             "First column zero\002,/4x,\0023. Random, CNDNUM = sqrt(0.1/EPS"
00063             ")\002,2x,\0029. Last column zero\002,/4x,\0024. Random, CNDNUM ="
00064             " 0.1/EPS\002,7x,\00210. Last n/2 columns zero\002,/4x,\0025. Sca"
00065             "led near underflow\002,10x,\00211. Scaled near underflow\002,/4x,"
00066             "\0026. Scaled near overflow\002,11x,\00212. Scaled near overflo"
00067             "w\002)";
00068     static char fmt_9996[] = "(/1x,a3,\002 drivers:  \002,a9,\002 positive d"
00069             "efinite matrices\002)";
00070     static char fmt_9995[] = "(/1x,a3,\002 drivers:  \002,a9,\002 positive d"
00071             "efinite packed matrices\002)";
00072     static char fmt_9985[] = "(4x,\0021. Diagonal\002,24x,\0026. Random, CND"
00073             "NUM = sqrt(0.1/EPS)\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
00074             ",\0027. Random, CNDNUM = 0.1/EPS\002,/3x,\002*3. First row and c"
00075             "olumn zero\002,7x,\0028. Scaled near underflow\002,/3x,\002*4. L"
00076             "ast row and column zero\002,8x,\0029. Scaled near overflow\002,/"
00077             "3x,\002*5. Middle row and column zero\002,/3x,\002(* - tests err"
00078             "or exits from \002,a3,\002TRF, no test ratios are computed)\002)";
00079     static char fmt_9975[] = "(3x,i2,\002: norm( U' * U - A ) / ( N * norm(A"
00080             ") * EPS )\002,\002, or\002,/7x,\002norm( L * L' - A ) / ( N * no"
00081             "rm(A) * EPS )\002)";
00082     static char fmt_9994[] = "(/1x,a3,\002 drivers:  \002,a9,\002 positive d"
00083             "efinite band matrices\002)";
00084     static char fmt_9984[] = "(4x,\0021. Random, CNDNUM = 2\002,14x,\0025. R"
00085             "andom, CNDNUM = sqrt(0.1/EPS)\002,/3x,\002*2. First row and colu"
00086             "mn zero\002,7x,\0026. Random, CNDNUM = 0.1/EPS\002,/3x,\002*3. L"
00087             "ast row and column zero\002,8x,\0027. Scaled near underflow\002,"
00088             "/3x,\002*4. Middle row and column zero\002,6x,\0028. Scaled near"
00089             " overflow\002,/3x,\002(* - tests error exits from \002,a3,\002TR"
00090             "F, no test ratios are computed)\002)";
00091     static char fmt_9993[] = "(/1x,a3,\002 drivers:  \002,a9,\002 positive d"
00092             "efinite tridiagonal\002)";
00093     static char fmt_9986[] = "(\002 Matrix types (1-6 have specified conditi"
00094             "on numbers):\002,/4x,\0021. Diagonal\002,24x,\0027. Random, unsp"
00095             "ecified CNDNUM\002,/4x,\0022. Random, CNDNUM = 2\002,14x,\0028. "
00096             "First row and column zero\002,/4x,\0023. Random, CNDNUM = sqrt(0"
00097             ".1/EPS)\002,2x,\0029. Last row and column zero\002,/4x,\0024. Ra"
00098             "ndom, CNDNUM = 0.1/EPS\002,7x,\00210. Middle row and column zer"
00099             "o\002,/4x,\0025. Scaled near underflow\002,10x,\00211. Scaled ne"
00100             "ar underflow\002,/4x,\0026. Scaled near overflow\002,11x,\00212."
00101             " Scaled near overflow\002)";
00102     static char fmt_9973[] = "(3x,i2,\002: norm( U'*D*U - A ) / ( N * norm(A"
00103             ") * EPS )\002,\002, or\002,/7x,\002norm( L*D*L' - A ) / ( N * no"
00104             "rm(A) * EPS )\002)";
00105     static char fmt_9992[] = "(/1x,a3,\002 drivers:  \002,a9,\002 indefinite"
00106             " matrices\002)";
00107     static char fmt_9991[] = "(/1x,a3,\002 drivers:  \002,a9,\002 indefinite"
00108             " packed matrices\002)";
00109     static char fmt_9983[] = "(4x,\0021. Diagonal\002,24x,\0026. Last n/2 ro"
00110             "ws and columns zero\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
00111             ",\0027. Random, CNDNUM = sqrt(0.1/EPS)\002,/4x,\0023. First row "
00112             "and column zero\002,7x,\0028. Random, CNDNUM = 0.1/EPS\002,/4x"
00113             ",\0024. Last row and column zero\002,8x,\0029. Scaled near under"
00114             "flow\002,/4x,\0025. Middle row and column zero\002,5x,\00210. Sc"
00115             "aled near overflow\002)";
00116     static char fmt_9982[] = "(4x,\0021. Diagonal\002,24x,\0027. Random, CND"
00117             "NUM = sqrt(0.1/EPS)\002,/4x,\0022. Random, CNDNUM = 2\002,14x"
00118             ",\0028. Random, CNDNUM = 0.1/EPS\002,/4x,\0023. First row and co"
00119             "lumn zero\002,7x,\0029. Scaled near underflow\002,/4x,\0024. Las"
00120             "t row and column zero\002,7x,\00210. Scaled near overflow\002,/4"
00121             "x,\0025. Middle row and column zero\002,5x,\00211. Block diagona"
00122             "l matrix\002,/4x,\0026. Last n/2 rows and columns zero\002)";
00123     static char fmt_9974[] = "(3x,i2,\002: norm( U*D*U' - A ) / ( N * norm(A"
00124             ") * EPS )\002,\002, or\002,/7x,\002norm( L*D*L' - A ) / ( N * no"
00125             "rm(A) * EPS )\002)";
00126     static char fmt_9990[] = "(/1x,a3,\002:  No header available\002)";
00127 
00128     /* System generated locals */
00129     cilist ci__1;
00130 
00131     /* Builtin functions */
00132     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00133     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00134 
00135     /* Local variables */
00136     char c1[1], c3[1], p2[2], sym[9];
00137     logical sord, corz;
00138     extern logical lsame_(char *, char *), lsamen_(integer *, 
00139             char *, char *);
00140 
00141     /* Fortran I/O blocks */
00142     static cilist io___6 = { 0, 0, 0, fmt_9999, 0 };
00143     static cilist io___7 = { 0, 0, 0, fmt_9989, 0 };
00144     static cilist io___8 = { 0, 0, 0, fmt_9981, 0 };
00145     static cilist io___9 = { 0, 0, 0, fmt_9980, 0 };
00146     static cilist io___10 = { 0, 0, 0, fmt_9979, 0 };
00147     static cilist io___11 = { 0, 0, 0, fmt_9978, 0 };
00148     static cilist io___12 = { 0, 0, 0, fmt_9977, 0 };
00149     static cilist io___13 = { 0, 0, 0, fmt_9976, 0 };
00150     static cilist io___14 = { 0, 0, 0, fmt_9972, 0 };
00151     static cilist io___15 = { 0, 0, 0, fmt_9998, 0 };
00152     static cilist io___16 = { 0, 0, 0, fmt_9988, 0 };
00153     static cilist io___17 = { 0, 0, 0, fmt_9981, 0 };
00154     static cilist io___18 = { 0, 0, 0, fmt_9980, 0 };
00155     static cilist io___19 = { 0, 0, 0, fmt_9979, 0 };
00156     static cilist io___20 = { 0, 0, 0, fmt_9978, 0 };
00157     static cilist io___21 = { 0, 0, 0, fmt_9977, 0 };
00158     static cilist io___22 = { 0, 0, 0, fmt_9976, 0 };
00159     static cilist io___23 = { 0, 0, 0, fmt_9972, 0 };
00160     static cilist io___24 = { 0, 0, 0, fmt_9997, 0 };
00161     static cilist io___25 = { 0, 0, 0, fmt_9987, 0 };
00162     static cilist io___26 = { 0, 0, 0, fmt_9981, 0 };
00163     static cilist io___27 = { 0, 0, 0, fmt_9980, 0 };
00164     static cilist io___28 = { 0, 0, 0, fmt_9979, 0 };
00165     static cilist io___29 = { 0, 0, 0, fmt_9978, 0 };
00166     static cilist io___30 = { 0, 0, 0, fmt_9977, 0 };
00167     static cilist io___31 = { 0, 0, 0, fmt_9976, 0 };
00168     static cilist io___33 = { 0, 0, 0, fmt_9996, 0 };
00169     static cilist io___34 = { 0, 0, 0, fmt_9995, 0 };
00170     static cilist io___35 = { 0, 0, 0, fmt_9985, 0 };
00171     static cilist io___36 = { 0, 0, 0, fmt_9975, 0 };
00172     static cilist io___37 = { 0, 0, 0, fmt_9980, 0 };
00173     static cilist io___38 = { 0, 0, 0, fmt_9979, 0 };
00174     static cilist io___39 = { 0, 0, 0, fmt_9978, 0 };
00175     static cilist io___40 = { 0, 0, 0, fmt_9977, 0 };
00176     static cilist io___41 = { 0, 0, 0, fmt_9976, 0 };
00177     static cilist io___42 = { 0, 0, 0, fmt_9994, 0 };
00178     static cilist io___43 = { 0, 0, 0, fmt_9994, 0 };
00179     static cilist io___44 = { 0, 0, 0, fmt_9984, 0 };
00180     static cilist io___45 = { 0, 0, 0, fmt_9975, 0 };
00181     static cilist io___46 = { 0, 0, 0, fmt_9980, 0 };
00182     static cilist io___47 = { 0, 0, 0, fmt_9979, 0 };
00183     static cilist io___48 = { 0, 0, 0, fmt_9978, 0 };
00184     static cilist io___49 = { 0, 0, 0, fmt_9977, 0 };
00185     static cilist io___50 = { 0, 0, 0, fmt_9976, 0 };
00186     static cilist io___51 = { 0, 0, 0, fmt_9993, 0 };
00187     static cilist io___52 = { 0, 0, 0, fmt_9993, 0 };
00188     static cilist io___53 = { 0, 0, 0, fmt_9986, 0 };
00189     static cilist io___54 = { 0, 0, 0, fmt_9973, 0 };
00190     static cilist io___55 = { 0, 0, 0, fmt_9980, 0 };
00191     static cilist io___56 = { 0, 0, 0, fmt_9979, 0 };
00192     static cilist io___57 = { 0, 0, 0, fmt_9978, 0 };
00193     static cilist io___58 = { 0, 0, 0, fmt_9977, 0 };
00194     static cilist io___59 = { 0, 0, 0, fmt_9976, 0 };
00195     static cilist io___60 = { 0, 0, 0, fmt_9992, 0 };
00196     static cilist io___61 = { 0, 0, 0, fmt_9991, 0 };
00197     static cilist io___62 = { 0, 0, 0, fmt_9983, 0 };
00198     static cilist io___63 = { 0, 0, 0, fmt_9982, 0 };
00199     static cilist io___64 = { 0, 0, 0, fmt_9974, 0 };
00200     static cilist io___65 = { 0, 0, 0, fmt_9980, 0 };
00201     static cilist io___66 = { 0, 0, 0, fmt_9979, 0 };
00202     static cilist io___67 = { 0, 0, 0, fmt_9977, 0 };
00203     static cilist io___68 = { 0, 0, 0, fmt_9978, 0 };
00204     static cilist io___69 = { 0, 0, 0, fmt_9976, 0 };
00205     static cilist io___70 = { 0, 0, 0, fmt_9992, 0 };
00206     static cilist io___71 = { 0, 0, 0, fmt_9991, 0 };
00207     static cilist io___72 = { 0, 0, 0, fmt_9983, 0 };
00208     static cilist io___73 = { 0, 0, 0, fmt_9974, 0 };
00209     static cilist io___74 = { 0, 0, 0, fmt_9980, 0 };
00210     static cilist io___75 = { 0, 0, 0, fmt_9979, 0 };
00211     static cilist io___76 = { 0, 0, 0, fmt_9977, 0 };
00212     static cilist io___77 = { 0, 0, 0, fmt_9978, 0 };
00213     static cilist io___78 = { 0, 0, 0, fmt_9976, 0 };
00214     static cilist io___79 = { 0, 0, 0, fmt_9990, 0 };
00215 
00216 
00217 
00218 /*  -- LAPACK test routine (version 3.1) -- */
00219 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00220 /*     November 2006 */
00221 
00222 /*     .. Scalar Arguments .. */
00223 /*     .. */
00224 
00225 /*  Purpose */
00226 /*  ======= */
00227 
00228 /*  ALADHD prints header information for the driver routines test paths. */
00229 
00230 /*  Arguments */
00231 /*  ========= */
00232 
00233 /*  IOUNIT  (input) INTEGER */
00234 /*          The unit number to which the header information should be */
00235 /*          printed. */
00236 
00237 /*  PATH    (input) CHARACTER*3 */
00238 /*          The name of the path for which the header information is to */
00239 /*          be printed.  Current paths are */
00240 /*             _GE:  General matrices */
00241 /*             _GB:  General band */
00242 /*             _GT:  General Tridiagonal */
00243 /*             _PO:  Symmetric or Hermitian positive definite */
00244 /*             _PS:  Symmetric or Hermitian positive semi-definite */
00245 /*             _PP:  Symmetric or Hermitian positive definite packed */
00246 /*             _PB:  Symmetric or Hermitian positive definite band */
00247 /*             _PT:  Symmetric or Hermitian positive definite tridiagonal */
00248 /*             _SY:  Symmetric indefinite */
00249 /*             _SP:  Symmetric indefinite packed */
00250 /*             _HE:  (complex) Hermitian indefinite */
00251 /*             _HP:  (complex) Hermitian indefinite packed */
00252 /*          The first character must be one of S, D, C, or Z (C or Z only */
00253 /*          if complex). */
00254 
00255 /*     .. Local Scalars .. */
00256 /*     .. */
00257 /*     .. External Functions .. */
00258 /*     .. */
00259 /*     .. Executable Statements .. */
00260 
00261     if (*iounit <= 0) {
00262         return 0;
00263     }
00264     *(unsigned char *)c1 = *(unsigned char *)path;
00265     *(unsigned char *)c3 = *(unsigned char *)&path[2];
00266     s_copy(p2, path + 1, (ftnlen)2, (ftnlen)2);
00267     sord = lsame_(c1, "S") || lsame_(c1, "D");
00268     corz = lsame_(c1, "C") || lsame_(c1, "Z");
00269     if (! (sord || corz)) {
00270         return 0;
00271     }
00272 
00273     if (lsamen_(&c__2, p2, "GE")) {
00274 
00275 /*        GE: General dense */
00276 
00277         io___6.ciunit = *iounit;
00278         s_wsfe(&io___6);
00279         do_fio(&c__1, path, (ftnlen)3);
00280         e_wsfe();
00281         ci__1.cierr = 0;
00282         ci__1.ciunit = *iounit;
00283         ci__1.cifmt = "( ' Matrix types:' )";
00284         s_wsfe(&ci__1);
00285         e_wsfe();
00286         io___7.ciunit = *iounit;
00287         s_wsfe(&io___7);
00288         e_wsfe();
00289         ci__1.cierr = 0;
00290         ci__1.ciunit = *iounit;
00291         ci__1.cifmt = "( ' Test ratios:' )";
00292         s_wsfe(&ci__1);
00293         e_wsfe();
00294         io___8.ciunit = *iounit;
00295         s_wsfe(&io___8);
00296         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00297         e_wsfe();
00298         io___9.ciunit = *iounit;
00299         s_wsfe(&io___9);
00300         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00301         e_wsfe();
00302         io___10.ciunit = *iounit;
00303         s_wsfe(&io___10);
00304         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00305         e_wsfe();
00306         io___11.ciunit = *iounit;
00307         s_wsfe(&io___11);
00308         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00309         e_wsfe();
00310         io___12.ciunit = *iounit;
00311         s_wsfe(&io___12);
00312         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00313         e_wsfe();
00314         io___13.ciunit = *iounit;
00315         s_wsfe(&io___13);
00316         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00317         e_wsfe();
00318         io___14.ciunit = *iounit;
00319         s_wsfe(&io___14);
00320         do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00321         e_wsfe();
00322         ci__1.cierr = 0;
00323         ci__1.ciunit = *iounit;
00324         ci__1.cifmt = "( ' Messages:' )";
00325         s_wsfe(&ci__1);
00326         e_wsfe();
00327 
00328     } else if (lsamen_(&c__2, p2, "GB")) {
00329 
00330 /*        GB: General band */
00331 
00332         io___15.ciunit = *iounit;
00333         s_wsfe(&io___15);
00334         do_fio(&c__1, path, (ftnlen)3);
00335         e_wsfe();
00336         ci__1.cierr = 0;
00337         ci__1.ciunit = *iounit;
00338         ci__1.cifmt = "( ' Matrix types:' )";
00339         s_wsfe(&ci__1);
00340         e_wsfe();
00341         io___16.ciunit = *iounit;
00342         s_wsfe(&io___16);
00343         e_wsfe();
00344         ci__1.cierr = 0;
00345         ci__1.ciunit = *iounit;
00346         ci__1.cifmt = "( ' Test ratios:' )";
00347         s_wsfe(&ci__1);
00348         e_wsfe();
00349         io___17.ciunit = *iounit;
00350         s_wsfe(&io___17);
00351         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00352         e_wsfe();
00353         io___18.ciunit = *iounit;
00354         s_wsfe(&io___18);
00355         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00356         e_wsfe();
00357         io___19.ciunit = *iounit;
00358         s_wsfe(&io___19);
00359         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00360         e_wsfe();
00361         io___20.ciunit = *iounit;
00362         s_wsfe(&io___20);
00363         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00364         e_wsfe();
00365         io___21.ciunit = *iounit;
00366         s_wsfe(&io___21);
00367         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00368         e_wsfe();
00369         io___22.ciunit = *iounit;
00370         s_wsfe(&io___22);
00371         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00372         e_wsfe();
00373         io___23.ciunit = *iounit;
00374         s_wsfe(&io___23);
00375         do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00376         e_wsfe();
00377         ci__1.cierr = 0;
00378         ci__1.ciunit = *iounit;
00379         ci__1.cifmt = "( ' Messages:' )";
00380         s_wsfe(&ci__1);
00381         e_wsfe();
00382 
00383     } else if (lsamen_(&c__2, p2, "GT")) {
00384 
00385 /*        GT: General tridiagonal */
00386 
00387         io___24.ciunit = *iounit;
00388         s_wsfe(&io___24);
00389         do_fio(&c__1, path, (ftnlen)3);
00390         e_wsfe();
00391         io___25.ciunit = *iounit;
00392         s_wsfe(&io___25);
00393         e_wsfe();
00394         ci__1.cierr = 0;
00395         ci__1.ciunit = *iounit;
00396         ci__1.cifmt = "( ' Test ratios:' )";
00397         s_wsfe(&ci__1);
00398         e_wsfe();
00399         io___26.ciunit = *iounit;
00400         s_wsfe(&io___26);
00401         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00402         e_wsfe();
00403         io___27.ciunit = *iounit;
00404         s_wsfe(&io___27);
00405         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00406         e_wsfe();
00407         io___28.ciunit = *iounit;
00408         s_wsfe(&io___28);
00409         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00410         e_wsfe();
00411         io___29.ciunit = *iounit;
00412         s_wsfe(&io___29);
00413         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00414         e_wsfe();
00415         io___30.ciunit = *iounit;
00416         s_wsfe(&io___30);
00417         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00418         e_wsfe();
00419         io___31.ciunit = *iounit;
00420         s_wsfe(&io___31);
00421         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00422         e_wsfe();
00423         ci__1.cierr = 0;
00424         ci__1.ciunit = *iounit;
00425         ci__1.cifmt = "( ' Messages:' )";
00426         s_wsfe(&ci__1);
00427         e_wsfe();
00428 
00429     } else if (lsamen_(&c__2, p2, "PO") || lsamen_(&
00430             c__2, p2, "PP") || lsamen_(&c__2, p2, "PS")) {
00431 
00432 /*        PO: Positive definite full */
00433 /*        PS: Positive definite full */
00434 /*        PP: Positive definite packed */
00435 
00436         if (sord) {
00437             s_copy(sym, "Symmetric", (ftnlen)9, (ftnlen)9);
00438         } else {
00439             s_copy(sym, "Hermitian", (ftnlen)9, (ftnlen)9);
00440         }
00441         if (lsame_(c3, "O")) {
00442             io___33.ciunit = *iounit;
00443             s_wsfe(&io___33);
00444             do_fio(&c__1, path, (ftnlen)3);
00445             do_fio(&c__1, sym, (ftnlen)9);
00446             e_wsfe();
00447         } else {
00448             io___34.ciunit = *iounit;
00449             s_wsfe(&io___34);
00450             do_fio(&c__1, path, (ftnlen)3);
00451             do_fio(&c__1, sym, (ftnlen)9);
00452             e_wsfe();
00453         }
00454         ci__1.cierr = 0;
00455         ci__1.ciunit = *iounit;
00456         ci__1.cifmt = "( ' Matrix types:' )";
00457         s_wsfe(&ci__1);
00458         e_wsfe();
00459         io___35.ciunit = *iounit;
00460         s_wsfe(&io___35);
00461         do_fio(&c__1, path, (ftnlen)3);
00462         e_wsfe();
00463         ci__1.cierr = 0;
00464         ci__1.ciunit = *iounit;
00465         ci__1.cifmt = "( ' Test ratios:' )";
00466         s_wsfe(&ci__1);
00467         e_wsfe();
00468         io___36.ciunit = *iounit;
00469         s_wsfe(&io___36);
00470         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00471         e_wsfe();
00472         io___37.ciunit = *iounit;
00473         s_wsfe(&io___37);
00474         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00475         e_wsfe();
00476         io___38.ciunit = *iounit;
00477         s_wsfe(&io___38);
00478         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00479         e_wsfe();
00480         io___39.ciunit = *iounit;
00481         s_wsfe(&io___39);
00482         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00483         e_wsfe();
00484         io___40.ciunit = *iounit;
00485         s_wsfe(&io___40);
00486         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00487         e_wsfe();
00488         io___41.ciunit = *iounit;
00489         s_wsfe(&io___41);
00490         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00491         e_wsfe();
00492         ci__1.cierr = 0;
00493         ci__1.ciunit = *iounit;
00494         ci__1.cifmt = "( ' Messages:' )";
00495         s_wsfe(&ci__1);
00496         e_wsfe();
00497 
00498     } else if (lsamen_(&c__2, p2, "PB")) {
00499 
00500 /*        PB: Positive definite band */
00501 
00502         if (sord) {
00503             io___42.ciunit = *iounit;
00504             s_wsfe(&io___42);
00505             do_fio(&c__1, path, (ftnlen)3);
00506             do_fio(&c__1, "Symmetric", (ftnlen)9);
00507             e_wsfe();
00508         } else {
00509             io___43.ciunit = *iounit;
00510             s_wsfe(&io___43);
00511             do_fio(&c__1, path, (ftnlen)3);
00512             do_fio(&c__1, "Hermitian", (ftnlen)9);
00513             e_wsfe();
00514         }
00515         ci__1.cierr = 0;
00516         ci__1.ciunit = *iounit;
00517         ci__1.cifmt = "( ' Matrix types:' )";
00518         s_wsfe(&ci__1);
00519         e_wsfe();
00520         io___44.ciunit = *iounit;
00521         s_wsfe(&io___44);
00522         do_fio(&c__1, path, (ftnlen)3);
00523         e_wsfe();
00524         ci__1.cierr = 0;
00525         ci__1.ciunit = *iounit;
00526         ci__1.cifmt = "( ' Test ratios:' )";
00527         s_wsfe(&ci__1);
00528         e_wsfe();
00529         io___45.ciunit = *iounit;
00530         s_wsfe(&io___45);
00531         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00532         e_wsfe();
00533         io___46.ciunit = *iounit;
00534         s_wsfe(&io___46);
00535         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00536         e_wsfe();
00537         io___47.ciunit = *iounit;
00538         s_wsfe(&io___47);
00539         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00540         e_wsfe();
00541         io___48.ciunit = *iounit;
00542         s_wsfe(&io___48);
00543         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00544         e_wsfe();
00545         io___49.ciunit = *iounit;
00546         s_wsfe(&io___49);
00547         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00548         e_wsfe();
00549         io___50.ciunit = *iounit;
00550         s_wsfe(&io___50);
00551         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00552         e_wsfe();
00553         ci__1.cierr = 0;
00554         ci__1.ciunit = *iounit;
00555         ci__1.cifmt = "( ' Messages:' )";
00556         s_wsfe(&ci__1);
00557         e_wsfe();
00558 
00559     } else if (lsamen_(&c__2, p2, "PT")) {
00560 
00561 /*        PT: Positive definite tridiagonal */
00562 
00563         if (sord) {
00564             io___51.ciunit = *iounit;
00565             s_wsfe(&io___51);
00566             do_fio(&c__1, path, (ftnlen)3);
00567             do_fio(&c__1, "Symmetric", (ftnlen)9);
00568             e_wsfe();
00569         } else {
00570             io___52.ciunit = *iounit;
00571             s_wsfe(&io___52);
00572             do_fio(&c__1, path, (ftnlen)3);
00573             do_fio(&c__1, "Hermitian", (ftnlen)9);
00574             e_wsfe();
00575         }
00576         io___53.ciunit = *iounit;
00577         s_wsfe(&io___53);
00578         e_wsfe();
00579         ci__1.cierr = 0;
00580         ci__1.ciunit = *iounit;
00581         ci__1.cifmt = "( ' Test ratios:' )";
00582         s_wsfe(&ci__1);
00583         e_wsfe();
00584         io___54.ciunit = *iounit;
00585         s_wsfe(&io___54);
00586         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00587         e_wsfe();
00588         io___55.ciunit = *iounit;
00589         s_wsfe(&io___55);
00590         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00591         e_wsfe();
00592         io___56.ciunit = *iounit;
00593         s_wsfe(&io___56);
00594         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00595         e_wsfe();
00596         io___57.ciunit = *iounit;
00597         s_wsfe(&io___57);
00598         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00599         e_wsfe();
00600         io___58.ciunit = *iounit;
00601         s_wsfe(&io___58);
00602         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00603         e_wsfe();
00604         io___59.ciunit = *iounit;
00605         s_wsfe(&io___59);
00606         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00607         e_wsfe();
00608         ci__1.cierr = 0;
00609         ci__1.ciunit = *iounit;
00610         ci__1.cifmt = "( ' Messages:' )";
00611         s_wsfe(&ci__1);
00612         e_wsfe();
00613 
00614     } else if (lsamen_(&c__2, p2, "SY") || lsamen_(&
00615             c__2, p2, "SP")) {
00616 
00617 /*        SY: Symmetric indefinite full */
00618 /*        SP: Symmetric indefinite packed */
00619 
00620         if (lsame_(c3, "Y")) {
00621             io___60.ciunit = *iounit;
00622             s_wsfe(&io___60);
00623             do_fio(&c__1, path, (ftnlen)3);
00624             do_fio(&c__1, "Symmetric", (ftnlen)9);
00625             e_wsfe();
00626         } else {
00627             io___61.ciunit = *iounit;
00628             s_wsfe(&io___61);
00629             do_fio(&c__1, path, (ftnlen)3);
00630             do_fio(&c__1, "Symmetric", (ftnlen)9);
00631             e_wsfe();
00632         }
00633         ci__1.cierr = 0;
00634         ci__1.ciunit = *iounit;
00635         ci__1.cifmt = "( ' Matrix types:' )";
00636         s_wsfe(&ci__1);
00637         e_wsfe();
00638         if (sord) {
00639             io___62.ciunit = *iounit;
00640             s_wsfe(&io___62);
00641             e_wsfe();
00642         } else {
00643             io___63.ciunit = *iounit;
00644             s_wsfe(&io___63);
00645             e_wsfe();
00646         }
00647         ci__1.cierr = 0;
00648         ci__1.ciunit = *iounit;
00649         ci__1.cifmt = "( ' Test ratios:' )";
00650         s_wsfe(&ci__1);
00651         e_wsfe();
00652         io___64.ciunit = *iounit;
00653         s_wsfe(&io___64);
00654         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00655         e_wsfe();
00656         io___65.ciunit = *iounit;
00657         s_wsfe(&io___65);
00658         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00659         e_wsfe();
00660         io___66.ciunit = *iounit;
00661         s_wsfe(&io___66);
00662         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00663         e_wsfe();
00664         io___67.ciunit = *iounit;
00665         s_wsfe(&io___67);
00666         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00667         e_wsfe();
00668         io___68.ciunit = *iounit;
00669         s_wsfe(&io___68);
00670         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00671         e_wsfe();
00672         io___69.ciunit = *iounit;
00673         s_wsfe(&io___69);
00674         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00675         e_wsfe();
00676         ci__1.cierr = 0;
00677         ci__1.ciunit = *iounit;
00678         ci__1.cifmt = "( ' Messages:' )";
00679         s_wsfe(&ci__1);
00680         e_wsfe();
00681 
00682     } else if (lsamen_(&c__2, p2, "HE") || lsamen_(&
00683             c__2, p2, "HP")) {
00684 
00685 /*        HE: Hermitian indefinite full */
00686 /*        HP: Hermitian indefinite packed */
00687 
00688         if (lsame_(c3, "E")) {
00689             io___70.ciunit = *iounit;
00690             s_wsfe(&io___70);
00691             do_fio(&c__1, path, (ftnlen)3);
00692             do_fio(&c__1, "Hermitian", (ftnlen)9);
00693             e_wsfe();
00694         } else {
00695             io___71.ciunit = *iounit;
00696             s_wsfe(&io___71);
00697             do_fio(&c__1, path, (ftnlen)3);
00698             do_fio(&c__1, "Hermitian", (ftnlen)9);
00699             e_wsfe();
00700         }
00701         ci__1.cierr = 0;
00702         ci__1.ciunit = *iounit;
00703         ci__1.cifmt = "( ' Matrix types:' )";
00704         s_wsfe(&ci__1);
00705         e_wsfe();
00706         io___72.ciunit = *iounit;
00707         s_wsfe(&io___72);
00708         e_wsfe();
00709         ci__1.cierr = 0;
00710         ci__1.ciunit = *iounit;
00711         ci__1.cifmt = "( ' Test ratios:' )";
00712         s_wsfe(&ci__1);
00713         e_wsfe();
00714         io___73.ciunit = *iounit;
00715         s_wsfe(&io___73);
00716         do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00717         e_wsfe();
00718         io___74.ciunit = *iounit;
00719         s_wsfe(&io___74);
00720         do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
00721         e_wsfe();
00722         io___75.ciunit = *iounit;
00723         s_wsfe(&io___75);
00724         do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
00725         e_wsfe();
00726         io___76.ciunit = *iounit;
00727         s_wsfe(&io___76);
00728         do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
00729         e_wsfe();
00730         io___77.ciunit = *iounit;
00731         s_wsfe(&io___77);
00732         do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
00733         e_wsfe();
00734         io___78.ciunit = *iounit;
00735         s_wsfe(&io___78);
00736         do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
00737         e_wsfe();
00738         ci__1.cierr = 0;
00739         ci__1.ciunit = *iounit;
00740         ci__1.cifmt = "( ' Messages:' )";
00741         s_wsfe(&ci__1);
00742         e_wsfe();
00743 
00744     } else {
00745 
00746 /*        Print error message if no header is available. */
00747 
00748         io___79.ciunit = *iounit;
00749         s_wsfe(&io___79);
00750         do_fio(&c__1, path, (ftnlen)3);
00751         e_wsfe();
00752     }
00753 
00754 /*     First line of header */
00755 
00756 
00757 /*     GE matrix types */
00758 
00759 
00760 /*     GB matrix types */
00761 
00762 
00763 /*     GT matrix types */
00764 
00765 
00766 /*     PT matrix types */
00767 
00768 
00769 /*     PO, PP matrix types */
00770 
00771 
00772 /*     PB matrix types */
00773 
00774 
00775 /*     SSY, SSP, CHE, CHP matrix types */
00776 
00777 
00778 /*     CSY, CSP matrix types */
00779 
00780 
00781 /*     Test ratios */
00782 
00783 
00784     return 0;
00785 
00786 /*     End of ALADHD */
00787 
00788 } /* aladhd_ */


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