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