/* xerrwv.f -- translated by f2c (version 20190311).
   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 <stdio.h>
#include "f2c.h"

/* Common Block Declarations */

struct {
    integer mesflg, lunit;
} eh0001_;

#define eh0001_1 eh0001_

/* Table of constant values */

static integer c__1 = 1;

/* Subroutine */ int xerrwv_(char *msg, integer *nmes, integer *nerr, 
	integer *level, integer *ni, integer *i1, integer *i2, integer *nr, 
	doublereal *r1, doublereal *r2)
{
    /* Initialized data */

    static integer ncpw = 1;

    /* Format strings */
    static char fmt_10[] = "(1x,15a4)";
    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)";

    /* System generated locals */
    integer i__1;

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

    /* Local variables */
    static integer i__, nch, lun, nwds;

    /* Fortran I/O blocks */
    static cilist io___5 = { 0, 0, 0, fmt_10, 0 };
    static cilist io___7 = { 0, 0, 0, fmt_20, 0 };
    static cilist io___8 = { 0, 0, 0, fmt_30, 0 };
    static cilist io___9 = { 0, 0, 0, fmt_40, 0 };
    static cilist io___10 = { 0, 0, 0, fmt_50, 0 };


/* ----------------------------------------------------------------------- */
/* subroutines xerrwv, xsetf, and xsetun, as given here, constitute */
/* a simplified version of the slatec error handling package. */
/* written by a. c. hindmarsh at llnl.  version of march 30, 1987. */
/* this version is in double precision. */

/* all arguments are input arguments. */

/* msg    = the message (hollerith literal or integer 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 number of hollerith characters stored per word, denoted */
/*    by ncpw below, is a data-loaded constant. */
/* 2. the value of nmes is assumed to be at most 60. */
/*    (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. */
/* 5. the common block /eh0001/ below is data-loaded (a machine- */
/*    dependent feature) with default values. */
/*    this block is needed for proper retention of parameters used by */
/*    this routine which the user can reset by calling xsetf or xsetun. */
/*    the variables in this block are as follows.. */
/*       mesflg = print control flag.. */
/*                1 means print all messages (the default). */
/*                0 means no printing. */
/*       lunit  = logical unit number for messages. */
/*                the default is 6 (machine-dependent). */
/* ----------------------------------------------------------------------- */
/* the following are instructions for installing this routine */
/* in different machine environments. */

/* to change the default output unit, change the data statement */
/* in the block data subprogram below. */

/* for a different number of characters per word, change the */
/* data statement setting ncpw below, and format 10.  alternatives for */
/* various computers are shown in comment cards. */

/* for a different run-abort command, change the statement following */
/* statement 100 at the end. */
/* ----------------------------------------------------------------------- */
/* ----------------------------------------------------------------------- */
/* the following data-loaded value of ncpw is valid for the cdc-6600 */
/* and cdc-7600 computers. */
/*     data ncpw/10/ */
/* the following is valid for the cray-1 computer. */
/*     data ncpw/8/ */
/* the following is valid for the burroughs 6700 and 7800 computers. */
/*     data ncpw/6/ */
/* the following is valid for the pdp-10 computer. */
/*     data ncpw/5/ */
/* the following is valid for the vax computer with 4 bytes per integer, */
/* and for the ibm-360, ibm-370, ibm-303x, and ibm-43xx computers. */
    /* Parameter adjustments */
    --msg;

    /* Function Body */
/* the following is valid for the pdp-11, or vax with 2-byte integers. */
/*     data ncpw/2/ */
/* ----------------------------------------------------------------------- */
/*     write (*, *) 'message', (msg(i),i=1,nmes), nerr */
/*     return */
    if (eh0001_1.mesflg == 0) {
	goto L100;
    }
/* get logical unit number. --------------------------------------------- */
    lun = eh0001_1.lunit;
/* get number of words in message. -------------------------------------- */
    nch = min(*nmes,60);
    nwds = nch / ncpw;
    if (nch != nwds * ncpw) {
	++nwds;
    }
/* write the message. --------------------------------------------------- */
    io___5.ciunit = lun;
    s_wsfe(&io___5);
    i__1 = nwds;
    for (i__ = 1; i__ <= i__1; ++i__) {
        putchar(msg[i__ - 1]);
        /*do_fio(&c__1, (char *)&msg[i__], (ftnlen)sizeof(integer)); */
    }
    printf("\n");
    if (*ni > 0) printf("     i1 = %d\n", *i1);
    if (*ni > 1) printf("     i2 = %d\n", *i2);
    if (*nr > 0) printf("     r1 = %e\n", *r1);
    if (*nr > 1) printf("     r2 = %e\n", *r2);
    goto L100;
/* ----------------------------------------------------------------------- */
/* the following format statement is to have the form */
/* 10  format(1x,mmann) */
/* where nn = ncpw and mm is the smallest integer .ge. 60/ncpw. */
/* the following is valid for ncpw = 10. */
/* 10  format(1x,6a10) */
/* the following is valid for ncpw = 8. */
/* 10  format(1x,8a8) */
/* the following is valid for ncpw = 6. */
/* 10  format(1x,10a6) */
/* the following is valid for ncpw = 5. */
/* 10  format(1x,12a5) */
/* the following is valid for ncpw = 4. */
/* the following is valid for ncpw = 2. */
/* 10  format(1x,30a2) */
/* ----------------------------------------------------------------------- */
    if (*ni == 1) {
	io___7.ciunit = lun;
	s_wsfe(&io___7);
	do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
	e_wsfe();
    }
    if (*ni == 2) {
	io___8.ciunit = lun;
	s_wsfe(&io___8);
	do_fio(&c__1, (char *)&(*i1), (ftnlen)sizeof(integer));
	do_fio(&c__1, (char *)&(*i2), (ftnlen)sizeof(integer));
	e_wsfe();
    }
    if (*nr == 1) {
	io___9.ciunit = lun;
	s_wsfe(&io___9);
	do_fio(&c__1, (char *)&(*r1), (ftnlen)sizeof(doublereal));
	e_wsfe();
    }
    if (*nr == 2) {
	io___10.ciunit = lun;
	s_wsfe(&io___10);
	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 xerrwv ---------------------- */
    return 0;
} /* xerrwv_ */

