This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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