File: DROOTS.FT of Tape: Various/ETH/f4
(Source file text) 

      SUBROUTINE ROOTS(ROOT,DR) 
C
      COMMON/INI/ ANF(10,10),DANF(10,10),PH(10,10),DPH(10,10) 
     $,AF(10,10),DAF(10,10),ETA(10,10),DETA(10,10),EMU(10,10), 
     $T(10),DT(10),ANFM(10),DANFM(10)
CDC  $,F(10,512)
      COMMON/TESPAR/ A0M,DA0M,AMU0,AF0(10),ETA0(10),A0(10)
     $,TDJ(10),DTDJ(10),TDM,DTDM
      COMMON/PARAM/IDENT,HANG,HI,HF,DK,NP,PI,SQHI,DKHI,I0DH,H0AL
      COMMON/STEER/MR,ADENT(10),MF,FREQ(10),I0
      COMMON /LINE/ A,B,DA,DB,SA,SB,SAB,TD,AMU,RR,RMSD,CHI
      COMMON /REGRES/ XL(10),YL(10),DY(10)
      COMMON/FRERUN/ IF,JR,INIT,LS
      COMMON/ACCUR/ DDMU1,DDMU2,DCHI,ERRMU
C
      LOGICAL FEHLER
      FEHLER=.F.
      ZA=ROOT 
      ZB=ROOT+DR
      FA=FMU(ZA)
      SIG=SIGN(1.,FA) 
      FA=SIG*FA 
      FB=SIG*FMU(ZB)
      IF(FA*FB) 30,30,500 
C 
C  LINEARE INTERPOLATION UND INTERVALLSCHACHTELUNG
C 
   30 ZC=(ZA*FB-ZB*FA)/(FB-FA)
      FC=SIG*FMU(ZC)
      IF(ABS(FC).LT.DDET) GOTO 91 
      IF(FC.LT.0.) GOTO 70
      ZD=(ZB+ZC)/2. 
      FD=SIG*FMU(ZD)
   50 IF(ABS(FD).LT.DDET) GOTO 92 
      IF(FD.LT.0.) GOTO 100 
      ZC=ZD
      FC=FD 
      ZD=(ZB+ZD)/2. 
      FD=SIG*FMU(ZD)
      GOTO 50 
   70 ZD=ZC
      FD=FC 
      ZC=(ZA+ZC)/2. 
      FC=SIG*FMU(ZC)
      IF(ABS(FC).LT.DDET) GOTO 91 
      IF(FC.LT.0.) GOTO 70
  100 ZA=ZC
      ZB=ZD 
      FA=FC
      FB=FD 
      GOTO 96 
   91 ZB=ZC
      ZA=ZB
      FA=.0
      FB=.0
      GOTO 96 
   92 ZB=ZD
      ZA=ZB
      FA=.0
      FB=.0
   96 CONTINUE
      IF(ABS(FA-FB).GT.DDET.AND.ABS(ZA-ZB).GT.DK) GOTO 30 
      ROOT=(ZA+ZB)/2. 
      RETURN
  500 FEHLER=.T.
      RETURN
      END