xerrwd.f

Go to the documentation of this file.

*DECK XERRWD
      SUBROUTINE xerrwd (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
C***BEGIN PROLOGUE  XERRWD
C***SUBSIDIARY
C***PURPOSE  Write error message with values.
C***LIBRARY   MATHLIB
C***CATEGORY  R3C
C***TYPE      DOUBLE PRECISION (XERRWV-S, XERRWD-D)
C***AUTHOR  Hindmarsh, Alan C., (LLNL)
C***DESCRIPTION
C
C  Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV,
C  as given here, constitute a simplified version of the SLATEC error
C  handling package.
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 machine-dependent and specialized for use
C  in limited context, in the following ways..
C  1. The argument MSG is assumed to be of type CHARACTER, and
C     the message is printed with a format of (1X,A).
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.  This statement may be machine-dependent.
C  4. R1 and R2 are assumed to be in double precision and are printed
C     in D21.13 format.
C
C***ROUTINES CALLED  IXSAV
C***REVISION HISTORY  (YYMMDD)
C   920831  DATE WRITTEN
C   921118  Replaced MFLGSV/LUNSAV by IXSAV. (ACH)
C   930329  Modified prologue to SLATEC format. (FNF)
C   930407  Changed MSG from CHARACTER*1 array to variable. (FNF)
C   930922  Minor cosmetic change. (FNF)
C***END PROLOGUE  XERRWD
C
C*Internal Notes:
C
C For a different default logical unit number, IXSAV (or a subsidiary
C routine that it calls) will need to be modified.
C For a different run-abort command, change the statement following
C statement 100 at the end.
C-----------------------------------------------------------------------
C Subroutines called by XERRWD.. None
C Function routine called by XERRWD.. IXSAV
C-----------------------------------------------------------------------
C**End
C
C  Declare arguments.
C
      DOUBLE PRECISION r1, r2
      INTEGER nmes, nerr, level, ni, i1, i2, nr
      CHARACTER*(*) msg
C
C  Declare local variables.
C
      INTEGER lunit, ixsav, mesflg
C
C  Get logical unit number and message print flag.
C
C***FIRST EXECUTABLE STATEMENT  XERRWD
      lunit = ixsav(1, 0, .false.)
      mesflg = ixsav(2, 0, .false.)
      IF (mesflg .EQ. 0) go to 100
C
C  Write the message.
C
      WRITE (lunit,10)  msg(1:nmes)
 10   FORMAT(1x,a)
      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 =',d21.13)
      IF (nr .EQ. 2) WRITE (lunit, 50) r1,r2
 50   FORMAT(6x,'In above,  R1 =',d21.13,3x,'R2 =',d21.13)
C
C  Abort the run if LEVEL = 2.
C
 100  IF (level .NE. 2) RETURN
      CALL xstopx(' ')
C----------------------- End of Subroutine XERRWD ----------------------
      END