File: RELFOU.FT of Tape: Various/ETH/f2

(Source file text) 

---

	SUBROUTINE RELFOU(LANA,NR)
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
	NN=N/2
	NRP=NR/2
	IF (LANA) GO TO 11
	B(1)=0.
	B(NN+1)=0.
	CALL REAFOU(NN,NRP,LANA)
	GO TO 12
11	DO 15 K=1,NRP
	A(K)=A(2*K-1)
	B(K)=A(2*K)
15	CONTINUE
C	CALL SCOPE(.T.)
12	K=NRP
	IF (.NOT.LANA) K=NN
	CALL COMFOU(LANA,-NN,K)
	IF (.NOT.LANA) GO TO 20
	A(NN+1)=A(1)
	B(NN+1)=B(1)
	CALL REAFOU(NN,NRP,LANA)
	B(1)=0.
	B(NN+1)=0.
	DO 50 I=1,NN
	AS=A(I)
	BS=B(I)
40	A(I)=SQRT(AS*AS+BS*BS)
	B(I)=ATAN2(BS,AS)
50	CONTINUE
	GO TO 26
20	DO 25 KK=1,NRP
	K=NRP-KK+1
	A(2*K)=B(K)
	A(2*K-1)=A(K)
25	CONTINUE
26	CONTINUE
	RETURN
	END

---