home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 326.lha / KFFT_v1.1 / ifftcr < prev    next >
Text File  |  1989-12-23  |  2KB  |  67 lines

  1. \ IFFTCR - Inverse Fast Fourier Transform - Complex in, Real out
  2. \
  3. \ KFFT V1.1 (C)Copyright 1989, Jerry Kallaus.  All rights reserved. 
  4. \ May be freely redistributed for non-commercial use (FREEWARE).
  5.  
  6. INCLUDE? fft1 fftinc
  7. ANEW task-ifftcr
  8.  
  9.  
  10. : IFFTCR { a m | n kn km a1r a1i savbits inshift-save --- }
  11.  
  12.    m 1-  2**  -> n
  13.  
  14. [ float_fft? NOT ] .IF  
  15.    inshift-fft @ DUP        -> inshift-save
  16.    IF  a n 2* inshift-fft @
  17.        NEGATE ASHIFT.ARRAY  THEN
  18. inshift-fft OFF
  19. .THEN
  20.  
  21. [ float_fft?  w_table_fft? NOT AND ]
  22. .IF
  23.    pi_fft n FLOAT S/ ZEXP
  24. .ELSE
  25.    m 1-  ZCELLS w-table-fft + Z@
  26. .THEN
  27.    z1
  28.    a ZCELL+           -> kn
  29.    n 1- ZCELLS a +    -> km
  30.  
  31.    n U2/ 1
  32.    DO
  33.      ZOVER Z* ZDUP
  34.      km Z@ CONJG ZDUP
  35.      kn Z@ Z+          -> a1i  -> a1r
  36.      kn Z@ Z-
  37.      ZNEGATE Z*
  38.      ZI* ZDUP
  39.      a1r a1i  Z+
  40.      kn DUP ZCELL+    -> kn
  41.      Z!
  42.      ZNEGATE a1r a1i
  43.      Z+ CONJG km DUP ZCELL-   -> km
  44.      Z!
  45.    LOOP
  46.    ZDROP  ZDROP
  47.    a Z@ S+
  48.    a Z@ S-
  49.    a Z!
  50.    kn Z@ ZDUP Z+ CONJG kn Z!
  51.  
  52. [ auto_scale_fft? ]  .IF
  53.    a n 2*  OR.ABS.ARRAY
  54.    >R                                    ( auto scale-down control:       )
  55.       [ 14 2** ] LITERAL                 ( Shift input to new stage right )
  56.       R@ <   IF 1 ELSE 0 THEN            ( 0,1 or 2 places depending on   )
  57.       [ 15 2** ] LITERAL                 ( highest bit set on output of   )
  58.       R> <   IF 1+       THEN            ( last stage.  if > 2**14 use 1  )
  59.       inshift-fft !                      (              if > 2**15 use 2  )
  60. .THEN
  61.  
  62.    a  m 1-  IFFT
  63.  
  64. [ auto_scale_fft? ]  .IF
  65.    inshift-save DUP  shifts-fft +!  blk-exp-fft +!  .THEN
  66. ;
  67.