C*********************************************************  
C
C     Subroutine for one dimensional searching.
C     Quadratic interpolation of Powell technique.
C     =======================
C*********************************************************
C     Neculai Andrei, 
C     Research Institute for Informatics
C     Advanced Modeling and Optimization Laboratory     
C*********************************************************     
C
	SUBROUTINE L3(N,X,S,BL)
	DOUBLE PRECISION X(N),S(N),BL
	DOUBLE PRECISION V(3),P(3),XT(50)
	DOUBLE PRECISION H,HL,F0,E,F,D,R,DM,DMM,BLM,EPS
C
	COMMON /PREC/EPS
	COMMON /TYPE/NO
	COMMON /WRIT/NX
	COMMON /L3A/ICOD
	COMMON /NOF/NBL
C
	IF(NO.EQ.6) THEN
	OPEN(6,FILE='PRINT.DAT',ACCESS='SEQUENTIAL',
     +         FORM='FORMATTED')
	ENDIF
C
	NBL=0
	ICOD=0
	JTYPE=0
	ITER=0
	H=2.0
	HL=0.5
C
	CALL FUNC(N,X,F0)
	NBL=NBL+1
	P(1)=0.0
	V(1)=F0
C
	DO 1 I=1,N
1	XT(I)=X(I)+HL*S(I)
	CALL FUNC(N,XT,F0)
	NBL=NBL+1
	P(2)=HL
	V(2)=F0
C
	IF(V(1).LT.V(2)) THEN
	DO 2 I=1,N
2	XT(I)=X(I)-HL*S(I)
	CALL FUNC(N,XT,F0)
	NBL=NBL+1
	P(3)=-HL
	V(3)=F0
C
	ELSE
C
	DO 3 I=1,N
3	XT(I)=X(I)+2.*HL*S(I)
	CALL FUNC(N,XT,F0)
	NBL=NBL+1
	P(3)=2.*HL
	V(3)=F0
	ENDIF
C
4	CONTINUE
C
	ITER=ITER+1
	IF(ITER.GT.1001) THEN
	WRITE(NX,100)
100	FORMAT(10X,'Too high accuracy for the quadratic interpolation',/,
     +         10X,'technique for one dimensional searching method',/,
     +         10X,'of Powell.',//,
     +         10X,'Please enter another accuracy EPS')
	ICOD=1
	RETURN
	ENDIF
C
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,200)
200           FORMAT(10X,'Puncts and Values')
              WRITE(NO,201) (P(I),I=1,3)
201           FORMAT(3F20.10)
              WRITE(NO,201)(V(I),I=1,3)
      ENDIF            
C
	E=(P(2)*P(2)-P(3)*P(3))*V(1) +
     +    (P(3)*P(3)-P(1)*P(1))*V(2) +
     +    (P(1)*P(1)-P(2)*P(2))*V(3)
C
	F=(P(2)-P(3))*V(1)+(P(3)-P(1))*V(2)+(P(1)-P(2))*V(3)
	IF(F.EQ.0.0) THEN
	BL=1.0
	GO TO 10
	ENDIF
C
	BLM=(0.5*E)/F
C
	D=(P(1)-P(2))*(P(2)-P(3))*(P(3)-P(1))
C
              IF(JTYPE.EQ.1) WRITE(NO,210) E,F,BLM,D
210           FORMAT(10X,'E,F,BLM,D =',4F16.8)
C
	R=F/D
C
              IF(JTYPE.EQ.1) WRITE(NO,211)R
211           FORMAT(10X,'R =',F12.6)
C
	DM=DABS(BLM-P(1))
	DMM=DM
	IMI=1
	IMA=1
	DO 5 I=2,3
	D=DABS(BLM-P(I))
	IF(DM.GT.D) THEN
	DM=D
	IMI=I
	ENDIF
	IF(DMM.LT.D) THEN
	DMM=D
	IMA=I
	ENDIF
5	CONTINUE
C
      IF(JTYPE.EQ.1) THEN
              WRITE(NO,202)
202           FORMAT(10X,'Min Value  And  Max Value')
              WRITE(NO,203)DM,IMI
203           FORMAT(10X,'DM = ',F12.6,6X,'IMI = ',I4)
              WRITE(NO,204) DMM,IMA
204           FORMAT(10X,'DMM= ',F12.6,6X,'IMA = ',I4)
      ENDIF
C
	IF(DM.GT.H) THEN
	IF(R.LT.0.0) THEN
	IF(BLM.GT.P(IMI)) THEN
	P(IMA)=P(IMI)+H
	ELSE
	P(IMA)=P(IMI)-H
	ENDIF
C
	ELSE
C
	IF(BLM.LT.P(IMA)) THEN
	P(IMA)=P(IMA)-H
	ELSE
	P(IMA)=P(IMA)+H
	ENDIF
C
	ENDIF
C
	DO 6 I=1,N
6	XT(I)=X(I)+P(IMA)*S(I)
	CALL FUNC(N,XT,F0)
	NBL=NBL+1
	V(IMA)=F0
	GO TO 4
C
	ENDIF
C
	DO 7 I=1,N
7	XT(I)=X(I)+BLM*S(I)
	CALL FUNC(N,XT,F0)
	NBL=NBL+1
C
	E=V(1)
	F=E
	IMI=1
	IMA=1
	DO 8 I=2,3
	IF(E.GT.V(I)) THEN
	E=V(I)
	IMI=I
	ENDIF
	IF(F.LT.V(I)) THEN
	F=V(I)
	IMA=I
	ENDIF
8	CONTINUE
C
	IF(R.LT.0.0.AND.DM.LT.EPS) THEN
	BL=BLM
	IF(E.LT.F0) BL=P(IMI)
	GO TO 10
	ENDIF
C
	IF(R.LT.0.0.AND.(DM.GT.EPS.OR.DM.LT.H)) THEN
	P(IMA)=BLM
	V(IMA)=F0
	GO TO 4
	ENDIF
C
10	CONTINUE
C      
              IF(JTYPE.EQ.1) WRITE(NO,300) BL,NBL
300           FORMAT(10X,'BL = ',F12.6,/,
     +               10X,'Number of Func. Eval. = ',I5)
	RETURN
	END
C
C************************************ Last card of L3.FOR