home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / turbopas / pas_sci.arc / NEWDR3.PAS < prev    next >
Pascal/Delphi Source File  |  1985-09-01  |  1KB  |  59 lines
  1. program newdr3;    { -> 257 }
  2.  
  3. var    x,x2    : real;
  4.     alldone    : boolean;
  5.     error    : boolean;
  6.  
  7. procedure func(x: real;
  8.         var fx,dfx: real);
  9.  
  10. { the vapor pressure of lead }
  11.  
  12. const
  13.    a = 18.19;
  14.    b = -23180.0;
  15.    c = -.8858;
  16.    logp = -4.60517  { ln(.01) }
  17.  
  18. begin
  19.   fx:= a + b/x + c*ln(x) - logp;
  20.   dfx:= -b/(x*x) + c/x
  21. end;    { func }
  22.  
  23. { procedure newton(var x: real);}
  24. const     tol    = 1.0E-6;
  25.  
  26. var    fx,dfx,dx,x1:    real;
  27.  
  28. begin    { newton }
  29.   repeat
  30.     x1:=x;
  31.     func(x,fx,dfx);
  32.     if(abs(dfx)<tol) then
  33.        begin
  34.           if(dfx>=0.0) then dfx:=tol
  35.           else dfx := -tol
  36.        end;
  37.     dx:=fx/dfx;
  38.     x:=x1-dx;
  39.     writeln('x=',x1,',fx=',fx,',dfx=',dfx);
  40.   until abs(dx)<=abs(tol*x)
  41. end;    { newton }
  42.  
  43. begin        { main program }
  44.   alldone:=false;
  45.   repeat
  46.     writeln;
  47.     write('First guess (999. to exit): ');    { first guess }
  48.     readln(x);
  49.     if x=999. then alldone:=true
  50.     else
  51.       begin
  52.     newton(x);
  53.     writeln;
  54.     writeln('The solution is ',x);
  55.     writeln
  56.       end
  57.   until alldone
  58. end.
  59.