1 program testapp;

     2 {$APPTYPE CONSOLE}

     3 uses

     4   SysUtils,

     5   fftreal in 'fftreal.pas',

     6   Math,

     7   Windows;

     8 

     9 var

    10    nbr_points  : longint;

    11    x, f        : pflt_array;

    12    fft         : TFFTReal;

    13    i           : longint;

    14    PI          : double;

    15    areal, img  : double;

    16    f_abs       : double;

    17    buffer_size : longint;

    18    nbr_tests   : longint;

    19    time0, time1, time2 : int64;

    20    timereso    : int64;

    21    offset      : longint;

    22    t0, t1      : double;

    23    nbr_s_chn   : longint;

    24    tempp1, tempp2 : pflt_array;

    25 

    26 begin

    27   (*______________________________________________

    28    *

    29    * Exactness test

    30    *______________________________________________

    31    *)

    32 

    33   WriteLn('Accuracy test:');

    34   WriteLn;

    35 

    36   nbr_points := 16;       // Power of 2

    37   GetMem(x, nbr_points * sizeof_flt);

    38   GetMem(f, nbr_points * sizeof_flt);

    39   fft := TFFTReal.Create(nbr_points);    // FFT object initialized here

    40 

    41   // Test signal

    42   PI := ArcTan(1) * 4;

    43   for i := 0 to nbr_points-1 do

    44   begin

    45     x^[i] := -1 + sin (3*2*PI*i/nbr_points)

    46                 + cos (5*2*PI*i/nbr_points) * 2

    47                 - sin (7*2*PI*i/nbr_points) * 3

    48                 + cos (8*2*PI*i/nbr_points) * 5;

    49   end;

    50 

    51   // Compute FFT and IFFT

    52   fft.do_fft(f, x);

    53   fft.do_ifft(f, x);

    54   fft.rescale(x);

    55 

    56   // Display the result

    57   WriteLn('FFT:');

    58   for i := 0 to nbr_points div 2 do

    59   begin

    60     areal := f^[i];

    61     if (i > 0) and (i < nbr_points div 2) then

    62       img := f^[i + nbr_points div 2]

    63     else

    64       img := 0;

    65 

    66     f_abs := Sqrt(areal * areal + img * img);

    67     WriteLn(Format('%5d: %12.6f %12.6f (%12.6f)', [i, areal, img, f_abs]));

    68   end;

    69 

    70   WriteLn;

    71   WriteLn('IFFT:');

    72   for i := 0 to nbr_points-1 do

    73     WriteLn(Format('%5d: %f', [i, x^[i]]));

    74 

    75   WriteLn;

    76 

    77   FreeMem(x);

    78   FreeMem(f);

    79   fft.Free;

    80 

    81 

    82   (*______________________________________________

    83    *

    84    * Speed test

    85    *______________________________________________

    86    *)

    87 

    88   WriteLn('Speed test:');

    89   WriteLn('Please wait...');

    90   WriteLn;

    91 

    92   nbr_points := 1024;	          // Power of 2

    93   buffer_size := 256*nbr_points;  // Number of flt_t (float or double)

    94   nbr_tests := 10000;

    95 

    96   assert(nbr_points <= buffer_size);

    97   GetMem(x, buffer_size * sizeof_flt);

    98   GetMem(f, buffer_size * sizeof_flt);

    99   fft := TFFTReal.Create(nbr_points);					// FFT object initialized here

   100 

   101   // Test signal: noise

   102   for i := 0 to nbr_points-1 do

   103     x^[i] := Random($7fff) - ($7fff shr 1);

   104 

   105   // timing

   106   QueryPerformanceFrequency(timereso);

   107   QueryPerformanceCounter(time0);

   108 

   109   for i := 0 to nbr_tests-1 do

   110   begin

   111     offset := (i * nbr_points) and (buffer_size - 1);

   112     tempp1 := f;

   113     inc(tempp1, offset);

   114     tempp2 := x;

   115     inc(tempp2, offset);

   116     fft.do_fft(tempp1, tempp2);

   117   end;

   118 

   119   QueryPerformanceCounter(time1);

   120 

   121   for i := 0 to nbr_tests-1 do

   122   begin

   123     offset := (i * nbr_points) and (buffer_size - 1);

   124     tempp1 := f;

   125     inc(tempp1, offset);

   126     tempp2 := x;

   127     inc(tempp2, offset);

   128     fft.do_ifft(tempp1, tempp2);

   129     fft.rescale(x);

   130   end;

   131 

   132   QueryPerformanceCounter(time2);

   133 

   134   t0 := ((time1-time0) / timereso) / nbr_tests;

   135   t1 := ((time2-time1) / timereso) / nbr_tests;

   136 

   137   WriteLn(Format('%d-points FFT           : %.0f us.', [nbr_points, t0 * 1000000]));

   138   WriteLn(Format('%d-points IFFT + scaling: %.0f us.', [nbr_points, t1 * 1000000]));

   139 

   140   nbr_s_chn := Floor(nbr_points / ((t0 + t1) * 44100 * 2));

   141   WriteLn(Format('Peak performance: FFT+IFFT on %d mono channels at 44.1 KHz (with overlapping)', [nbr_s_chn]));

   142   WriteLn;

   143 

   144   FreeMem(x);

   145   FreeMem(f);

   146   fft.Free;

   147 

   148   WriteLn('Press [Return] key to terminate...');

   149   ReadLn;

   150 end.