1 | !DECK J4SAVE |
---|
2 | FUNCTION J4SAVE(IWHICH, IVALUE, ISET) |
---|
3 | IMPLICIT NONE |
---|
4 | !***BEGIN PROLOGUE J4SAVE |
---|
5 | !***SUBSIDIARY |
---|
6 | !***PURPOSE Save or reCALL global variables needed by error |
---|
7 | ! handling routines. |
---|
8 | !***LIBRARY SLATEC (XERROR) |
---|
9 | !***TYPE INTEGER (J4SAVE-I) |
---|
10 | !***KEYWORDS ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR |
---|
11 | !***AUTHOR Jones, R. E., (SNLA) |
---|
12 | !***DESCRIPTION |
---|
13 | ! |
---|
14 | ! Abstract |
---|
15 | ! J4SAVE saves and recalls several global variables needed |
---|
16 | ! by the library error handling routines. |
---|
17 | ! |
---|
18 | ! Description of Parameters |
---|
19 | ! --Input-- |
---|
20 | ! IWHICH - Index of item desired. |
---|
21 | ! = 1 Refers to current error number. |
---|
22 | ! = 2 Refers to current error control flag. |
---|
23 | ! = 3 Refers to current unit number to which error |
---|
24 | ! messages are to be sent. (0 means use standard.) |
---|
25 | ! = 4 Refers to the maximum number of times any |
---|
26 | ! message is to be printed (as set by XERMAX). |
---|
27 | ! = 5 Refers to the total number of units to which |
---|
28 | ! each error message is to be written. |
---|
29 | ! = 6 Refers to the 2nd unit for error messages |
---|
30 | ! = 7 Refers to the 3rd unit for error messages |
---|
31 | ! = 8 Refers to the 4th unit for error messages |
---|
32 | ! = 9 Refers to the 5th unit for error messages |
---|
33 | ! IVALUE - The value to be set for the IWHICH-th parameter, |
---|
34 | ! if ISET is .TRUE. . |
---|
35 | ! ISET - If ISET=.TRUE., the IWHICH-th parameter will BE |
---|
36 | ! given the value, IVALUE. If ISET=.FALSE., the |
---|
37 | ! IWHICH-th parameter will be unchanged, and IVALUE |
---|
38 | ! is a dummy parameter. |
---|
39 | ! --Output-- |
---|
40 | ! The (old) value of the IWHICH-th parameter will be returned |
---|
41 | ! in the function value, J4SAVE. |
---|
42 | ! |
---|
43 | !***SEE ALSO XERMSG |
---|
44 | !***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC |
---|
45 | ! Error-handling Package, SAND82-0800, Sandia |
---|
46 | ! Laboratories, 1982. |
---|
47 | !***ROUTINES CALLED (NONE) |
---|
48 | !***REVISION HISTORY (YYMMDD) |
---|
49 | ! 790801 DATE WRITTEN |
---|
50 | ! 891214 Prologue converted to Version 4.0 format. (BAB) |
---|
51 | ! 900205 Minor modifications to prologue. (WRB) |
---|
52 | ! 900402 Added TYPE section. (WRB) |
---|
53 | ! 910411 Added KEYWORDS section. (WRB) |
---|
54 | ! 920501 Reformatted the REFERENCES section. (WRB) |
---|
55 | !***END PROLOGUE J4SAVE |
---|
56 | LOGICAL :: ISET |
---|
57 | INTEGER :: IPARAM(9) |
---|
58 | SAVE IPARAM |
---|
59 | DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/ |
---|
60 | DATA IPARAM(5)/1/ |
---|
61 | DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/ |
---|
62 | INTEGER :: J4SAVE,IWHICH,IVALUE |
---|
63 | !***FIRST EXECUTABLE STATEMENT J4SAVE |
---|
64 | J4SAVE = IPARAM(IWHICH) |
---|
65 | IF (ISET) IPARAM(IWHICH) = IVALUE |
---|
66 | |
---|
67 | END FUNCTION J4SAVE |
---|