swiftnav: serrrfp.c Source File

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