swiftnav: derrrfp.c Source File

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