share/odepack/fortran/dsrcms.f

   1 *DECK DSRCMS
   2       SUBROUTINE DSRCMS (RSAV, ISAV, JOB)
   3 C-----------------------------------------------------------------------
   4 C This routine saves or restores (depending on JOB) the contents of
   5 C the Common blocks DLS001, DLSS01, which are used
   6 C internally by one or more ODEPACK solvers.
   7 C
   8 C RSAV = real array of length 224 or more.
   9 C ISAV = integer array of length 71 or more.
  10 C JOB  = flag indicating to save or restore the Common blocks:
  11 C        JOB  = 1 if Common is to be saved (written to RSAV/ISAV)
  12 C        JOB  = 2 if Common is to be restored (read from RSAV/ISAV)
  13 C        A call with JOB = 2 presumes a prior call with JOB = 1.
  14 C-----------------------------------------------------------------------
  15       INTEGER ISAV, JOB
  16       INTEGER ILS, ILSS
  17       INTEGER I, LENILS, LENISS, LENRLS, LENRSS
  18       DOUBLE PRECISION RSAV,   RLS, RLSS
  19       DIMENSION RSAV(*), ISAV(*)
  20       SAVE LENRLS, LENILS, LENRSS, LENISS
  21       COMMON /DLS001/ RLS(218), ILS(37)
  22       COMMON /DLSS01/ RLSS(6), ILSS(34)
  23       DATA LENRLS/218/, LENILS/37/, LENRSS/6/, LENISS/34/
  24 C
  25       IF (JOB .EQ. 2) GO TO 100
  26       DO 10 I = 1,LENRLS
  27  10     RSAV(I) = RLS(I)
  28       DO 15 I = 1,LENRSS
  29  15     RSAV(LENRLS+I) = RLSS(I)
  30 C
  31       DO 20 I = 1,LENILS
  32  20     ISAV(I) = ILS(I)
  33       DO 25 I = 1,LENISS
  34  25     ISAV(LENILS+I) = ILSS(I)
  35 C
  36       RETURN
  37 C
  38  100  CONTINUE
  39       DO 110 I = 1,LENRLS
  40  110     RLS(I) = RSAV(I)
  41       DO 115 I = 1,LENRSS
  42  115     RLSS(I) = RSAV(LENRLS+I)
  43 C
  44       DO 120 I = 1,LENILS
  45  120     ILS(I) = ISAV(I)
  46       DO 125 I = 1,LENISS
  47  125     ILSS(I) = ISAV(LENILS+I)
  48 C
  49       RETURN
  50 C----------------------- End of Subroutine DSRCMS ----------------------
  51       END