File: COMFOU.FC of Tape: Various/ETH/fc1
(.FC,.FO Focal format converted to 'WRITE' listing)
C-OS/8 FOCAL, 1972 01.01 C "COMFOU" 01.02 01.03 S MI=256 01.05 S SW(1)=2.1;S SW(2)=2.2;S SW(3)=2.1;S SW(4)=2.3 01.06 S SW(5)=2.1;S SW(6)=2.2;S SW(7)=2.1;S SW(8)=2.4 01.10 S NI=N;S N=FABS(N);S NH=FITR(N/2);S NQ=FITR(NH/2);S NE=5*FITR(NQ/2) 01.20 S CT=0;S IM=0;S P=N;I (R)1.27,1.25,1.27 01.25 S AN=1;G 1.29 01.27 I (R-N)1.28,1.29,1.28 01.28 D 7 01.29 S LH=P 01.30 S L=LH;I (L-1)1.4,1.4;D 3;G 1.3 01.40 S IM=N-1;S J=0;S M=0;F I=1,IM;D 4 01.50 I (-NI)1.6;R 01.60 I (AN)1.7,1.7;S H=1/N;F I=0,IM;D 1.8 01.70 R 01.80 S Z=FCOM(I,H*FCOM(I));S Z=FCOM(MI+I,H*FCOM(MI+I));S Z=FX(0,500) 01.90 R 02.01 C "REVERS" STORES REVERSED BIT PATTERN OF I AS J 02.02 02.05 S M=M+1;G SW(M) 02.10 S J=J+NH;R 02.20 S J=J-NQ;R 02.30 S J=J-NE;R 02.40 S J=0;S K=1;S M=I 02.50 S M=M+M;I (M)2.6,2.55,2.6 02.55 R 02.60 I (M-N)2.7;S M=M-N;S J=J+K 02.70 S K=K+K;G 2.5 03.01 C "FOR L=LH WHILE L>1" 03.02 S LH=FITR(L/2);S M=7;S DC=-2/(1+CT*CT);S DS=-CT*DC 03.03 S H=2*DC;S CI=1;S SI=0 03.05 I (AN)3.1,3.1;S DS=-DS 03.10 F I=0,IM;D 5 03.20 S IM=2*IM+1;S CT=CT+FSQT(1+CT*CT) 04.01 C "FOR I=1,IMAX" 04.10 D 2 04.20 I (J-I)4.3;R 04.30 S H=FCOM(I);S Z=FCOM(I,FCOM(J));S Z=FCOM(J,H) 04.40 S H=FCOM(MI+I);S Z=FCOM(MI+I,FCOM(MI+J));S Z=FCOM(MI+J,H) 04.45 S Z=FX(0,500) 04.50 R 05.01 C "FOR I=0,IM" 05.10 D 2;S KM=J+LH-1;F K=J,KM;D 6 05.20 S CI=CI+DC;S SI=SI+DS 05.30 S DC=H*CI+DC;S DS=H*SI+DS 06.01 C "FOR K=J,KM" 06.05 S KH=K+LH 06.10 S OR=FCOM(K);S OI=FCOM(MI+K) 06.20 S QR=FCOM(KH)*CI-FCOM(MI+KH)*SI 06.30 S QI=FCOM(KH)*SI+FCOM(MI+KH)*CI 06.40 S Z=FCOM(K,OR+QR);S Z=FCOM(MI+K,OI+QI) 06.50 S Z=FCOM(KH,OR-QR);S Z=FCOM(MI+KH,OI-QI) 06.60 S Z=FX(0,500) 07.01 C "SYNTHESIS" 07.02 07.10 S Q=1;S K=R 07.20 S K=2*K;I (N-K)7.3;S Q=2*Q;G 7.2 07.30 S P=FITR(N/Q) 07.40 F K=1-P,-R;S Z=FCOM(-K,0);S Z=FCOM(MI-K,0) 07.50 S LH=P 07.60 S K=LH;I (N-K)7.8,7.8;D 7.7;S LH=LH*2;G 7.6 07.70 F J=1-LH,0;S Z=FCOM(LH-J,FCOM(-J));S Z=FCOM(MI+LH-J,FCOM(MI-J)) 07.80 S I=Q;S IM=Q-1 07.90 S I=FITR(I/2);I (I)7.95,7.95;S CT=CT+FSQT(1+CT*CT);G 7.9 07.95 R 08.01 C "RELFOU" 08.02 08.05 A "ANAL=1,SYNTH=0",AN 08.10 S NN=FITR(N/2);S MI=256 08.20 I (-AN)8.3;S Z=FCOM(MI,0);S Z=FCOM(MI+NN,0);D 9;G 8.5 08.25 S Z=FCOM(K,FCOM(2*K));S Z=FCOM(MI+K,FCOM(2*K+1)) 08.30 F K=0,N-1;D 8.25;D 14.1 08.50 I (AN)8.55,8.55;S R=0;G 8.6 08.55 S R=NN 08.60 S N=-NN;D 1;S N=N*2 08.70 I (AN)8.8,8.8, 8.75 08.75 S Z=FCOM(NN,FCOM(0));S Z=FCOM(MI+NN,FCOM(MI));D 9 08.76 S Z=FCOM(MI,0);S Z=FCOM(MI+NN,0) 08.77 F I=1,NN-1;S Z=FCOM(NN+I,FCOM(MI+I));D 14.1 08.78 R 08.80 F K=1-NN,0;S Z=FCOM(1-2*K,FCOM(MI-K));S Z=FCOM(-2*K,FCOM(-K));D 14.1 08.85 T "" 08.90 R 09.01 C "REALTR" 09.02 09.10 S NH=FITR(NN/2);S HR=FSIN(FATN(1)/NH);S R=-4*HR*HR 09.20 S DC=-R/2;S DS=FSIN(2*FATN(1)/NH);I (AN)9.25,9.25;S AF=1/N;G 9.3 09.25 S AF=1/2 09.30 S CK=1;S SK=0 09.40 F K=0,NH;D 13;D 14.1 09.50 R 10.01 C DATA FUNCTION 10.10 A ?N?;S NM=N/2;A ?NU?,?PH?,?TA? 10.20 F I=0,N-1;S Z=FCOM(I,1.1*FCOS(I*NU*PI/N+PH)*FEXP(-TA*I*PI/N));S Z=FX(0,500) 10.30 F I=N,255;S Z=FCOM(I,0);S Z=FX(0,500) 10.35 Q 10.40 T "";D 1;T "";S Z=FX(0,500) 11.10 S Z=FDIS(4,-FDIS(4));S Z=FDIS(5,-FDIS(5)) 12.10 F I=1,NM;S Z=FSQT(FCOM(I)^2+FCOM(I+NM)^2);S X=PI*FSGN(FCOM(I+NM))*FSGN(FABS(FCOM(I))-FCOM(I))+FATN(FCOM(I+NM)/FCOM(I));S Z=FCOM(I,Z);S Z=FCOM(I+NM,X);S Z=FX(0,500) 12.20 S Z=FCOM(NM,0);D 14.1 13.10 S NK=NN-K;S RF=FCOM(K)+FCOM(NK);S IF=FCOM(MI+K)-FCOM(MI+NK) 13.20 S GR=FCOM(K)-FCOM(NK);S GI=FCOM(MI+K)+FCOM(MI+NK) 13.30 S HR=GR*CK+GI*SK;S HI=GI*CK-GR*SK 13.40 S Z=FCOM(K,(RF+HI)*AF);S Z=FCOM(NK,(RF-HI)*AF) 13.50 S Z=FCOM(MI+K,(HR-IF)*AF);S Z=FCOM(MI+NK,(HR+IF)*AF) 13.60 S DC=R*CK+DC;S CK=CK+DC;S DS=R*SK+DS;S SK=SK+DS 13.70 R 14.10 S Z=FX(0,500) 14.20 S Z=FX(1,500) 15.10 F I=0,NN;S Z=FCOM(I,FSQT(FCOM(I)^2+FCOM(I+NN)^2));D 14.1 17.10 A Z 17.20 S Z=FCOM(0,Z) 17.30 D 14.1 17.40 G 17.1