Mercurial > hg > octave-nkf
changeset 4039:e82257ed348c
[project @ 2002-08-14 19:33:31 by jwe]
author | jwe |
---|---|
date | Wed, 14 Aug 2002 19:33:31 +0000 |
parents | 243f50d6f3d5 |
children | 5b781670e9ee |
files | libcruft/dasrt/dasrt_xerrwv.f libcruft/dasrt/xerrwv.f |
diffstat | 2 files changed, 69 insertions(+), 69 deletions(-) [+] |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/libcruft/dasrt/dasrt_xerrwv.f @@ -0,0 +1,69 @@ + SUBROUTINE DASRT_XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, + $ NR, R1, R2) + INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR + DOUBLE PRECISION R1, R2 + CHARACTER*1 MSG(NMES) +C----------------------------------------------------------------------- +C Subroutine XERRWV, as given here, constitutes a simplified version of +C the SLATEC error handling package. +C Written by A. C. Hindmarsh and P. N. Brown at LLNL. +C Modified 1/8/90 by Clement Ulrich at LLNL. +C Version of 8 January, 1990. +C This version is in double precision. +C +C All arguments are input arguments. +C +C MSG = The message (character array). +C NMES = The length of MSG (number of characters). +C NERR = The error number (not used). +C LEVEL = The error level.. +C 0 or 1 means recoverable (control returns to caller). +C 2 means fatal (run is aborted--see note below). +C NI = Number of integers (0, 1, or 2) to be printed with message. +C I1,I2 = Integers to be printed, depending on NI. +C NR = Number of reals (0, 1, or 2) to be printed with message. +C R1,R2 = Reals to be printed, depending on NR. +C +C Note.. this routine is compatible with ANSI-77; however the +C following assumptions may not be valid for some machines: +C +C 1. The argument MSG is assumed to be of type CHARACTER, and +C the message is printed with a format of (1X,80A1). +C 2. The message is assumed to take only one line. +C Multi-line messages are generated by repeated calls. +C 3. If LEVEL = 2, control passes to the statement STOP +C to abort the run. For a different run-abort command, +C change the statement following statement 100 at the end. +C 4. R1 and R2 are assumed to be in double precision and are printed +C in E21.13 format. +C 5. The logical unit number 6 is standard output. +C For a different default logical unit number, change the assignment +C statement for LUNIT below. +C +C----------------------------------------------------------------------- +C Subroutines called by XERRWV.. None +C Function routines called by XERRWV.. None +C----------------------------------------------------------------------- +C + INTEGER I, LUNIT, MESFLG +C +C Define message print flag and logical unit number. ------------------- + MESFLG = 1 + LUNIT = 6 + IF (MESFLG .EQ. 0) GO TO 100 +C Write the message. --------------------------------------------------- + WRITE (LUNIT,10) (MSG(I),I=1,NMES) + 10 FORMAT(1X,80A1) + IF (NI .EQ. 1) WRITE (LUNIT, 20) I1 + 20 FORMAT(6X,'In above message, I1 =',I10) + IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2 + 30 FORMAT(6X,'In above message, I1 =',I10,3X,'I2 =',I10) + IF (NR .EQ. 1) WRITE (LUNIT, 40) R1 + 40 FORMAT(6X,'In above message, R1 =',E21.13) + IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2 + 50 FORMAT(6X,'In above, R1 =',E21.13,3X,'R2 =',E21.13) +C Abort the run if LEVEL = 2. ------------------------------------------ + 100 IF (LEVEL .NE. 2) RETURN + STOP +C----------------------- End of Subroutine XERRWV ---------------------- + END
deleted file mode 100644 --- a/libcruft/dasrt/xerrwv.f +++ /dev/null @@ -1,69 +0,0 @@ - SUBROUTINE DASRT_XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, - $ NR, R1, R2) - INTEGER NMES, NERR, LEVEL, NI, I1, I2, NR - DOUBLE PRECISION R1, R2 - CHARACTER*1 MSG(NMES) -C----------------------------------------------------------------------- -C Subroutine XERRWV, as given here, constitutes a simplified version of -C the SLATEC error handling package. -C Written by A. C. Hindmarsh and P. N. Brown at LLNL. -C Modified 1/8/90 by Clement Ulrich at LLNL. -C Version of 8 January, 1990. -C This version is in double precision. -C -C All arguments are input arguments. -C -C MSG = The message (character array). -C NMES = The length of MSG (number of characters). -C NERR = The error number (not used). -C LEVEL = The error level.. -C 0 or 1 means recoverable (control returns to caller). -C 2 means fatal (run is aborted--see note below). -C NI = Number of integers (0, 1, or 2) to be printed with message. -C I1,I2 = Integers to be printed, depending on NI. -C NR = Number of reals (0, 1, or 2) to be printed with message. -C R1,R2 = Reals to be printed, depending on NR. -C -C Note.. this routine is compatible with ANSI-77; however the -C following assumptions may not be valid for some machines: -C -C 1. The argument MSG is assumed to be of type CHARACTER, and -C the message is printed with a format of (1X,80A1). -C 2. The message is assumed to take only one line. -C Multi-line messages are generated by repeated calls. -C 3. If LEVEL = 2, control passes to the statement STOP -C to abort the run. For a different run-abort command, -C change the statement following statement 100 at the end. -C 4. R1 and R2 are assumed to be in double precision and are printed -C in E21.13 format. -C 5. The logical unit number 6 is standard output. -C For a different default logical unit number, change the assignment -C statement for LUNIT below. -C -C----------------------------------------------------------------------- -C Subroutines called by XERRWV.. None -C Function routines called by XERRWV.. None -C----------------------------------------------------------------------- -C - INTEGER I, LUNIT, MESFLG -C -C Define message print flag and logical unit number. ------------------- - MESFLG = 1 - LUNIT = 6 - IF (MESFLG .EQ. 0) GO TO 100 -C Write the message. --------------------------------------------------- - WRITE (LUNIT,10) (MSG(I),I=1,NMES) - 10 FORMAT(1X,80A1) - IF (NI .EQ. 1) WRITE (LUNIT, 20) I1 - 20 FORMAT(6X,'In above message, I1 =',I10) - IF (NI .EQ. 2) WRITE (LUNIT, 30) I1,I2 - 30 FORMAT(6X,'In above message, I1 =',I10,3X,'I2 =',I10) - IF (NR .EQ. 1) WRITE (LUNIT, 40) R1 - 40 FORMAT(6X,'In above message, R1 =',E21.13) - IF (NR .EQ. 2) WRITE (LUNIT, 50) R1,R2 - 50 FORMAT(6X,'In above, R1 =',E21.13,3X,'R2 =',E21.13) -C Abort the run if LEVEL = 2. ------------------------------------------ - 100 IF (LEVEL .NE. 2) RETURN - STOP -C----------------------- End of Subroutine XERRWV ---------------------- - END