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 / xgetua.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  66 lines
  1. C*DECK XGETUA
  2.       SUBROUTINE XGETUA (IUNITA, N)
  3. C***BEGIN PROLOGUE  XGETUA
  4. C***PURPOSE  Return unit number(s) to which error messages are being
  5. C            sent.
  6. C***LIBRARY   SLATEC (XERROR)
  7. C***CATEGORY  R3C
  8. C***TYPE      ALL (XGETUA-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        XGETUA may be called to determine the unit number or numbers
  17. C        to which error messages are being sent.
  18. C        These unit numbers may have been set by a call to XSETUN,
  19. C        or a call to XSETUA, or may be a default value.
  20. C
  21. C     Description of Parameters
  22. C      --Output--
  23. C        IUNIT - an array of one to five unit numbers, depending
  24. C                on the value of N.  A value of zero refers to the
  25. C                default unit, as defined by the I1MACH machine
  26. C                constant routine.  Only IUNIT(1),...,IUNIT(N) are
  27. C                defined by XGETUA.  The values of IUNIT(N+1),...,
  28. C                IUNIT(5) are not defined (for N .LT. 5) or altered
  29. C                in any way by XGETUA.
  30. C        N     - the number of units to which copies of the
  31. C                error messages are being sent.  N will be in the
  32. C                range from 1 to 5.
  33. C
  34. C     CAUTION:  The use of COMMON in this version is not safe for
  35. C               multiprocessing.
  36. C
  37. C***REFERENCES  JONES R.E., KAHANER D.K., 'XERROR, THE SLATEC ERROR-
  38. C                 HANDLING PACKAGE', SAND82-0800, SANDIA LABORATORIES,
  39. C                 1982.
  40. C***ROUTINES CALLED  (NONE)
  41. C***COMMON BLOCKS    XERUNI
  42. C***REVISION HISTORY  (YYMMDD)
  43. C   790801  DATE WRITTEN
  44. C   861211  REVISION DATE from Version 3.2
  45. C   891214  Prologue converted to Version 4.0 format.  (BAB)
  46. C   901011  Rewritten to not use J4SAVE.  (FNF)
  47. C   901012  Corrected initialization problem.  (FNF)
  48. C***END PROLOGUE  XGETUA
  49.       DIMENSION IUNITA(5)
  50.       INTEGER  NUNIT, IUNIT(5)
  51.       COMMON /XERUNI/ NUNIT, IUNIT
  52. C***FIRST EXECUTABLE STATEMENT  XGETUA
  53. C       Initialize so XERMSG will use standard error unit number if
  54. C       block has not been set up by a CALL XSETUA.
  55. C       CAUTION:  This assumes uninitialized COMMON tests .LE.0 .
  56.       IF (NUNIT.LE.0) THEN
  57.          NUNIT = 1
  58.          IUNIT(1) = 0
  59.       ENDIF
  60.       N = NUNIT
  61.       DO 30 I=1,N
  62.          IUNITA(I) = IUNIT(I)
  63.    30 CONTINUE
  64.       RETURN
  65.       END
  66.