share/odepack/fortran/dsrcom.f

   1 *DECK DSRCOM
   2       SUBROUTINE DSRCOM (RSAV, ISAV, JOB)
   3 C***BEGIN PROLOGUE  DSRCOM
   4 C***SUBSIDIARY
   5 C***PURPOSE  Save/restore ODEPACK COMMON blocks.
   6 C***TYPE      DOUBLE PRECISION (SSRCOM-S, DSRCOM-D)
   7 C***AUTHOR  Hindmarsh, Alan C., (LLNL)
   8 C***DESCRIPTION
   9 C
  10 C  This routine saves or restores (depending on JOB) the contents of
  11 C  the COMMON block DLS001, which is used internally
  12 C  by one or more ODEPACK solvers.
  13 C
  14 C  RSAV = real array of length 218 or more.
  15 C  ISAV = integer array of length 37 or more.
  16 C  JOB  = flag indicating to save or restore the COMMON blocks:
  17 C         JOB  = 1 if COMMON is to be saved (written to RSAV/ISAV)
  18 C         JOB  = 2 if COMMON is to be restored (read from RSAV/ISAV)
  19 C         A call with JOB = 2 presumes a prior call with JOB = 1.
  20 C
  21 C***SEE ALSO  DLSODE
  22 C***ROUTINES CALLED  (NONE)
  23 C***COMMON BLOCKS    DLS001
  24 C***REVISION HISTORY  (YYMMDD)
  25 C   791129  DATE WRITTEN
  26 C   890501  Modified prologue to SLATEC/LDOC format.  (FNF)
  27 C   890503  Minor cosmetic changes.  (FNF)
  28 C   921116  Deleted treatment of block /EH0001/.  (ACH)
  29 C   930801  Reduced Common block length by 2.  (ACH)
  30 C   930809  Renamed to allow single/double precision versions. (ACH)
  31 C   010418  Reduced Common block length by 209+12. (ACH)
  32 C   031105  Restored 'own' variables to Common block /DLS001/, to
  33 C           enable interrupt/restart feature. (ACH)
  34 C   031112  Added SAVE statement for data-loaded constants.
  35 C***END PROLOGUE  DSRCOM
  36 C**End
  37       INTEGER ISAV, JOB
  38       INTEGER ILS
  39       INTEGER I, LENILS, LENRLS
  40       DOUBLE PRECISION RSAV,   RLS
  41       DIMENSION RSAV(*), ISAV(*)
  42       SAVE LENRLS, LENILS
  43       COMMON /DLS001/ RLS(218), ILS(37)
  44       DATA LENRLS/218/, LENILS/37/
  45 C
  46 C***FIRST EXECUTABLE STATEMENT  DSRCOM
  47       IF (JOB .EQ. 2) GO TO 100
  48 C
  49       DO 10 I = 1,LENRLS
  50  10     RSAV(I) = RLS(I)
  51       DO 20 I = 1,LENILS
  52  20     ISAV(I) = ILS(I)
  53       RETURN
  54 C
  55  100  CONTINUE
  56       DO 110 I = 1,LENRLS
  57  110     RLS(I) = RSAV(I)
  58       DO 120 I = 1,LENILS
  59  120     ILS(I) = ISAV(I)
  60       RETURN
  61 C----------------------- END OF SUBROUTINE DSRCOM ----------------------
  62       END