← Back to branch summary

~ubuntu-branches/ubuntu/saucy/python-scipy/saucy

« back to all changes in this revision

Viewing changes to Lib/sandbox/spline/fitpack/fppocu.f

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
http://bugs.debian.org/489149
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/sandbox/spline/fitpack/fppocu.f
1
 
      subroutine fppocu(idim,k,a,b,ib,db,nb,ie,de,ne,cp,np)
2
 
c  subroutine fppocu finds a idim-dimensional polynomial curve p(u) =
3
 
c  (p1(u),p2(u),...,pidim(u)) of degree k, satisfying certain derivative
4
 
c  constraints at the end points a and b, i.e.
5
 
c                  (l)
6
 
c    if ib > 0 : pj   (a) = db(idim*l+j), l=0,1,...,ib-1
7
 
c                  (l)
8
 
c    if ie > 0 : pj   (b) = de(idim*l+j), l=0,1,...,ie-1
9
 
c
10
 
c  the polynomial curve is returned in its b-spline representation
11
 
c  ( coefficients cp(j), j=1,2,...,np )
12
 
c  ..
13
 
c  ..scalar arguments..
14
 
      integer idim,k,ib,nb,ie,ne,np
15
 
      real*8 a,b
16
 
c  ..array arguments..
17
 
      real*8 db(nb),de(ne),cp(np)
18
 
c  ..local scalars..
19
 
      real*8 ab,aki
20
 
      integer i,id,j,jj,l,ll,k1,k2
21
 
c  ..local array..
22
 
      real*8 work(6,6)
23
 
c  ..
24
 
      k1 = k+1
25
 
      k2 = 2*k1
26
 
      ab = b-a
27
 
      do 110 id=1,idim
28
 
        do 10 j=1,k1
29
 
          work(j,1) = 0.
30
 
  10    continue
31
 
        if(ib.eq.0) go to 50
32
 
        l = id
33
 
        do 20 i=1,ib
34
 
          work(1,i) = db(l)
35
 
          l = l+idim
36
 
  20    continue
37
 
        if(ib.eq.1) go to 50
38
 
        ll = ib
39
 
        do 40 j=2,ib
40
 
          ll =  ll-1
41
 
          do 30 i=1,ll
42
 
            aki = k1-i
43
 
            work(j,i) = ab*work(j-1,i+1)/aki + work(j-1,i)
44
 
  30      continue
45
 
  40    continue
46
 
  50    if(ie.eq.0) go to 90
47
 
        l = id
48
 
        j = k1
49
 
        do 60 i=1,ie
50
 
          work(j,i) = de(l)
51
 
          l = l+idim
52
 
          j = j-1
53
 
  60    continue
54
 
        if(ie.eq.1) go to 90
55
 
        ll = ie
56
 
        do 80 jj=2,ie
57
 
          ll =  ll-1
58
 
          j = k1+1-jj
59
 
          do 70 i=1,ll
60
 
            aki = k1-i
61
 
            work(j,i) = work(j+1,i) - ab*work(j,i+1)/aki
62
 
            j = j-1
63
 
  70      continue
64
 
  80    continue
65
 
  90    l = (id-1)*k2
66
 
        do 100 j=1,k1
67
 
          l = l+1
68
 
          cp(l) = work(j,1)
69
 
 100    continue
70
 
 110  continue
71
 
      return
72
 
      end