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