File: REAFOU.FT of Tape: Various/ETH/f2
(Source file text)
SUBROUTINE REAFOU(NN,NR,LANA) 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 LOGICAL LANA C NH=NN/2 HR=SIN(PI/(4.*FLOAT(NH))) R=-4.*HR*HR DC=-R/2. DS=SIN(PI/(2.*FLOAT(NH))) FA=.5 IF (LANA) FA=1./FLOAT(N) CK=1. SK=0. SHIFT=(FLOAT(NR)-.5)/NN HR=SIN(PI*SHIFT/2.) WR=-4.*HR*HR WDC=-WR/2. WDS=SIN(PI*SHIFT) WCK=1. WSK=0. KK=NH+1 DO 3 K=1,KK NK=NN-K+2 FR=A(K)+A(NK) FI=B(K)-B(NK) GR=A(K)-A(NK) GI=B(K)+B(NK) HR=GR*CK+GI*SK HI=GI*CK-GR*SK AK=(FR+HI)*FA BK=(HR-FI)*FA A(K)=AK*WCK+BK*WSK B(K)=BK*WCK-AK*WSK ANK=(FR-HI)*FA BNK=(HR+FI)*FA A(NK)=-BNK*WCK-ANK*WSK B(NK)=+ANK*WCK-BNK*WSK DC=R*CK+DC CK=CK+DC DS=R*SK+DS SK=SK+DS WDC=WR*WCK+WDC WCK=WCK+WDC WDS=WR*WSK+WDS WSK=WSK+WDS 3 CONTINUE RETURN END