This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / GEANT321 / gheisha / rtmi.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1995/10/24 10:20:59  cernlib
6 * Geant
7 *
8 *
9 #include "geant321/pilot.h"
10 *CMZ :  3.21/02 29/03/94  15.41.38  by  S.Giani
11 *-- Author :
12       SUBROUTINE RTMI(X,F,FCT,XLI,XRI,EPS,IEND,IER)
13 C
14 C *** NVE 16-MAR-1988 CERN GENEVA ***
15 C
16 C ORIGIN : H.FESEFELDT (27-OCT-1983)
17 C COPIED FROM R01UTL.SSP.S  23.4.82
18 C
19       EXTERNAL FCT
20 C --- PREPARE ITERATION ---
21       IER=0
22       XL=XLI
23       XR=XRI
24       X=XL
25       TOL=X
26       F=FCT(TOL)
27       IF(F)1,16,1
28     1 FL=F
29       X=XR
30       TOL=X
31       F=FCT(TOL)
32       IF(F)2,16,2
33     2 FR=F
34       IF(SIGN(1.,FL)+SIGN(1.,FR))25,3,25
35 C
36 C     BASIC ASSUMPTION FL*FR LESS THAN 0 IS SATISFIED.
37 C     GENERATE TOLERANCE FOR FUNCTION VALUES.
38     3 I=0
39       TOLF=100.*EPS
40 C
41 C
42 C     START ITERATION LOOP
43     4 I=I+1
44 C
45 C     START BISECTION LOOP
46       DO 13 K=1,IEND
47       X=.5*(XL+XR)
48       TOL=X
49       F=FCT(TOL)
50       IF(F)5,16,5
51     5 IF(SIGN(1.,F)+SIGN(1.,FR))7,6,7
52 C
53 C     INTERCHANGE XL AND XR IN ORDER TO GET THE SAME SIGN IN F AND FR
54     6 TOL=XL
55       XL=XR
56       XR=TOL
57       TOL=FL
58       FL=FR
59       FR=TOL
60     7 TOL=F-FL
61       A=F*TOL
62       A=A+A
63       IF(A-FR*(FR-FL))8,9,9
64     8 IF(I-IEND)17,17,9
65     9 XR=X
66       FR=F
67 C
68 C     TEST ON SATISFACTORY ACCURACY IN BISECTION LOOP
69       TOL=EPS
70       A=ABS(XR)
71       IF(A-1.)11,11,10
72    10 TOL=TOL*A
73    11 IF(ABS(XR-XL)-TOL)12,12,13
74    12 IF(ABS(FR-FL)-TOLF)14,14,13
75    13 CONTINUE
76 C     END OF BISECTION LOOP
77 C
78 C     NO CONVERGENCE AFTER IEND ITERATION STEPS FOLLOWED BY IEND
79 C     SUCCESSIVE STEPS OF BISECTION OR STEADILY INCREASING FUNCTION
80 C     VALUES AT RIGHT BOUNDS. ERROR RETURN.
81       IER=1
82    14 IF(ABS(FR)-ABS(FL))16,16,15
83    15 X=XL
84       F=FL
85    16 RETURN
86 C
87 C     COMPUTATION OF ITERATED X-VALUE BY INVERSE PARABOLIC INTERPOLATION
88    17 A=FR-F
89       DX=(X-XL)*FL*(1.+F*(A-TOL)/(A*(FR-FL)))/TOL
90       XM=X
91       FM=F
92       X=XL-DX
93       TOL=X
94       F=FCT(TOL)
95       IF(F)18,16,18
96 C
97 C     TEST ON SATISFACTORY ACCURACY IN ITERATION LOOP
98    18 TOL=EPS
99       A=ABS(X)
100       IF(A-1.)20,20,19
101    19 TOL=TOL*A
102    20 IF(ABS(DX)-TOL)21,21,22
103    21 IF(ABS(F)-TOLF)16,16,22
104 C
105 C     PREPARATION OF NEXT BISECTION LOOP
106    22 IF(SIGN(1.,F)+SIGN(1.,FL))24,23,24
107    23 XR=X
108       FR=F
109       GO TO 4
110    24 XL=X
111       FL=F
112       XR=XM
113       FR=FM
114       GO TO 4
115 C     END OF ITERATION LOOP
116 C
117 C
118 C     ERROR RETURN IN CASE OF WRONG INPUT DATA
119    25 IER=2
120       RETURN
121       END