swiftnav: serrsy.c Source File

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