home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / PZEXTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.3 KB  |  53 lines
  1. PROCEDURE pzextr(iest: integer; xest: real; yest: glyarray;
  2.        VAR yz,dy: glyarray; nv,nuse: integer);
  3. (* Programs using routine PZEXTR 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.    glqcol: ARRAY [1..glnmax,1..glncol] OF real;
  13. in the main routine. *)
  14. CONST
  15.    nmax=10;
  16. VAR
  17.    m1,k1,j: integer;
  18.    q,f2,f1,delta: real;
  19.    d: ARRAY [1..nmax] OF real;
  20. BEGIN
  21.    glx[iest] := xest;
  22.    FOR j := 1 TO nv DO BEGIN
  23.       dy[j] := yest[j];
  24.       yz[j] := yest[j]
  25.    END;
  26.    IF (iest = 1) THEN BEGIN
  27.       FOR j := 1 TO nv DO BEGIN
  28.          glqcol[j,1] := yest[j]
  29.       END
  30.    END ELSE BEGIN
  31.       IF (iest < nuse) THEN m1 := iest ELSE m1 := nuse;
  32.       FOR j := 1 TO nv DO BEGIN
  33.          d[j] := yest[j]
  34.       END;
  35.       FOR k1 := 1 TO m1-1 DO BEGIN
  36.          delta := 1.0/(glx[iest-k1]-xest);
  37.          f1 := xest*delta;
  38.          f2 := glx[iest-k1]*delta;
  39.          FOR j := 1 TO nv DO BEGIN
  40.             q := glqcol[j,k1];
  41.             glqcol[j,k1] := dy[j];
  42.             delta := d[j]-q;
  43.             dy[j] := f1*delta;
  44.             d[j] := f2*delta;
  45.             yz[j] := yz[j]+dy[j]
  46.          END
  47.       END;
  48.       FOR j := 1 TO nv DO BEGIN
  49.          glqcol[j,m1] := dy[j]
  50.       END
  51.    END
  52. END;
  53.