view libcruft/dasrt/dasrt_xerrwv.f @ 4039:e82257ed348c

[project @ 2002-08-14 19:33:31 by jwe]
author jwe
date Wed, 14 Aug 2002 19:33:31 +0000
parents
children
line wrap: on
line source

      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