GNU Octave  9.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
xerrwd.f
Go to the documentation of this file.
1 
2 *DECK XERRWD
3  SUBROUTINE xerrwd (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
4 C***BEGIN PROLOGUE XERRWD
5 C***SUBSIDIARY
6 C***PURPOSE Write error message with values.
7 C***LIBRARY MATHLIB
8 C***CATEGORY R3C
9 C***TYPE DOUBLE PRECISION (XERRWV-S, XERRWD-D)
10 C***AUTHOR Hindmarsh, Alan C., (LLNL)
11 C***DESCRIPTION
12 C
13 C Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV,
14 C as given here, constitute a simplified version of the SLATEC error
15 C handling package.
16 C
17 C All arguments are input arguments.
18 C
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.
29 C
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
39 C in D21.13 format.
40 C
41 C***ROUTINES CALLED IXSAV
42 C***REVISION HISTORY (YYMMDD)
43 C 920831 DATE WRITTEN
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
49 C
50 C*Internal Notes:
51 C
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-----------------------------------------------------------------------
60 C**End
61 C
62 C Declare arguments.
63 C
64  DOUBLE PRECISION R1, R2
65  INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR
66  CHARACTER*(*) MSG
67 C
68 C Declare local variables.
69 C
70  INTEGER LUNIT, IXSAV, MESFLG
71 C
72 C Get logical unit number and message print flag.
73 C
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
78 C
79 C Write the message.
80 C
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)
91 C
92 C Abort the run if LEVEL = 2.
93 C
94  100 IF (level .NE. 2) RETURN
95  CALL xstopx (' ')
96 C----------------------- End of Subroutine XERRWD ----------------------
97  END
subroutine xerrwd(MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
Definition: xerrwd.f:4