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