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