swiftnav: cerrrfp.c Source File

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