File: TAUFOU.FT of Tape: Various/ETH/f2
(Source file text)
SUBROUTINE TAUFOU(IST,FNU,PHI,AF,TAU) C COMMON /TITLE/ ADENT,GLOBAL,RUN,ICREAT COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI, $ UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX COMMON /PARAM/ DKHI,SHFACT,CHISQ,ITORQ,IDILA,DK,DL,HANG $ ,HUP,HDOWN,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,CAP,EICH 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 ITORQ,IDILA,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