forked from navoj/ChemEngNumMeth
-
Notifications
You must be signed in to change notification settings - Fork 1
/
modfib.for
60 lines (60 loc) · 1.8 KB
/
modfib.for
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
C
C***************************** ABSTRACT *******************************
C
C THIS SUBROUTINE CALCULATES THE OPTIMUM OF A BOUNDED, ONE-DIMENSIONAL
C OBJECTIVE FUNCTION USING THE MODIFIED FIBONACCI METHOD. WHEN TYPE
C IS EQUAL TO +1, THE PROGRAM SEEKS A MAXIMUM. WHEN TYPE IS EQUAL TO
C -1, THE PROGRAM SEEKS A MINIMUM.
C
C*************************** NOMENCLATURE *****************************
C
C XL- THE LENGTH OF THE REGION OF UNCERTAINTY
C XMIN- THE DESIRED ACCURACY IN THE OPTIMUM VALUE OF X
C TYPE- +1 PROGRAM SEEKS A MAXIMUM; -1 PROGRAM SEEKS A MINIMUM
C XLB- THE LEFT BOUNDARY OF THE REGION OF UNCERTAINTY
C XRL- THE RIGHT BPUNDARY OF THE REGION OF UNCERTAINTY
C X1- VALUE OF X AT (XLB+.382*L)
C X2- VALUE OF X AT (XRB-.382*L)
C YLB- VALUE OF Y AT X=XLB
C YRB- VALUE OF Y AT X=XRB
C Y1- VALUE OF Y AT X=X1
C Y2- VALUE OF Y AT X=X2
C
C************************************************************************
SUBROUTINE MODFIB(F,XLB,XRB,XMIN,TYPE,YLB,YRB)
IMPLICIT REAL*8(A-H,O-Z)
EXTERNAL F
C EVALUATE Y AT THE BOUNDARIES
CALL F(XLB,YLB)
CALL F(XRB,YRB)
C INITIATE THE MODIFIED FIBONACCI SEARCH
XL=XRB-XLB
X1=XLB+.382*XL
CALL F(X1,Y1)
X2=XRB-.382*XL
CALL F(X2,Y2)
1 CONTINUE
IF(TYPE*Y2.GT.TYPE*Y1)GO TO 2
C DISCARD THE RIGHT SIDE OF THE REGION OF UNCERTAINTY
XRB=X2
YRB=Y2
X2=X1
Y2=Y1
XL=XRB-XLB
IF(XL.LT.XMIN) GO TO 10
X1=XLB+.382*XL
CALL F(X1,Y1)
GO TO 1
C DISCARD THE LEFT SIDE OF THE REGION OF UNCERTAINTY
2 XLB=X1
YLB=Y1
X1=X2
Y1=Y2
XL=XRB-XLB
IF(XL.LT.XMIN)GO TO 10
X2=XRB-.382*XL
CALL F(X2,Y2)
GO TO 1
C RETURN TO CALLING PROGRAM
10 RETURN
END