'********************************************************
'*        Find minimum of a real function Y=F(X)        *
'*        using routine for Golden Section Search       *
'* ---------------------------------------------------- *
'* REFERENCE: "Numerical Recipes, The Art of Scientific *
'*             Computing By W.H. Press, B.P. Flannery,  *
'*             S.A. Teukolsky and W.T. Vetterling,      *
'*             Cambridge University Press, 1986" [8].   *
'* ---------------------------------------------------- *
'* Sample run:                                          *
'*                                                      *
'* Find a minimum of function X*SIN(X)-2*COS(X)         *
'* between X=4 and X=6.                                 *
'*                                                      *
'* X1=4.d0  X2=5.d0  X3=6.d0  TOL=1.d-6                 *
'*                                                      *
'* Function minimum is:  -5.53452877400217              *
'*                                                      *
'* for X=   5.232937106616176                           *
'*                                                      *
'*                         BASIC Version By J-P Moreau. *
'*                              (www.jpmoreau.fr)       *
'********************************************************
Defdbl a-h,o-z

AX=4# : BX=5# : CX=6#
TOL=1e-6

gosub 2000  'call Golden subroutine

cls
print
print " Function minimum is "; YMINI
print
print " for X="; XMINI
print

END


'Function to be analyzed
1000 F=xx*SIN(xx)-2*COS(xx)
RETURN


'FUNCTION GOLDEN(AX,BX,CX,TOL,XMIN)
'Given a function F, and given a bracketing triplet of abscissas
'AX, BX, CX (such that BX is between AX and CX, and F(BX) is less
'than both F(AX) and F(CX)), this routine performs a golden section
'search for the minimum, isolating it to a fractional precision of
'about TOL. The abscissa of the minimum is returned as XMIN, and the minimum
'function value is returned as GOLDEN, the returned function value.
2000 R=.61803399 : C=1-R   'Golden ratios
  X0=AX  'At any given time we will keep trace of 4 points:
  X3=CX  'X0,X1,X2,X3.
  IF ABS(CX-BX) > ABS(BX-AX) THEN
    X1=BX : X2=BX+C*(CX-BX)
  ELSE
    X2=BX : X1=BX-C*(BX-AX)
  END IF
  'Initial function evaluations
  xx=X1:gosub 1000:F1=F
  xx=X2:gosub 1000:F2=F
1 IF ABS(X3-X0) > TOL*(ABS(X1)+ABS(X2)) THEN
    IF F2 < F1 THEN
      X0=X1 : X1=X2
      X2=R*X1+C*X3
      F0=F1 : F1=F2
      xx=X2:gosub 1000:F2=F
    ELSE
      X3=X2 : X2=X1
      X1=R*X2+C*X0
      F3=F2 : F2=F1
      xx=X1:gosub 1000:F1=F
    END IF
    GOTO 1
  END IF
  IF F1 < F2 THEN
    YMINI=F1
    XMINI=X1
  ELSE
    YMINI=F2
    XMINI=X2
  END IF
RETURN


'end of file golden.bas