swiftnav: cerrsy.c Source File

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