]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 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 |