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

« back to all changes in this revision

Viewing changes to Lib/interpolate/fitpack/fpchep.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 fpchep(x,m,t,n,k,ier)
 
2
c  subroutine fpchep verifies the number and the position of the knots
 
3
c  t(j),j=1,2,...,n of a periodic spline of degree k, in relation to
 
4
c  the number and the position of the data points x(i),i=1,2,...,m.
 
5
c  if all of the following conditions are fulfilled, ier is set
 
6
c  to zero. if one of the conditions is violated ier is set to ten.
 
7
c      1) k+1 <= n-k-1 <= m+k-1
 
8
c      2) t(1) <= t(2) <= ... <= t(k+1)
 
9
c         t(n-k) <= t(n-k+1) <= ... <= t(n)
 
10
c      3) t(k+1) < t(k+2) < ... < t(n-k)
 
11
c      4) t(k+1) <= x(i) <= t(n-k)
 
12
c      5) the conditions specified by schoenberg and whitney must hold
 
13
c         for at least one subset of data points, i.e. there must be a
 
14
c         subset of data points y(j) such that
 
15
c             t(j) < y(j) < t(j+k+1), j=k+1,...,n-k-1
 
16
c  ..
 
17
c  ..scalar arguments..
 
18
      integer m,n,k,ier
 
19
c  ..array arguments..
 
20
      real*8 x(m),t(n)
 
21
c  ..local scalars..
 
22
      integer i,i1,i2,j,j1,k1,k2,l,l1,l2,mm,m1,nk1,nk2
 
23
      real*8 per,tj,tl,xi
 
24
c  ..
 
25
      k1 = k+1
 
26
      k2 = k1+1
 
27
      nk1 = n-k1
 
28
      nk2 = nk1+1
 
29
      m1 = m-1
 
30
      ier = 10
 
31
c  check condition no 1
 
32
      if(nk1.lt.k1 .or. n.gt.m+2*k) go to 130
 
33
c  check condition no 2
 
34
      j = n
 
35
      do 20 i=1,k
 
36
        if(t(i).gt.t(i+1)) go to 130
 
37
        if(t(j).lt.t(j-1)) go to 130
 
38
        j = j-1
 
39
  20  continue
 
40
c  check condition no 3
 
41
      do 30 i=k2,nk2
 
42
        if(t(i).le.t(i-1)) go to 130
 
43
  30  continue
 
44
c  check condition no 4
 
45
      if(x(1).lt.t(k1) .or. x(m).gt.t(nk2)) go to 130
 
46
c  check condition no 5
 
47
      l1 = k1
 
48
      l2 = 1
 
49
      do 50 l=1,m
 
50
         xi = x(l)
 
51
  40     if(xi.lt.t(l1+1) .or. l.eq.nk1) go to 50
 
52
         l1 = l1+1
 
53
         l2 = l2+1
 
54
         if(l2.gt.k1) go to 60
 
55
         go to 40
 
56
  50  continue
 
57
      l = m
 
58
  60  per = t(nk2)-t(k1)
 
59
      do 120 i1=2,l
 
60
         i = i1-1
 
61
         mm = i+m1
 
62
         do 110 j=k1,nk1
 
63
            tj = t(j)
 
64
            j1 = j+k1
 
65
            tl = t(j1)
 
66
  70        i = i+1
 
67
            if(i.gt.mm) go to 120
 
68
            i2 = i-m1
 
69
            if(i2) 80,80,90
 
70
  80        xi = x(i)
 
71
            go to 100
 
72
  90        xi = x(i2)+per
 
73
 100        if(xi.le.tj) go to 70
 
74
            if(xi.ge.tl) go to 120
 
75
 110     continue
 
76
         ier = 0
 
77
         go to 130
 
78
 120  continue
 
79
 130  return
 
80
      end