#include "blaswrap.h"
/*  -- translated by f2c (version 19990503).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    integer infot, nout;
    logical ok, lerr;
} infoc_;

#define infoc_1 infoc_

struct {
    char srnamt[6];
} srnamc_;

#define srnamc_1 srnamc_

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int xerbla_(char *srname, integer *info)
{
    /* Format strings */
    static char fmt_9999[] = "(\002 *** XERBLA was called from \002,a6,\002 "
	    "with INFO = \002,i6,\002 instead of \002,i2,\002 ***\002)";
    static char fmt_9997[] = "(\002 *** On entry to \002,a6,\002 parameter n"
	    "umber \002,i6,\002 had an illegal value ***\002)";
    static char fmt_9998[] = "(\002 *** XERBLA was called with SRNAME = \002"
	    ",a6,\002 instead of \002,a6,\002 ***\002)";

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

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



/*  -- LAPACK auxiliary routine (version 3.0) --   
       Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
       Courant Institute, Argonne National Lab, and Rice University   
       February 29, 1992   


    Purpose   
    =======   

    This is a special version of XERBLA to be used only as part of   
    the test program for testing error exits from the LAPACK routines.   
    Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRMANT,   
    where INFOT and SRNAMT are values stored in COMMON.   

    Arguments   
    =========   

    SRNAME  (input) CHARACTER*6   
            The name of the subroutine calling XERBLA.  This name should   
            match the COMMON variable SRNAMT.   

    INFO    (input) INTEGER   
            The error return code from the calling subroutine.  INFO   
            should equal the COMMON variable INFOT.   

    Further Details   
    ======= =======   

    The following variables are passed via the common blocks INFOC and   
    SRNAMC:   

    INFOT   INTEGER      Expected integer return code   
    NOUT    INTEGER      Unit number for printing error messages   
    OK      LOGICAL      Set to .TRUE. if INFO = INFOT and   
                         SRNAME = SRNAMT, otherwise set to .FALSE.   
    LERR    LOGICAL      Set to .TRUE., indicating that XERBLA was called   
    SRNAMT  CHARACTER*6  Expected name of calling subroutine */



    infoc_1.lerr = TRUE_;
    if (*info != infoc_1.infot) {
	if (infoc_1.infot != 0) {
	    io___1.ciunit = infoc_1.nout;
	    s_wsfe(&io___1);
	    do_fio(&c__1, srnamc_1.srnamt, (ftnlen)6);
	    do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
	    do_fio(&c__1, (char *)&infoc_1.infot, (ftnlen)sizeof(integer));
	    e_wsfe();
	} else {
	    io___2.ciunit = infoc_1.nout;
	    s_wsfe(&io___2);
	    do_fio(&c__1, srname, (ftnlen)6);
	    do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
	    e_wsfe();
	}
	infoc_1.ok = FALSE_;
    }
    if (s_cmp(srname, srnamc_1.srnamt, (ftnlen)6, (ftnlen)6) != 0) {
	io___3.ciunit = infoc_1.nout;
	s_wsfe(&io___3);
	do_fio(&c__1, srname, (ftnlen)6);
	do_fio(&c__1, srnamc_1.srnamt, (ftnlen)6);
	e_wsfe();
	infoc_1.ok = FALSE_;
    }
    return 0;


/*     End of XERBLA */

} /* xerbla_ */