chkxer.c

Go to the documentation of this file.

/* chkxer.f -- translated by f2c (version 20061008).
   You must link the resulting object file with libf2c:
        on Microsoft Windows system, link with libf2c.lib;
        on Linux or Unix systems, link with .../path/to/libf2c.a -lm
        or, if you install libf2c.a in a standard place, with -lf2c -lm
        -- in that order, at the end of the command line, as in
                cc *.o -lf2c -lm
        Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

                http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"
#include "blaswrap.h"
#include "string.h"

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int chkxer_(char *srnamt, integer *infot, integer *nout, 
        logical *lerr, logical *ok)
{
    /* Format strings */
    static char fmt_9999[] = "(\002 *** Illegal value of parameter number"
            " \002,i2,\002 not detected by \002,a6,\002 ***\002)";

    /* Builtin functions */
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), i_len_trim(
            char *, ftnlen), e_wsfe(void);

    /* Fortran I/O blocks */
    static cilist io___1 = { 0, 0, 0, fmt_9999, 0 };

        int srnamt_len;

        srnamt_len = strlen (srnamt);



/*  Tests whether XERBLA has detected an error when it should. */

/*  Auxiliary routine for test program for Level 2 Blas. */

/*  -- Written on 10-August-1987. */
/*     Richard Hanson, Sandia National Labs. */
/*     Jeremy Du Croz, NAG Central Office. */

/*  ===================================================================== */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. Executable Statements .. */
    if (! (*lerr)) {
        io___1.ciunit = *nout;
        s_wsfe(&io___1);
        do_fio(&c__1, (char *)&(*infot), (ftnlen)sizeof(integer));
        do_fio(&c__1, srnamt, i_len_trim(srnamt, srnamt_len));
        e_wsfe();
        *ok = FALSE_;
    }
    *lerr = FALSE_;
    return 0;


/*     End of CHKXER. */

} /* chkxer_ */