File: curev.f

package info (click to toggle)
python-scipy 0.18.1-2
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 75,464 kB
  • ctags: 79,406
  • sloc: python: 143,495; cpp: 89,357; fortran: 81,650; ansic: 79,778; makefile: 364; sh: 265
file content (110 lines) | stat: -rw-r--r-- 3,484 bytes parent folder | download | duplicates (11)
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
      subroutine curev(idim,t,n,c,nc,k,u,m,x,mx,ier)
c  subroutine curev evaluates in a number of points u(i),i=1,2,...,m
c  a spline curve s(u) of degree k and dimension idim, given in its
c  b-spline representation.
c
c  calling sequence:
c     call curev(idim,t,n,c,nc,k,u,m,x,mx,ier)
c
c  input parameters:
c    idim : integer, giving the dimension of the spline curve.
c    t    : array,length n, which contains the position of the knots.
c    n    : integer, giving the total number of knots of s(u).
c    c    : array,length nc, which contains the b-spline coefficients.
c    nc   : integer, giving the total number of coefficients of s(u).
c    k    : integer, giving the degree of s(u).
c    u    : array,length m, which contains the points where s(u) must
c           be evaluated.
c    m    : integer, giving the number of points where s(u) must be
c           evaluated.
c    mx   : integer, giving the dimension of the array x. mx >= m*idim
c
c  output parameters:
c    x    : array,length mx,giving the value of s(u) at the different
c           points. x(idim*(i-1)+j) will contain the j-th coordinate
c           of the i-th point on the curve.
c    ier  : error flag
c      ier = 0 : normal return
c      ier =10 : invalid input data (see restrictions)
c
c  restrictions:
c    m >= 1
c    mx >= m*idim
c    t(k+1) <= u(i) <= u(i+1) <= t(n-k) , i=1,2,...,m-1.
c
c  other subroutines required: fpbspl.
c
c  references :
c    de boor c : on calculating with b-splines, j. approximation theory
c                6 (1972) 50-62.
c    cox m.g.  : the numerical evaluation of b-splines, j. inst. maths
c                applics 10 (1972) 134-149.
c    dierckx p. : curve and surface fitting with splines, monographs on
c                 numerical analysis, oxford university press, 1993.
c
c  author :
c    p.dierckx
c    dept. computer science, k.u.leuven
c    celestijnenlaan 200a, b-3001 heverlee, belgium.
c    e-mail : Paul.Dierckx@cs.kuleuven.ac.be
c
c  latest update : march 1987
c
c  ..scalar arguments..
      integer idim,n,nc,k,m,mx,ier
c  ..array arguments..
      real*8 t(n),c(nc),u(m),x(mx)
c  ..local scalars..
      integer i,j,jj,j1,k1,l,ll,l1,mm,nk1
      real*8 arg,sp,tb,te
c  ..local array..
      real*8 h(6)
c  ..
c  before starting computations a data check is made. if the input data
c  are invalid control is immediately repassed to the calling program.
      ier = 10
      if (m.lt.1) go to 100
      if (m.eq.1) go to 30
      go to 10
  10  do 20 i=2,m
        if(u(i).lt.u(i-1)) go to 100
  20  continue
  30  if(mx.lt.(m*idim)) go to 100
      ier = 0
c  fetch tb and te, the boundaries of the approximation interval.
      k1 = k+1
      nk1 = n-k1
      tb = t(k1)
      te = t(nk1+1)
      l = k1
      l1 = l+1
c  main loop for the different points.
      mm = 0
      do 80 i=1,m
c  fetch a new u-value arg.
        arg = u(i)
        if(arg.lt.tb) arg = tb
        if(arg.gt.te) arg = te
c  search for knot interval t(l) <= arg < t(l+1)
  40    if(arg.lt.t(l1) .or. l.eq.nk1) go to 50
        l = l1
        l1 = l+1
        go to 40
c  evaluate the non-zero b-splines at arg.
  50    call fpbspl(t,n,k,arg,l,h)
c  find the value of s(u) at u=arg.
        ll = l-k1
        do 70 j1=1,idim
          jj = ll
          sp = 0.
          do 60 j=1,k1
            jj = jj+1
            sp = sp+c(jj)*h(j)
  60      continue
          mm = mm+1
          x(mm) = sp
          ll = ll+n
  70    continue
  80  continue
 100  return
      end