GNU Octave  9.1.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
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
charNDArray max(char d, const charNDArray &m)
Definition: chNDArray.cc:230
charNDArray min(char d, const charNDArray &m)
Definition: chNDArray.cc:207
subroutine fdump
Definition: fdump.f:3
function j4save(IWHICH, IVALUE, ISET)
Definition: j4save.f:3
subroutine xercnt(LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
Definition: xercnt.f:3
subroutine xerhlt(MESSG)
Definition: xerhlt.f:3
subroutine xermsg(LIBRAR, SUBROU, MESSG, NERR, LEVEL)
Definition: xermsg.f:3
subroutine xerprn(PREFIX, NPREF, MESSG, NWRAP)
Definition: xerprn.f:3
subroutine xersve(LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
Definition: xersve.f:4