share/odepack/fortran/dsrcma.f

   1 *DECK DSRCMA
   2       SUBROUTINE DSRCMA (RSAV, ISAV, JOB)
   3 C-----------------------------------------------------------------------
   4 C This routine saves or restores (depending on JOB) the contents of
   5 C the Common blocks DLS001, DLSA01, which are used
   6 C internally by one or more ODEPACK solvers.
   7 C
   8 C RSAV = real array of length 240 or more.
   9 C ISAV = integer array of length 46 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, ILSA
  17       INTEGER I, LENRLS, LENILS, LENRLA, LENILA
  18       DOUBLE PRECISION RSAV
  19       DOUBLE PRECISION RLS, RLSA
  20       DIMENSION RSAV(*), ISAV(*)
  21       SAVE LENRLS, LENILS, LENRLA, LENILA
  22       COMMON /DLS001/ RLS(218), ILS(37)
  23       COMMON /DLSA01/ RLSA(22), ILSA(9)
  24       DATA LENRLS/218/, LENILS/37/, LENRLA/22/, LENILA/9/
  25 C
  26       IF (JOB .EQ. 2) GO TO 100
  27       DO 10 I = 1,LENRLS
  28  10     RSAV(I) = RLS(I)
  29       DO 15 I = 1,LENRLA
  30  15     RSAV(LENRLS+I) = RLSA(I)
  31 C
  32       DO 20 I = 1,LENILS
  33  20     ISAV(I) = ILS(I)
  34       DO 25 I = 1,LENILA
  35  25     ISAV(LENILS+I) = ILSA(I)
  36 C
  37       RETURN
  38 C
  39  100  CONTINUE
  40       DO 110 I = 1,LENRLS
  41  110     RLS(I) = RSAV(I)
  42       DO 115 I = 1,LENRLA
  43  115     RLSA(I) = RSAV(LENRLS+I)
  44 C
  45       DO 120 I = 1,LENILS
  46  120     ILS(I) = ISAV(I)
  47       DO 125 I = 1,LENILA
  48  125     ILSA(I) = ISAV(LENILS+I)
  49 C
  50       RETURN
  51 C----------------------- End of Subroutine DSRCMA ----------------------
  52       END