home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NRPAS13 / POLINT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  1KB  |  46 lines
  1. PROCEDURE polint(xa,ya: glnarray; n: integer;
  2.        x: real; VAR y,dy: real);
  3. (* Programs using routine POLINT must define the type
  4. TYPE
  5.    glnarray = ARRAY [1..n] OF real;
  6. in the main routine. *)
  7. VAR
  8.    ns,m,i: integer;
  9.    w,hp,ho,dift,dif,den: real;
  10.    c,d: glnarray;
  11. BEGIN
  12.    ns := 1;
  13.    dif := abs(x-xa[1]);
  14.    FOR i := 1 TO n DO BEGIN
  15.       dift := abs(x-xa[i]);
  16.       IF (dift < dif) THEN BEGIN
  17.          ns := i;
  18.          dif := dift
  19.       END;
  20.       c[i] := ya[i];
  21.       d[i] := ya[i]
  22.    END;
  23.    y := ya[ns];
  24.    ns := ns-1;
  25.    FOR m := 1 TO n-1 DO BEGIN
  26.       FOR i := 1 TO n-m DO BEGIN
  27.          ho := xa[i]-x;
  28.          hp := xa[i+m]-x;
  29.          w := c[i+1]-d[i];
  30.          den := ho-hp;
  31.          IF (den = 0.0) THEN BEGIN
  32.             writeln ('pause in routine POLINT'); readln END;
  33.          den := w/den;
  34.          d[i] := hp*den;
  35.          c[i] := ho*den
  36.       END;
  37.       IF ((2*ns) < (n-m)) THEN BEGIN
  38.          dy := c[ns+1]
  39.       END ELSE BEGIN
  40.          dy := d[ns];
  41.          ns := ns-1
  42.       END;
  43.       y := y+dy
  44.    END
  45. END;
  46.