GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
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