home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / QROOT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.1 KB  |  44 lines
  1. PROCEDURE qroot(p: glnarray; n: integer; VAR b,c: real; eps: real);
  2. (* Programs using procedure QROOT must define the types
  3. TYPE
  4.    glnarray = ARRAY [1..n] OF real;
  5.    glnvarray = ARRAY [1..3] OF real;
  6. in the main routine *)
  7. LABEL 99;
  8. CONST
  9.    itmax=20;
  10.    tiny=1.0e-6;
  11. VAR
  12.    iter,i: integer;
  13.    sc,sb,s,rc,rb,r,dv,delc,delb: real;
  14.    q,qq,rem: glnarray;
  15.    d: glnvarray;
  16. BEGIN
  17.    d[3] := 1.0;
  18.    FOR iter := 1 TO itmax DO BEGIN
  19.       d[2] := b;
  20.       d[1] := c;
  21.       poldiv(p,n,d,3,q,rem);
  22.       s := rem[1];
  23.       r := rem[2];
  24.       poldiv(q,n-1,d,3,qq,rem);
  25.       sc := -rem[1];
  26.       rc := -rem[2];
  27.       FOR i := n-1 DOWNTO 1 DO BEGIN
  28.          q[i+1] := q[i]
  29.       END;
  30.       q[1] := 0.0;
  31.       poldiv(q,n,d,3,qq,rem);
  32.       sb := -rem[1];
  33.       rb := -rem[2];
  34.       dv := 1.0/(sb*rc-sc*rb);
  35.       delb := (r*sc-s*rc)*dv;
  36.       delc := (-r*sb+s*rb)*dv;
  37.       b := b+delb;
  38.       c := c+delc;
  39.       IF(((abs(delb) <= eps*abs(b)) OR (abs(b) < tiny)) AND
  40.       ((abs(delc) <= eps*abs(c)) OR (abs(c) < tiny))) THEN GOTO 99
  41.    END;
  42.    writeln('pause in routine QROOT - too many iterations');
  43. 99:   END;
  44.