← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Lib/interpolate/fitpack/fpbisp.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:
Lib/interpolate/fitpack/fpbisp.f
 
1
      subroutine fpbisp(tx,nx,ty,ny,c,kx,ky,x,mx,y,my,z,wx,wy,lx,ly)
 
2
c  ..scalar arguments..
 
3
      integer nx,ny,kx,ky,mx,my
 
4
c  ..array arguments..
 
5
      integer lx(mx),ly(my)
 
6
      real*8 tx(nx),ty(ny),c((nx-kx-1)*(ny-ky-1)),x(mx),y(my),z(mx*my),
 
7
     * wx(mx,kx+1),wy(my,ky+1)
 
8
c  ..local scalars..
 
9
      integer kx1,ky1,l,l1,l2,m,nkx1,nky1
 
10
      real*8 arg,sp,tb,te
 
11
c  ..local arrays..
 
12
      real*8 h(6)
 
13
c  ..subroutine references..
 
14
c    fpbspl
 
15
c  ..
 
16
      kx1 = kx+1
 
17
      nkx1 = nx-kx1
 
18
      tb = tx(kx1)
 
19
      te = tx(nkx1+1)
 
20
      l = kx1
 
21
      l1 = l+1
 
22
      do 40 i=1,mx
 
23
        arg = x(i)
 
24
        if(arg.lt.tb) arg = tb
 
25
        if(arg.gt.te) arg = te
 
26
  10    if(arg.lt.tx(l1) .or. l.eq.nkx1) go to 20
 
27
        l = l1
 
28
        l1 = l+1
 
29
        go to 10
 
30
  20    call fpbspl(tx,nx,kx,arg,l,h)
 
31
        lx(i) = l-kx1
 
32
        do 30 j=1,kx1
 
33
          wx(i,j) = h(j)
 
34
  30    continue
 
35
  40  continue
 
36
      ky1 = ky+1
 
37
      nky1 = ny-ky1
 
38
      tb = ty(ky1)
 
39
      te = ty(nky1+1)
 
40
      l = ky1
 
41
      l1 = l+1
 
42
      do 80 i=1,my
 
43
        arg = y(i)
 
44
        if(arg.lt.tb) arg = tb
 
45
        if(arg.gt.te) arg = te
 
46
  50    if(arg.lt.ty(l1) .or. l.eq.nky1) go to 60
 
47
        l = l1
 
48
        l1 = l+1
 
49
        go to 50
 
50
  60    call fpbspl(ty,ny,ky,arg,l,h)
 
51
        ly(i) = l-ky1
 
52
        do 70 j=1,ky1
 
53
          wy(i,j) = h(j)
 
54
  70    continue
 
55
  80  continue
 
56
      m = 0
 
57
      do 130 i=1,mx
 
58
        l = lx(i)*nky1
 
59
        do 90 i1=1,kx1
 
60
          h(i1) = wx(i,i1)
 
61
  90    continue
 
62
        do 120 j=1,my
 
63
          l1 = l+ly(j)
 
64
          sp = 0.
 
65
          do 110 i1=1,kx1
 
66
            l2 = l1
 
67
            do 100 j1=1,ky1
 
68
              l2 = l2+1
 
69
              sp = sp+c(l2)*h(i1)*wy(j,j1)
 
70
 100        continue
 
71
            l1 = l1+nky1
 
72
 110      continue
 
73
          m = m+1
 
74
          z(m) = sp
 
75
 120    continue
 
76
 130  continue
 
77
      return
 
78
      end
 
79