1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
C/MEMBR ADD NAME=RSCAR1,SSI=0
subroutine rscar1 (rsav, isav)
c%purpose
c this routine restores from rsav and isav the contents of common
c blocks ls0001, lsa001, and eh0001, which are used internally in the
c lsodar package. this presumes that rsav and isav were loaded by means
c of subroutine svcma or the equivalent.
c!
double precision isav
integer ieh, ils, ilsa
integer i, lenrls, lenils, lenrla, lenila
double precision rsav
double precision rls, rlsa, rlsr
dimension rsav(*), isav(*)
common /ls0001/ rls(219), ils(39)
common /lsa001/ rlsa(22), ilsa(9)
common /lsr001/ rlsr(5),ilsr(9)
common /eh0001/ ieh(2)
data lenrls/219/, lenils/39/, lenrla/22/, lenila/9/
data lenrlr/5/,lenilr/9/
c
l=1
call dcopy(lenrls,rsav(l),1,rls,1)
l=l+lenrls
call dcopy(lenrla,rsav(l),1,rlsa,1)
l=l+lenrla
call dcopy(lenrlr,rsav(l),1,rlsr,1)
c
l=0
do 20 i = 1,lenils
ils(i) = int(isav(l+i))
20 continue
l=l+lenils
do 25 i = 1,lenila
ilsa(i) = int(isav(l+i))
25 continue
l=l+lenila
do 26 i=1,lenilr
ilsr(i) = int(isav(l+i))
26 continue
l=l+lenilr
c
ieh(1) = int(isav(l+1))
ieh(2) = int(isav(l+2))
return
end
|
