home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / DBRENT.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.3 KB  |  61 lines
  1. PROGRAM d10r4(input,output);
  2. (* driver for routine DBRENT *)
  3. CONST
  4.    tol=1.0e-6;
  5.    eql=1.0e-4;
  6. VAR
  7.    ax,bx,cx,fa,fb,fc,xmin,dbr : real;
  8.    i,iflag,j,nmin : integer;
  9.    amin : ARRAY [1..20] OF real;
  10.  
  11. (*$I MODFILE.PAS *)
  12. (*$I BESSJ1.PAS *)
  13.  
  14. FUNCTION dfunc(x: real): real;
  15. BEGIN
  16.    dfunc := -bessj1(x)
  17. END;
  18.  
  19. (*$I BESSJ0.PAS *)
  20.  
  21. FUNCTION func(x: real): real;
  22. BEGIN
  23.    func := bessj0(x)
  24. END;
  25.  
  26. (*$I MNBRAK.PAS *)
  27.  
  28. (*$I DBRENT.PAS *)
  29.  
  30. BEGIN
  31.    nmin := 0;
  32.    writeln;
  33.    writeln('minima of the function bessj0');
  34.    writeln('min. #':10,'x':8,
  35.       'bessj0(x)':16,'bessj1(x)':12,'DBRENT':11);
  36.    FOR i := 1 to 100 DO BEGIN
  37.       ax := i;
  38.       bx := i+1.0;
  39.       mnbrak(ax,bx,cx,fa,fb,fc);
  40.       dbr := dbrent(ax,bx,cx,tol,xmin);
  41.       IF (nmin = 0) THEN BEGIN
  42.          amin[1] := xmin;
  43.          nmin := 1;
  44.          writeln(nmin:7,xmin:15:6,func(xmin):12:6,
  45.             dfunc(xmin):12:6,dbr:12:6);
  46.       END ELSE BEGIN
  47.          iflag := 0;
  48.          FOR j := 1 to nmin DO BEGIN
  49.             IF  (abs(xmin-amin[j]) <= eql*xmin)
  50.                THEN iflag := 1
  51.          END;
  52.          IF (iflag = 0) THEN BEGIN
  53.             nmin := nmin+1;
  54.             amin[nmin] := xmin;
  55.             writeln(nmin:7,xmin:15:6,func(xmin):12:6,
  56.                dfunc(xmin):12:6,dbr:12:6)
  57.          END
  58.       END
  59.    END
  60. END.
  61.