home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / odepack / xerrwv.f < prev   
Text File  |  1996-09-28  |  5KB  |  115 lines

  1.       SUBROUTINE XERRWV (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
  2.       INTEGER MSG, NMES, NERR, LEVEL, NI, I1, I2, NR,
  3.      1   I, LUN, LUNIT, MESFLG, NCPW, NCH, NWDS
  4.       DOUBLE PRECISION R1, R2 
  5.       DIMENSION MSG(NMES)
  6. C-----------------------------------------------------------------------
  7. C SUBROUTINES XERRWV, XSETF, AND XSETUN, AS GIVEN HERE, CONSTITUTE
  8. C A SIMPLIFIED VERSION OF THE SLATEC ERROR HANDLING PACKAGE.
  9. C WRITTEN BY A. C. HINDMARSH AT LLNL.  VERSION OF MARCH 30, 1987.
  10. C THIS VERSION IS IN DOUBLE PRECISION.
  11. C
  12. C ALL ARGUMENTS ARE INPUT ARGUMENTS.
  13. C
  14. C MSG    = THE MESSAGE (HOLLERITH LITERAL OR INTEGER ARRAY).
  15. C NMES   = THE LENGTH OF MSG (NUMBER OF CHARACTERS).
  16. C NERR   = THE ERROR NUMBER (NOT USED). 
  17. C LEVEL  = THE ERROR LEVEL..
  18. C          0 OR 1 MEANS RECOVERABLE (CONTROL RETURNS TO CALLER).
  19. C          2 MEANS FATAL (RUN IS ABORTED--SEE NOTE BELOW).
  20. C NI     = NUMBER OF INTEGERS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE.
  21. C I1,I2  = INTEGERS TO BE PRINTED, DEPENDING ON NI.
  22. C NR     = NUMBER OF REALS (0, 1, OR 2) TO BE PRINTED WITH MESSAGE.
  23. C R1,R2  = REALS TO BE PRINTED, DEPENDING ON NR.
  24. C
  25. C NOTE..  THIS ROUTINE IS MACHINE-DEPENDENT AND SPECIALIZED FOR USE
  26. C IN LIMITED CONTEXT, IN THE FOLLOWING WAYS..
  27. C 1. THE NUMBER OF HOLLERITH CHARACTERS STORED PER WORD, DENOTED
  28. C    BY NCPW BELOW, IS A DATA-LOADED CONSTANT.
  29. C 2. THE VALUE OF NMES IS ASSUMED TO BE AT MOST 60.
  30. C    (MULTI-LINE MESSAGES ARE GENERATED BY REPEATED CALLS.) 
  31. C 3. IF LEVEL = 2, CONTROL PASSES TO THE STATEMENT   STOP
  32. C    TO ABORT THE RUN.  THIS STATEMENT MAY BE MACHINE-DEPENDENT.
  33. C 4. R1 AND R2 ARE ASSUMED TO BE IN DOUBLE PRECISION AND ARE PRINTED
  34. C    IN D21.13 FORMAT.
  35. C 5. THE COMMON BLOCK /EH0001/ BELOW IS DATA-LOADED (A MACHINE-
  36. C    DEPENDENT FEATURE) WITH DEFAULT VALUES.
  37. C    THIS BLOCK IS NEEDED FOR PROPER RETENTION OF PARAMETERS USED BY
  38. C    THIS ROUTINE WHICH THE USER CAN RESET BY CALLING XSETF OR XSETUN.
  39. C    THE VARIABLES IN THIS BLOCK ARE AS FOLLOWS.. 
  40. C       MESFLG = PRINT CONTROL FLAG..
  41. C                1 MEANS PRINT ALL MESSAGES (THE DEFAULT).
  42. C                0 MEANS NO PRINTING.
  43. C       LUNIT  = LOGICAL UNIT NUMBER FOR MESSAGES.
  44. C                THE DEFAULT IS 6 (MACHINE-DEPENDENT).
  45. C-----------------------------------------------------------------------
  46. C THE FOLLOWING ARE INSTRUCTIONS FOR INSTALLING THIS ROUTINE
  47. C IN DIFFERENT MACHINE ENVIRONMENTS.
  48. C
  49. C TO CHANGE THE DEFAULT OUTPUT UNIT, CHANGE THE DATA STATEMENT
  50. C IN THE BLOCK DATA SUBPROGRAM BELOW.
  51. C
  52. C FOR A DIFFERENT NUMBER OF CHARACTERS PER WORD, CHANGE THE 
  53. C DATA STATEMENT SETTING NCPW BELOW, AND FORMAT 10.  ALTERNATIVES FOR 
  54. C VARIOUS COMPUTERS ARE SHOWN IN COMMENT CARDS.
  55. C
  56. C FOR A DIFFERENT RUN-ABORT COMMAND, CHANGE THE STATEMENT FOLLOWING
  57. C STATEMENT 100 AT THE END.
  58. C-----------------------------------------------------------------------
  59.       COMMON /EH0001/ MESFLG, LUNIT
  60. C-----------------------------------------------------------------------
  61. C THE FOLLOWING DATA-LOADED VALUE OF NCPW IS VALID FOR THE CDC-6600
  62. C AND CDC-7600 COMPUTERS.
  63. C     DATA NCPW/10/ 
  64. C THE FOLLOWING IS VALID FOR THE CRAY-1 COMPUTER. 
  65. C     DATA NCPW/8/
  66. C THE FOLLOWING IS VALID FOR THE BURROUGHS 6700 AND 7800 COMPUTERS.
  67. C     DATA NCPW/6/
  68. C THE FOLLOWING IS VALID FOR THE PDP-10 COMPUTER. 
  69. C     DATA NCPW/5/
  70. C THE FOLLOWING IS VALID FOR THE VAX COMPUTER WITH 4 BYTES PER INTEGER,
  71. C AND FOR THE IBM-360, IBM-370, IBM-303X, AND IBM-43XX COMPUTERS.
  72.       DATA NCPW/4/
  73. C THE FOLLOWING IS VALID FOR THE PDP-11, OR VAX WITH 2-BYTE INTEGERS. 
  74. C     DATA NCPW/2/
  75. C-----------------------------------------------------------------------
  76.       IF (MESFLG .EQ. 0) GO TO 100
  77. C GET LOGICAL UNIT NUMBER. ---------------------------------------------
  78.       LUN = LUNIT
  79. C GET NUMBER OF WORDS IN MESSAGE. --------------------------------------
  80.       NCH = MIN0(NMES,60)
  81.       NWDS = NCH/NCPW
  82.       IF (NCH .NE. NWDS*NCPW) NWDS = NWDS + 1
  83. C WRITE THE MESSAGE. ---------------------------------------------------
  84.       WRITE (LUN, 10) (MSG(I),I=1,NWDS) 
  85. C-----------------------------------------------------------------------
  86. C THE FOLLOWING FORMAT STATEMENT IS TO HAVE THE FORM
  87. C 10  FORMAT(1X,MMANN)
  88. C WHERE NN = NCPW AND MM IS THE SMALLEST INTEGER .GE. 60/NCPW.
  89. C THE FOLLOWING IS VALID FOR NCPW = 10. 
  90. C 10  FORMAT(1X,6A10)
  91. C THE FOLLOWING IS VALID FOR NCPW = 8.
  92. C 10  FORMAT(1X,8A8)
  93. C THE FOLLOWING IS VALID FOR NCPW = 6.
  94. C 10  FORMAT(1X,10A6)
  95. C THE FOLLOWING IS VALID FOR NCPW = 5.
  96. C 10  FORMAT(1X,12A5)
  97. C THE FOLLOWING IS VALID FOR NCPW = 4.
  98.   10  FORMAT(1X,15A4)
  99. C THE FOLLOWING IS VALID FOR NCPW = 2.
  100. C 10  FORMAT(1X,30A2)
  101. C-----------------------------------------------------------------------
  102.       IF (NI .EQ. 1) WRITE (LUN, 20) I1 
  103.  20   FORMAT(6X,23HIN ABOVE MESSAGE,  I1 =,I10)
  104.       IF (NI .EQ. 2) WRITE (LUN, 30) I1,I2
  105.  30   FORMAT(6X,23HIN ABOVE MESSAGE,  I1 =,I10,3X,4HI2 =,I10)
  106.       IF (NR .EQ. 1) WRITE (LUN, 40) R1 
  107.  40   FORMAT(6X,23HIN ABOVE MESSAGE,  R1 =,D21.13)
  108.       IF (NR .EQ. 2) WRITE (LUN, 50) R1,R2
  109.  50   FORMAT(6X,15HIN ABOVE,  R1 =,D21.13,3X,4HR2 =,D21.13) 
  110. C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
  111.  100  IF (LEVEL .NE. 2) RETURN
  112.       CALL XSTOPX (' ')
  113. C----------------------- END OF SUBROUTINE XERRWV ----------------------
  114.       END 
  115.