home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / DFPMIN.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.6 KB  |  69 lines
  1. PROGRAM d10r11(input,output);
  2. (* driver for routine DFPMIN *)
  3. CONST
  4.    ndim=3;
  5.    ftol=1.0e-6;
  6.    pio2=1.5707963;
  7. TYPE
  8.    glnarray = ARRAY [1..ndim] OF real;
  9.    glndim = glnarray;
  10.    glnbyn = ARRAY [1..ndim,1..ndim] OF real;
  11. VAR
  12.    ncom : integer;
  13.    pcom,xicom : glnarray; 
  14.    angl,fret : real;
  15.    iter,k : integer;
  16.    p : glnarray;
  17.  
  18. (*$I MODFILE.PAS *)
  19. (*$I BESSJ0.PAS *)
  20.  
  21. (*$I BESSJ1.PAS *)
  22.  
  23. FUNCTION fnc(x: glnarray): real;
  24. BEGIN
  25.    fnc := 1.0-bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5)
  26. END;
  27.  
  28. PROCEDURE dfnc(x: glnarray; VAR df: glnarray);
  29. BEGIN
  30.    df[1] := bessj1(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5);
  31.    df[2] := bessj0(x[1]-0.5)*bessj1(x[2]-0.5)*bessj0(x[3]-0.5);
  32.    df[3] := bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj1(x[3]-0.5)
  33. END;
  34.  
  35. (*$I F1DIM.PAS *)
  36.  
  37. FUNCTION func(x: real): real;
  38. BEGIN
  39.    func := f1dim(x)
  40. END;
  41.  
  42. (*$I MNBRAK.PAS *)
  43.  
  44. (*$I BRENT.PAS *)
  45.  
  46. (*$I LINMIN.PAS *)
  47.  
  48. (*$I DFPMIN.PAS *)
  49.  
  50. BEGIN
  51.    writeln('Program finds the minimum of a function');
  52.    writeln('with different trial starting vectors.');
  53.    writeln('True minimum is (0.5,0.5,0.5)');
  54.    FOR k := 0 to 4 DO BEGIN
  55.       angl := pio2*k/4.0;
  56.       p[1] := 2.0*cos(angl);
  57.       p[2] := 2.0*sin(angl);
  58.       p[3] := 0.0;
  59.       writeln;
  60.       writeln('Starting vector: (',
  61.          p[1]:6:4,',',p[2]:6:4,',',p[3]:6:4,')');
  62.       dfpmin(p,ndim,ftol,iter,fret);
  63.       writeln('Iterations:',iter:3);
  64.       writeln('Solution vector: (',
  65.          p[1]:6:4,',',p[2]:6:4,',',p[3]:6:4,')');
  66.       writeln('Func. value at solution',fret:14)
  67.    END
  68. END.
  69.