swiftnav: derrls.c Source File

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