implementation
//PROGRAM D9R8
//Driver for routine FRPRMN
uses
  unit2;
  {$R *.DFM}
Function FUNC2(X:array of real; N:integer):real;
begin
    FUNC2:=1 - BESSJ0(X[1]-0.5) * BESSJ0(X[2]-0.5) * BESSJ0(X[3]-0.5);
end;

procedure DFUNC(X:array of real;var DF:array of real);
begin
    DF[1]:= BESSJ1(X[1]-0.5) * BESSJ0(X[2]-0.5) * BESSJ0(X[3]-0.5);
    DF[2]:= BESSJ0(X[1]-0.5) * BESSJ1(X[2]-0.5) * BESSJ0(X[3]-0.5);
    DF[3]:= BESSJ0(X[1]-0.5) * BESSJ0(X[2]-0.5) * BESSJ1(X[3]-0.5);
end;

Function FUNC(X:real):real;
begin
  FUNC:=F1DIM(X);
end;

Function DERIV(X:real):real;
begin
    DERIV:= -BESSJ1(X);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  s1='%8.4f'; s2 = '#0'; s3 = '.#####0e+00';
  PIO2 = 1.5707963;  NDIM = 3; FTOL = 0.000001;
var
  F:TextFile;
  P:array[0..3] of real;
  K,ITER:integer;   ANGL,FRET:real;
begin
  //輸出計(jì)算結(jié)果到文件
  AssignFile(F, 'd:\delphi_shu\p9\d9r8.dat');
  Rewrite(F);
  Writeln(F);
  Writeln(F, '   PROGRAM finds the minimum of a function');
  Writeln(F, '   with different trial starting vectors.');
  Writeln(F, '   True minimum is (0.5, 0.5, 0.5)');
  Writeln(F);
  For K:= 0 To 4 do
  begin
    ANGL:= PIO2 * K / 4;
    P[1]:= 2 * Cos(ANGL);
    P[2]:= 2 * Sin(ANGL);
    P[3]:= 0;
    Writeln(F, '   Starting vector: (', Format(s1,[P[1]]),
                   Format(s1,[P[2]]),Format(s1,[P[3]]),')');
    FRPRMN(P, NDIM, FTOL, ITER, FRET);
    Writeln(F, '   Iterations: ', FormatFloat(s2,ITER));
    Writeln(F, '   Solution vector: (', Format(s1,[P[1]]),
                   Format(s1,[P[2]]),Format(s1,[P[3]]),')');
    Writeln(F, '   Func. value at solution  ', FormatFloat(s3,FRET));
    Writeln(F);
  end;
  CloseFile(F);
  //屏幕顯示計(jì)算結(jié)果
  memo1.Lines.LoadFromFile('d:\delphi_shu\p9\d9r8.dat');
end;