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
xermsg.f
Go to the documentation of this file.
1 *DECK XERMSG
2  SUBROUTINE xermsg (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
3 C***BEGIN PROLOGUE XERMSG
4 C***PURPOSE Process error messages for SLATEC and other libraries.
5 C***LIBRARY SLATEC (XERROR)
6 C***CATEGORY R3C
7 C***TYPE ALL (XERMSG-A)
8 C***KEYWORDS ERROR MESSAGE, XERROR
9 C***AUTHOR Fong, Kirby, (NMFECC at LLNL)
10 C***DESCRIPTION
11 C
12 C XERMSG processes a diagnostic message in a manner determined by the
13 C value of LEVEL and the current value of the library error control
14 C flag, KONTRL. See subroutine XSETF for details.
15 C
16 C LIBRAR A character constant (or character variable) with the name
17 C of the library. This will be 'SLATEC' for the SLATEC
18 C Common Math Library. The error handling package is
19 C general enough to be used by many libraries
20 C simultaneously, so it is desirable for the routine that
21 C detects and reports an error to identify the library name
22 C as well as the routine name.
23 C
24 C SUBROU A character constant (or character variable) with the name
25 C of the routine that detected the error. Usually it is the
26 C name of the routine that is calling XERMSG. There are
27 C some instances where a user callable library routine calls
28 C lower level subsidiary routines where the error is
29 C detected. In such cases it may be more informative to
30 C supply the name of the routine the user called rather than
31 C the name of the subsidiary routine that detected the
32 C error.
33 C
34 C MESSG A character constant (or character variable) with the text
35 C of the error or warning message. In the example below,
36 C the message is a character constant that contains a
37 C generic message.
38 C
39 C CALL XERMSG ('SLATEC', 'MMPY',
40 C *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION',
41 C *3, 1)
42 C
43 C It is possible (and is sometimes desirable) to generate a
44 C specific message--e.g., one that contains actual numeric
45 C values. Specific numeric values can be converted into
46 C character strings using formatted WRITE statements into
47 C character variables. This is called standard Fortran
48 C internal file I/O and is exemplified in the first three
49 C lines of the following example. You can also catenate
50 C substrings of characters to construct the error message.
51 C Here is an example showing the use of both writing to
52 C an internal file and catenating character strings.
53 C
54 C CHARACTER*5 CHARN, CHARL
55 C WRITE (CHARN,10) N
56 C WRITE (CHARL,10) LDA
57 C 10 FORMAT(I5)
58 C CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN//
59 C * ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'//
60 C * CHARL, 3, 1)
61 C
62 C There are two subtleties worth mentioning. One is that
63 C the // for character catenation is used to construct the
64 C error message so that no single character constant is
65 C continued to the next line. This avoids confusion as to
66 C whether there are trailing blanks at the end of the line.
67 C The second is that by catenating the parts of the message
68 C as an actual argument rather than encoding the entire
69 C message into one large character variable, we avoid
70 C having to know how long the message will be in order to
71 C declare an adequate length for that large character
72 C variable. XERMSG calls XERPRN to print the message using
73 C multiple lines if necessary. If the message is very long,
74 C XERPRN will break it into pieces of 72 characters (as
75 C requested by XERMSG) for printing on multiple lines.
76 C Also, XERMSG asks XERPRN to prefix each line with ' * '
77 C so that the total line length could be 76 characters.
78 C Note also that XERPRN scans the error message backwards
79 C to ignore trailing blanks. Another feature is that
80 C the substring '$$' is treated as a new line sentinel
81 C by XERPRN. If you want to construct a multiline
82 C message without having to count out multiples of 72
83 C characters, just use '$$' as a separator. '$$'
84 C obviously must occur within 72 characters of the
85 C start of each line to have its intended effect since
86 C XERPRN is asked to wrap around at 72 characters in
87 C addition to looking for '$$'.
88 C
89 C NERR An integer value that is chosen by the library routine's
90 C author. It must be in the range -99 to 999 (three
91 C printable digits). Each distinct error should have its
92 C own error number. These error numbers should be described
93 C in the machine readable documentation for the routine.
94 C The error numbers need be unique only within each routine,
95 C so it is reasonable for each routine to start enumerating
96 C errors from 1 and proceeding to the next integer.
97 C
98 C LEVEL An integer value in the range 0 to 2 that indicates the
99 C level (severity) of the error. Their meanings are
100 C
101 C -1 A warning message. This is used if it is not clear
102 C that there really is an error, but the user's attention
103 C may be needed. An attempt is made to only print this
104 C message once.
105 C
106 C 0 A warning message. This is used if it is not clear
107 C that there really is an error, but the user's attention
108 C may be needed.
109 C
110 C 1 A recoverable error. This is used even if the error is
111 C so serious that the routine cannot return any useful
112 C answer. If the user has told the error package to
113 C return after recoverable errors, then XERMSG will
114 C return to the Library routine which can then return to
115 C the user's routine. The user may also permit the error
116 C package to terminate the program upon encountering a
117 C recoverable error.
118 C
119 C 2 A fatal error. XERMSG will not return to its caller
120 C after it receives a fatal error. This level should
121 C hardly ever be used; it is much better to allow the
122 C user a chance to recover. An example of one of the few
123 C cases in which it is permissible to declare a level 2
124 C error is a reverse communication Library routine that
125 C is likely to be called repeatedly until it integrates
126 C across some interval. If there is a serious error in
127 C the input such that another step cannot be taken and
128 C the Library routine is called again without the input
129 C error having been corrected by the caller, the Library
130 C routine will probably be called forever with improper
131 C input. In this case, it is reasonable to declare the
132 C error to be fatal.
133 C
134 C Each of the arguments to XERMSG is input; none will be modified by
135 C XERMSG. A routine may make multiple calls to XERMSG with warning
136 C level messages; however, after a call to XERMSG with a recoverable
137 C error, the routine should return to the user. Do not try to call
138 C XERMSG with a second recoverable error after the first recoverable
139 C error because the error package saves the error number. The user
140 C can retrieve this error number by calling another entry point in
141 C the error handling package and then clear the error number when
142 C recovering from the error. Calling XERMSG in succession causes the
143 C old error number to be overwritten by the latest error number.
144 C This is considered harmless for error numbers associated with
145 C warning messages but must not be done for error numbers of serious
146 C errors. After a call to XERMSG with a recoverable error, the user
147 C must be given a chance to call NUMXER or XERCLR to retrieve or
148 C clear the error number.
149 C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
150 C Error-handling Package, SAND82-0800, Sandia
151 C Laboratories, 1982.
152 C***ROUTINES CALLED FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE
153 C***REVISION HISTORY (YYMMDD)
154 C 880101 DATE WRITTEN
155 C 880621 REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988.
156 C THERE ARE TWO BASIC CHANGES.
157 C 1. A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO
158 C PRINT MESSAGES. THIS ROUTINE WILL BREAK LONG MESSAGES
159 C INTO PIECES FOR PRINTING ON MULTIPLE LINES. '$$' IS
160 C ACCEPTED AS A NEW LINE SENTINEL. A PREFIX CAN BE
161 C ADDED TO EACH LINE TO BE PRINTED. XERMSG USES EITHER
162 C ' ***' OR ' * ' AND LONG MESSAGES ARE BROKEN EVERY
163 C 72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE
164 C LENGTH OUTPUT CAN NOW BE AS GREAT AS 76.
165 C 2. THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE
166 C FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE
167 C OF LOWER CASE.
168 C 880708 REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30.
169 C THE PRINCIPAL CHANGES ARE
170 C 1. CLARIFY COMMENTS IN THE PROLOGUES
171 C 2. RENAME XRPRNT TO XERPRN
172 C 3. REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES
173 C SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE /
174 C CHARACTER FOR NEW RECORDS.
175 C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
176 C CLEAN UP THE CODING.
177 C 890721 REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN
178 C PREFIX.
179 C 891013 REVISED TO CORRECT COMMENTS.
180 C 891214 Prologue converted to Version 4.0 format. (WRB)
181 C 900510 Changed test on NERR to be -9999999 < NERR < 99999999, but
182 C NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3. Added
183 C LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and
184 C XERCTL to XERCNT. (RWC)
185 C 920501 Reformatted the REFERENCES section. (WRB)
186 C***END PROLOGUE XERMSG
187  CHARACTER*(*) librar, subrou, messg
188  CHARACTER*8 xlibr, xsubr
189  CHARACTER*72 temp
190  CHARACTER*20 lfirst
191 C***FIRST EXECUTABLE STATEMENT XERMSG
192  lkntrl = j4save(2, 0, .false.)
193  maxmes = j4save(4, 0, .false.)
194 C
195 C LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL.
196 C MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE
197 C SHOULD BE PRINTED. IF MAXMES IS LESS THAN ZERO, THERE IS
198 C NO LIMIT.
199 C
200 C WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN
201 C CALLING XERMSG. THE ERROR NUMBER SHOULD BE POSITIVE,
202 C AND THE LEVEL SHOULD BE BETWEEN 0 AND 2.
203 C
204  IF (nerr.LT.-9999999 .OR. nerr.GT.99999999 .OR. nerr.EQ.0 .OR.
205  * level.LT.-1 .OR. level.GT.2) THEN
206  CALL xerprn(' ***', -1, 'FATAL ERROR IN...$$ ' //
207  * 'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '//
208  * 'JOB ABORT DUE TO FATAL ERROR.', 72)
209  CALL xersve(' ', ' ', ' ', 0, 0, 0, kdummy)
210  CALL xerhlt(' ***XERMSG -- INVALID INPUT')
211  RETURN
212  ENDIF
213 C
214 C RECORD THE MESSAGE.
215 C
216  i = j4save(1, nerr, .true.)
217  CALL xersve(librar, subrou, messg, 1, nerr, level, kount)
218 C
219 C HANDLE PRINT-ONCE WARNING MESSAGES.
220 C
221  IF (level.EQ.-1 .AND. kount.GT.1) RETURN
222 C
223 C ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG.
224 C
225  xlibr = librar
226  xsubr = subrou
227  lfirst = messg
228  lerr = nerr
229  llevel = level
230  CALL xercnt(xlibr, xsubr, lfirst, lerr, llevel, lkntrl)
231 C
232  lkntrl = max(-2, min(2,lkntrl))
233  mkntrl = abs(lkntrl)
234 C
235 C SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS
236 C ZERO AND THE ERROR IS NOT FATAL.
237 C
238  IF (level.LT.2 .AND. lkntrl.EQ.0) go to 30
239  IF (level.EQ.0 .AND. maxmes.GE.0 .AND. kount.GT.maxmes) go to 30
240  IF (level.EQ.1 .AND. maxmes.GE.0 .AND. kount.GT.maxmes
241  * .AND. mkntrl.EQ.1) go to 30
242  IF (level.EQ.2 .AND. maxmes.GE.0 .AND. kount.GT.max(1,maxmes))
243  * go to 30
244 C
245 C ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A
246 C MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS)
247 C AND SENDING IT OUT VIA XERPRN. PRINT ONLY IF CONTROL FLAG
248 C IS NOT ZERO.
249 C
250  IF (lkntrl .NE. 0) THEN
251  temp(1:21) = 'MESSAGE FROM ROUTINE '
252  i = min(len(subrou), 16)
253  temp(22:21+i) = subrou(1:i)
254  temp(22+i:33+i) = ' IN LIBRARY '
255  ltemp = 33 + i
256  i = min(len(librar), 16)
257  temp(ltemp+1:ltemp+i) = librar(1:i)
258  temp(ltemp+i+1:ltemp+i+1) = '.'
259  ltemp = ltemp + i + 1
260  CALL xerprn(' ***', -1, temp(1:ltemp), 72)
261  ENDIF
262 C
263 C IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE
264 C PRINTING THE MESSAGE. THE INTRODUCTORY LINE TELLS THE CHOICE
265 C FROM EACH OF THE FOLLOWING THREE OPTIONS.
266 C 1. LEVEL OF THE MESSAGE
267 C 'INFORMATIVE MESSAGE'
268 C 'POTENTIALLY RECOVERABLE ERROR'
269 C 'FATAL ERROR'
270 C 2. WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE
271 C 'PROG CONTINUES'
272 C 'PROG ABORTED'
273 C 3. WHETHER OR NOT A TRACEBACK WAS REQUESTED. (THE TRACEBACK
274 C MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS
275 C WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.)
276 C 'TRACEBACK REQUESTED'
277 C 'TRACEBACK NOT REQUESTED'
278 C NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT
279 C EXCEED 74 CHARACTERS.
280 C WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED.
281 C
282  IF (lkntrl .GT. 0) THEN
283 C
284 C THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL.
285 C
286  IF (level .LE. 0) THEN
287  temp(1:20) = 'INFORMATIVE MESSAGE,'
288  ltemp = 20
289  ELSEIF (level .EQ. 1) THEN
290  temp(1:30) = 'POTENTIALLY RECOVERABLE ERROR,'
291  ltemp = 30
292  ELSE
293  temp(1:12) = 'FATAL ERROR,'
294  ltemp = 12
295  ENDIF
296 C
297 C THEN WHETHER THE PROGRAM WILL CONTINUE.
298 C
299  IF ((mkntrl.EQ.2 .AND. level.GE.1) .OR.
300  * (mkntrl.EQ.1 .AND. level.EQ.2)) THEN
301  temp(ltemp+1:ltemp+14) = ' PROG ABORTED,'
302  ltemp = ltemp + 14
303  ELSE
304  temp(ltemp+1:ltemp+16) = ' PROG CONTINUES,'
305  ltemp = ltemp + 16
306  ENDIF
307 C
308 C FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK.
309 C
310  IF (lkntrl .GT. 0) THEN
311  temp(ltemp+1:ltemp+20) = ' TRACEBACK REQUESTED'
312  ltemp = ltemp + 20
313  ELSE
314  temp(ltemp+1:ltemp+24) = ' TRACEBACK NOT REQUESTED'
315  ltemp = ltemp + 24
316  ENDIF
317  CALL xerprn(' ***', -1, temp(1:ltemp), 72)
318  ENDIF
319 C
320 C NOW SEND OUT THE MESSAGE.
321 C
322  CALL xerprn(' * ', -1, messg, 72)
323 C
324 C IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A
325 C TRACEBACK.
326 C
327  IF (lkntrl .GT. 0) THEN
328  WRITE (temp, '(''ERROR NUMBER = '', I8)') nerr
329  DO 10 i=16,22
330  IF (temp(i:i) .NE. ' ') go to 20
331  10 CONTINUE
332 C
333  20 CALL xerprn(' * ', -1, temp(1:15) // temp(i:23), 72)
334  CALL fdump
335  ENDIF
336 C
337 C IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE.
338 C
339  IF (lkntrl .NE. 0) THEN
340  CALL xerprn(' * ', -1, ' ', 72)
341  CALL xerprn(' ***', -1, 'END OF MESSAGE', 72)
342  CALL xerprn(' ', 0, ' ', 72)
343  ENDIF
344 C
345 C IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE
346 C CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN.
347 C
348  30 IF (level.LE.0 .OR. (level.EQ.1 .AND. mkntrl.LE.1)) RETURN
349 C
350 C THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A
351 C FATAL ERROR. PRINT THE REASON FOR THE ABORT AND THE ERROR
352 C SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT.
353 C
354  IF (lkntrl.GT.0
355  * .AND. (maxmes.LT.0 .OR. kount.LT.max(1,maxmes))) THEN
356  IF (level .EQ. 1) THEN
357  CALL xerprn
358  * (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72)
359  ELSE
360  CALL xerprn(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72)
361  ENDIF
362  CALL xersve(' ', ' ', ' ', -1, 0, 0, kdummy)
363  CALL xerhlt(' ')
364  ELSE
365  CALL xerhlt(messg)
366  ENDIF
367  RETURN
368  END