| [5246] | 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 | RETURN |
|---|
| 67 | END FUNCTION J4SAVE |
|---|
