swiftnav: zerrgt.c Source File

Go to the documentation of this file.
00001 /* zerrgt.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_n1 = -1;
00035 static integer c__0 = 0;
00036 static integer c__1 = 1;
00037 
00038 /* Subroutine */ int zerrgt_(char *path, integer *nunit)
00039 {
00040     /* System generated locals */
00041     integer i__1;
00042     doublereal d__1;
00043 
00044     /* Builtin functions */
00045     integer s_wsle(cilist *), e_wsle(void);
00046     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00047 
00048     /* Local variables */
00049     doublecomplex b[2];
00050     doublereal d__[2];
00051     doublecomplex e[2];
00052     integer i__;
00053     doublecomplex w[2], x[2];
00054     char c2[2];
00055     doublereal r1[2], r2[2], df[2];
00056     doublecomplex ef[2], dl[2];
00057     integer ip[2];
00058     doublecomplex du[2];
00059     doublereal rw[2];
00060     doublecomplex du2[2], dlf[2], duf[2];
00061     integer info;
00062     doublereal rcond, anorm;
00063     extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
00064     extern logical lsamen_(integer *, char *, char *);
00065     extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
00066             *, logical *), zgtcon_(char *, integer *, doublecomplex *, 
00067              doublecomplex *, doublecomplex *, doublecomplex *, integer *, 
00068             doublereal *, doublereal *, doublecomplex *, integer *), 
00069             zptcon_(integer *, doublereal *, doublecomplex *, doublereal *, 
00070             doublereal *, doublereal *, integer *), zgtrfs_(char *, integer *, 
00071              integer *, doublecomplex *, doublecomplex *, doublecomplex *, 
00072             doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
00073 , integer *, doublecomplex *, integer *, doublecomplex *, integer 
00074             *, doublereal *, doublereal *, doublecomplex *, doublereal *, 
00075             integer *), zgttrf_(integer *, doublecomplex *, 
00076             doublecomplex *, doublecomplex *, doublecomplex *, integer *, 
00077             integer *), zptrfs_(char *, integer *, integer *, doublereal *, 
00078             doublecomplex *, doublereal *, doublecomplex *, doublecomplex *, 
00079             integer *, doublecomplex *, integer *, doublereal *, doublereal *, 
00080              doublecomplex *, doublereal *, integer *), zpttrf_(
00081             integer *, doublereal *, doublecomplex *, integer *), zgttrs_(
00082             char *, integer *, integer *, doublecomplex *, doublecomplex *, 
00083             doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
00084             integer *, integer *), zpttrs_(char *, integer *, integer 
00085             *, doublereal *, doublecomplex *, doublecomplex *, integer *, 
00086             integer *);
00087 
00088     /* Fortran I/O blocks */
00089     static cilist io___1 = { 0, 0, 0, 0, 0 };
00090 
00091 
00092 
00093 /*  -- LAPACK test routine (version 3.1) -- */
00094 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00095 /*     November 2006 */
00096 
00097 /*     .. Scalar Arguments .. */
00098 /*     .. */
00099 
00100 /*  Purpose */
00101 /*  ======= */
00102 
00103 /*  ZERRGT tests the error exits for the COMPLEX*16 tridiagonal */
00104 /*  routines. */
00105 
00106 /*  Arguments */
00107 /*  ========= */
00108 
00109 /*  PATH    (input) CHARACTER*3 */
00110 /*          The LAPACK path name for the routines to be tested. */
00111 
00112 /*  NUNIT   (input) INTEGER */
00113 /*          The unit number for output. */
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 /*     .. Executable Statements .. */
00132 
00133     infoc_1.nout = *nunit;
00134     io___1.ciunit = infoc_1.nout;
00135     s_wsle(&io___1);
00136     e_wsle();
00137     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00138     for (i__ = 1; i__ <= 2; ++i__) {
00139         d__[i__ - 1] = 1.;
00140         i__1 = i__ - 1;
00141         e[i__1].r = 2., e[i__1].i = 0.;
00142         i__1 = i__ - 1;
00143         dl[i__1].r = 3., dl[i__1].i = 0.;
00144         i__1 = i__ - 1;
00145         du[i__1].r = 4., du[i__1].i = 0.;
00146 /* L10: */
00147     }
00148     anorm = 1.;
00149     infoc_1.ok = TRUE_;
00150 
00151     if (lsamen_(&c__2, c2, "GT")) {
00152 
00153 /*        Test error exits for the general tridiagonal routines. */
00154 
00155 /*        ZGTTRF */
00156 
00157         s_copy(srnamc_1.srnamt, "ZGTTRF", (ftnlen)32, (ftnlen)6);
00158         infoc_1.infot = 1;
00159         zgttrf_(&c_n1, dl, e, du, du2, ip, &info);
00160         chkxer_("ZGTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00161                 infoc_1.ok);
00162 
00163 /*        ZGTTRS */
00164 
00165         s_copy(srnamc_1.srnamt, "ZGTTRS", (ftnlen)32, (ftnlen)6);
00166         infoc_1.infot = 1;
00167         zgttrs_("/", &c__0, &c__0, dl, e, du, du2, ip, x, &c__1, &info);
00168         chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00169                 infoc_1.ok);
00170         infoc_1.infot = 2;
00171         zgttrs_("N", &c_n1, &c__0, dl, e, du, du2, ip, x, &c__1, &info);
00172         chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00173                 infoc_1.ok);
00174         infoc_1.infot = 3;
00175         zgttrs_("N", &c__0, &c_n1, dl, e, du, du2, ip, x, &c__1, &info);
00176         chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00177                 infoc_1.ok);
00178         infoc_1.infot = 10;
00179         zgttrs_("N", &c__2, &c__1, dl, e, du, du2, ip, x, &c__1, &info);
00180         chkxer_("ZGTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00181                 infoc_1.ok);
00182 
00183 /*        ZGTRFS */
00184 
00185         s_copy(srnamc_1.srnamt, "ZGTRFS", (ftnlen)32, (ftnlen)6);
00186         infoc_1.infot = 1;
00187         zgtrfs_("/", &c__0, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, 
00188                  x, &c__1, r1, r2, w, rw, &info);
00189         chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00190                 infoc_1.ok);
00191         infoc_1.infot = 2;
00192         zgtrfs_("N", &c_n1, &c__0, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, 
00193                  x, &c__1, r1, r2, w, rw, &info);
00194         chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00195                 infoc_1.ok);
00196         infoc_1.infot = 3;
00197         zgtrfs_("N", &c__0, &c_n1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, 
00198                  x, &c__1, r1, r2, w, rw, &info);
00199         chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200                 infoc_1.ok);
00201         infoc_1.infot = 13;
00202         zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__1, 
00203                  x, &c__2, r1, r2, w, rw, &info);
00204         chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00205                 infoc_1.ok);
00206         infoc_1.infot = 15;
00207         zgtrfs_("N", &c__2, &c__1, dl, e, du, dlf, ef, duf, du2, ip, b, &c__2, 
00208                  x, &c__1, r1, r2, w, rw, &info);
00209         chkxer_("ZGTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00210                 infoc_1.ok);
00211 
00212 /*        ZGTCON */
00213 
00214         s_copy(srnamc_1.srnamt, "ZGTCON", (ftnlen)32, (ftnlen)6);
00215         infoc_1.infot = 1;
00216         zgtcon_("/", &c__0, dl, e, du, du2, ip, &anorm, &rcond, w, &info);
00217         chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00218                 infoc_1.ok);
00219         infoc_1.infot = 2;
00220         zgtcon_("I", &c_n1, dl, e, du, du2, ip, &anorm, &rcond, w, &info);
00221         chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00222                 infoc_1.ok);
00223         infoc_1.infot = 8;
00224         d__1 = -anorm;
00225         zgtcon_("I", &c__0, dl, e, du, du2, ip, &d__1, &rcond, w, &info);
00226         chkxer_("ZGTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00227                 infoc_1.ok);
00228 
00229     } else if (lsamen_(&c__2, c2, "PT")) {
00230 
00231 /*        Test error exits for the positive definite tridiagonal */
00232 /*        routines. */
00233 
00234 /*        ZPTTRF */
00235 
00236         s_copy(srnamc_1.srnamt, "ZPTTRF", (ftnlen)32, (ftnlen)6);
00237         infoc_1.infot = 1;
00238         zpttrf_(&c_n1, d__, e, &info);
00239         chkxer_("ZPTTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00240                 infoc_1.ok);
00241 
00242 /*        ZPTTRS */
00243 
00244         s_copy(srnamc_1.srnamt, "ZPTTRS", (ftnlen)32, (ftnlen)6);
00245         infoc_1.infot = 1;
00246         zpttrs_("/", &c__1, &c__0, d__, e, x, &c__1, &info);
00247         chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00248                 infoc_1.ok);
00249         infoc_1.infot = 2;
00250         zpttrs_("U", &c_n1, &c__0, d__, e, x, &c__1, &info);
00251         chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00252                 infoc_1.ok);
00253         infoc_1.infot = 3;
00254         zpttrs_("U", &c__0, &c_n1, d__, e, x, &c__1, &info);
00255         chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00256                 infoc_1.ok);
00257         infoc_1.infot = 7;
00258         zpttrs_("U", &c__2, &c__1, d__, e, x, &c__1, &info);
00259         chkxer_("ZPTTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00260                 infoc_1.ok);
00261 
00262 /*        ZPTRFS */
00263 
00264         s_copy(srnamc_1.srnamt, "ZPTRFS", (ftnlen)32, (ftnlen)6);
00265         infoc_1.infot = 1;
00266         zptrfs_("/", &c__1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, 
00267                  w, rw, &info);
00268         chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00269                 infoc_1.ok);
00270         infoc_1.infot = 2;
00271         zptrfs_("U", &c_n1, &c__0, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, 
00272                  w, rw, &info);
00273         chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00274                 infoc_1.ok);
00275         infoc_1.infot = 3;
00276         zptrfs_("U", &c__0, &c_n1, d__, e, df, ef, b, &c__1, x, &c__1, r1, r2, 
00277                  w, rw, &info);
00278         chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00279                 infoc_1.ok);
00280         infoc_1.infot = 9;
00281         zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__1, x, &c__2, r1, r2, 
00282                  w, rw, &info);
00283         chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00284                 infoc_1.ok);
00285         infoc_1.infot = 11;
00286         zptrfs_("U", &c__2, &c__1, d__, e, df, ef, b, &c__2, x, &c__1, r1, r2, 
00287                  w, rw, &info);
00288         chkxer_("ZPTRFS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00289                 infoc_1.ok);
00290 
00291 /*        ZPTCON */
00292 
00293         s_copy(srnamc_1.srnamt, "ZPTCON", (ftnlen)32, (ftnlen)6);
00294         infoc_1.infot = 1;
00295         zptcon_(&c_n1, d__, e, &anorm, &rcond, rw, &info);
00296         chkxer_("ZPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00297                 infoc_1.ok);
00298         infoc_1.infot = 4;
00299         d__1 = -anorm;
00300         zptcon_(&c__0, d__, e, &d__1, &rcond, rw, &info);
00301         chkxer_("ZPTCON", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00302                 infoc_1.ok);
00303     }
00304 
00305 /*     Print a summary line. */
00306 
00307     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00308 
00309     return 0;
00310 
00311 /*     End of ZERRGT */
00312 
00313 } /* zerrgt_ */