swiftnav: zerrhe.c Source File

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