swiftnav: derrsy.c Source File

Go to the documentation of this file.
00001 /* derrsy.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 /* Common Block Declarations */
00017 
00018 struct {
00019     integer infot, nout;
00020     logical ok, lerr;
00021 } infoc_;
00022 
00023 #define infoc_1 infoc_
00024 
00025 struct {
00026     char srnamt[32];
00027 } srnamc_;
00028 
00029 #define srnamc_1 srnamc_
00030 
00031 /* Table of constant values */
00032 
00033 static integer c__2 = 2;
00034 static integer c__0 = 0;
00035 static integer c__1 = 1;
00036 static integer c_n1 = -1;
00037 static integer c__4 = 4;
00038 static doublereal c_b152 = -1.;
00039 
00040 /* Subroutine */ int derrsy_(char *path, integer *nunit)
00041 {
00042     /* Builtin functions */
00043     integer s_wsle(cilist *), e_wsle(void);
00044     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00045 
00046     /* Local variables */
00047     doublereal a[16]    /* was [4][4] */, b[4];
00048     integer i__, j;
00049     doublereal w[12], x[4];
00050     char c2[2];
00051     doublereal r1[4], r2[4], af[16]     /* was [4][4] */;
00052     integer ip[4], iw[4], info;
00053     doublereal anrm, rcond;
00054     extern /* Subroutine */ int dsytf2_(char *, integer *, doublereal *, 
00055             integer *, integer *, integer *), alaesm_(char *, logical 
00056             *, integer *);
00057     extern logical lsamen_(integer *, char *, char *);
00058     extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
00059             *, logical *), dspcon_(char *, integer *, doublereal *, 
00060             integer *, doublereal *, doublereal *, doublereal *, integer *, 
00061             integer *), dsycon_(char *, integer *, doublereal *, 
00062             integer *, integer *, doublereal *, doublereal *, doublereal *, 
00063             integer *, integer *), dsprfs_(char *, integer *, integer 
00064             *, doublereal *, doublereal *, integer *, doublereal *, integer *, 
00065              doublereal *, integer *, doublereal *, doublereal *, doublereal *
00066 , integer *, integer *), dsptrf_(char *, integer *, 
00067             doublereal *, integer *, integer *), dsptri_(char *, 
00068             integer *, doublereal *, integer *, doublereal *, integer *), dsyrfs_(char *, integer *, integer *, doublereal *, 
00069             integer *, doublereal *, integer *, integer *, doublereal *, 
00070             integer *, doublereal *, integer *, doublereal *, doublereal *, 
00071             doublereal *, integer *, integer *), dsytrf_(char *, 
00072             integer *, doublereal *, integer *, integer *, doublereal *, 
00073             integer *, integer *), dsytri_(char *, integer *, 
00074             doublereal *, integer *, integer *, doublereal *, integer *), dsptrs_(char *, integer *, integer *, doublereal *, 
00075             integer *, doublereal *, integer *, integer *), dsytrs_(
00076             char *, integer *, integer *, doublereal *, integer *, integer *, 
00077             doublereal *, integer *, integer *);
00078 
00079     /* Fortran I/O blocks */
00080     static cilist io___1 = { 0, 0, 0, 0, 0 };
00081 
00082 
00083 
00084 /*  -- LAPACK test routine (version 3.1) -- */
00085 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00086 /*     November 2006 */
00087 
00088 /*     .. Scalar Arguments .. */
00089 /*     .. */
00090 
00091 /*  Purpose */
00092 /*  ======= */
00093 
00094 /*  DERRSY tests the error exits for the DOUBLE PRECISION routines */
00095 /*  for symmetric indefinite matrices. */
00096 
00097 /*  Arguments */
00098 /*  ========= */
00099 
00100 /*  PATH    (input) CHARACTER*3 */
00101 /*          The LAPACK path name for the routines to be tested. */
00102 
00103 /*  NUNIT   (input) INTEGER */
00104 /*          The unit number for output. */
00105 
00106 /*  ===================================================================== */
00107 
00108 /*     .. Parameters .. */
00109 /*     .. */
00110 /*     .. Local Scalars .. */
00111 /*     .. */
00112 /*     .. Local Arrays .. */
00113 /*     .. */
00114 /*     .. External Functions .. */
00115 /*     .. */
00116 /*     .. External Subroutines .. */
00117 /*     .. */
00118 /*     .. Scalars in Common .. */
00119 /*     .. */
00120 /*     .. Common blocks .. */
00121 /*     .. */
00122 /*     .. Intrinsic Functions .. */
00123 /*     .. */
00124 /*     .. Executable Statements .. */
00125 
00126     infoc_1.nout = *nunit;
00127     io___1.ciunit = infoc_1.nout;
00128     s_wsle(&io___1);
00129     e_wsle();
00130     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00131 
00132 /*     Set the variables to innocuous values. */
00133 
00134     for (j = 1; j <= 4; ++j) {
00135         for (i__ = 1; i__ <= 4; ++i__) {
00136             a[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j);
00137             af[i__ + (j << 2) - 5] = 1. / (doublereal) (i__ + j);
00138 /* L10: */
00139         }
00140         b[j - 1] = 0.;
00141         r1[j - 1] = 0.;
00142         r2[j - 1] = 0.;
00143         w[j - 1] = 0.;
00144         x[j - 1] = 0.;
00145         ip[j - 1] = j;
00146         iw[j - 1] = j;
00147 /* L20: */
00148     }
00149     anrm = 1.;
00150     rcond = 1.;
00151     infoc_1.ok = TRUE_;
00152 
00153     if (lsamen_(&c__2, c2, "SY")) {
00154 
00155 /*        Test error exits of the routines that use the Bunch-Kaufman */
00156 /*        factorization of a symmetric indefinite matrix. */
00157 
00158 /*        DSYTRF */
00159 
00160         s_copy(srnamc_1.srnamt, "DSYTRF", (ftnlen)32, (ftnlen)6);
00161         infoc_1.infot = 1;
00162         dsytrf_("/", &c__0, a, &c__1, ip, w, &c__1, &info);
00163         chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00164                 infoc_1.ok);
00165         infoc_1.infot = 2;
00166         dsytrf_("U", &c_n1, a, &c__1, ip, w, &c__1, &info);
00167         chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00168                 infoc_1.ok);
00169         infoc_1.infot = 4;
00170         dsytrf_("U", &c__2, a, &c__1, ip, w, &c__4, &info);
00171         chkxer_("DSYTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00172                 infoc_1.ok);
00173 
00174 /*        DSYTF2 */
00175 
00176         s_copy(srnamc_1.srnamt, "DSYTF2", (ftnlen)32, (ftnlen)6);
00177         infoc_1.infot = 1;
00178         dsytf2_("/", &c__0, a, &c__1, ip, &info);
00179         chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00180                 infoc_1.ok);
00181         infoc_1.infot = 2;
00182         dsytf2_("U", &c_n1, a, &c__1, ip, &info);
00183         chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00184                 infoc_1.ok);
00185         infoc_1.infot = 4;
00186         dsytf2_("U", &c__2, a, &c__1, ip, &info);
00187         chkxer_("DSYTF2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00188                 infoc_1.ok);
00189 
00190 /*        DSYTRI */
00191 
00192         s_copy(srnamc_1.srnamt, "DSYTRI", (ftnlen)32, (ftnlen)6);
00193         infoc_1.infot = 1;
00194         dsytri_("/", &c__0, a, &c__1, ip, w, &info);
00195         chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00196                 infoc_1.ok);
00197         infoc_1.infot = 2;
00198         dsytri_("U", &c_n1, a, &c__1, ip, w, &info);
00199         chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200                 infoc_1.ok);
00201         infoc_1.infot = 4;
00202         dsytri_("U", &c__2, a, &c__1, ip, w, &info);
00203         chkxer_("DSYTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00204                 infoc_1.ok);
00205 
00206 /*        DSYTRS */
00207 
00208         s_copy(srnamc_1.srnamt, "DSYTRS", (ftnlen)32, (ftnlen)6);
00209         infoc_1.infot = 1;
00210         dsytrs_("/", &c__0, &c__0, a, &c__1, ip, b, &c__1, &info);
00211         chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00212                 infoc_1.ok);
00213         infoc_1.infot = 2;
00214         dsytrs_("U", &c_n1, &c__0, a, &c__1, ip, b, &c__1, &info);
00215         chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00216                 infoc_1.ok);
00217         infoc_1.infot = 3;
00218         dsytrs_("U", &c__0, &c_n1, a, &c__1, ip, b, &c__1, &info);
00219         chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00220                 infoc_1.ok);
00221         infoc_1.infot = 5;
00222         dsytrs_("U", &c__2, &c__1, a, &c__1, ip, b, &c__2, &info);
00223         chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00224                 infoc_1.ok);
00225         infoc_1.infot = 8;
00226         dsytrs_("U", &c__2, &c__1, a, &c__2, ip, b, &c__1, &info);
00227         chkxer_("DSYTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00228                 infoc_1.ok);
00229 
00230 /*        DSYRFS */
00231 
00232         s_copy(srnamc_1.srnamt, "DSYRFS", (ftnlen)32, (ftnlen)6);
00233         infoc_1.infot = 1;
00234         dsyrfs_("/", &c__0, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
00235                 c__1, r1, r2, w, iw, &info);
00236         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00237                 infoc_1.ok);
00238         infoc_1.infot = 2;
00239         dsyrfs_("U", &c_n1, &c__0, a, &c__1, af, &c__1, ip, b, &c__1, x, &
00240                 c__1, r1, r2, w, iw, &info);
00241         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00242                 infoc_1.ok);
00243         infoc_1.infot = 3;
00244         dsyrfs_("U", &c__0, &c_n1, a, &c__1, af, &c__1, ip, b, &c__1, x, &
00245                 c__1, r1, r2, w, iw, &info);
00246         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00247                 infoc_1.ok);
00248         infoc_1.infot = 5;
00249         dsyrfs_("U", &c__2, &c__1, a, &c__1, af, &c__2, ip, b, &c__2, x, &
00250                 c__2, r1, r2, w, iw, &info);
00251         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00252                 infoc_1.ok);
00253         infoc_1.infot = 7;
00254         dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__1, ip, b, &c__2, x, &
00255                 c__2, r1, r2, w, iw, &info);
00256         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257                 infoc_1.ok);
00258         infoc_1.infot = 10;
00259         dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__1, x, &
00260                 c__2, r1, r2, w, iw, &info);
00261         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262                 infoc_1.ok);
00263         infoc_1.infot = 12;
00264         dsyrfs_("U", &c__2, &c__1, a, &c__2, af, &c__2, ip, b, &c__2, x, &
00265                 c__1, r1, r2, w, iw, &info);
00266         chkxer_("DSYRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00267                 infoc_1.ok);
00268 
00269 /*        DSYCON */
00270 
00271         s_copy(srnamc_1.srnamt, "DSYCON", (ftnlen)32, (ftnlen)6);
00272         infoc_1.infot = 1;
00273         dsycon_("/", &c__0, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
00274         chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00275                 infoc_1.ok);
00276         infoc_1.infot = 2;
00277         dsycon_("U", &c_n1, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
00278         chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00279                 infoc_1.ok);
00280         infoc_1.infot = 4;
00281         dsycon_("U", &c__2, a, &c__1, ip, &anrm, &rcond, w, iw, &info);
00282         chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00283                 infoc_1.ok);
00284         infoc_1.infot = 6;
00285         dsycon_("U", &c__1, a, &c__1, ip, &c_b152, &rcond, w, iw, &info);
00286         chkxer_("DSYCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00287                 infoc_1.ok);
00288 
00289     } else if (lsamen_(&c__2, c2, "SP")) {
00290 
00291 /*        Test error exits of the routines that use the Bunch-Kaufman */
00292 /*        factorization of a symmetric indefinite packed matrix. */
00293 
00294 /*        DSPTRF */
00295 
00296         s_copy(srnamc_1.srnamt, "DSPTRF", (ftnlen)32, (ftnlen)6);
00297         infoc_1.infot = 1;
00298         dsptrf_("/", &c__0, a, ip, &info);
00299         chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00300                 infoc_1.ok);
00301         infoc_1.infot = 2;
00302         dsptrf_("U", &c_n1, a, ip, &info);
00303         chkxer_("DSPTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00304                 infoc_1.ok);
00305 
00306 /*        DSPTRI */
00307 
00308         s_copy(srnamc_1.srnamt, "DSPTRI", (ftnlen)32, (ftnlen)6);
00309         infoc_1.infot = 1;
00310         dsptri_("/", &c__0, a, ip, w, &info);
00311         chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00312                 infoc_1.ok);
00313         infoc_1.infot = 2;
00314         dsptri_("U", &c_n1, a, ip, w, &info);
00315         chkxer_("DSPTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00316                 infoc_1.ok);
00317 
00318 /*        DSPTRS */
00319 
00320         s_copy(srnamc_1.srnamt, "DSPTRS", (ftnlen)32, (ftnlen)6);
00321         infoc_1.infot = 1;
00322         dsptrs_("/", &c__0, &c__0, a, ip, b, &c__1, &info);
00323         chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00324                 infoc_1.ok);
00325         infoc_1.infot = 2;
00326         dsptrs_("U", &c_n1, &c__0, a, ip, b, &c__1, &info);
00327         chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00328                 infoc_1.ok);
00329         infoc_1.infot = 3;
00330         dsptrs_("U", &c__0, &c_n1, a, ip, b, &c__1, &info);
00331         chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00332                 infoc_1.ok);
00333         infoc_1.infot = 7;
00334         dsptrs_("U", &c__2, &c__1, a, ip, b, &c__1, &info);
00335         chkxer_("DSPTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00336                 infoc_1.ok);
00337 
00338 /*        DSPRFS */
00339 
00340         s_copy(srnamc_1.srnamt, "DSPRFS", (ftnlen)32, (ftnlen)6);
00341         infoc_1.infot = 1;
00342         dsprfs_("/", &c__0, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, 
00343                 iw, &info);
00344         chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00345                 infoc_1.ok);
00346         infoc_1.infot = 2;
00347         dsprfs_("U", &c_n1, &c__0, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, 
00348                 iw, &info);
00349         chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00350                 infoc_1.ok);
00351         infoc_1.infot = 3;
00352         dsprfs_("U", &c__0, &c_n1, a, af, ip, b, &c__1, x, &c__1, r1, r2, w, 
00353                 iw, &info);
00354         chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00355                 infoc_1.ok);
00356         infoc_1.infot = 8;
00357         dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__1, x, &c__2, r1, r2, w, 
00358                 iw, &info);
00359         chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00360                 infoc_1.ok);
00361         infoc_1.infot = 10;
00362         dsprfs_("U", &c__2, &c__1, a, af, ip, b, &c__2, x, &c__1, r1, r2, w, 
00363                 iw, &info);
00364         chkxer_("DSPRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00365                 infoc_1.ok);
00366 
00367 /*        DSPCON */
00368 
00369         s_copy(srnamc_1.srnamt, "DSPCON", (ftnlen)32, (ftnlen)6);
00370         infoc_1.infot = 1;
00371         dspcon_("/", &c__0, a, ip, &anrm, &rcond, w, iw, &info);
00372         chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00373                 infoc_1.ok);
00374         infoc_1.infot = 2;
00375         dspcon_("U", &c_n1, a, ip, &anrm, &rcond, w, iw, &info);
00376         chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00377                 infoc_1.ok);
00378         infoc_1.infot = 5;
00379         dspcon_("U", &c__1, a, ip, &c_b152, &rcond, w, iw, &info);
00380         chkxer_("DSPCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00381                 infoc_1.ok);
00382     }
00383 
00384 /*     Print a summary line. */
00385 
00386     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00387 
00388     return 0;
00389 
00390 /*     End of DERRSY */
00391 
00392 } /* derrsy_ */