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