swiftnav: serrls.c Source File

Go to the documentation of this file.
00001 /* serrls.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__0 = 0;
00035 static integer c__1 = 1;
00036 static integer c_n1 = -1;
00037 static integer c__10 = 10;
00038 
00039 /* Subroutine */ int serrls_(char *path, integer *nunit)
00040 {
00041     /* Builtin functions */
00042     integer s_wsle(cilist *), e_wsle(void);
00043     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00044 
00045     /* Local variables */
00046     real a[4]   /* was [2][2] */, b[4]  /* was [2][2] */, s[2], w[2];
00047     char c2[2];
00048     integer ip[2], info, irnk;
00049     real rcond;
00050     extern /* Subroutine */ int sgels_(char *, integer *, integer *, integer *
00051 , real *, integer *, real *, integer *, real *, integer *, 
00052             integer *), alaesm_(char *, logical *, integer *);
00053     extern logical lsamen_(integer *, char *, char *);
00054     extern /* Subroutine */ int sgelsd_(integer *, integer *, integer *, real 
00055             *, integer *, real *, integer *, real *, real *, integer *, real *
00056 , integer *, integer *, integer *), chkxer_(char *, integer *, 
00057             integer *, logical *, logical *), sgelss_(integer *, 
00058             integer *, integer *, real *, integer *, real *, integer *, real *
00059 , real *, integer *, real *, integer *, integer *), sgelsx_(
00060             integer *, integer *, integer *, real *, integer *, real *, 
00061             integer *, integer *, real *, integer *, real *, integer *), 
00062             sgelsy_(integer *, integer *, integer *, real *, integer *, real *
00063 , integer *, integer *, real *, integer *, real *, integer *, 
00064             integer *);
00065 
00066     /* Fortran I/O blocks */
00067     static cilist io___1 = { 0, 0, 0, 0, 0 };
00068 
00069 
00070 
00071 /*  -- LAPACK test routine (version 3.1) -- */
00072 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00073 /*     November 2006 */
00074 
00075 /*     .. Scalar Arguments .. */
00076 /*     .. */
00077 
00078 /*  Purpose */
00079 /*  ======= */
00080 
00081 /*  SERRLS tests the error exits for the REAL least squares */
00082 /*  driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD). */
00083 
00084 /*  Arguments */
00085 /*  ========= */
00086 
00087 /*  PATH    (input) CHARACTER*3 */
00088 /*          The LAPACK path name for the routines to be tested. */
00089 
00090 /*  NUNIT   (input) INTEGER */
00091 /*          The unit number for output. */
00092 
00093 /*  ===================================================================== */
00094 
00095 /*     .. Parameters .. */
00096 /*     .. */
00097 /*     .. Local Scalars .. */
00098 /*     .. */
00099 /*     .. Local Arrays .. */
00100 /*     .. */
00101 /*     .. External Functions .. */
00102 /*     .. */
00103 /*     .. External Subroutines .. */
00104 /*     .. */
00105 /*     .. Scalars in Common .. */
00106 /*     .. */
00107 /*     .. Common blocks .. */
00108 /*     .. */
00109 /*     .. Executable Statements .. */
00110 
00111     infoc_1.nout = *nunit;
00112     io___1.ciunit = infoc_1.nout;
00113     s_wsle(&io___1);
00114     e_wsle();
00115     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00116     a[0] = 1.f;
00117     a[2] = 2.f;
00118     a[3] = 3.f;
00119     a[1] = 4.f;
00120     infoc_1.ok = TRUE_;
00121 
00122     if (lsamen_(&c__2, c2, "LS")) {
00123 
00124 /*        Test error exits for the least squares driver routines. */
00125 
00126 /*        SGELS */
00127 
00128         s_copy(srnamc_1.srnamt, "SGELS ", (ftnlen)32, (ftnlen)6);
00129         infoc_1.infot = 1;
00130         sgels_("/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info);
00131         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00132                 infoc_1.ok);
00133         infoc_1.infot = 2;
00134         sgels_("N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, w, &c__1, &info);
00135         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00136                 infoc_1.ok);
00137         infoc_1.infot = 3;
00138         sgels_("N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info);
00139         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00140                 infoc_1.ok);
00141         infoc_1.infot = 4;
00142         sgels_("N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, w, &c__1, &info);
00143         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00144                 infoc_1.ok);
00145         infoc_1.infot = 6;
00146         sgels_("N", &c__2, &c__0, &c__0, a, &c__1, b, &c__2, w, &c__2, &info);
00147         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00148                 infoc_1.ok);
00149         infoc_1.infot = 8;
00150         sgels_("N", &c__2, &c__0, &c__0, a, &c__2, b, &c__1, w, &c__2, &info);
00151         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00152                 infoc_1.ok);
00153         infoc_1.infot = 10;
00154         sgels_("N", &c__1, &c__1, &c__0, a, &c__1, b, &c__1, w, &c__1, &info);
00155         chkxer_("SGELS ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156                 infoc_1.ok);
00157 
00158 /*        SGELSS */
00159 
00160         s_copy(srnamc_1.srnamt, "SGELSS", (ftnlen)32, (ftnlen)6);
00161         infoc_1.infot = 1;
00162         sgelss_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00163                 &c__1, &info);
00164         chkxer_("SGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00165                 infoc_1.ok);
00166         infoc_1.infot = 2;
00167         sgelss_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00168                 &c__1, &info);
00169         chkxer_("SGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00170                 infoc_1.ok);
00171         infoc_1.infot = 3;
00172         sgelss_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00173                 &c__1, &info);
00174         chkxer_("SGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00175                 infoc_1.ok);
00176         infoc_1.infot = 5;
00177         sgelss_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, 
00178                 &c__2, &info);
00179         chkxer_("SGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00180                 infoc_1.ok);
00181         infoc_1.infot = 7;
00182         sgelss_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, 
00183                 &c__2, &info);
00184         chkxer_("SGELSS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00185                 infoc_1.ok);
00186 
00187 /*        SGELSX */
00188 
00189         s_copy(srnamc_1.srnamt, "SGELSX", (ftnlen)32, (ftnlen)6);
00190         infoc_1.infot = 1;
00191         sgelsx_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00192                  &info);
00193         chkxer_("SGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00194                 infoc_1.ok);
00195         infoc_1.infot = 2;
00196         sgelsx_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00197                  &info);
00198         chkxer_("SGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00199                 infoc_1.ok);
00200         infoc_1.infot = 3;
00201         sgelsx_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00202                  &info);
00203         chkxer_("SGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00204                 infoc_1.ok);
00205         infoc_1.infot = 5;
00206         sgelsx_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, 
00207                  &info);
00208         chkxer_("SGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00209                 infoc_1.ok);
00210         infoc_1.infot = 7;
00211         sgelsx_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, 
00212                  &info);
00213         chkxer_("SGELSX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00214                 infoc_1.ok);
00215 
00216 /*        SGELSY */
00217 
00218         s_copy(srnamc_1.srnamt, "SGELSY", (ftnlen)32, (ftnlen)6);
00219         infoc_1.infot = 1;
00220         sgelsy_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00221                  &c__10, &info);
00222         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00223                 infoc_1.ok);
00224         infoc_1.infot = 2;
00225         sgelsy_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00226                  &c__10, &info);
00227         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00228                 infoc_1.ok);
00229         infoc_1.infot = 3;
00230         sgelsy_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, ip, &rcond, &irnk, w, 
00231                  &c__10, &info);
00232         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00233                 infoc_1.ok);
00234         infoc_1.infot = 5;
00235         sgelsy_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, ip, &rcond, &irnk, w, 
00236                  &c__10, &info);
00237         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00238                 infoc_1.ok);
00239         infoc_1.infot = 7;
00240         sgelsy_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, ip, &rcond, &irnk, w, 
00241                  &c__10, &info);
00242         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00243                 infoc_1.ok);
00244         infoc_1.infot = 12;
00245         sgelsy_(&c__2, &c__2, &c__1, a, &c__2, b, &c__2, ip, &rcond, &irnk, w, 
00246                  &c__1, &info);
00247         chkxer_("SGELSY", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00248                 infoc_1.ok);
00249 
00250 /*        SGELSD */
00251 
00252         s_copy(srnamc_1.srnamt, "SGELSD", (ftnlen)32, (ftnlen)6);
00253         infoc_1.infot = 1;
00254         sgelsd_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00255                 &c__10, ip, &info);
00256         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257                 infoc_1.ok);
00258         infoc_1.infot = 2;
00259         sgelsd_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00260                 &c__10, ip, &info);
00261         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262                 infoc_1.ok);
00263         infoc_1.infot = 3;
00264         sgelsd_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, s, &rcond, &irnk, w, 
00265                 &c__10, ip, &info);
00266         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00267                 infoc_1.ok);
00268         infoc_1.infot = 5;
00269         sgelsd_(&c__2, &c__0, &c__0, a, &c__1, b, &c__2, s, &rcond, &irnk, w, 
00270                 &c__10, ip, &info);
00271         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00272                 infoc_1.ok);
00273         infoc_1.infot = 7;
00274         sgelsd_(&c__2, &c__0, &c__0, a, &c__2, b, &c__1, s, &rcond, &irnk, w, 
00275                 &c__10, ip, &info);
00276         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00277                 infoc_1.ok);
00278         infoc_1.infot = 12;
00279         sgelsd_(&c__2, &c__2, &c__1, a, &c__2, b, &c__2, s, &rcond, &irnk, w, 
00280                 &c__1, ip, &info);
00281         chkxer_("SGELSD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00282                 infoc_1.ok);
00283     }
00284 
00285 /*     Print a summary line. */
00286 
00287     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00288 
00289     return 0;
00290 
00291 /*     End of SERRLS */
00292 
00293 } /* serrls_ */