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