3
SUBROUTINE XERRWD (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
4
C***BEGIN PROLOGUE XERRWD
6
C***PURPOSE Write error message with values.
9
C***TYPE DOUBLE PRECISION (XERRWV-S, XERRWD-D)
10
C***AUTHOR Hindmarsh, Alan C., (LLNL)
13
C Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV,
14
C as given here, constitute a simplified version of the SLATEC error
17
C All arguments are input arguments.
19
C MSG = The message (character array).
20
C NMES = The length of MSG (number of characters).
21
C NERR = The error number (not used).
22
C LEVEL = The error level..
23
C 0 or 1 means recoverable (control returns to caller).
24
C 2 means fatal (run is aborted--see note below).
25
C NI = Number of integers (0, 1, or 2) to be printed with message.
26
C I1,I2 = Integers to be printed, depending on NI.
27
C NR = Number of reals (0, 1, or 2) to be printed with message.
28
C R1,R2 = Reals to be printed, depending on NR.
30
C Note.. this routine is machine-dependent and specialized for use
31
C in limited context, in the following ways..
32
C 1. The argument MSG is assumed to be of type CHARACTER, and
33
C the message is printed with a format of (1X,A).
34
C 2. The message is assumed to take only one line.
35
C Multi-line messages are generated by repeated calls.
36
C 3. If LEVEL = 2, control passes to the statement STOP
37
C to abort the run. This statement may be machine-dependent.
38
C 4. R1 and R2 are assumed to be in double precision and are printed
41
C***ROUTINES CALLED IXSAV
42
C***REVISION HISTORY (YYMMDD)
44
C 921118 Replaced MFLGSV/LUNSAV by IXSAV. (ACH)
45
C 930329 Modified prologue to SLATEC format. (FNF)
46
C 930407 Changed MSG from CHARACTER*1 array to variable. (FNF)
47
C 930922 Minor cosmetic change. (FNF)
48
C***END PROLOGUE XERRWD
52
C For a different default logical unit number, IXSAV (or a subsidiary
53
C routine that it calls) will need to be modified.
54
C For a different run-abort command, change the statement following
55
C statement 100 at the end.
56
C-----------------------------------------------------------------------
57
C Subroutines called by XERRWD.. None
58
C Function routine called by XERRWD.. IXSAV
59
C-----------------------------------------------------------------------
64
DOUBLE PRECISION R1, R2
65
INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
68
C Declare local variables.
70
INTEGER LUNIT, IXSAV, MESFLG
72
C Get logical unit number and message print flag.
74
C***FIRST EXECUTABLE STATEMENT XERRWD
75
LUNIT = IXSAV (1, 0, .FALSE.)
76
MESFLG = IXSAV (2, 0, .FALSE.)
77
IF (MESFLG .EQ. 0) GO TO 100
81
WRITE (LUNIT,10) MSG(1:NMES)
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)
92
C Abort the run if LEVEL = 2.
94
100 IF (LEVEL .NE. 2) RETURN
96
C----------------------- End of Subroutine XERRWD ----------------------