1
subroutine srcar (rsav, isav, job)
2
c-----------------------------------------------------------------------
3
c this routine saves or restores (depending on job) the contents of
4
c the common blocks ls0001, lsa001, lar001, and eh0001, which are used
5
c internally by one or more odepack solvers.
7
c rsav = real array of length 245 or more.
8
c isav = integer array of length 59 or more.
9
c job = flag indicating to save or restore the common blocks..
10
c job = 1 if common is to be saved (written to rsav/isav)
11
c job = 2 if common is to be restored (read from rsav/isav)
12
c a call with job = 2 presumes a prior call with job = 1.
13
c-----------------------------------------------------------------------
15
integer ieh, ils, ilsa, ilsr
16
integer i, ioff, lenrls, lenils, lenrla, lenila, lenrlr, lenilr
18
double precision rls, rlsa, rlsr
19
dimension rsav(1), isav(1)
20
common /ls0001/ rls(218), ils(39)
21
common /lsa001/ rlsa(22), ilsa(9)
22
common /lsr001/ rlsr(5), ilsr(9)
23
common /eh0001/ ieh(2)
24
data lenrls/218/, lenils/39/, lenrla/22/, lenila/9/
25
data lenrlr/5/, lenilr/9/
27
if (job .eq. 2) go to 100
31
15 rsav(lenrls+i) = rlsa(i)
32
ioff = lenrls + lenrla
34
20 rsav(ioff+i) = rlsr(i)
39
35 isav(lenils+i) = ilsa(i)
40
ioff = lenils + lenila
42
40 isav(ioff+i) = ilsr(i)
53
115 rlsa(i) = rsav(lenrls+i)
54
ioff = lenrls + lenrla
56
120 rlsr(i) = rsav(ioff+i)
61
135 ilsa(i) = isav(lenils+i)
62
ioff = lenils + lenila
64
140 ilsr(i) = isav(ioff+i)
70
c----------------------- end of subroutine srcar -----------------------