/* daux.f -- translated by f2c (version 20030320).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* Table of constant values */

static integer c__1 = 1;
static integer c__0 = 0;
static logical c_false = FALSE_;
static integer c__2 = 2;
static logical c_true = TRUE_;

/*      DOUBLE PRECISION FUNCTION D1MACH (IDUM) */
/*      INTEGER IDUM */
/* C----------------------------------------------------------------------- */
/* C THIS ROUTINE COMPUTES THE UNIT ROUNDOFF OF THE MACHINE IN DOUBLE */
/* C PRECISION.  THIS IS DEFINED AS THE SMALLEST POSITIVE MACHINE NUMBER */
/* C U SUCH THAT  1.0D0 + U .NE. 1.0D0 (IN DOUBLE PRECISION). */
/* C----------------------------------------------------------------------- */
/*      DOUBLE PRECISION U, COMP */
/*      U = 1.0D0 */
/* 10   U = U*0.5D0 */
/*      COMP = 1.0D0 + U */
/*      IF (COMP .NE. 1.0D0) GO TO 10 */
/*      D1MACH = U*2.0D0 */
/*      RETURN */
/* C----------------------- END OF FUNCTION D1MACH ------------------------ */
/*      END */
/* DECK XERRWD */
/* Subroutine */ int xerrwd_(char *msg, integer *nmes, integer *nerr, integer 
	*level, integer *ni, integer *i1, integer *i2, integer *nr, 
	doublereal *r1, doublereal *r2, ftnlen msg_len)
{
    /* Format strings */
    static char fmt_10[] = "(1x,a)";
    static char fmt_20[] = "(6x,\002In above message,  I1 =\002,i10)";
    static char fmt_30[] = "(6x,\002In above message,  I1 =\002,i10,3x,\002I"
	    "2 =\002,i10)";
    static char fmt_40[] = "(6x,\002In above message,  R1 =\002,d21.13)";
    static char fmt_50[] = "(6x,\002In above,  R1 =\002,d21.13,3x,\002R2 "
	    "=\002,d21.13)";

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

    /* Local variables */
    extern integer ixsav_(integer *, integer *, logical *);
    integer lunit, mesflg;

    /* Fortran I/O blocks */
    static cilist io___3 = { 0, 0, 0, fmt_10, 0 };
    static cilist io___4 = { 0, 0, 0, fmt_20, 0 };
    static cilist io___5 = { 0, 0, 0, fmt_30, 0 };
    static cilist io___6 = { 0, 0, 0, fmt_40, 0 };
    static cilist io___7 = { 0, 0, 0, fmt_50, 0 };


/* ***BEGIN PROLOGUE  XERRWD */
/* ***SUBSIDIARY */
/* ***PURPOSE  Write error message with values. */
/* ***LIBRARY   MATHLIB */
/* ***CATEGORY  R3C */
/* ***TYPE      DOUBLE PRECISION (XERRWV-S, XERRWD-D) */
/* ***AUTHOR  Hindmarsh, Alan C., (LLNL) */
/* ***DESCRIPTION */

/*  Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV, */
/*  as given here, constitute a simplified version of the SLATEC error */
/*  handling package. */

/*  All arguments are input arguments. */

/*  MSG    = The message (character array). */
/*  NMES   = The length of MSG (number of characters). */
/*  NERR   = The error number (not used). */
/*  LEVEL  = The error level.. */
/*           0 or 1 means recoverable (control returns to caller). */
/*           2 means fatal (run is aborted--see note below). */
/*  NI     = Number of integers (0, 1, or 2) to be printed with message. */
/*  I1,I2  = Integers to be printed, depending on NI. */
/*  NR     = Number of reals (0, 1, or 2) to be printed with message. */
/*  R1,R2  = Reals to be printed, depending on NR. */

/*  Note..  this routine is machine-dependent and specialized for use */
/*  in limited context, in the following ways.. */
/*  1. The argument MSG is assumed to be of type CHARACTER, and */
/*     the message is printed with a format of (1X,A). */
/*  2. The message is assumed to take only one line. */
/*     Multi-line messages are generated by repeated calls. */
/*  3. If LEVEL = 2, control passes to the statement   STOP */
/*     to abort the run.  This statement may be machine-dependent. */
/*  4. R1 and R2 are assumed to be in double precision and are printed */
/*     in D21.13 format. */

/* ***ROUTINES CALLED  IXSAV */
/* ***REVISION HISTORY  (YYMMDD) */
/*   920831  DATE WRITTEN */
/*   921118  Replaced MFLGSV/LUNSAV by IXSAV. (ACH) */
/*   930329  Modified prologue to SLATEC format. (FNF) */
/*   930407  Changed MSG from CHARACTER*1 array to variable. (FNF) */
/*   930922  Minor cosmetic change. (FNF) */
/* ***END PROLOGUE  XERRWD */

/* *Internal Notes: */

/* For a different default logical unit number, IXSAV (or a subsidiary */
/* routine that it calls) will need to be modified. */
/* For a different run-abort command, change the statement following */
/* statement 100 at the end. */
/* ----------------------------------------------------------------------- */
/* Subroutines called by XERRWD.. None */
/* Function routine called by XERRWD.. IXSAV */
/* ----------------------------------------------------------------------- */
/* **End */

/*  Declare arguments. */


/*  Declare local variables. */


/*  Get logical unit number and message print flag. */

/* ***FIRST EXECUTABLE STATEMENT  XERRWD */
    lunit = ixsav_(&c__1, &c__0, &c_false);
    mesflg = ixsav_(&c__2, &c__0, &c_false);
    if (mesflg == 0) {
	goto L100;
    }

/*  Write the message. */

    io___3.ciunit = lunit;
    s_wsfe(&io___3);
    do_fio(&c__1, msg, msg_len);
    e_wsfe();
    if (*ni == 1) {
	io___4.ciunit = lunit;
	s_wsfe(&io___4);
	do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
	e_wsfe();
    }
    if (*ni == 2) {
	io___5.ciunit = lunit;
	s_wsfe(&io___5);
	do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
	do_fio(&c__1, (char *)&(*i2), (ftnlen)sizeof(integer));
	e_wsfe();
    }
    if (*nr == 1) {
	io___6.ciunit = lunit;
	s_wsfe(&io___6);
	do_fio(&c__1, (char *)&(*r1), (ftnlen)sizeof(doublereal));
	e_wsfe();
    }
    if (*nr == 2) {
	io___7.ciunit = lunit;
	s_wsfe(&io___7);
	do_fio(&c__1, (char *)&(*r1), (ftnlen)sizeof(doublereal));
	do_fio(&c__1, (char *)&(*r2), (ftnlen)sizeof(doublereal));
	e_wsfe();
    }

/*  Abort the run if LEVEL = 2. */

L100:
    if (*level != 2) {
	return 0;
    }
    s_stop("", (ftnlen)0);
/* ----------------------- End of Subroutine XERRWD ---------------------- */
    return 0;
} /* xerrwd_ */

/* DECK XSETF */
/* Subroutine */ int xsetf_(integer *mflag)
{
    integer junk;
    extern integer ixsav_(integer *, integer *, logical *);

/* ***BEGIN PROLOGUE  XSETF */
/* ***PURPOSE  Reset the error print control flag. */
/* ***LIBRARY   MATHLIB */
/* ***CATEGORY  R3A */
/* ***TYPE      ALL (XSETF-A) */
/* ***KEYWORDS  ERROR CONTROL */
/* ***AUTHOR  Hindmarsh, Alan C., (LLNL) */
/* ***DESCRIPTION */

/*   XSETF sets the error print control flag to MFLAG: */
/*      MFLAG=1 means print all messages (the default). */
/*      MFLAG=0 means no printing. */

/* ***SEE ALSO  XERMSG, XERRWD, XERRWV */
/* ***REFERENCES  (NONE) */
/* ***ROUTINES CALLED  IXSAV */
/* ***REVISION HISTORY  (YYMMDD) */
/*   921118  DATE WRITTEN */
/*   930329  Added SLATEC format prologue. (FNF) */
/*   930407  Corrected SEE ALSO section. (FNF) */
/*   930922  Made user-callable, and other cosmetic changes. (FNF) */
/* ***END PROLOGUE  XSETF */

/* Subroutines called by XSETF.. None */
/* Function routine called by XSETF.. IXSAV */
/* ----------------------------------------------------------------------- */
/* **End */

/* ***FIRST EXECUTABLE STATEMENT  XSETF */
    if (*mflag == 0 || *mflag == 1) {
	junk = ixsav_(&c__2, mflag, &c_true);
    }
    return 0;
/* ----------------------- End of Subroutine XSETF ----------------------- */
} /* xsetf_ */

/* DECK XSETUN */
/* Subroutine */ int xsetun_(integer *lun)
{
    integer junk;
    extern integer ixsav_(integer *, integer *, logical *);

/* ***BEGIN PROLOGUE  XSETUN */
/* ***PURPOSE  Reset the logical unit number for error messages. */
/* ***LIBRARY   MATHLIB */
/* ***CATEGORY  R3B */
/* ***TYPE      ALL (XSETUN-A) */
/* ***KEYWORDS  ERROR CONTROL */
/* ***DESCRIPTION */

/*   XSETUN sets the logical unit number for error messages to LUN. */

/* ***AUTHOR  Hindmarsh, Alan C., (LLNL) */
/* ***SEE ALSO  XERMSG, XERRWD, XERRWV */
/* ***REFERENCES  (NONE) */
/* ***ROUTINES CALLED  IXSAV */
/* ***REVISION HISTORY  (YYMMDD) */
/*   921118  DATE WRITTEN */
/*   930329  Added SLATEC format prologue. (FNF) */
/*   930407  Corrected SEE ALSO section. (FNF) */
/*   930922  Made user-callable, and other cosmetic changes. (FNF) */
/* ***END PROLOGUE  XSETUN */

/* Subroutines called by XSETUN.. None */
/* Function routine called by XSETUN.. IXSAV */
/* ----------------------------------------------------------------------- */
/* **End */

/* ***FIRST EXECUTABLE STATEMENT  XSETUN */
    if (*lun > 0) {
	junk = ixsav_(&c__1, lun, &c_true);
    }
    return 0;
/* ----------------------- End of Subroutine XSETUN ---------------------- */
} /* xsetun_ */

/* DECK IXSAV */
integer ixsav_(integer *ipar, integer *ivalue, logical *iset)
{
    /* System generated locals */
    integer ret_val;

    /* Local variables */
    integer lunit, lundef, mesflg;

/* ***BEGIN PROLOGUE  IXSAV */
/* ***SUBSIDIARY */
/* ***PURPOSE  Save and recall error message control parameters. */
/* ***LIBRARY   MATHLIB */
/* ***CATEGORY  R3C */
/* ***TYPE      ALL (IXSAV-A) */
/* ***AUTHOR  Hindmarsh, Alan C., (LLNL) */
/* ***DESCRIPTION */

/*  IXSAV saves and recalls one of two error message parameters: */
/*    LUNIT, the logical unit number to which messages are printed, and */
/*    MESFLG, the message print flag. */
/*  This is a modification of the SLATEC library routine J4SAVE. */

/*  Saved local variables.. */
/*   LUNIT  = Logical unit number for messages. */
/*   LUNDEF = Default logical unit number, data-loaded to 6 below */
/*            (may be machine-dependent). */
/*   MESFLG = Print control flag.. */
/*            1 means print all messages (the default). */
/*            0 means no printing. */

/*  On input.. */
/*    IPAR   = Parameter indicator (1 for LUNIT, 2 for MESFLG). */
/*    IVALUE = The value to be set for the parameter, if ISET = .TRUE. */
/*    ISET   = Logical flag to indicate whether to read or write. */
/*             If ISET = .TRUE., the parameter will be given */
/*             the value IVALUE.  If ISET = .FALSE., the parameter */
/*             will be unchanged, and IVALUE is a dummy argument. */

/*  On return.. */
/*    IXSAV = The (old) value of the parameter. */

/* ***SEE ALSO  XERMSG, XERRWD, XERRWV */
/* ***ROUTINES CALLED  NONE */
/* ***REVISION HISTORY  (YYMMDD) */
/*   921118  DATE WRITTEN */
/*   930329  Modified prologue to SLATEC format. (FNF) */
/*   941025  Minor modification re default unit number. (ACH) */
/* ***END PROLOGUE  IXSAV */

/* **End */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* The following Fortran-77 declaration is to cause the values of the */
/* listed (local) variables to be saved between calls to this routine. */
/* ----------------------------------------------------------------------- */
/*      SAVE LUNIT, LUNDEF, MESFLG */
/* dgg mod 2/2007 */
    lunit = -1;
    lundef = 6;
    mesflg = 1;
/*      DATA LUNIT/-1/, LUNDEF/6/, MESFLG/1/ */

/* ***FIRST EXECUTABLE STATEMENT  IXSAV */
    if (*ipar == 1) {
	if (lunit == -1) {
	    lunit = lundef;
	}
	ret_val = lunit;
	if (*iset) {
	    lunit = *ivalue;
	}
    }

    if (*ipar == 2) {
	ret_val = mesflg;
	if (*iset) {
	    mesflg = *ivalue;
	}
    }

    return ret_val;
/* ----------------------- End of Function IXSAV ------------------------- */
} /* ixsav_ */