home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / NRPAS13.ZIP / RZEXTR.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  1KB  |  55 lines
  1. PROCEDURE rzextr(iest: integer; xest: real; yest: glyarray;
  2.        VAR yz,dy: glyarray; nv,nuse: integer);
  3. (* Programs using routine RZEXTR must declare
  4. TYPE
  5.    glyarray = ARRAY [1..nv] OF real;
  6. CONST
  7.    glimax=11;
  8.    glnmax=10;
  9.    glncol=7;
  10. VAR
  11.    glx: ARRAY [1..glimax] OF real;
  12.    gld: ARRAY [1..glnmax,1..glncol] OF real;
  13. in the main routine. *)
  14. CONST
  15.    ncol=7;
  16. VAR
  17.    m1,k,j: integer;
  18.    yy,v,ddy,c,b1,b: real;
  19.    fx: ARRAY [1..ncol] OF real;
  20. BEGIN
  21.    glx[iest] := xest;
  22.    IF (iest = 1) THEN BEGIN
  23.       FOR j := 1 TO nv DO BEGIN
  24.          yz[j] := yest[j];
  25.          gld[j,1] := yest[j];
  26.          dy[j] := yest[j]
  27.       END
  28.    END ELSE BEGIN
  29.       IF (iest < nuse) THEN m1 := iest ELSE m1 := nuse;
  30.       FOR k := 1 TO m1-1 DO BEGIN
  31.          fx[k+1] := glx[iest-k]/xest
  32.       END;
  33.       FOR j := 1 TO nv DO BEGIN
  34.          yy := yest[j];
  35.          v := gld[j,1];
  36.          c := yy;
  37.          gld[j,1] := yy;
  38.          FOR k := 2 TO m1 DO BEGIN
  39.             b1 := fx[k]*v;
  40.             b := b1-c;
  41.             IF (b <> 0.0) THEN BEGIN
  42.                b := (c-v)/b;
  43.                ddy := c*b;
  44.                c := b1*b
  45.             END ELSE ddy := v;
  46.             IF (k <> m1) THEN v := gld[j,k];
  47.             gld[j,k] := ddy;
  48.             yy := yy+ddy
  49.          END;
  50.          dy[j] := ddy;
  51.          yz[j] := yy
  52.       END
  53.    END
  54. END;
  55.