* * $Id$ * * $Log$ * Revision 1.1.1.1 1995/10/24 10:20:59 cernlib * Geant * * #include "geant321/pilot.h" *CMZ : 3.21/02 29/03/94 15.41.38 by S.Giani *-- Author : SUBROUTINE RTMI(X,F,FCT,XLI,XRI,EPS,IEND,IER) C C *** NVE 16-MAR-1988 CERN GENEVA *** C C ORIGIN : H.FESEFELDT (27-OCT-1983) C COPIED FROM R01UTL.SSP.S 23.4.82 C EXTERNAL FCT C --- PREPARE ITERATION --- IER=0 XL=XLI XR=XRI X=XL TOL=X F=FCT(TOL) IF(F)1,16,1 1 FL=F X=XR TOL=X F=FCT(TOL) IF(F)2,16,2 2 FR=F IF(SIGN(1.,FL)+SIGN(1.,FR))25,3,25 C C BASIC ASSUMPTION FL*FR LESS THAN 0 IS SATISFIED. C GENERATE TOLERANCE FOR FUNCTION VALUES. 3 I=0 TOLF=100.*EPS C C C START ITERATION LOOP 4 I=I+1 C C START BISECTION LOOP DO 13 K=1,IEND X=.5*(XL+XR) TOL=X F=FCT(TOL) IF(F)5,16,5 5 IF(SIGN(1.,F)+SIGN(1.,FR))7,6,7 C C INTERCHANGE XL AND XR IN ORDER TO GET THE SAME SIGN IN F AND FR 6 TOL=XL XL=XR XR=TOL TOL=FL FL=FR FR=TOL 7 TOL=F-FL A=F*TOL A=A+A IF(A-FR*(FR-FL))8,9,9 8 IF(I-IEND)17,17,9 9 XR=X FR=F C C TEST ON SATISFACTORY ACCURACY IN BISECTION LOOP TOL=EPS A=ABS(XR) IF(A-1.)11,11,10 10 TOL=TOL*A 11 IF(ABS(XR-XL)-TOL)12,12,13 12 IF(ABS(FR-FL)-TOLF)14,14,13 13 CONTINUE C END OF BISECTION LOOP C C NO CONVERGENCE AFTER IEND ITERATION STEPS FOLLOWED BY IEND C SUCCESSIVE STEPS OF BISECTION OR STEADILY INCREASING FUNCTION C VALUES AT RIGHT BOUNDS. ERROR RETURN. IER=1 14 IF(ABS(FR)-ABS(FL))16,16,15 15 X=XL F=FL 16 RETURN C C COMPUTATION OF ITERATED X-VALUE BY INVERSE PARABOLIC INTERPOLATION 17 A=FR-F DX=(X-XL)*FL*(1.+F*(A-TOL)/(A*(FR-FL)))/TOL XM=X FM=F X=XL-DX TOL=X F=FCT(TOL) IF(F)18,16,18 C C TEST ON SATISFACTORY ACCURACY IN ITERATION LOOP 18 TOL=EPS A=ABS(X) IF(A-1.)20,20,19 19 TOL=TOL*A 20 IF(ABS(DX)-TOL)21,21,22 21 IF(ABS(F)-TOLF)16,16,22 C C PREPARATION OF NEXT BISECTION LOOP 22 IF(SIGN(1.,F)+SIGN(1.,FL))24,23,24 23 XR=X FR=F GO TO 4 24 XL=X FL=F XR=XM FR=FM GO TO 4 C END OF ITERATION LOOP C C C ERROR RETURN IN CASE OF WRONG INPUT DATA 25 IER=2 RETURN END