share/odepack/fortran/dsrcpk.f

   1 *DECK DSRCPK
   2       SUBROUTINE DSRCPK (RSAV, ISAV, JOB)
   3 C-----------------------------------------------------------------------
   4 C This routine saves or restores (depending on JOB) the contents of
   5 C the Common blocks DLS001, DLPK01, which are used
   6 C internally by the DLSODPK solver.
   7 C
   8 C RSAV = real array of length 222 or more.
   9 C ISAV = integer array of length 50 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, ILSP
  17       INTEGER I, LENILP, LENRLP, LENILS, LENRLS
  18       DOUBLE PRECISION RSAV,   RLS, RLSP
  19       DIMENSION RSAV(*), ISAV(*)
  20       SAVE LENRLS, LENILS, LENRLP, LENILP
  21       COMMON /DLS001/ RLS(218), ILS(37)
  22       COMMON /DLPK01/ RLSP(4), ILSP(13)
  23       DATA LENRLS/218/, LENILS/37/, LENRLP/4/, LENILP/13/
  24 C
  25       IF (JOB .EQ. 2) GO TO 100
  26       CALL DCOPY (LENRLS, RLS, 1, RSAV, 1)
  27       CALL DCOPY (LENRLP, RLSP, 1, RSAV(LENRLS+1), 1)
  28       DO 20 I = 1,LENILS
  29  20     ISAV(I) = ILS(I)
  30       DO 40 I = 1,LENILP
  31  40     ISAV(LENILS+I) = ILSP(I)
  32       RETURN
  33 C
  34  100  CONTINUE
  35       CALL DCOPY (LENRLS, RSAV, 1, RLS, 1)
  36       CALL DCOPY (LENRLP, RSAV(LENRLS+1), 1, RLSP, 1)
  37       DO 120 I = 1,LENILS
  38  120     ILS(I) = ISAV(I)
  39       DO 140 I = 1,LENILP
  40  140     ILSP(I) = ISAV(LENILS+I)
  41       RETURN
  42 C----------------------- End of Subroutine DSRCPK ----------------------
  43       END