~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to Lib/integrate/odepack/srcar.f

  • Committer: Bazaar Package Importer
  • Author(s): Daniel T. Chen (new)
  • Date: 2005-03-16 02:15:29 UTC
  • Revision ID: james.westby@ubuntu.com-20050316021529-xrjlowsejs0cijig
Tags: upstream-0.3.2
ImportĀ upstreamĀ versionĀ 0.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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.
 
6
c
 
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-----------------------------------------------------------------------
 
14
      integer isav, job
 
15
      integer ieh, ils, ilsa, ilsr
 
16
      integer i, ioff, lenrls, lenils, lenrla, lenila, lenrlr, lenilr
 
17
      double precision rsav
 
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/
 
26
c
 
27
      if (job .eq. 2) go to 100
 
28
      do 10 i = 1,lenrls
 
29
 10     rsav(i) = rls(i)
 
30
      do 15 i = 1,lenrla
 
31
 15     rsav(lenrls+i) = rlsa(i)
 
32
      ioff = lenrls + lenrla
 
33
      do 20 i = 1,lenrlr
 
34
 20     rsav(ioff+i) = rlsr(i)
 
35
c
 
36
      do 30 i = 1,lenils
 
37
 30     isav(i) = ils(i)
 
38
      do 35 i = 1,lenila
 
39
 35     isav(lenils+i) = ilsa(i)
 
40
      ioff = lenils + lenila
 
41
      do 40 i = 1,lenilr
 
42
 40     isav(ioff+i) = ilsr(i)
 
43
c
 
44
      ioff = ioff + lenilr
 
45
      isav(ioff+1) = ieh(1)
 
46
      isav(ioff+2) = ieh(2)
 
47
      return
 
48
c
 
49
 100  continue
 
50
      do 110 i = 1,lenrls
 
51
 110     rls(i) = rsav(i)
 
52
      do 115 i = 1,lenrla
 
53
 115     rlsa(i) = rsav(lenrls+i)
 
54
      ioff = lenrls + lenrla
 
55
      do 120 i = 1,lenrlr
 
56
 120     rlsr(i) = rsav(ioff+i)
 
57
c
 
58
      do 130 i = 1,lenils
 
59
 130     ils(i) = isav(i)
 
60
      do 135 i = 1,lenila
 
61
 135     ilsa(i) = isav(lenils+i)
 
62
      ioff = lenils + lenila
 
63
      do 140 i = 1,lenilr
 
64
 140     ilsr(i) = isav(ioff+i)
 
65
c
 
66
      ioff = ioff + lenilr
 
67
      ieh(1) = isav(ioff+1)
 
68
      ieh(2) = isav(ioff+2)
 
69
      return
 
70
c----------------------- end of subroutine srcar -----------------------
 
71
      end