← Back to branch summary

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

« back to all changes in this revision

Viewing changes to scipy/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:
scipy/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