|
3912
|
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 |
|
4106
|
81 WRITE (LUNIT,10) MSG(1:NMES) |
|
3912
|
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 |
|
4040
|
95 CALL XSTOPX (' ') |
|
3912
|
96 C----------------------- End of Subroutine XERRWD ---------------------- |
|
|
97 END |
