<div id='wikitext'>
<pre><b> File: COMFOU.FT of Tape: Various/ETH/f2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	SUBROUTINE COMFOU(LANA,NC,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
	NI=NC
	NC=IABS(NC)
	NH=NC/2
	NQ=NH/2
	NE=5*NQ/2
	CT=0.
	IM=1
	NPR=NC
	IF (NR.EQ.NC) GO TO 3
	LL=1
	K=NR
	GO TO 10
9	LL=LL*2
10	K=2*K
	IF (K.LE.NC) GO TO 9
	NPR=NC/LL
	NPMNR=NPR-NR
	IF (NPMNR.EQ.0) GO TO 14
	DO 12 KK=1,NPMNR
	K=NPR-KK+1
	A(K)=0.
	B(K)=0.
12	CONTINUE
14	LH=NPR
13	IF (LH.GE.NC) GO TO 15
	DO 50 JJ=1,LH
	J=LH-JJ+1
	A(J+LH)=A(J)
	B(J+LH)=B(J)
50	CONTINUE
	LH=2*LH
	GO TO 13
15	I=LL
	IM=LL
16	I=I/2
	IF (I.LT.1) GO TO 17
	CT=CT+SQRT(1.+CT*CT)
	GO TO 16
17	CONTINUE
3	LH=NPR
19	IF (LH.LE.1) GO TO 20
	LH=LH/2
	M=7
C	CALL SCOPE(.T.)
	DC=-2./(1.+CT*CT)
	DS=-CT*DC
	H=2.*DC
	CI=1.
	SI=0.
	IF (LANA) DS=-DS
	DO 30 I=1,IM
	ASSIGN 110 TO INVRET
	GO TO 100
110	KM=J+LH-1
	DO 40 K=J,KM
	KD=K+LH
	PRE=A(K)
	PIM=B(K)
	QR=A(KD)*CI-B(KD)*SI
	QI=A(KD)*SI+B(KD)*CI
	A(K)=PRE+QR
	B(K)=PIM+QI
	A(KD)=PRE-QR
	B(KD)=PIM-QI
40	CONTINUE
	CI=CI+DC
	SI=SI+DS
	DC=H*CI+DC
	DS=H*SI+DS
30	CONTINUE
	IM=IM*2
	CT=CT+SQRT(1.+CT*CT)
	GO TO 19
20	J=1
	M=0
	DO 60 I=2,NC
	ASSIGN 120 TO INVRET
	GO TO 100
120	IF (J.GE.I) GO TO 60
	H=A(I)
	A(I)=A(J)
	A(J)=H
	H=B(I)
	B(I)=B(J)
	B(J)=H
60	CONTINUE
	IF (.NOT.LANA.OR.NI.LT.0) GO TO 67
	H=1./FLOAT(NC)
	DO 66 I=1,NC
	A(I)=H*A(I)
	B(I)=H*B(I)
66	CONTINUE
67	CONTINUE
	RETURN
C
100	M=M+1
	GO TO (201,202,201,204,201,202,201,208),M
201	J=J+NH
	GO TO 210
202	J=J-NQ
	GO TO 210
204	J=J-NE
	GO TO 210
208	J=1
	K=1
	M=I-1
220	M=M+M
	IF (M.EQ.0) GO TO 210
	IF (M.LT.NC) GO TO 230
	M=M-NC
	J=J+K
230	K=K+K
	GO TO 220
210	GO TO INVRET,(110,120)
C
	END
</pre>
<hr/>
</div>