C******************************************************
C
C     Subroutine for one dimensional searching.
C     Golden section with interval searching.
C     ============== 
C******************************************************
C     Neculai Andrei, 
C     Research Institute for Informatics
C     Advanced Modeling and Optimization Laboratory     
C******************************************************
C
	SUBROUTINE L1(N,X,S,BL)
	DOUBLE PRECISION X(N),S(N),BL
	DOUBLE PRECISION F0,FY,FY1,SL,SL1,G1,G2,G2P,D1,D2
	DOUBLE PRECISION R,R1,EPS,EPS1,Y(40)
C
	COMMON /PREC/EPS
	COMMON /TYPE/NO
	COMMON /NOF/NBL
C
	EPS1=0.001
C
	R=0.618034
	R1=1.0-R
	SL=1.
	NBL=0
	JTYPE=0
C
	IF(NO.EQ.6)THEN
	OPEN(6,FILE='PRINT.DAT',ACCESS='SEQUENTIAL',
     +       FORM='FORMATTED')
	ENDIF
C
	CALL FUNC(N,X,F0)
	NBL=NBL+1
C     
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,20)
20            FORMAT(10X,'Basic Point')
              WRITE(NO,21)(I,X(I),I=1,N)
21            FORMAT(10X,I3,5X,F12.6)
              WRITE(NO,22)F0
22            FORMAT(10X,'Function Value in Basic Point = ',F12.6)
      ENDIF
C
	DO 1 I=1,N
1	Y(I)=X(I)+SL*S(I)
	CALL FUNC(N,Y,FY)
	NBL=NBL+1
C     
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,23)
23            FORMAT(10X,'Point: X+SL*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,24)FY
24            FORMAT(10X,'Function value in X+SL*S = ',F12.6)
      ENDIF
C
	SL1=SL-EPS1
	DO 2 I=1,N
2	Y(I)=X(I)+SL1*S(I)
	CALL FUNC(N,Y,FY1)
	NBL=NBL+1
C     
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,25)
25            FORMAT(10X,'Point: X+(SL-EPS1)*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,26)FY1
26            FORMAT(10X,'Function value in X+(SL-EPS1)*S = ',F12.6)
      ENDIF
C
	IF(FY.LT.FY1) GO TO 6
C
	D1=0.0
	D2=SL
	GO TO 7
C
6	K=1
	G1=SL
5	G2=G1+SL
C
15	CONTINUE
C
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,27)K
27            FORMAT(5X,'K = ',I3)
              WRITE(NO,28)G1,G2
28            FORMAT(5X,'G1 = ',F12.6,5X,'G2 = ',F12.6)
      ENDIF
C
	DO 3 I=1,N
3	Y(I)=X(I)+G2*S(I)
	CALL FUNC(N,Y,FY)
	NBL=NBL+1
C     
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,29)
29            FORMAT(5X,'Point: X+G2*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,30)FY
30            FORMAT(5X,'Function value in X+G2*S = ',F12.6)
      ENDIF
C
	G2P=G2-EPS1
	DO 4 I=1,N
4	Y(I)=X(I)+G2P*S(I)
	CALL FUNC(N,Y,FY1)
	NBL=NBL+1
C          
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,31)
31            FORMAT(5X,'Point: X+(G2-EPS1)*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,32)FY1
32            FORMAT(5X,'Function value in X+(G2-EPS1)*S = ',F12.6)
      ENDIF
C
	IF(FY.LE.FY1) THEN
	  IF(K.GT.10) THEN
	    K=1
	    EPS1=-EPS1
	    G1=0.
	    G2=SL
	    GO TO 15
	  ENDIF
	  K=K+1
	  G1=G2
	  GO TO 5
	ELSE
	  D1=G1
	  D2=G2
	  GO TO 7
	ENDIF
C
7	SL=D2-D1
C
              IF(JTYPE.EQ.1) WRITE(NO,33)SL
33            FORMAT(5X,'--------------------- SL = ',F12.6)
C
	IF(SL.LE.EPS) GO TO 10
C
	G1=D1+R1*SL
	G2=D1+R*SL
C
	DO 8 I=1,N
8	Y(I)=X(I)+G1*S(I)
	CALL FUNC(N,Y,FY)
	NBL=NBL+1
C
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,34)
34            FORMAT(10X,'Point: X+G1*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,35)FY
35            FORMAT(10X,'Function value in X+G1*S = ',F12.6)
      ENDIF
C
	DO 9 I=1,N
9	Y(I)=X(I)+G2*S(I)
	CALL FUNC(N,Y,FY1)
	NBL=NBL+1
C          
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,36)
36            FORMAT(10X,'Point: X+G2*S')
              WRITE(NO,21)(I,Y(I),I=1,N)
              WRITE(NO,37)FY1
37            FORMAT(10X,'Function value in X+G2*S = ',F12.6)
      ENDIF
C
	IF(FY.LT.FY1) THEN
	  D2=G2
	ELSE
	  D1=G1
	ENDIF
C
              IF(JTYPE.EQ.1) WRITE(NO,38)D1,D2
38            FORMAT(10X,'D1 = ',F12.6,5X,'D2 = ',F12.6)
	GO TO 7
C
10	BL=(D1+D2)/2
C             
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,39)BL
39            FORMAT(20X,'Minimum Point = ',F12.6)
              WRITE(NO,40)NBL
40            FORMAT(20X,'Number of Function Evaluation =',I5)
      ENDIF
C
	RETURN
	END
C
C*********************************** Last card of L1.FOR