*DECK DSRCPK
SUBROUTINE DSRCPK (RSAV, ISAV, JOB)
C-----------------------------------------------------------------------
C This routine saves or restores (depending on JOB) the contents of
C the Common blocks DLS001, DLPK01, which are used
C internally by the DLSODPK solver.
C
C RSAV = real array of length 222 or more.
C ISAV = integer array of length 50 or more.
C JOB = flag indicating to save or restore the Common blocks:
C JOB = 1 if Common is to be saved (written to RSAV/ISAV)
C JOB = 2 if Common is to be restored (read from RSAV/ISAV)
C A call with JOB = 2 presumes a prior call with JOB = 1.
C-----------------------------------------------------------------------
INTEGER ISAV, JOB
INTEGER ILS, ILSP
INTEGER I, LENILP, LENRLP, LENILS, LENRLS
DOUBLE PRECISION RSAV, RLS, RLSP
DIMENSION RSAV(*), ISAV(*)
SAVE LENRLS, LENILS, LENRLP, LENILP
COMMON /DLS001/ RLS(218), ILS(37)
COMMON /DLPK01/ RLSP(4), ILSP(13)
DATA LENRLS/218/, LENILS/37/, LENRLP/4/, LENILP/13/
C
IF (JOB .EQ. 2) GO TO 100
CALL DCOPY (LENRLS, RLS, 1, RSAV, 1)
CALL DCOPY (LENRLP, RLSP, 1, RSAV(LENRLS+1), 1)
DO 20 I = 1,LENILS
20 ISAV(I) = ILS(I)
DO 40 I = 1,LENILP
40 ISAV(LENILS+I) = ILSP(I)
RETURN
C
100 CONTINUE
CALL DCOPY (LENRLS, RSAV, 1, RLS, 1)
CALL DCOPY (LENRLP, RSAV(LENRLS+1), 1, RLSP, 1)
DO 120 I = 1,LENILS
120 ILS(I) = ISAV(I)
DO 140 I = 1,LENILP
140 ILSP(I) = ISAV(LENILS+I)
RETURN
C----------------------- End of Subroutine DSRCPK ----------------------
END