2 SUBROUTINE xermsg (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
187 CHARACTER*(*) LIBRAR, SUBROU, MESSG
188 CHARACTER*8 XLIBR, XSUBR
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')
216 i =
j4save(1, nerr, .true.)
217 CALL
xersve(librar, subrou, messg, 1, nerr, level, kount)
221 IF (level.EQ.-1 .AND. kount.GT.1)
RETURN
230 CALL
xercnt(xlibr, xsubr, lfirst, lerr, llevel, lkntrl)
232 lkntrl =
max(-2,
min(2,lkntrl))
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))
250 IF (lkntrl .NE. 0)
THEN
251 temp(1:21) =
'MESSAGE FROM ROUTINE '
253 temp(22:21+i) = subrou(1:i)
254 temp(22+i:33+i) =
' IN LIBRARY '
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)
282 IF (lkntrl .GT. 0)
THEN
286 IF (level .LE. 0)
THEN
287 temp(1:20) =
'INFORMATIVE MESSAGE,'
289 ELSEIF (level .EQ. 1)
THEN
290 temp(1:30) =
'POTENTIALLY RECOVERABLE ERROR,'
293 temp(1:12) =
'FATAL ERROR,'
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,'
304 temp(ltemp+1:ltemp+16) =
' PROG CONTINUES,'
310 IF (lkntrl .GT. 0)
THEN
311 temp(ltemp+1:ltemp+20) =
' TRACEBACK REQUESTED'
314 temp(ltemp+1:ltemp+24) =
' TRACEBACK NOT REQUESTED'
317 CALL
xerprn(
' ***', -1, temp(1:ltemp), 72)
322 CALL
xerprn(
' * ', -1, messg, 72)
327 IF (lkntrl .GT. 0)
THEN
328 WRITE (temp,
'(''ERROR NUMBER = '', I8)') nerr
330 IF (temp(i:i) .NE.
' ') go
to 20
333 20 CALL
xerprn(
' * ', -1, temp(1:15) // temp(i:23), 72)
339 IF (lkntrl .NE. 0)
THEN
340 CALL
xerprn(
' * ', -1,
' ', 72)
341 CALL
xerprn(
' ***', -1,
'END OF MESSAGE', 72)
342 CALL
xerprn(
' ', 0,
' ', 72)
348 30
IF (level.LE.0 .OR. (level.EQ.1 .AND. mkntrl.LE.1))
RETURN
355 * .AND. (maxmes.LT.0 .OR. kount.LT.
max(1,maxmes)))
THEN
356 IF (level .EQ. 1)
THEN
358 * (
' ***', -1,
'JOB ABORT DUE TO UNRECOVERED ERROR.', 72)
360 CALL
xerprn(
' ***', -1,
'JOB ABORT DUE TO FATAL ERROR.', 72)
362 CALL
xersve(
' ',
' ',
' ', -1, 0, 0, kdummy)
subroutine xerprn(PREFIX, NPREF, MESSG, NWRAP)
subroutine xersve(LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to
subroutine xercnt(LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
charNDArray max(char d, const charNDArray &m)
subroutine xermsg(LIBRAR, SUBROU, MESSG, NERR, LEVEL)
OCTAVE_EXPORT octave_value_list return the value of the option it must match the dimension of the state and the relative tolerance must also be a vector of the same length tem it must match the dimension of the state and the absolute tolerance must also be a vector of the same length The local error test applied at each integration step is xample roup abs(local error in x(i))<
function j4save(IWHICH, IVALUE, ISET)
charNDArray min(char d, const charNDArray &m)