*DECK DSRCMS SUBROUTINE DSRCMS (RSAV, ISAV, JOB) C----------------------------------------------------------------------- C This routine saves or restores (depending on JOB) the contents of C the Common blocks DLS001, DLSS01, which are used C internally by one or more ODEPACK solvers. C C RSAV = real array of length 224 or more. C ISAV = integer array of length 71 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, ILSS INTEGER I, LENILS, LENISS, LENRLS, LENRSS DOUBLE PRECISION RSAV, RLS, RLSS DIMENSION RSAV(*), ISAV(*) SAVE LENRLS, LENILS, LENRSS, LENISS COMMON /DLS001/ RLS(218), ILS(37) COMMON /DLSS01/ RLSS(6), ILSS(34) DATA LENRLS/218/, LENILS/37/, LENRSS/6/, LENISS/34/ C IF (JOB .EQ. 2) GO TO 100 DO 10 I = 1,LENRLS 10 RSAV(I) = RLS(I) DO 15 I = 1,LENRSS 15 RSAV(LENRLS+I) = RLSS(I) C DO 20 I = 1,LENILS 20 ISAV(I) = ILS(I) DO 25 I = 1,LENISS 25 ISAV(LENILS+I) = ILSS(I) C RETURN C 100 CONTINUE DO 110 I = 1,LENRLS 110 RLS(I) = RSAV(I) DO 115 I = 1,LENRSS 115 RLSS(I) = RSAV(LENRLS+I) C DO 120 I = 1,LENILS 120 ILS(I) = ISAV(I) DO 125 I = 1,LENISS 125 ILSS(I) = ISAV(LENILS+I) C RETURN C----------------------- End of Subroutine DSRCMS ---------------------- END