chkxer.c
Go to the documentation of this file.
00001 /* chkxer.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 #include "string.h"
00016 
00017 /* Table of constant values */
00018 
00019 static integer c__1 = 1;
00020 
00021 /* Subroutine */ int chkxer_(char *srnamt, integer *infot, integer *nout, 
00022         logical *lerr, logical *ok)
00023 {
00024     /* Format strings */
00025     static char fmt_9999[] = "(\002 *** Illegal value of parameter number"
00026             " \002,i2,\002 not detected by \002,a6,\002 ***\002)";
00027 
00028     /* Builtin functions */
00029     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), i_len_trim(
00030             char *, ftnlen), e_wsfe(void);
00031 
00032     /* Fortran I/O blocks */
00033     static cilist io___1 = { 0, 0, 0, fmt_9999, 0 };
00034 
00035         int srnamt_len;
00036 
00037         srnamt_len = strlen (srnamt);
00038 
00039 
00040 
00041 /*  Tests whether XERBLA has detected an error when it should. */
00042 
00043 /*  Auxiliary routine for test program for Level 2 Blas. */
00044 
00045 /*  -- Written on 10-August-1987. */
00046 /*     Richard Hanson, Sandia National Labs. */
00047 /*     Jeremy Du Croz, NAG Central Office. */
00048 
00049 /*  ===================================================================== */
00050 
00051 /*     .. Scalar Arguments .. */
00052 /*     .. */
00053 /*     .. Intrinsic Functions .. */
00054 /*     .. */
00055 /*     .. Executable Statements .. */
00056     if (! (*lerr)) {
00057         io___1.ciunit = *nout;
00058         s_wsfe(&io___1);
00059         do_fio(&c__1, (char *)&(*infot), (ftnlen)sizeof(integer));
00060         do_fio(&c__1, srnamt, i_len_trim(srnamt, srnamt_len));
00061         e_wsfe();
00062         *ok = FALSE_;
00063     }
00064     *lerr = FALSE_;
00065     return 0;
00066 
00067 
00068 /*     End of CHKXER. */
00069 
00070 } /* chkxer_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:29