share/odepack/fortran/dsrckr.f

   1 *DECK DSRCKR
   2       SUBROUTINE DSRCKR (RSAV, ISAV, JOB)
   3 C-----------------------------------------------------------------------
   4 C This routine saves or restores (depending on JOB) the contents of
   5 C the Common blocks DLS001, DLS002, DLSR01, DLPK01, which
   6 C are used internally by the DLSODKR solver.
   7 C
   8 C RSAV = real array of length 228 or more.
   9 C ISAV = integer array of length 63 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, ILS2, ILSR, ILSP
  17       INTEGER I, IOFF, LENILP, LENRLP, LENILS, LENRLS, LENILR, LENRLR
  18       DOUBLE PRECISION RSAV,   RLS, RLS2, RLSR, RLSP
  19       DIMENSION RSAV(*), ISAV(*)
  20       SAVE LENRLS, LENILS, LENRLP, LENILP, LENRLR, LENILR
  21       COMMON /DLS001/ RLS(218), ILS(37)
  22       COMMON /DLS002/ RLS2, ILS2(4)
  23       COMMON /DLSR01/ RLSR(5), ILSR(9)
  24       COMMON /DLPK01/ RLSP(4), ILSP(13)
  25       DATA LENRLS/218/, LENILS/37/, LENRLP/4/, LENILP/13/
  26       DATA LENRLR/5/, LENILR/9/
  27 C
  28       IF (JOB .EQ. 2) GO TO 100
  29       CALL DCOPY (LENRLS, RLS, 1, RSAV, 1)
  30       RSAV(LENRLS+1) = RLS2
  31       CALL DCOPY (LENRLR, RLSR, 1, RSAV(LENRLS+2), 1)
  32       CALL DCOPY (LENRLP, RLSP, 1, RSAV(LENRLS+LENRLR+2), 1)
  33       DO 20 I = 1,LENILS
  34  20     ISAV(I) = ILS(I)
  35       ISAV(LENILS+1) = ILS2(1)
  36       ISAV(LENILS+2) = ILS2(2)
  37       ISAV(LENILS+3) = ILS2(3)
  38       ISAV(LENILS+4) = ILS2(4)
  39       IOFF = LENILS + 2
  40       DO 30 I = 1,LENILR
  41  30     ISAV(IOFF+I) = ILSR(I)
  42       IOFF = IOFF + LENILR
  43       DO 40 I = 1,LENILP
  44  40     ISAV(IOFF+I) = ILSP(I)
  45       RETURN
  46 C
  47  100  CONTINUE
  48       CALL DCOPY (LENRLS, RSAV, 1, RLS, 1)
  49       RLS2 = RSAV(LENRLS+1)
  50       CALL DCOPY (LENRLR, RSAV(LENRLS+2), 1, RLSR, 1)
  51       CALL DCOPY (LENRLP, RSAV(LENRLS+LENRLR+2), 1, RLSP, 1)
  52       DO 120 I = 1,LENILS
  53  120    ILS(I) = ISAV(I)
  54       ILS2(1) = ISAV(LENILS+1)
  55       ILS2(2) = ISAV(LENILS+2)
  56       ILS2(3) = ISAV(LENILS+3)
  57       ILS2(4) = ISAV(LENILS+4)
  58       IOFF = LENILS + 2
  59       DO 130 I = 1,LENILR
  60  130    ILSR(I) = ISAV(IOFF+I)
  61       IOFF = IOFF + LENILR
  62       DO 140 I = 1,LENILP
  63  140    ILSP(I) = ISAV(IOFF+I)
  64       RETURN
  65 C----------------------- End of Subroutine DSRCKR ----------------------
  66       END