swiftnav: zerrrfp.c Source File

Go to the documentation of this file.
00001 /* zerrrfp.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__0 = 0;
00034 static integer c_n1 = -1;
00035 static integer c__1 = 1;
00036 
00037 /* Subroutine */ int zerrrfp_(integer *nunit)
00038 {
00039     /* Format strings */
00040     static char fmt_9999[] = "(1x,\002COMPLEX*16 RFP routines passed the tes"
00041             "ts of the \002,\002error exits\002)";
00042     static char fmt_9998[] = "(\002 *** RFP routines failed the tests of the"
00043             " error \002,\002exits ***\002)";
00044 
00045     /* Builtin functions */
00046     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00047     integer s_wsfe(cilist *), e_wsfe(void);
00048 
00049     /* Local variables */
00050     doublecomplex a[1]  /* was [1][1] */, b[1]  /* was [1][1] */, beta;
00051     integer info;
00052     doublecomplex alpha;
00053     extern /* Subroutine */ int zhfrk_(char *, char *, char *, integer *, 
00054             integer *, doublecomplex *, doublecomplex *, integer *, 
00055             doublecomplex *, doublecomplex *), ztfsm_(
00056             char *, char *, char *, char *, char *, integer *, integer *, 
00057             doublecomplex *, doublecomplex *, doublecomplex *, integer *), chkxer_(char *, integer *
00058 , integer *, logical *, logical *), zpftrf_(char *, char *
00059 , integer *, doublecomplex *, integer *), zpftri_(
00060             char *, char *, integer *, doublecomplex *, integer *), ztftri_(char *, char *, char *, integer *, doublecomplex 
00061             *, integer *), zpftrs_(char *, char *, 
00062             integer *, integer *, doublecomplex *, doublecomplex *, integer *, 
00063              integer *), ztfttp_(char *, char *, integer *, 
00064             doublecomplex *, doublecomplex *, integer *), 
00065             ztpttf_(char *, char *, integer *, doublecomplex *, doublecomplex 
00066             *, integer *), ztfttr_(char *, char *, integer *, 
00067             doublecomplex *, doublecomplex *, integer *, integer *), ztrttf_(char *, char *, integer *, doublecomplex *, 
00068             integer *, doublecomplex *, integer *), ztpttr_(
00069             char *, integer *, doublecomplex *, doublecomplex *, integer *, 
00070             integer *), ztrttp_(char *, integer *, doublecomplex *, 
00071             integer *, doublecomplex *, integer *);
00072 
00073     /* Fortran I/O blocks */
00074     static cilist io___6 = { 0, 0, 0, fmt_9999, 0 };
00075     static cilist io___7 = { 0, 0, 0, fmt_9998, 0 };
00076 
00077 
00078 
00079 /*  -- LAPACK test routine (version 3.2.0) -- */
00080 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00081 /*     November 2008 */
00082 
00083 /*     .. Scalar Arguments .. */
00084 /*     .. */
00085 
00086 /*  Purpose */
00087 /*  ======= */
00088 
00089 /*  ZERRRFP tests the error exits for the COMPLEX*16 driver routines */
00090 /*  for solving linear systems of equations. */
00091 
00092 /*  ZDRVRFP tests the COMPLEX*16 LAPACK RFP routines: */
00093 /*      ZTFSM, ZTFTRI, ZHFRK, ZTFTTP, ZTFTTR, ZPFTRF, ZPFTRS, ZTPTTF, */
00094 /*      ZTPTTR, ZTRTTF, and ZTRTTP */
00095 
00096 /*  Arguments */
00097 /*  ========= */
00098 
00099 /*  NUNIT   (input) INTEGER */
00100 /*          The unit number for output. */
00101 
00102 /*  ===================================================================== */
00103 
00104 /*     .. */
00105 /*     .. Local Scalars .. */
00106 /*     .. */
00107 /*     .. Local Arrays .. */
00108 /*     .. */
00109 /*     .. External Subroutines .. */
00110 /*     .. */
00111 /*     .. Scalars in Common .. */
00112 /*     .. */
00113 /*     .. Intrinsic Functions .. */
00114 /*     .. */
00115 /*     .. Common blocks .. */
00116 /*     .. */
00117 /*     .. Executable Statements .. */
00118 
00119     infoc_1.nout = *nunit;
00120     infoc_1.ok = TRUE_;
00121     a[0].r = 1., a[0].i = 1.;
00122     b[0].r = 1., b[0].i = 1.;
00123     alpha.r = 1., alpha.i = 1.;
00124     beta.r = 1., beta.i = 1.;
00125 
00126     s_copy(srnamc_1.srnamt, "ZPFTRF", (ftnlen)32, (ftnlen)6);
00127     infoc_1.infot = 1;
00128     zpftrf_("/", "U", &c__0, a, &info);
00129     chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00130             infoc_1.ok);
00131     infoc_1.infot = 2;
00132     zpftrf_("N", "/", &c__0, a, &info);
00133     chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00134             infoc_1.ok);
00135     infoc_1.infot = 3;
00136     zpftrf_("N", "U", &c_n1, a, &info);
00137     chkxer_("ZPFTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00138             infoc_1.ok);
00139 
00140     s_copy(srnamc_1.srnamt, "ZPFTRS", (ftnlen)32, (ftnlen)6);
00141     infoc_1.infot = 1;
00142     zpftrs_("/", "U", &c__0, &c__0, a, b, &c__1, &info);
00143     chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00144             infoc_1.ok);
00145     infoc_1.infot = 2;
00146     zpftrs_("N", "/", &c__0, &c__0, a, b, &c__1, &info);
00147     chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00148             infoc_1.ok);
00149     infoc_1.infot = 3;
00150     zpftrs_("N", "U", &c_n1, &c__0, a, b, &c__1, &info);
00151     chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00152             infoc_1.ok);
00153     infoc_1.infot = 4;
00154     zpftrs_("N", "U", &c__0, &c_n1, a, b, &c__1, &info);
00155     chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156             infoc_1.ok);
00157     infoc_1.infot = 7;
00158     zpftrs_("N", "U", &c__0, &c__0, a, b, &c__0, &info);
00159     chkxer_("ZPFTRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00160             infoc_1.ok);
00161 
00162     s_copy(srnamc_1.srnamt, "ZPFTRI", (ftnlen)32, (ftnlen)6);
00163     infoc_1.infot = 1;
00164     zpftri_("/", "U", &c__0, a, &info);
00165     chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00166             infoc_1.ok);
00167     infoc_1.infot = 2;
00168     zpftri_("N", "/", &c__0, a, &info);
00169     chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00170             infoc_1.ok);
00171     infoc_1.infot = 3;
00172     zpftri_("N", "U", &c_n1, a, &info);
00173     chkxer_("ZPFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00174             infoc_1.ok);
00175 
00176     s_copy(srnamc_1.srnamt, "ZTFSM ", (ftnlen)32, (ftnlen)6);
00177     infoc_1.infot = 1;
00178     ztfsm_("/", "L", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1);
00179     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00180             infoc_1.ok);
00181     infoc_1.infot = 2;
00182     ztfsm_("N", "/", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1);
00183     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00184             infoc_1.ok);
00185     infoc_1.infot = 3;
00186     ztfsm_("N", "L", "/", "C", "U", &c__0, &c__0, &alpha, a, b, &c__1);
00187     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00188             infoc_1.ok);
00189     infoc_1.infot = 4;
00190     ztfsm_("N", "L", "U", "/", "U", &c__0, &c__0, &alpha, a, b, &c__1);
00191     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00192             infoc_1.ok);
00193     infoc_1.infot = 5;
00194     ztfsm_("N", "L", "U", "C", "/", &c__0, &c__0, &alpha, a, b, &c__1);
00195     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00196             infoc_1.ok);
00197     infoc_1.infot = 6;
00198     ztfsm_("N", "L", "U", "C", "U", &c_n1, &c__0, &alpha, a, b, &c__1);
00199     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200             infoc_1.ok);
00201     infoc_1.infot = 7;
00202     ztfsm_("N", "L", "U", "C", "U", &c__0, &c_n1, &alpha, a, b, &c__1);
00203     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00204             infoc_1.ok);
00205     infoc_1.infot = 11;
00206     ztfsm_("N", "L", "U", "C", "U", &c__0, &c__0, &alpha, a, b, &c__0);
00207     chkxer_("ZTFSM ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00208             infoc_1.ok);
00209 
00210     s_copy(srnamc_1.srnamt, "ZTFTRI", (ftnlen)32, (ftnlen)6);
00211     infoc_1.infot = 1;
00212     ztftri_("/", "L", "N", &c__0, a, &info);
00213     chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00214             infoc_1.ok);
00215     infoc_1.infot = 2;
00216     ztftri_("N", "/", "N", &c__0, a, &info);
00217     chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00218             infoc_1.ok);
00219     infoc_1.infot = 3;
00220     ztftri_("N", "L", "/", &c__0, a, &info);
00221     chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00222             infoc_1.ok);
00223     infoc_1.infot = 4;
00224     ztftri_("N", "L", "N", &c_n1, a, &info);
00225     chkxer_("ZTFTRI", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00226             infoc_1.ok);
00227 
00228     s_copy(srnamc_1.srnamt, "ZTFTTR", (ftnlen)32, (ftnlen)6);
00229     infoc_1.infot = 1;
00230     ztfttr_("/", "U", &c__0, a, b, &c__1, &info);
00231     chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00232             infoc_1.ok);
00233     infoc_1.infot = 2;
00234     ztfttr_("N", "/", &c__0, a, b, &c__1, &info);
00235     chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00236             infoc_1.ok);
00237     infoc_1.infot = 3;
00238     ztfttr_("N", "U", &c_n1, a, b, &c__1, &info);
00239     chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00240             infoc_1.ok);
00241     infoc_1.infot = 6;
00242     ztfttr_("N", "U", &c__0, a, b, &c__0, &info);
00243     chkxer_("ZTFTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00244             infoc_1.ok);
00245 
00246     s_copy(srnamc_1.srnamt, "ZTRTTF", (ftnlen)32, (ftnlen)6);
00247     infoc_1.infot = 1;
00248     ztrttf_("/", "U", &c__0, a, &c__1, b, &info);
00249     chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00250             infoc_1.ok);
00251     infoc_1.infot = 2;
00252     ztrttf_("N", "/", &c__0, a, &c__1, b, &info);
00253     chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00254             infoc_1.ok);
00255     infoc_1.infot = 3;
00256     ztrttf_("N", "U", &c_n1, a, &c__1, b, &info);
00257     chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00258             infoc_1.ok);
00259     infoc_1.infot = 5;
00260     ztrttf_("N", "U", &c__0, a, &c__0, b, &info);
00261     chkxer_("ZTRTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262             infoc_1.ok);
00263 
00264     s_copy(srnamc_1.srnamt, "ZTFTTP", (ftnlen)32, (ftnlen)6);
00265     infoc_1.infot = 1;
00266     ztfttp_("/", "U", &c__0, a, b, &info);
00267     chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00268             infoc_1.ok);
00269     infoc_1.infot = 2;
00270     ztfttp_("N", "/", &c__0, a, b, &info);
00271     chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00272             infoc_1.ok);
00273     infoc_1.infot = 3;
00274     ztfttp_("N", "U", &c_n1, a, b, &info);
00275     chkxer_("ZTFTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00276             infoc_1.ok);
00277 
00278     s_copy(srnamc_1.srnamt, "ZTPTTF", (ftnlen)32, (ftnlen)6);
00279     infoc_1.infot = 1;
00280     ztpttf_("/", "U", &c__0, a, b, &info);
00281     chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00282             infoc_1.ok);
00283     infoc_1.infot = 2;
00284     ztpttf_("N", "/", &c__0, a, b, &info);
00285     chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00286             infoc_1.ok);
00287     infoc_1.infot = 3;
00288     ztpttf_("N", "U", &c_n1, a, b, &info);
00289     chkxer_("ZTPTTF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00290             infoc_1.ok);
00291 
00292     s_copy(srnamc_1.srnamt, "ZTRTTP", (ftnlen)32, (ftnlen)6);
00293     infoc_1.infot = 1;
00294     ztrttp_("/", &c__0, a, &c__1, b, &info);
00295     chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00296             infoc_1.ok);
00297     infoc_1.infot = 2;
00298     ztrttp_("U", &c_n1, a, &c__1, b, &info);
00299     chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00300             infoc_1.ok);
00301     infoc_1.infot = 4;
00302     ztrttp_("U", &c__0, a, &c__0, b, &info);
00303     chkxer_("ZTRTTP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00304             infoc_1.ok);
00305 
00306     s_copy(srnamc_1.srnamt, "ZTPTTR", (ftnlen)32, (ftnlen)6);
00307     infoc_1.infot = 1;
00308     ztpttr_("/", &c__0, a, b, &c__1, &info);
00309     chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00310             infoc_1.ok);
00311     infoc_1.infot = 2;
00312     ztpttr_("U", &c_n1, a, b, &c__1, &info);
00313     chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00314             infoc_1.ok);
00315     infoc_1.infot = 5;
00316     ztpttr_("U", &c__0, a, b, &c__0, &info);
00317     chkxer_("ZTPTTR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00318             infoc_1.ok);
00319 
00320     s_copy(srnamc_1.srnamt, "ZHFRK ", (ftnlen)32, (ftnlen)6);
00321     infoc_1.infot = 1;
00322     zhfrk_("/", "U", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
00323     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00324             infoc_1.ok);
00325     infoc_1.infot = 2;
00326     zhfrk_("N", "/", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
00327     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00328             infoc_1.ok);
00329     infoc_1.infot = 3;
00330     zhfrk_("N", "U", "/", &c__0, &c__0, &alpha, a, &c__1, &beta, b);
00331     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00332             infoc_1.ok);
00333     infoc_1.infot = 4;
00334     zhfrk_("N", "U", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, b);
00335     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00336             infoc_1.ok);
00337     infoc_1.infot = 5;
00338     zhfrk_("N", "U", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, b);
00339     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00340             infoc_1.ok);
00341     infoc_1.infot = 8;
00342     zhfrk_("N", "U", "N", &c__0, &c__0, &alpha, a, &c__0, &beta, b);
00343     chkxer_("ZHFRK ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00344             infoc_1.ok);
00345 
00346 /*     Print a summary line. */
00347 
00348     if (infoc_1.ok) {
00349         io___6.ciunit = infoc_1.nout;
00350         s_wsfe(&io___6);
00351         e_wsfe();
00352     } else {
00353         io___7.ciunit = infoc_1.nout;
00354         s_wsfe(&io___7);
00355         e_wsfe();
00356     }
00357 
00358     return 0;
00359 
00360 /*     End of ZERRRFP */
00361 
00362 } /* zerrrfp_ */