home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / NRPAS13.ZIP / QROOT.DEM < prev    next >
Text File  |  1991-04-29  |  1KB  |  53 lines
  1. PROGRAM d9r12(input,output);
  2. (* driver for routine QROOT *)
  3. CONST
  4.    n=7;
  5.    nv=3;
  6.    eps=1.0e-6;
  7.    ntry=10;
  8.    tiny=1.0e-5;
  9. TYPE
  10.    glnarray = ARRAY [1..n] OF real;
  11.    glnvarray = ARRAY [1..nv] OF real;
  12. VAR
  13.    i,j,nflag,nroot : integer;
  14.    p : glnarray;
  15.    b,c : ARRAY [1..ntry] OF real;
  16.  
  17. (*$I MODFILE.PAS *)
  18. (*$I POLDIV.PAS *)
  19.  
  20. (*$I QROOT.PAS *)
  21.  
  22. BEGIN
  23.    p[1] := 10.0; p[2] := -18.0; p[3] := 25.0; p[4] := -24.0;
  24.    p[5] := 16.0; p[6] := -6.0; p[7] := 1.0;
  25.    writeln;
  26.    writeln('P(x) := x^6-6x^5+16x^4-24x^3+25x^2-18x+10');
  27.    writeln('Quadratic factors x^2+bx+c');
  28.    writeln;
  29.    writeln('factor':6,'b':10,'c':12);
  30.    writeln;
  31.    nroot := 0;
  32.    FOR i := 1 to ntry DO BEGIN
  33.       c[i] := 0.5*i;
  34.       b[i] := -0.5*i;
  35.       qroot(p,n,b[i],c[i],eps);
  36.       IF  (nroot = 0)  THEN BEGIN
  37.          writeln(nroot:4,'   ',b[i]:12:6,c[i]:12:6);
  38.          nroot := 1
  39.       END ELSE BEGIN
  40.          nflag := 0;
  41.          FOR j := 1 to nroot DO BEGIN
  42.             IF ((abs(b[i]-b[j]) < tiny)
  43.                AND (abs(c[i]-c[j]) < tiny)) 
  44.                THEN nflag := 1
  45.          END;
  46.          IF  (nflag = 0)  THEN BEGIN
  47.             writeln(nroot:4,'   ',b[i]:12:6,c[i]:12:6);
  48.             nroot := nroot+1
  49.          END
  50.       END
  51.    END
  52. END.
  53.