Mercurial > octave-nkf

annotate libcruft/slatec-err/xsetf.f @ 5103:e2ed74b9bfa0 after-gnuplot-split

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2004-12-28 02:43:01 by jwe]
author jwe
date Tue, 28 Dec 2004 02:43:01 +0000
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 XSETF
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
2 SUBROUTINE XSETF (KONTRL)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
3 C***BEGIN PROLOGUE XSETF
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
4 C***PURPOSE Set the error control flag.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
5 C***LIBRARY SLATEC (XERROR)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
6 C***CATEGORY R3A
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
7 C***TYPE ALL (XSETF-A)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
8 C***KEYWORDS ERROR, XERROR
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
9 C***AUTHOR Jones, R. E., (SNLA)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
10 C***DESCRIPTION
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
11 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
12 C Abstract
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
13 C XSETF sets the error control flag value to KONTRL.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
14 C (KONTRL is an input parameter only.)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
15 C The following table shows how each message is treated,
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
16 C depending on the values of KONTRL and LEVEL. (See XERMSG
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
17 C for description of LEVEL.)
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 If KONTRL is zero or negative, no information other than the
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
20 C message itself (including numeric values, if any) will be
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
21 C printed. If KONTRL is positive, introductory messages,
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
22 C trace-backs, etc., will be printed in addition to the message.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
23 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
24 C ABS(KONTRL)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
25 C LEVEL 0 1 2
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
26 C value
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
27 C 2 fatal fatal fatal
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
28 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
29 C 1 not printed printed fatal
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
30 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
31 C 0 not printed printed printed
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
32 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
33 C -1 not printed printed printed
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
34 C only only
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
35 C once once
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
36 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
37 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
38 C Error-handling Package, SAND82-0800, Sandia
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
39 C Laboratories, 1982.
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
40 C***ROUTINES CALLED J4SAVE, XERMSG
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
41 C***REVISION HISTORY (YYMMDD)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
42 C 790801 DATE WRITTEN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
43 C 890531 Changed all specific intrinsics to generic. (WRB)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
44 C 890531 REVISION DATE from Version 3.2
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
45 C 891214 Prologue converted to Version 4.0 format. (BAB)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
46 C 900510 Change call to XERRWV to XERMSG. (RWC)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
47 C 920501 Reformatted the REFERENCES section. (WRB)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
48 C***END PROLOGUE XSETF
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
49 CHARACTER *8 XERN1
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
50 C***FIRST EXECUTABLE STATEMENT XSETF
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
51 IF (ABS(KONTRL) .GT. 2) THEN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
52 WRITE (XERN1, '(I8)') KONTRL
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
53 CALL XERMSG ('SLATEC', 'XSETF',
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
54 * 'INVALID ARGUMENT = ' // XERN1, 1, 2)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
55 RETURN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
56 ENDIF
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
57 C
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
58 JUNK = J4SAVE(2,KONTRL,.TRUE.)
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
59 RETURN
5a691cbef111 [project @ 1999-10-12 05:21:34 by jwe]
jwe
parents:
diff changeset
60 END