Mercurial > hg > octave-nkf

annotate libcruft/slatec-err/xgetua.f @ 12748:bb55443911ff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
maint: periodic merge of stable to default
author John W. Eaton <jwe@octave.org>
date Wed, 15 Jun 2011 10:42:03 -0400
parents 5a691cbef111
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3274
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
1 *DECK XGETUA
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
2 SUBROUTINE XGETUA (IUNITA, N)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE XGETUA
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
4 C***PURPOSE Return unit number(s) to which error messages are being
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
5 C sent.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
6 C***LIBRARY SLATEC (XERROR)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
7 C***CATEGORY R3C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
8 C***TYPE ALL (XGETUA-A)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
9 C***KEYWORDS ERROR, XERROR
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
10 C***AUTHOR Jones, R. E., (SNLA)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
11 C***DESCRIPTION
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
12 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
13 C Abstract
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
14 C XGETUA may be called to determine the unit number or numbers
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
15 C to which error messages are being sent.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
16 C These unit numbers may have been set by a call to XSETUN,
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
17 C or a call to XSETUA, or may be a default value.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
18 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
19 C Description of Parameters
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
20 C --Output--
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
21 C IUNIT - an array of one to five unit numbers, depending
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
22 C on the value of N. A value of zero refers to the
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
23 C default unit, as defined by the I1MACH machine
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
24 C constant routine. Only IUNIT(1),...,IUNIT(N) are
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
25 C defined by XGETUA. The values of IUNIT(N+1),...,
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
26 C IUNIT(5) are not defined (for N .LT. 5) or altered
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
27 C in any way by XGETUA.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
28 C N - the number of units to which copies of the
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
29 C error messages are being sent. N will be in the
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
30 C range from 1 to 5.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
31 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
32 C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
33 C Error-handling Package, SAND82-0800, Sandia
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
34 C Laboratories, 1982.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
35 C***ROUTINES CALLED J4SAVE
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
36 C***REVISION HISTORY (YYMMDD)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
37 C 790801 DATE WRITTEN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
38 C 861211 REVISION DATE from Version 3.2
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
39 C 891214 Prologue converted to Version 4.0 format. (BAB)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
40 C 920501 Reformatted the REFERENCES section. (WRB)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
41 C***END PROLOGUE XGETUA
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
42 DIMENSION IUNITA(5)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
43 C***FIRST EXECUTABLE STATEMENT XGETUA
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
44 N = J4SAVE(5,0,.FALSE.)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
45 DO 30 I=1,N
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
46 INDEX = I+4
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
47 IF (I.EQ.1) INDEX = 3
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
48 IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
49 30 CONTINUE
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
50 RETURN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
51 END