File: neville.cmd

package info (click to toggle)
evolver 2.70+ds-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 17,148 kB
  • sloc: ansic: 127,395; makefile: 209; sh: 98
file content (180 lines) | stat: -rw-r--r-- 6,388 bytes parent folder | download | duplicates (2)
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
// neville.cmd
// Neville's algorithm for computing Bspline values

// Programmer: Ken Brakke, brakke@susqu.edu, http://www.susqu.edu/brakke

// Contents:
//   neville1  - interpolation and derivatives in one dimension
//   neville2  - interpolation and derivatives in two dimensions.

// Neville algorithm for interpolating along one dimension. 

// Usage of neville1:
// neville1_data should be set up by caller, redimensioning if necessary
// Indexed by point number along curve and data dimension.

define neville1_data real[0][0]; // not modified by neville1

// Returned from neville1.  Index is data dimension.
define neville1_value real[0];   // interpolated values
define neville1_deriv real[0];   // interpolated deriv wrt u 

procedure neville1 ( 
      real neville1_order,  // order of interpolation polynomial
      real neville1_dim,    // range dimension
      real neville1_u       // interpolation spot, between 0 and 1
  )  
{
  local neville1_array; local neville1_darray;
  define neville1_array real[neville1_order+1][neville1_dim];
  define neville1_darray real[neville1_order+1][neville1_dim];
  define neville1_value real[neville1_dim];   // interpolated values
  define neville1_deriv real[neville1_dim];   // interpolated deriv wrt u 
  local inx;local dinx;
  inx := 1;
  while ( inx <= neville1_order+1 ) do
  { 
    dinx := 1;
    while ( dinx <= neville1_dim ) do
    { neville1_array[inx][dinx] := neville1_data[inx][dinx];
      neville1_darray[inx][dinx] := 0;
      dinx += 1;
    };
    inx += 1;
  };
  // scale npoint to integer based value
  local nnpoint;
  nnpoint := neville1_u*neville1_order;
  local linx;
  linx := 1;
  while ( linx <= neville1_order ) do
  { inx := 1;
    while ( inx + linx <= neville1_order + 1 ) do
    { dinx := 1;
      while ( dinx <= neville1_dim ) do
      { // do derivatives first, since dependent on current value
        neville1_darray[inx][dinx] := 
         ((inx-1+linx - nnpoint)*neville1_darray[inx][dinx]
              + (nnpoint - (inx-1))*neville1_darray[inx+1][dinx])/linx +
         (-neville1_array[inx][dinx] + neville1_array[inx+1][dinx])/linx;
        neville1_array[inx][dinx] := 
         ((inx-1+linx - nnpoint)*neville1_array[inx][dinx]
              + (nnpoint - (inx-1))*neville1_array[inx+1][dinx])/linx;
        dinx += 1;
      };
      inx += 1;
    };
    linx += 1;
  };
  dinx := 1;
  while ( dinx <= neville1_dim ) do
  { neville1_value[dinx] := neville1_array[1][dinx];
    neville1_deriv[dinx] := neville1_darray[1][dinx]*neville1_order;
    dinx += 1;
  };
}
 

// Neville algorithm for interpolating in 2D

// Usage of neville2:
// Initialize neville2_data, neville2_u arrays.
// Call neville2.

// Input data, indexed by (i,j) node coordinate and data dimension.
define neville2_data real[0][0][0];
define neville2_u real[2]; // incoming; should sum to at most 1
neville2_u[1] :=  1/3;
neville2_u[2] :=  1/3; 

// Return values, indexed by data dimension.
define neville2_value real[0] // return values of position
define neville2_deriv real[0][2] // return values of partials

procedure neville2 (
   real neville2_order,  // of polynomial
   real neville2_dim     // dimension of values
  )
{
  local neville2_array; local neville2_darray; local uupoint;

  define neville2_array 
     real[neville2_order+1][neville2_order+1][neville2_dim];
  define neville2_darray 
     real[neville2_order+1][neville2_order+1][neville2_dim][2];
  define uupoint real[2];  // scaled target coordinates
  define neville2_value real[neville2_dim]; // return values of position
  define neville2_deriv real[neville2_dim][2]; // return values of partials

  // initialize data; kludge due to fact that indexing on vertices
  // only does the three corners.
  local inx; local jnx; local dinx;
  inx := 1;
  while ( inx <= neville2_order+1 ) do
  { jnx := 1;
    while ( inx + jnx <= neville2_order+2 ) do
    { dinx := 1;
      while ( dinx <= neville2_dim ) do
      { neville2_array[inx][jnx][dinx] :=  neville2_data[inx][jnx][dinx];
        neville2_darray[inx][jnx][dinx][1] := 0;
        neville2_darray[inx][jnx][dinx][2] := 0;
        dinx += 1;
      };
      jnx += 1;
    };
    inx += 1;
  };

  // scale npoint to integer based value
  uupoint[1] := neville2_u[1]*neville2_order;
  uupoint[2] := neville2_u[2]*neville2_order;
  local linx;
  linx := 1;
  while ( linx <= neville2_order ) do
  { inx := 1;
    while ( inx + linx <= neville2_order + 1 ) do
    { jnx := 1;
      while ( inx + jnx + linx <= neville2_order + 2 ) do
      { dinx := 1;
        while ( dinx <= neville2_dim ) do
        { // do derivatives first, since dependent on current value
          neville2_darray[inx][jnx][dinx][1] :=  
                ((inx+jnx-2+linx-uupoint[1]-uupoint[2])
                       *neville2_darray[inx][jnx][dinx][1]
              + (uupoint[1]-(inx-1))*neville2_darray[inx+1][jnx][dinx][1]
              + (uupoint[2]-(jnx-1))*neville2_darray[inx][jnx+1][dinx][1])/linx
              + (-neville2_array[inx][jnx][dinx]
                  + neville2_array[inx+1][jnx][dinx] )/linx;
          neville2_darray[inx][jnx][dinx][2] :=  
                ((inx+jnx-2+linx-uupoint[1]-uupoint[2])
                       *neville2_darray[inx][jnx][dinx][2]
              + (uupoint[1]-(inx-1))*neville2_darray[inx+1][jnx][dinx][2]
              + (uupoint[2]-(jnx-1))*neville2_darray[inx][jnx+1][dinx][2])/linx
              + (-neville2_array[inx][jnx][dinx]
                  + neville2_array[inx][jnx+1][dinx] )/linx;

          neville2_array[inx][jnx][dinx] :=  
         ((inx+jnx-2+linx-uupoint[1]-uupoint[2])*neville2_array[inx][jnx][dinx]
              + (uupoint[1] - (inx-1))*neville2_array[inx+1][jnx][dinx]
              + (uupoint[2] - (jnx-1))*neville2_array[inx][jnx+1][dinx])/linx;
          dinx += 1;
        };
        jnx += 1;
      };
      inx += 1;
    };
    linx += 1;
  };
  dinx := 1;
  while ( dinx <= neville2_dim ) do
  { neville2_value[dinx] := neville2_array[1][1][dinx];
    neville2_deriv[dinx][1] := neville2_darray[1][1][dinx][1]*neville2_order;
    neville2_deriv[dinx][2] := neville2_darray[1][1][dinx][2]*neville2_order;
    dinx += 1;
  };
}
 


// End neville.cmd