Changeset 5105 for LMDZ6/branches/Amaury_dev/libf/misc/j4save.f90

Timestamp:

Jul 23, 2024, 7:14:34 PM (4 months ago)

Author:

abarral

Message:

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

File:

• LMDZ6/branches/Amaury_dev/libf/misc/j4save.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/misc/j4save.F) (1 diff)

LMDZ6/branches/Amaury_dev/libf/misc/j4save.f90

@@ -1 @@
-*DECK J4SAVE
-      FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
-      IMPLICIT NONE
-C***BEGIN PROLOGUE  J4SAVE
-C***SUBSIDIARY
-C***PURPOSE  Save or reCALL global variables needed by error
-C            handling routines.
-C***LIBRARY   SLATEC (XERROR)
-C***TYPE      INTEGER (J4SAVE-I)
-C***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
-C***AUTHOR  Jones, R. E., (SNLA)
-C***DESCRIPTION
-C
-C     Abstract
-C        J4SAVE saves and recalls several global variables needed
-C        by the library error handling routines.
-C
-C     Description of Parameters
-C      --Input--
-C        IWHICH - Index of item desired.
-C                = 1 Refers to current error number.
-C                = 2 Refers to current error control flag.
-C                = 3 Refers to current unit number to which error
-C                    messages are to be sent.  (0 means use standard.)
-C                = 4 Refers to the maximum number of times any
-C                     message is to be printed (as set by XERMAX).
-C                = 5 Refers to the total number of units to which
-C                     each error message is to be written.
-C                = 6 Refers to the 2nd unit for error messages
-C                = 7 Refers to the 3rd unit for error messages
-C                = 8 Refers to the 4th unit for error messages
-C                = 9 Refers to the 5th unit for error messages
-C        IVALUE - The value to be set for the IWHICH-th parameter,
-C                 if ISET is .TRUE. .
-C        ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
-C                 given the value, IVALUE.  If ISET=.FALSE., the
-C                 IWHICH-th parameter will be unchanged, and IVALUE
-C                 is a dummy parameter.
-C      --Output--
-C        The (old) value of the IWHICH-th parameter will be returned
-C        in the function value, J4SAVE.
-C
-C***SEE ALSO  XERMSG
-C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
-C                 Error-handling Package, SAND82-0800, Sandia
-C                 Laboratories, 1982.
-C***ROUTINES CALLED  (NONE)
-C***REVISION HISTORY  (YYMMDD)
-C   790801  DATE WRITTEN
-C   891214  Prologue converted to Version 4.0 format.  (BAB)
-C   900205  Minor modifications to prologue.  (WRB)
-C   900402  Added TYPE section.  (WRB)
-C   910411  Added KEYWORDS section.  (WRB)
-C   920501  Reformatted the REFERENCES section.  (WRB)
-C***END PROLOGUE  J4SAVE
-      LOGICAL ISET
-      INTEGER IPARAM(9)
-      SAVE IPARAM
-      DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
-      DATA IPARAM(5)/1/
-      DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
-      INTEGER J4SAVE,IWHICH,IVALUE
-C***FIRST EXECUTABLE STATEMENT  J4SAVE
-      J4SAVE = IPARAM(IWHICH)
-      IF (ISET) IPARAM(IWHICH) = IVALUE
-      RETURN
-      END
+!DECK J4SAVE
+FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
+  IMPLICIT NONE
+  !***BEGIN PROLOGUE  J4SAVE
+  !***SUBSIDIARY
+  !***PURPOSE  Save or reCALL global variables needed by error
+         ! handling routines.
+  !***LIBRARY   SLATEC (XERROR)
+  !***TYPE      INTEGER (J4SAVE-I)
+  !***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
+  !***AUTHOR  Jones, R. E., (SNLA)
+  !***DESCRIPTION
+  !
+  ! Abstract
+  !    J4SAVE saves and recalls several global variables needed
+  !    by the library error handling routines.
+  !
+  ! Description of Parameters
+  !  --Input--
+  !    IWHICH - Index of item desired.
+  !            = 1 Refers to current error number.
+  !            = 2 Refers to current error control flag.
+  !            = 3 Refers to current unit number to which error
+  !                messages are to be sent.  (0 means use standard.)
+  !            = 4 Refers to the maximum number of times any
+  !                 message is to be printed (as set by XERMAX).
+  !            = 5 Refers to the total number of units to which
+  !                 each error message is to be written.
+  !            = 6 Refers to the 2nd unit for error messages
+  !            = 7 Refers to the 3rd unit for error messages
+  !            = 8 Refers to the 4th unit for error messages
+  !            = 9 Refers to the 5th unit for error messages
+  !    IVALUE - The value to be set for the IWHICH-th parameter,
+  !             if ISET is .TRUE. .
+  !    ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
+  !             given the value, IVALUE.  If ISET=.FALSE., the
+  !             IWHICH-th parameter will be unchanged, and IVALUE
+  !             is a dummy parameter.
+  !  --Output--
+  !    The (old) value of the IWHICH-th parameter will be returned
+  !    in the function value, J4SAVE.
+  !
+  !***SEE ALSO  XERMSG
+  !***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+  !             Error-handling Package, SAND82-0800, Sandia
+  !             Laboratories, 1982.
+  !***ROUTINES CALLED  (NONE)
+  !***REVISION HISTORY  (YYMMDD)
+  !   790801  DATE WRITTEN
+  !   891214  Prologue converted to Version 4.0 format.  (BAB)
+  !   900205  Minor modifications to prologue.  (WRB)
+  !   900402  Added TYPE section.  (WRB)
+  !   910411  Added KEYWORDS section.  (WRB)
+  !   920501  Reformatted the REFERENCES section.  (WRB)
+  !***END PROLOGUE  J4SAVE
+  LOGICAL :: ISET
+  INTEGER :: IPARAM(9)
+  SAVE IPARAM
+  DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
+  DATA IPARAM(5)/1/
+  DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
+  INTEGER :: J4SAVE,IWHICH,IVALUE
+  !***FIRST EXECUTABLE STATEMENT  J4SAVE
+  J4SAVE = IPARAM(IWHICH)
+  IF (ISET) IPARAM(IWHICH) = IVALUE
+
+END FUNCTION J4SAVE