← Back to branch summary

~ubuntu-branches/ubuntu/karmic/scilab/karmic

« back to all changes in this revision

Viewing changes to routines/calelm/intp.f

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2002-03-21 16:57:43 UTC
  • Revision ID: james.westby@ubuntu.com-20020321165743-e9mv12c1tb1plztg
Tags: upstream-2.6
Import upstream version 2.6

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/calelm/intp.f
 
1
      subroutine intp(x,xd,yd,n,nc,y)
 
2
c!purpose
 
3
c     linear interpolation computes y=F(x) for f a tabulated function
 
4
c      from R to R^n 
 
5
c!parameters
 
6
c     x    : x given point
 
7
c     xd   : vector (nc) of abscissae mesh points (xd(i+1)>=xd(i))
 
8
c     yd   : matrix (nc x n): yd(i,j)=Fj(x(i))
 
9
c     n    : dimension of F image
 
10
c     returned values
 
11
c     y    : vector (n) :interpolated value of F(x)
 
12
c!remarks
 
13
c     if x<=xd(1) y=yd(1,:)
 
14
c      if x>=xd(nc) y=yd(nc,:)
 
15
c!origin
 
16
c     Pejman GOHARI 1996
 
17
c!
 
18
c     Copyright INRIA
 
19
      double precision x,xd(*),y(*),yd(nc,*)
 
20
      integer n,nc
 
21
c     
 
22
      if (nc.eq.1) then
 
23
         call dcopy(n,yd(1,1),nc,y,1)
 
24
      elseif(x.ge.xd(nc)) then 
 
25
         call dcopy(n,yd(nc,1),nc,y,1)
 
26
      elseif(x.le.xd(1)) then 
 
27
         call dcopy(n,yd(1,1),nc,y,1)
 
28
      else
 
29
c     find x interval
 
30
         do 10 i=1,nc
 
31
            if (x.lt.xd(i)) then
 
32
               inter=i-1
 
33
               goto 20
 
34
            endif
 
35
 10      continue
 
36
 20      continue
 
37
c     
 
38
c     compute interpolated y
 
39
c     
 
40
         if (xd(inter+1).eq.xd(inter)) then
 
41
            call dcopy(n,yd(inter,1),nc,y,1)
 
42
         else
 
43
            do 40 i=1,n
 
44
               y(i)=yd(inter,i)+
 
45
     &              (x-xd(inter))*((yd(inter+1,i)-yd(inter,i))/
 
46
     &              (xd(inter+1)-xd(inter)))
 
47
 40         continue
 
48
         endif
 
49
      endif
 
50
      end
 
51