1
2*DECK XERRWD
3      SUBROUTINE XERRWD (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
4C***BEGIN PROLOGUE  XERRWD
5C***SUBSIDIARY
6C***PURPOSE  Write error message with values.
7C***LIBRARY   MATHLIB
8C***CATEGORY  R3C
9C***TYPE      DOUBLE PRECISION (XERRWV-S, XERRWD-D)
10C***AUTHOR  Hindmarsh, Alan C., (LLNL)
11C***DESCRIPTION
12C
13C  Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV,
14C  as given here, constitute a simplified version of the SLATEC error
15C  handling package.
16C
17C  All arguments are input arguments.
18C
19C  MSG    = The message (character array).
20C  NMES   = The length of MSG (number of characters).
21C  NERR   = The error number (not used).
22C  LEVEL  = The error level..
23C           0 or 1 means recoverable (control returns to caller).
24C           2 means fatal (run is aborted--see note below).
25C  NI     = Number of integers (0, 1, or 2) to be printed with message.
26C  I1,I2  = Integers to be printed, depending on NI.
27C  NR     = Number of reals (0, 1, or 2) to be printed with message.
28C  R1,R2  = Reals to be printed, depending on NR.
29C
30C  Note..  this routine is machine-dependent and specialized for use
31C  in limited context, in the following ways..
32C  1. The argument MSG is assumed to be of type CHARACTER, and
33C     the message is printed with a format of (1X,A).
34C  2. The message is assumed to take only one line.
35C     Multi-line messages are generated by repeated calls.
36C  3. If LEVEL = 2, control passes to the statement   STOP
37C     to abort the run.  This statement may be machine-dependent.
38C  4. R1 and R2 are assumed to be in double precision and are printed
39C     in D21.13 format.
40C
41C***ROUTINES CALLED  IXSAV
42C***REVISION HISTORY  (YYMMDD)
43C   920831  DATE WRITTEN
44C   921118  Replaced MFLGSV/LUNSAV by IXSAV. (ACH)
45C   930329  Modified prologue to SLATEC format. (FNF)
46C   930407  Changed MSG from CHARACTER*1 array to variable. (FNF)
47C   930922  Minor cosmetic change. (FNF)
48C***END PROLOGUE  XERRWD
49C
50C*Internal Notes:
51C
52C For a different default logical unit number, IXSAV (or a subsidiary
53C routine that it calls) will need to be modified.
54C For a different run-abort command, change the statement following
55C statement 100 at the end.
56C-----------------------------------------------------------------------
57C Subroutines called by XERRWD.. None
58C Function routine called by XERRWD.. IXSAV
59C-----------------------------------------------------------------------
60C**End
61C
62C  Declare arguments.
63C
64      DOUBLE PRECISION R1, R2
65      INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
66      CHARACTER*(*) MSG
67C
68C  Declare local variables.
69C
70      INTEGER LUNIT, IXSAV, MESFLG
71C
72C  Get logical unit number and message print flag.
73C
74C***FIRST EXECUTABLE STATEMENT  XERRWD
75      LUNIT = IXSAV (1, 0, .FALSE.)
76      MESFLG = IXSAV (2, 0, .FALSE.)
77      IF (MESFLG .EQ. 0) GO TO 100
78C
79C  Write the message.
80C
81      WRITE (LUNIT,10)  MSG(1:NMES)
82 10   FORMAT(1X,A)
83      IF (NI .EQ. 1) WRITE (LUNIT, 20) I1
84 20   FORMAT(6X,'In above message,  I1 =',I10)
85      IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2
86 30   FORMAT(6X,'In above message,  I1 =',I10,3X,'I2 =',I10)
87      IF (NR .EQ. 1) WRITE (LUNIT, 40) R1
88 40   FORMAT(6X,'In above message,  R1 =',D21.13)
89      IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2
90 50   FORMAT(6X,'In above,  R1 =',D21.13,3X,'R2 =',D21.13)
91C
92C  Abort the run if LEVEL = 2.
93C
94 100  IF (LEVEL .NE. 2) RETURN
95      CALL XSTOPX (' ')
96C----------------------- End of Subroutine XERRWD ----------------------
97      END
98