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 / dassl / xsetua.f < prev   
Text File  |  1996-09-28  |  2KB  |  66 lines
  1. C*DECK XSETUA
  2.       SUBROUTINE XSETUA (IUNITA, N)
  3. C***BEGIN PROLOGUE  XSETUA
  4. C***PURPOSE  Set logical unit numbers (up to 5) to which error
  5. C            messages are to be sent.
  6. C***LIBRARY   SLATEC (XERROR)
  7. C***CATEGORY  R3B
  8. C***TYPE      ALL (XSETUA-A)
  9. C***KEYWORDS  ERROR, XERROR
  10. C***AUTHOR  JONES, R. E., (SNLA)
  11. C             Modified by
  12. C           FRITSCH, F. N., (LLNL)
  13. C***DESCRIPTION
  14. C
  15. C     Abstract
  16. C        XSETUA may be called to declare a list of up to five
  17. C        logical units, each of which is to receive a copy of
  18. C        each error message processed by this package.
  19. C        The purpose of XSETUA is to allow simultaneous printing
  20. C        of each error message on, say, a main output file,
  21. C        an interactive terminal, and other files such as graphics
  22. C        communication files.
  23. C
  24. C     Description of Parameters
  25. C      --Input--
  26. C        IUNIT - an array of up to five unit numbers.
  27. C                Normally these numbers should all be different
  28. C                (but duplicates are not prohibited.)
  29. C        N     - the number of unit numbers provided in IUNIT
  30. C                must have 1 .LE. N .LE. 5.
  31. C
  32. C     CAUTION:  The use of COMMON in this version is not safe for
  33. C               multiprocessing.
  34. C
  35. C***REFERENCES  JONES R.E., KAHANER D.K., 'XERROR, THE SLATEC ERROR-
  36. C                 HANDLING PACKAGE', SAND82-0800, SANDIA LABORATORIES,
  37. C                 1982.
  38. C***ROUTINES CALLED  XERMSG
  39. C***COMMON BLOCKS    XERUNI
  40. C***REVISION HISTORY  (YYMMDD)
  41. C   790801  DATE WRITTEN
  42. C   861211  REVISION DATE from Version 3.2
  43. C   891214  Prologue converted to Version 4.0 format.  (BAB)
  44. C   900510  Change call to XERRWV to XERMSG.  (RWC)
  45. C   901011  Rewritten to not use J4SAVE.  (FNF)
  46. C***END PROLOGUE  XSETUA
  47.       DIMENSION IUNITA(5)
  48.       INTEGER  NUNIT, IUNIT(5)
  49.       COMMON /XERUNI/ NUNIT, IUNIT
  50.       CHARACTER *8 XERN1
  51. C***FIRST EXECUTABLE STATEMENT  XSETUA
  52. C
  53.       IF (N.LT.1 .OR. N.GT.5) THEN
  54.          WRITE (XERN1, '(I8)') N
  55.          CALL XERMSG ('SLATEC', 'XSETUA',
  56.      *      'INVALID NUMBER OF UNITS, N = ' // XERN1, 1, 2)
  57.          RETURN
  58.       ENDIF
  59. C
  60.       DO 10 I=1,N
  61.          IUNIT(I) = IUNITA(I)
  62.    10 CONTINUE
  63.       NUNIT = N
  64.       RETURN
  65.       END
  66.