*DECK XERRWD
SUBROUTINE XERRWD (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
C***BEGIN PROLOGUE XERRWD
C***SUBSIDIARY
C***PURPOSE Write error message with values.
C***CATEGORY R3C
C***TYPE DOUBLE PRECISION (XERRWV-S, XERRWD-D)
C***AUTHOR Hindmarsh, Alan C., (LLNL)
C***DESCRIPTION
C
C Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV,
C as given here, constitute a simplified version of the SLATEC error
C handling package.
C
C All arguments are input arguments.
C
C MSG = The message (character array).
C NMES = The length of MSG (number of characters).
C NERR = The error number (not used).
C LEVEL = The error level..
C 0 or 1 means recoverable (control returns to caller).
C 2 means fatal (run is aborted--see note below).
C NI = Number of integers (0, 1, or 2) to be printed with message.
C I1,I2 = Integers to be printed, depending on NI.
C NR = Number of reals (0, 1, or 2) to be printed with message.
C R1,R2 = Reals to be printed, depending on NR.
C
C Note.. this routine is machine-dependent and specialized for use
C in limited context, in the following ways..
C 1. The argument MSG is assumed to be of type CHARACTER, and
C the message is printed with a format of (1X,A).
C 2. The message is assumed to take only one line.
C Multi-line messages are generated by repeated calls.
C 3. If LEVEL = 2, control passes to the statement STOP
C to abort the run. This statement may be machine-dependent.
C 4. R1 and R2 are assumed to be in double precision and are printed
C in D21.13 format.
C
C***ROUTINES CALLED IXSAV
C***REVISION HISTORY (YYMMDD)
C 920831 DATE WRITTEN
C 921118 Replaced MFLGSV/LUNSAV by IXSAV. (ACH)
C 930329 Modified prologue to SLATEC format. (FNF)
C 930407 Changed MSG from CHARACTER*1 array to variable. (FNF)
C 930922 Minor cosmetic change. (FNF)
C***END PROLOGUE XERRWD
C
C*Internal Notes:
C
C For a different default logical unit number, IXSAV (or a subsidiary
C routine that it calls) will need to be modified.
C For a different run-abort command, change the statement following
C statement 100 at the end.
C-----------------------------------------------------------------------
C Subroutines called by XERRWD.. None
C Function routine called by XERRWD.. IXSAV
C-----------------------------------------------------------------------
C**End
C
C Declare arguments.
C
DOUBLE PRECISION R1, R2
INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
CHARACTER*(*) MSG
C
C Declare local variables.
C
INTEGER LUNIT, IXSAV, MESFLG
C
C Get logical unit number and message print flag.
C
C***FIRST EXECUTABLE STATEMENT XERRWD
LUNIT = IXSAV (1, 0, .FALSE.)
MESFLG = IXSAV (2, 0, .FALSE.)
IF (MESFLG .EQ. 0) GO TO 100
C
C Write the message.
C
WRITE (LUNIT,10) MSG
10 FORMAT(1X,A)
IF (NI .EQ. 1) WRITE (LUNIT, 20) I1
20 FORMAT(6X,'In above message, I1 =',I10)
IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2
30 FORMAT(6X,'In above message, I1 =',I10,3X,'I2 =',I10)
IF (NR .EQ. 1) WRITE (LUNIT, 40) R1
40 FORMAT(6X,'In above message, R1 =',D21.13)
IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2
50 FORMAT(6X,'In above, R1 =',D21.13,3X,'R2 =',D21.13)
C
C Abort the run if LEVEL = 2.
C
100 IF (LEVEL .NE. 2) RETURN
STOP
C----------------------- End of Subroutine XERRWD ----------------------
END