MINICERN/mathlib/gen/divon/newptq.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:03:28  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE NEWPTQ (EPS,T,ETA,SFTBND,XLAMDA,U,FU,GU,XMIN,FMIN,XW,FW
  11      1,XV,FV,A,FA,B,OLDF,B1,SCXBD,E,D,RR,SS,GTEST1,GTEST2,TOL,ILOC,ITEST
  12      2)
  13       INTEGER ILOC, ITEST
  14       DOUBLE PRECISION EPS, T, ETA, SFTBND, XLAMDA, U, FU, GU,
  15      1   XMIN, FMIN, XW, FW, XV, FV, A, FA, B, OLDF,
  16      2   B1, SCXBD, E, D, RR, SS, GTEST1, GTEST2, TOL
  17       DOUBLE PRECISION A1, D1, D2, Q, R, S, T2, XM
  18       GOTO (10,20,20,230,220),ILOC
  19  10   ITEST=2
  20       TOL=T
  21       T2=TOL+TOL
  22       IF(U.LE.0.0D+0.OR.XLAMDA.LE.T2.OR.GU.GT.0.0D+0) RETURN
  23       ITEST=1
  24       XMIN=0.0D+0
  25       XW=0.0D+0
  26       XV=0.0D+0
  27       A=0.0D+0
  28       OLDF=FU
  29       FMIN=FU
  30       FW=FU
  31       FV=FU
  32       FA=FU
  33       D=U
  34       SCXBD=EPS*ABS(XLAMDA)+T
  35       B=XLAMDA+SCXBD
  36       E=B
  37       B1=B
  38       SCXBD=XLAMDA-SCXBD/(1.0D+0+EPS)
  39       GTEST1=-1.0D-4*GU
  40       GTEST2=-ETA*GU
  41       ILOC=2
  42       GOTO 190
  43  20   IF(FU.GT.FMIN) GOTO 50
  44       IF(U.LT.0.0D+0) GOTO 30
  45       A=0.0D+0
  46       FA=FMIN
  47       GOTO 40
  48  30   B=0.0D+0
  49  40   XV=XW
  50       FV=FW
  51       FW=FMIN
  52       FMIN=FU
  53       XMIN=XMIN+U
  54       A=A-U
  55       B=B-U
  56       XV=XV-U
  57       XW=0.0D+0-U
  58       SCXBD=SCXBD-U
  59       TOL=EPS*ABS(XMIN)+T
  60       T2=TOL+TOL
  61       GOTO 90
  62  50   IF(U.GE.0.0D+0) GOTO 60
  63       A=U
  64       FA=FU
  65       GOTO 70
  66  60   B=U
  67  70   IF(FU.GT.FW.AND.XW.NE.0.0D+0) GOTO 80
  68       XV=XW
  69       FV=FW
  70       XW=U
  71       FW=FU
  72       GOTO 90
  73  80   IF(FU.GT.FV.AND.XV.NE.0.0D+0.AND.XV.NE.XW) GOTO 90
  74       XV=U
  75       FV=FU
  76  90   XM=5.0D-1*(A+B)
  77       IF(ABS(XM).LE.T2-5.0D-1*(B-A).OR.XMIN+B.LE.SFTBND.OR.FA-FMIN.LE.
  78      1ABS(A)*GTEST2.AND.FMIN.LT.OLDF.AND.(ABS(XMIN-XLAMDA).GT.TOL.OR.S
  79      2CXBD.LT.B)) GOTO 210
  80       R=0.0D+0
  81       Q=0.0D+0
  82       S=0.0D+0
  83       IF(ABS(E).LE.TOL) GOTO 120
  84       IF(ILOC.NE.2) GOTO 100
  85       Q=2.0D+0*(FW-FMIN-XW*GU)
  86       S=GU*XW*XW
  87       IF(XMIN.NE.0.0D+0) S=(2.0D+0*(FMIN-FW)+XW*GU)*XW
  88       GOTO 110
  89  100  R=XW*(FV-FMIN)
  90       Q=XV*(FW-FMIN)
  91       S=R*XW-Q*XV
  92       Q=2.0D+0*(Q-R)
  93  110  IF(Q.GT.0.0D+0) S=-S
  94       IF(Q.LE.0.0D+0) Q=-Q
  95       R=E
  96       IF(D.NE.B1.OR.B.LE.SCXBD) E=D
  97  120  A1=A
  98       B1=B
  99       IF(XMIN.NE.A) GOTO 130
 100       D=XM
 101       GOTO 160
 102  130  IF(B.LE.SCXBD) GOTO 140
 103       D=-4.0D+0*A
 104       IF(D.GE.B) D=SCXBD
 105       GOTO 160
 106  140  D1=A
 107       D2=B
 108       IF(ABS(D2).GT.TOL.AND.(XW.LE.0.0D+0.OR.ABS(D1).LE.TOL)) GOTO 1
 109      150
 110       U=D1
 111       D1=D2
 112       D2=U
 113  150  U=-D1/D2
 114       D=5.0D+0*D2*(1.0D-1+1.0D+0/U)/1.1D+1
 115       IF(U.LT.1.0D+0) D=5.0D-1*D2*SQRT(U)
 116  160  IF(D.LE.0.0D+0) A1=D
 117       IF(D.GT.0.0D+0) B1=D
 118       IF(ABS(S).GE.ABS(5.0D-1*Q*R).OR.S.LE.Q*A1.OR.S.GE.Q*B1) GOTO 1
 119      170
 120       D=S/Q
 121       IF(D-A.GE.T2.AND.B-D.GE.T2) GOTO 180
 122       D=TOL
 123       IF(XM.LE.0.0D+0) D=-TOL
 124       GOTO 180
 125  170  E=B
 126       IF(XM.LE.0.0D+0) E=A
 127  180  ILOC=3
 128  190  IF(D.LT.SCXBD) GOTO 200
 129       D=SCXBD
 130       SCXBD=SCXBD*(1.0D+0+7.5D-1*EPS)+7.5D-1*TOL
 131  200  U=D
 132       IF(ABS(D).LT.TOL.AND.D.LE.0.0D+0) U=-TOL
 133       IF(ABS(D).LT.TOL.AND.D.GT.0.0D+0) U=TOL
 134       ITEST=1
 135       RETURN
 136  210  RR=XMIN
 137       SS=5.0D-1
 138       FU=FMIN
 139  220  IF(ABS(XMIN-XLAMDA).GE.TOL.OR.XMIN.EQ.T) GOTO 230
 140       XMIN=XLAMDA
 141       IF(SCXBD.LE.B) GOTO 230
 142       U=0.0D+0
 143       ILOC=4
 144       ITEST=1
 145       RETURN
 146  230  IF(XMIN+B.GT.SFTBND) GOTO 240
 147       ITEST=4
 148       RETURN
 149  240  IF(OLDF-FU.LE.GTEST1*XMIN) GOTO 250
 150       FMIN=FU
 151       ITEST=0
 152       RETURN
 153  250  IF(XMIN.NE.T) GOTO 260
 154       ITEST=3
 155       RETURN
 156  260  XMIN=RR*SS
 157       SS=SS*SS
 158       IF(XMIN.LT.T) XMIN=T
 159       ITEST=1
 160       U=0.0D+0
 161       ILOC=5
 162       RETURN
 163       END