view libcruft/odepack/xerrwv.f @ 3458:d25bc039237b

[project @ 2000-01-19 09:36:14 by jwe]
author jwe
date Wed, 19 Jan 2000 09:36:28 +0000
parents 30c606bec7a8
children
line wrap: on
line source

      SUBROUTINE XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
      INTEGER MSG, NMES, NERR, LEVEL, NI, I1, I2, NR,
     1   I, LUN, LUNIT, MESFLG, NCPW, NCH, NWDS
      DOUBLE PRECISION R1, R2 
      DIMENSION MSG(NMES)
C-----------------------------------------------------------------------
C SUBROUTINES XERRWV, XSETF, AND XSETUN, AS GIVEN HERE, CONSTITUTE
C A SIMPLIFIED VERSION OF THE SLATEC ERROR HANDLING PACKAGE.
C WRITTEN BY A. C. HINDMARSH AT LLNL.  VERSION OF MARCH 30, 1987.
C THIS VERSION IS IN DOUBLE PRECISION.
C
C ALL ARGUMENTS ARE INPUT ARGUMENTS.
C
C MSG    = THE MESSAGE (HOLLERITH LITERAL OR INTEGER 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 NUMBER OF HOLLERITH CHARACTERS STORED PER WORD, DENOTED
C    BY NCPW BELOW, IS A DATA-LOADED CONSTANT.
C 2. THE VALUE OF NMES IS ASSUMED TO BE AT MOST 60.
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 5. THE COMMON BLOCK /EH0001/ BELOW IS DATA-LOADED (A MACHINE-
C    DEPENDENT FEATURE) WITH DEFAULT VALUES.
C    THIS BLOCK IS NEEDED FOR PROPER RETENTION OF PARAMETERS USED BY
C    THIS ROUTINE WHICH THE USER CAN RESET BY CALLING XSETF OR XSETUN.
C    THE VARIABLES IN THIS BLOCK ARE AS FOLLOWS.. 
C       MESFLG = PRINT CONTROL FLAG..
C                1 MEANS PRINT ALL MESSAGES (THE DEFAULT).
C                0 MEANS NO PRINTING.
C       LUNIT  = LOGICAL UNIT NUMBER FOR MESSAGES.
C                THE DEFAULT IS 6 (MACHINE-DEPENDENT).
C-----------------------------------------------------------------------
C THE FOLLOWING ARE INSTRUCTIONS FOR INSTALLING THIS ROUTINE
C IN DIFFERENT MACHINE ENVIRONMENTS.
C
C TO CHANGE THE DEFAULT OUTPUT UNIT, CHANGE THE DATA STATEMENT
C IN THE BLOCK DATA SUBPROGRAM BELOW.
C
C FOR A DIFFERENT NUMBER OF CHARACTERS PER WORD, CHANGE THE 
C DATA STATEMENT SETTING NCPW BELOW, AND FORMAT 10.  ALTERNATIVES FOR 
C VARIOUS COMPUTERS ARE SHOWN IN COMMENT CARDS.
C
C FOR A DIFFERENT RUN-ABORT COMMAND, CHANGE THE STATEMENT FOLLOWING
C STATEMENT 100 AT THE END.
C-----------------------------------------------------------------------
      COMMON /EH0001/ MESFLG, LUNIT
C-----------------------------------------------------------------------
C THE FOLLOWING DATA-LOADED VALUE OF NCPW IS VALID FOR THE CDC-6600
C AND CDC-7600 COMPUTERS.
C     DATA NCPW/10/ 
C THE FOLLOWING IS VALID FOR THE CRAY-1 COMPUTER. 
C     DATA NCPW/8/
C THE FOLLOWING IS VALID FOR THE BURROUGHS 6700 AND 7800 COMPUTERS.
C     DATA NCPW/6/
C THE FOLLOWING IS VALID FOR THE PDP-10 COMPUTER. 
C     DATA NCPW/5/
C THE FOLLOWING IS VALID FOR THE VAX COMPUTER WITH 4 BYTES PER INTEGER,
C AND FOR THE IBM-360, IBM-370, IBM-303X, AND IBM-43XX COMPUTERS.
      DATA NCPW/4/
C THE FOLLOWING IS VALID FOR THE PDP-11, OR VAX WITH 2-BYTE INTEGERS. 
C     DATA NCPW/2/
C-----------------------------------------------------------------------
      IF (MESFLG .EQ. 0) GO TO 100
C GET LOGICAL UNIT NUMBER. ---------------------------------------------
      LUN = LUNIT
C GET NUMBER OF WORDS IN MESSAGE. --------------------------------------
      NCH = MIN0(NMES,60)
      NWDS = NCH/NCPW
      IF (NCH .NE. NWDS*NCPW) NWDS = NWDS + 1
C WRITE THE MESSAGE. ---------------------------------------------------
      WRITE (LUN, 10) (MSG(I),I=1,NWDS) 
C-----------------------------------------------------------------------
C THE FOLLOWING FORMAT STATEMENT IS TO HAVE THE FORM
C 10  FORMAT(1X,MMANN)
C WHERE NN = NCPW AND MM IS THE SMALLEST INTEGER .GE. 60/NCPW.
C THE FOLLOWING IS VALID FOR NCPW = 10. 
C 10  FORMAT(1X,6A10)
C THE FOLLOWING IS VALID FOR NCPW = 8.
C 10  FORMAT(1X,8A8)
C THE FOLLOWING IS VALID FOR NCPW = 6.
C 10  FORMAT(1X,10A6)
C THE FOLLOWING IS VALID FOR NCPW = 5.
C 10  FORMAT(1X,12A5)
C THE FOLLOWING IS VALID FOR NCPW = 4.
  10  FORMAT(1X,15A4)
C THE FOLLOWING IS VALID FOR NCPW = 2.
C 10  FORMAT(1X,30A2)
C-----------------------------------------------------------------------
      IF (NI .EQ. 1) WRITE (LUN, 20) I1 
 20   FORMAT(6X,23HIN ABOVE MESSAGE,  I1 =,I10)
      IF (NI .EQ. 2) WRITE (LUN, 30) I1,I2
 30   FORMAT(6X,23HIN ABOVE MESSAGE,  I1 =,I10,3X,4HI2 =,I10)
      IF (NR .EQ. 1) WRITE (LUN, 40) R1 
 40   FORMAT(6X,23HIN ABOVE MESSAGE,  R1 =,D21.13)
      IF (NR .EQ. 2) WRITE (LUN, 50) R1,R2
 50   FORMAT(6X,15HIN ABOVE,  R1 =,D21.13,3X,4HR2 =,D21.13) 
C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
 100  IF (LEVEL .NE. 2) RETURN
      CALL XSTOPX (' ')
C----------------------- END OF SUBROUTINE XERRWV ----------------------
      END