File: KRE.FT of Tape: Various/ETH/f4
(Source file text)
SUBROUTINE RELFOU(LANA,NR) 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 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