(FILECREATED "11-Jul-84 23:58:18" {ERIS}<SPEECH>ROACH>FFT.FPKG;2
 3584   

      changes to:  (FNS FFT FFT.TEST))


(* Copyright (c)  by NIL. All rights reserved.)

(PRETTYCOMPRINT FFTCOMS)

(RPAQQ FFTCOMS
 ((FNS FFT FFT.TEST)
		(P (MOVD 'ELT 'FASTELT)
		   (MOVD 'SETA 'FASTSETA))))
(DEFINEQ

(FFT

  (LAMBDA (AREAL AIMAG)                                      (* kbr: "11-Jul-84 23:58")

                                                             (* Fast Fourier Transform AREAL = real part%, AIMAG = 

							     imaginary part)

    (PROG (AR AI PI I J K M N LE
 LE1 IP NV2 NM1 UR UI WR WI TR TI)
                                                             (* Initialize)

          (SETQ AR AREAL)
          (SETQ AI AIMAG)
          (SETQ PI 3.141593)
          (SETQ N (ARRAYSIZE AR))
          (SETQ NV2 (IQUOTIENT N 2))
          (SETQ NM1 (SUB1 N))                                (* Compute M = log (N))

          (SETQ M 0)
          (SETQ I 1)
      L1  (COND
	    ((ILESSP I N)
	      (SETQ M (ADD1 M))
	      (SETQ I (IPLUS I I))
	      (GO L1)))
          (COND
	    ((NOT (IEQP N (EXPT 2.0 M)))
	      (PRIN1 "Error ... array size not a power of two.")
	      (HELP)
	      (RETURN (TERPRI))))                            (* Interchange elements)

          (SETQ J 1)                                         (* in bit-reversed order)

          (SETQ I 1)
      L3  (COND
	    ((ILESSP I J)
	      (SETQ TR (FASTELT AR J))
	      (SETQ TI (FASTELT AI J))
	      (FASTSETA AR J (FASTELT AR I))
	      (FASTSETA AI J (FASTELT AI I))
	      (FASTSETA AR I TR)
	      (FASTSETA AI I TI)))
          (SETQ K NV2)
      L6  (COND
	    ((ILESSP K J)
	      (SETQ J (IDIFFERENCE J K))
	      (SETQ K (IQUOTIENT K 2))
	      (GO L6)))
          (SETQ J (IPLUS J K))
          (SETQ I (ADD1 I))
          (COND
	    ((ILESSP I N)
	      (GO L3)))
          (FOR
 L FROM
 1 TO
 M
	     DO
                                              (* Loop thru stages)

		(SETQ LE
 (EXPT 2.0 L))
		(SETQ LE1 (IQUOTIENT LE
 2))
		(SETQ UR 1.0)
		(SETQ UI 0.0)
		(SETQ WR (COS (FQUOTIENT PI (FLOAT LE1))))
		(SETQ WI (SIN (FQUOTIENT PI (FLOAT LE1))))
		(FOR
 J FROM
 1 TO
 LE1
		   DO
                                        (* Loop thru butterflies)

		      (FOR
 I FROM
 J BY
 LE
 TO
 N
			 DO
                                  (* Do a butterfly)

			    (SETQ IP (IPLUS I LE1))
			    (SETQ TR (FDIFFERENCE (FTIMES (FASTELT AR IP)
							  UR)
						  (FTIMES (FASTELT AI IP)
							  UI)))
			    (SETQ TI (FPLUS (FTIMES (FASTELT AR IP)
						    UI)
					    (FTIMES (FASTELT AI IP)
						    UR)))
			    (FASTSETA AR IP (FDIFFERENCE (FASTELT AR I)
							 TR))
			    (FASTSETA AI IP (FDIFFERENCE (FASTELT AI I)
							 TI))
			    (FASTSETA AR I (FPLUS (FASTELT AR I)
						  TR))
			    (FASTSETA AI I (FPLUS (FASTELT AI I)
						  TI)))
		      (SETQ TR (FDIFFERENCE (FTIMES UR WR)
					    (FTIMES UI WI)))
		      (SETQ TI (FPLUS (FTIMES UR WI)
				      (FTIMES UI WR)))
		      (SETQ UR TR)
		      (SETQ UI TI)))
          (RETURN T))))

(FFT.TEST

  (LAMBDA (SIZE)                                             (* kbr: "11-Jul-84 23:58")

    (COND
      ((NULL SIZE)
	(SETQ SIZE 1024)))
    (PROG (RE IM)
          (SETQ RE (ARRAY SIZE))
          (SETQ IM (ARRAY SIZE))
          (FOR
 I FROM
 1 TO
 SIZE
	     DO
 (SETA RE I 0.0)
		(SETA IM I 0.0))
          (RETURN (TIMEALL (FFT
 RE IM))))))
)
(MOVD 'ELT 'FASTELT)
(MOVD 'SETA 'FASTSETA)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (290 3518 (FFT 300 . 3136) (FFT.TEST 3138 . 3516)))))
STOP