| 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 |
|---|
