source: LMDZ6/branches/Amaury_dev/libf/misc/j4save.f90 @ 5105

Last change on this file since 5105 was 5105, checked in by abarral, 8 weeks ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 2.6 KB
Line 
1!DECK J4SAVE
2FUNCTION 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
67END FUNCTION J4SAVE
Note: See TracBrowser for help on using the repository browser.