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

	SUBROUTINE TAUFOU(IST,FNU,PHI,AF,TAU)
C
	COMMON /TITLE/ ADENT,GLOBAL,DITOMO,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT(11),CHISQ,DK,DL,HANG
     $  ,HUP,HDOWN,CAPMO,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,EICH
	COMMON /EFFMU/ FRE1(11),FRE2(11),PERMAS(11)
	COMMON /PEAKS/ TASWI,KBLOW,KBLOW1,KMAX,K1,K3,CHI,
     $  Q(11,4),HIGHT(21),INDEX(21)
	COMMON /VECT/ C(44),D1(11,4),DIAGEL(44),D(44),E(44)
	COMMON /DATIN/ F(512),NP
	COMMON /CONST/ PI,TWOPI
	COMMON /PLOTC/ PLTBUF(400)
	COMMON /FAF/ A(2049),B(2049),N
	DIMENSION AR(44,44),Z(44,44)
	EQUIVALENCE (A,AR),(B,Z)
	INTEGER RUN
	REAL K3
	LOGICAL ITEST,TASWI
C
	NU=IST
	AM12=A(NU)-A(NU-1)
	AM32=A(NU+1)-A(NU)
	AMSL=(AM12+AM32)/2.
	AMCUR=(AM32-AM12)/2.
	DNU=-AMSL/(2.*AMCUR)
	AM=A(NU)-AMSL*AMSL/(4.*AMCUR)
	IDNU=IFIX(DNU)
	DNU=DNU-IDNU
	NU=NU+IDNU
	FNU=(NU+DNU-1.)*NP/N
	ANU=TWOPI*FNU
	HLFINT=FLOAT(NP)/2.
	CONV=FLOAT(N)/TWOPI
	PHI12=B(NU)-B(NU-1)
	IF (ABS(PHI12).GT.PI) PHI12=PHI12-SIGN(TWOPI,PHI12)
	PHI32=B(NU+1)-B(NU)
	IF (ABS(PHI32).GT.PI) PHI32=PHI32-SIGN(TWOPI,PHI32)
	PHISL=(PHI12+PHI32)/2.
	PHICUR=(PHI32-PHI12)/2.
	PHI=B(NU)+PHISL*DNU+PHICUR*DNU*DNU
	SDBPHI=SIN(2.*PHI)
	CDBPHI=COS(2.*PHI)
	SNU=SIN(ANU)
	CNU=COS(ANU)
	SIMOM=(CNU-SNU/ANU)*SDBPHI*HLFINT/ANU
	SINTGR=1./(1.+CDBPHI*SNU/ANU)
	SINCNT=SIMOM*SINTGR
	AF=AM*SINTGR*N/NP
	PHI=PHI-SIMOM*TWOPI/HLFINT
	DPHDNU=PHISL+2.*PHICUR*DNU
	DPHDNU=DPHDNU*CONV+SINCNT
	TAUCNT=DPHDNU/HLFINT
	IF (ABS(TAUCNT).LE.0.99) GO TO 5
	X2=SIGN(PI*100.,TAUCNT)
	GO TO 30
5	X1=SIGN(1.,TAUCNT)/(1.-ABS(TAUCNT))
	IF (ABS(TAUCNT).LT.0.5) X1=TAUCNT*3.
	DIF1=1.E10
10	DUM=EXP(2.*X1)
	TH=(DUM-1.)/(DUM+1.)
	X2=TH/(1.-TAUCNT*TH)
	DIF2=X2-X1
	IF (ABS(DIF1).LT.1.E-6) GO TO 20
	O=DIF2/DIF1
	P=O/(1.-O)
20	X2=X2+P*DIF2
	IF (ABS(X2-X1).LT.1.E-3) GO TO 30
	X1=X2
	DIF1=DIF2
	GO TO 10
30	TAU=X2*2.
	IF (ABS(TAU).GT.10.) TAU=SIGN(10.,TAU)
	PHI=AMOD(PHI/PI+1.+FNU-FNU/NP,2.)*PI-PI
C	WRITE(4,100) NU,FNU,DNU,ANU,HLFINT,CONV,PHI,PHISL
C     $  ,PHICUR,DPHDNU,TAUCNT,TAU,PI,SINCNT,SDBPHI,CNU,SNU
C100	FORMAT(1H ,I4,2(8(F10.4,1X)/))
	END