serrtz.c
Go to the documentation of this file.
00001 /* serrtz.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_n1 = -1;
00035 static integer c__0 = 0;
00036 static integer c__1 = 1;
00037 
00038 /* Subroutine */ int serrtz_(char *path, integer *nunit)
00039 {
00040     /* Builtin functions */
00041     integer s_wsle(cilist *), e_wsle(void);
00042     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00043 
00044     /* Local variables */
00045     real a[4]   /* was [2][2] */, w[2];
00046     char c2[2];
00047     real tau[2];
00048     integer info;
00049     extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
00050     extern logical lsamen_(integer *, char *, char *);
00051     extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
00052             *, logical *), stzrqf_(integer *, integer *, real *, 
00053             integer *, real *, integer *), stzrzf_(integer *, integer *, real 
00054             *, integer *, real *, real *, integer *, integer *);
00055 
00056     /* Fortran I/O blocks */
00057     static cilist io___1 = { 0, 0, 0, 0, 0 };
00058 
00059 
00060 
00061 /*  -- LAPACK test routine (version 3.1) -- */
00062 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00063 /*     November 2006 */
00064 
00065 /*     .. Scalar Arguments .. */
00066 /*     .. */
00067 
00068 /*  Purpose */
00069 /*  ======= */
00070 
00071 /*  SERRTZ tests the error exits for STZRQF and STZRZF. */
00072 
00073 /*  Arguments */
00074 /*  ========= */
00075 
00076 /*  PATH    (input) CHARACTER*3 */
00077 /*          The LAPACK path name for the routines to be tested. */
00078 
00079 /*  NUNIT   (input) INTEGER */
00080 /*          The unit number for output. */
00081 
00082 /*  ===================================================================== */
00083 
00084 /*     .. Parameters .. */
00085 /*     .. */
00086 /*     .. Local Scalars .. */
00087 /*     .. */
00088 /*     .. Local Arrays .. */
00089 /*     .. */
00090 /*     .. External Functions .. */
00091 /*     .. */
00092 /*     .. External Subroutines .. */
00093 /*     .. */
00094 /*     .. Scalars in Common .. */
00095 /*     .. */
00096 /*     .. Common blocks .. */
00097 /*     .. */
00098 /*     .. Executable Statements .. */
00099 
00100     infoc_1.nout = *nunit;
00101     io___1.ciunit = infoc_1.nout;
00102     s_wsle(&io___1);
00103     e_wsle();
00104     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00105     a[0] = 1.f;
00106     a[2] = 2.f;
00107     a[3] = 3.f;
00108     a[1] = 4.f;
00109     w[0] = 0.f;
00110     w[1] = 0.f;
00111     infoc_1.ok = TRUE_;
00112 
00113     if (lsamen_(&c__2, c2, "TZ")) {
00114 
00115 /*        Test error exits for the trapezoidal routines. */
00116 
00117 /*        STZRQF */
00118 
00119         s_copy(srnamc_1.srnamt, "STZRQF", (ftnlen)32, (ftnlen)6);
00120         infoc_1.infot = 1;
00121         stzrqf_(&c_n1, &c__0, a, &c__1, tau, &info);
00122         chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00123                 infoc_1.ok);
00124         infoc_1.infot = 2;
00125         stzrqf_(&c__1, &c__0, a, &c__1, tau, &info);
00126         chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00127                 infoc_1.ok);
00128         infoc_1.infot = 4;
00129         stzrqf_(&c__2, &c__2, a, &c__1, tau, &info);
00130         chkxer_("STZRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00131                 infoc_1.ok);
00132 
00133 /*        STZRZF */
00134 
00135         s_copy(srnamc_1.srnamt, "STZRZF", (ftnlen)32, (ftnlen)6);
00136         infoc_1.infot = 1;
00137         stzrzf_(&c_n1, &c__0, a, &c__1, tau, w, &c__1, &info);
00138         chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00139                 infoc_1.ok);
00140         infoc_1.infot = 2;
00141         stzrzf_(&c__1, &c__0, a, &c__1, tau, w, &c__1, &info);
00142         chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00143                 infoc_1.ok);
00144         infoc_1.infot = 4;
00145         stzrzf_(&c__2, &c__2, a, &c__1, tau, w, &c__1, &info);
00146         chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00147                 infoc_1.ok);
00148         infoc_1.infot = 7;
00149         stzrzf_(&c__2, &c__2, a, &c__2, tau, w, &c__1, &info);
00150         chkxer_("STZRZF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00151                 infoc_1.ok);
00152     }
00153 
00154 /*     Print a summary line. */
00155 
00156     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00157 
00158     return 0;
00159 
00160 /*     End of SERRTZ */
00161 
00162 } /* serrtz_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:05