!******************************************************** !* 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" * !* [BIBLI 08]. * !* ---------------------------------------------------- * !* 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.53452877400214 * !* * !* for X= 5.23293710350907 * !* * !******************************************************** PROGRAM SEEK_MINIMUM REAL*8 X1,X2,X3,XMINI,YMINI,TOL X1=4.d0; X2=5.d0; X3=6.d0 TOL=1.d-6 YMINI=GOLDEN(X1,X2,X3,TOL,XMINI) print *,'' print *,' Function minimum is ',YMINI print *,'' print *,' for X=',XMINI print *,'' stop END !Function to be analyzed REAL*8 FUNCTION F(X) REAL*8 X F=X*SIN(X)-2.*COS(X) RETURN END REAL*8 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. PARAMETER(R=.61803399,C=1.-R) !Golden ratios IMPLICIT REAL*8 A-H,O-Z X0=AX !At any given time we will keep trace of 4 points: X3=CX !X0,X1,X2,X3. IF(ABS(CX-BX).GT.ABS(BX-AX)) THEN X1=BX; X2=BX+C*(CX-BX) ELSE X2=BX; X1=BX-C*(BX-AX) ENDIF F1=F(X1); F2=F(X2) !Initial function evaluations 1 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN IF(F2.LT.F1) THEN X0=X1; X1=X2 X2=R*X1+C*X3 F0=F1; F1=F2 F2=F(X2) ELSE X3=X2; X2=X1 X1=R*X2+C*X0 F3=F2; F2=F1 F1=F(X1) ENDIF GOTO 1 ENDIF IF(F1.LT.F2) THEN GOLDEN=F1 XMIN=X1 ELSE GOLDEN=F2 XMIN=X2 ENDIF RETURN END !end of file golden.f90