*
* $Id: locsch.F,v 1.1.1.1 1996/04/01 15:03:27 mclareni Exp $
*
* $Log: locsch.F,v $
* Revision 1.1.1.1  1996/04/01 15:03:27  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE LOCSCH (IIMIN,N,NFREE,IFREE,X,FX,XLOW,XHI,DELTA,SUFTOL,
     1NFCNT,Y,FY,Z,FZ,P)
      INTEGER IIMIN, N, NFREE, NFCNT
      INTEGER IFREE(N)
      DOUBLE PRECISION FX, DELTA, SUFTOL, FY, FZ
      DOUBLE PRECISION X(N), XLOW(N), XHI(N), Y(N), Z(N), P(N)
      INTEGER I, II, ILOC, ITEST
      DOUBLE PRECISION A, B, B1, D, DELX, DFUN, E, EPSMCH, ETA, FA,
     1                 FBEST, FSAV, FTEST, FU, FV, FW, GTEST1, GTEST2,
     2                 GTP, GU, OLDF, PE, PNORM, R, RR, RTEPS,
     3                 SCXBD, SFTBND, SMAX, SNMAX, SOPP, SPMAX, SS,
     4                 SSAV, STP, STPDN, STPNEG, STPPOS, STPUP, T,
     5                 TOL, U, XBEST, XLAMDA, XV, XW, YSAV
      DATA EPSMCH/2.22D-16/
      RTEPS=SQRT(EPSMCH)
      DELX=DELTA
      DO 10 I=1,N
      Y(I)=X(I)
      Z(I)=X(I)
 10   CONTINUE
      FZ=FX
      FY=FX
      SMAX=1.0D+30
      DO 40 I=1,NFREE
      II=IFREE(I)
      STPUP=XHI(II)-X(II)
      STPDN=X(II)-XLOW(II)
      IF(STPUP.LT.STPDN) GOTO 20
      P(I)=1.0D+0
      STP=STPUP
      GOTO 30
 20   P(I)=-1.0D+0
      STP=STPDN
 30   IF(STP.LT.SMAX) SMAX=STP
 40   CONTINUE
      SMAX=0.9D+0*SMAX
 50   IF(DELX.GT.SMAX) DELX=SMAX
      DO 60 I=1,NFREE
      II=IFREE(I)
      Y(II)=X(II)+DELX*P(I)
 60   CONTINUE
      FY=DFUN(N,Y)
      IF(IIMIN.EQ.2) FY=-FY
      NFCNT=NFCNT+1
      FTEST=SUFTOL*(1.0D+0+ABS(FX))
      IF(ABS(FX-FY).GT.FTEST.OR.DELX.EQ.SMAX) GOTO 70
      DELX=5.0D+0*DELX
      GOTO 50
 70   DELX=DELTA
      CALL ORTHVC(N,NFREE,IFREE,X,FX,XLOW,XHI,Y,FY,P,SPMAX,SNMAX)
      SMAX=0.9D+0*SPMAX
      SOPP=0.9D+0*SNMAX
      IF(SMAX.GE.SNMAX.OR.NFREE.EQ.1) GOTO 90
      DO 80 I=1,NFREE
      P(I)=-P(I)
 80   CONTINUE
      SSAV=SMAX
      SMAX=SOPP
      SOPP=SSAV
 90   IF(DELX.GT.SMAX) DELX=SMAX
 100  DO 110 I=1,NFREE
      II=IFREE(I)
      Z(II)=Y(II)+DELX*P(I)
 110  CONTINUE
      FZ=DFUN(N,Z)
      IF(IIMIN.EQ.2) FZ=-FZ
      NFCNT=NFCNT+1
      FTEST=SUFTOL*(1.0D+0+ABS(FY))
      IF(ABS(FY-FZ).GT.FTEST.OR.(5.0D+0*DELX).GT.SMAX) GOTO 120
      DELX=5.0D+0*DELX
      GOTO 100
 120  IF(FY.EQ.FZ) GOTO 210
      IF(FY.LT.FZ) GOTO 130
      GTP=(FZ-FY)/DELX
      XLAMDA=SMAX/0.9D+0
      U=MIN(2.0D+0*DELX,SMAX)
      GOTO 160
 130  DO 140 I=1,NFREE
      P(I)=-P(I)
 140  CONTINUE
      U=MIN(2.0D+0*DELX,SOPP)
      XLAMDA=SOPP/0.9D+0+DELX
      GTP=(FY-FZ)/DELX
      DO 150 I=1,N
      YSAV=Y(I)
      Y(I)=Z(I)
      Z(I)=YSAV
 150  CONTINUE
      FSAV=FY
      FY=FZ
      FZ=FSAV
 160  CALL RLEN(NFREE,P,PNORM)
      PE=PNORM+RTEPS
      ILOC=1
      FU=FY
      GU=GTP
      SFTBND=0.0D+0
      ETA=RTEPS
      T=RTEPS/PE
 170  CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
     1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
      IF(ITEST.NE.1) GOTO 190
      R=XBEST+U
      DO 180 I=1,NFREE
      II=IFREE(I)
      Z(II)=Y(II)+R*P(I)
 180  CONTINUE
      FU=DFUN(N,Z)
      IF(IIMIN.EQ.2) FU=-FU
      NFCNT=NFCNT+1
      FZ=FU
      GOTO 170
 190  IF(ITEST.NE.0) GOTO 210
      DO 200 I=1,NFREE
      II=IFREE(I)
      Z(II)=Y(II)+XBEST*P(I)
 200  CONTINUE
      FZ=FBEST
 210  IF(FZ.EQ.FX) RETURN
      DO 220 I=1,NFREE
      II=IFREE(I)
      P(I)=Z(II)-X(II)
 220  CONTINUE
      SPMAX=1.0D+30
      SNMAX=1.0D+30
      DO 230 I=1,NFREE
      II=IFREE(I)
      CALL MXSTEP(X(II),XLOW(II),XHI(II),P(I),STPPOS,STPNEG)
      IF(STPPOS.LT.SPMAX) SPMAX=STPPOS
      IF(STPNEG.LT.SNMAX) SNMAX=STPNEG
 230  CONTINUE
      CALL RLEN(NFREE,P,PNORM)
      GTP=FZ-FX
      U=MIN(2.0D+0,0.9D+0*SPMAX)
      XLAMDA=SPMAX
      IF(FZ.LT.FX) GOTO 270
      DELX=DELTA/(PNORM+RTEPS)
      IF(DELX.GT.0.9D+0*SNMAX) DELX=0.9D+0*SNMAX
      DO 240 I=1,NFREE
      II=IFREE(I)
      Y(II)=X(II)-DELX*P(I)
 240  CONTINUE
      FY=DFUN(N,Y)
      IF(IIMIN.EQ.2) FY=-FY
      NFCNT=NFCNT+1
      IF(FY.LT.FX) GOTO 250
      IF(DELX.LT.1.0D+0) GTP=(FX-FY)/DELX
      GOTO 270
 250  GTP=(FY-FX)/DELX
      DO 260 I=1,NFREE
      P(I)=-P(I)
 260  CONTINUE
      U=MIN(2.0D+0*DELX,0.9D+0*SNMAX)
      XLAMDA=SNMAX
 270  ILOC=1
      PE=PNORM+RTEPS
      FU=FX
      GU=GTP
      SFTBND=0.0D+0
      ETA=RTEPS
      T=RTEPS/PE
 280  CALL NEWPTQ(RTEPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XBEST,FBEST,XW,FW,X
     1V,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST)
      IF(ITEST.NE.1) GOTO 300
      R=XBEST+U
      DO 290 I=1,NFREE
      II=IFREE(I)
      Y(II)=X(II)+R*P(I)
 290  CONTINUE
      FU=DFUN(N,Y)
      IF(IIMIN.EQ.2) FU=-FU
      NFCNT=NFCNT+1
      GOTO 280
 300  IF(ITEST.NE.0) RETURN
      DO 310 I=1,NFREE
      II=IFREE(I)
      Z(II)=X(II)+XBEST*P(I)
 310  CONTINUE
      FZ=FBEST
      RETURN
      END