////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit provides procedures for performing real and complex fast         //
// Radix-2 and Radix-4 fourier transforms.                                    //
// Derived from:                                                              //
// Turbo Pascal Numerical Methods Toolbox                                     //
// Copyright (c) 1986, 87 by Borland International, Inc.                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20011218 - Creation (uses CRW16), should be tested                         //
// 20230506 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_fft24; // Fast Fourier Transform, 2 and 4 radix.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes,
 _crw_alloc;

type
  TRadix         = (Radix2,Radix4);

const
  FFTMaxNumPoints = MaxInt div sizeof(double);  { Upper limit of NumPoints }


procedure TestInput(NumPoints    : integer;
                out NumberOfBits : integer;
                out Error        : integer;
                    Radix        : TRadix);
 {
 TestInput
 --------------------------------------------------------------------------
 Input: NumPoints
 Output: NumberOfBits, Error

 Purpose:

 Radix=Radix2 case:
 This procedure checks the input.  If the number of points (NumPoints)
 is less than two or is not a multiple of two then an error is returned.
 NumberOfBits is the number of bits necessary to represent NumPoints in
 binary (e.g. if NumPoints = 16, NumberOfBits = 4).

 Radix=Radix4 case:
 This procedure checks the input.  If the number of points (NumPoints)
 is less than four or is not a multiple of four then an error is returned.
 NumberOfTwoBits is the number of twobits (i.e. two bits) necessary to
 represent NumPoints in base 4 (e.g. if NumPoints = 16,NumberOfTwoBits = 3).

 Error:  0: No Errors
         1: NumPoints < 2 for Radix2 or < 4 for Radix4
         2: NumPoints not a power of two (or 4 for radix-4 transforms)
         3: Radix value not in [Radix2,Radix4]
 --------------------------------------------------------------------------
 }

procedure MakeSinCosTable(NumPoints : integer;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);

 {
 MakeSinCosTable
 --------------------------------------------------------------------------
 Input: NumPoints
 Output: SinTable, CosTable

 Purpose:

 This procedure fills in a table with sin and cosine values.
 It is faster to pull data out of this table than it is to
 calculate the sines and cosines.
 --------------------------------------------------------------------------
 }

procedure FFT(NumberOfBits : integer;
              NumPoints    : integer;
              Inverse      : boolean;
          var XReal        : array of double;
          var XImag        : array of double;
          var SinTable     : array of double;
          var CosTable     : array of double;
              Radix        : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable
 Output: XReal, XImag

 Purpose:

 Radix=Radix2 case:
 This procedure implements the actual fast Fourier transform routine.
 The vector X, which must be entered in bit-inverted order, is transformed
 in place.  The transformation uses the Cooley-Tukey algorithm.

 Radix=Radix4 case:
 This procedure implements the actual fast fourier transform routine.
 The vector X, which must be entered in twobit-inverted order, is transformed
 in place.  The transformation uses the Cooley-Tukey algorithm.

 Warning!
 Necassary  to call TestInput and MakeSinCosTable before FFT use!
 Next procedures such as:
  RealFFT,ComplexFFT,RealConvolution,ComplexConvolution,....
 makes this automatically.
 --------------------------------------------------------------------------
 }

procedure RealFFT(NumPoints : integer;
                  Inverse   : boolean;
              var XReal     : array of double;
              var XImag     : array of double;
              var Error     : integer;
              var DummyReal : array of double;
              var DummyImag : array of double;
              var SinTable  : array of double;
              var CosTable  : array of double;
                  Radix     : TRadix);
 {
 --------------------------------------------------------------------------
 Input: NumPoints, Inverse, XReal, XImag
 Output: XReal, XImag, Error

 Purpose:

 This procedure uses the complex Fourier transform routine (FFT)
 to transform real data.  The real data is in the vector XReal.
 Appropriate shuffling of indices changes the real vector into two vectors
 (representing complex data) which are only half the size of the original
 vector.  Appropriate unshuffling at the end produces the transform of the
 real data.

 Variables:

 NumPoints           : Number of data points in X
 Inverse             : False => forward transform True ==> inverse transform
 XReal,XImag         : Data points arrays
 Error               : Indicates an error (see TestInput)
 DummyReal,DummyImag : Internally use arrays
 SinTable,CosTable   : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

procedure RealConvolution(NumPoints : integer;
                      var XReal     : array of double;
                      var XImag     : array of double;
                      var HReal     : array of double;
                      var Error     : integer;
                      var HImag     : array of double;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumPoints, XReal, XImag, HReal
 Output: XReal, XImag, Error

 Purpose:

 This procedure performs a convolution of the real data XReal and HReal.
 The result is returned in the complex vector XReal, XImag.

 Variables:

 NumPoints               : Number of data points in X
 XReal,HReal             : Data points arrays
 Error                   : Indicates an error (see TestInput)
 SinTable,CosTable,HImag : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

procedure RealCorrelation(NumPoints : integer;
                      var Auto      : boolean;
                      var XReal     : array of double;
                      var XImag     : array of double;
                      var HReal     : array of double;
                      var Error     : integer;
                      var HImag     : array of double;
                      var DummyReal : array of double;
                      var DummyImag : array of double;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumPoints, Auto, XReal, XImag, HReal
 Output: XReal, XImag, Error

 Purpose:

 This procedure performs a correlation (auto or cross) of the real data
 XReal and HReal.
 The correlation is returned in the complex vector XReal, XImag.

 Variables:

 NumPoints               : Number of data points in X
 Auto                    : True => auto-correlation False=> cross-correlation
 XReal                   : First sample array
 HReal                   : Second sample array
 Error                   : Indicates an error (see TestInput)
 SinTable,CosTable,HImag : Internally use arrays
 DummyReal,DummyImag     : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

procedure ComplexFFT(NumPoints : integer;
                     Inverse   : boolean;
                 var XReal     : array of double;
                 var XImag     : array of double;
                 var Error     : integer;
                 var SinTable  : array of double;
                 var CosTable  : array of double;
                     Radix     : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumPoints, Inverse, XReal, XImag
 Output: XReal, XImag, Error

 Purpose:

 This procedure performs a fast Fourier transform of the complex data
 XReal, XImag.
 The vectors XReal and XImag are transformed in place.

 Variables:

 NumPoints         : Number of data points in X
 Inverse           : FALSE => Forward Transform
                     TRUE => Inverse  Transform
 XReal,XImag       : Data points array
 Error             : Indicates an error (see TestInput)
 SinTable,CosTable : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

procedure ComplexConvolution(NumPoints : integer;
                         var XReal     : array of double;
                         var XImag     : array of double;
                         var HReal     : array of double;
                         var HImag     : array of double;
                         var Error     : integer;
                         var SinTable  : array of double;
                         var CosTable  : array of double;
                             Radix     : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumPoints, XReal, XImag, HReal, HImag
 Output: XReal, XImag, Error

 Purpose:

 This procedure performs a convolution of the data XReal, XImag and
 the data HReal and HImag.
 The vectors XReal, XImag, HReal and HImag are transformed in place.

 Variables:

 NumPoints         : Number of data points in X
 XReal,XImag       : Data points arrays
 HReal,HImag       : Data points arrays
 Error             : Indicates an error (see TestInput)
 SinTable,CosTable : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

procedure ComplexCorrelation(NumPoints : integer;
                         var Auto      : boolean;
                         var XReal     : array of double;
                         var XImag     : array of double;
                         var HReal     : array of double;
                         var HImag     : array of double;
                         var Error     : integer;
                         var DummyReal : array of double;
                         var DummyImag : array of double;
                         var SinTable  : array of double;
                         var CosTable  : array of double;
                             Radix     : TRadix);

 {
 --------------------------------------------------------------------------
 Input: NumPoints, Auto, XReal, XImag, HReal, HImag
 Output: XReal, XImag, Error

 Purpose:

 This procedure performs a correlation (auto or cross) of the complex data
 XReal, XImag and the complex data HReal, HImag.
 The vectors XReal, XImag, HReal, and HImag are transformed in place.

 Variables:

 NumPoints           : Number of data points in X
 Auto                : True => auto-correlation  False=> cross-correlation
 XReal,XImag         : First sample arrays
 HReal,HImag         : Second sample arrays
 Error               : Indicates an error (see TestInput)
 DummyReal,DummyImag : Internally use arrays
 SinTable,CosTable   : Internally use arrays

 ! All arrays must be at least NumPoints of double size !
 --------------------------------------------------------------------------
 }

implementation

procedure TestIfPowerOfBase(NumPoints    : integer;
                        out NumberOfBits : integer;
                        out Error        : integer;
                            Base         : integer
                            );
var
 PowerOfBase : integer;
begin
  NumberOfBits := 0;
  if NumPoints < Base then begin
   Error := 1;    { NumPoints is too small }
   exit;
  end;
  NumberOfBits := 1;
  PowerOfBase  := Base;
  while PowerOfBase <= FFTMaxNumPoints do begin
    if NumPoints = PowerOfBase then begin
      Error := 0;  { NumPoints is a power of Base}
      exit;
    end;
    inc(NumberOfBits);
    PowerOfBase := PowerOfBase * Base;
    if PowerOfBase > NumPoints then break;
  end;
  Error := 2;      { NumPoints not a power of Base or too large }
end; { procedure TestIfPowerOfBase }

procedure TestInput(NumPoints    : integer;
                out NumberOfBits : integer;
                out Error        : integer;
                    Radix        : TRadix);
begin
 NumberOfBits:=0;
 case Radix of
  Radix2 : TestIfPowerOfBase(NumPoints,NumberOfBits,Error,2);
  Radix4 : TestIfPowerOfBase(NumPoints,NumberOfBits,Error,4);
  else Error:=3;
 end;
end;

procedure MakeSinCosTable2(NumPoints : integer;
                       var SinTable  : array of double;
                       var CosTable  : array of double
                           );
var
  RealFactor, ImagFactor : double;
  Term, TermMinus1, UpperLimit : integer;
begin
  RealFactor :=  Cos(2 * Pi / NumPoints);
  ImagFactor := -Sqrt(1 - Sqr(RealFactor));
  CosTable[0] := 1;
  SinTable[0] := 0;
  CosTable[1] := RealFactor;
  SinTable[1] := ImagFactor;
  UpperLimit := NumPoints shr 1 - 1;
  for Term := 2 to UpperLimit do begin
    TermMinus1 := Term - 1;
    CosTable[Term] :=  CosTable[TermMinus1] * RealFactor -
                        SinTable[TermMinus1] * ImagFactor;
    SinTable[Term] :=  CosTable[TermMinus1] * ImagFactor +
                        SinTable[TermMinus1] * RealFactor;
  end;
end; { procedure MakeSinCosTable2 }

procedure MakeSinCosTable4(NumPoints : integer;
                       var SinTable  : array of double;
                       var CosTable  : array of double
                       );
var
  RealFactor, ImagFactor : double;
  Term, TermMinus1, UpperLimit : integer;
begin
  RealFactor :=  Cos(Pi / (NumPoints SHR 1));
  ImagFactor := -Sqrt(1 - Sqr(RealFactor));
  CosTable[0] := 1;
  SinTable[0] := 0;
  CosTable[1] := RealFactor;
  SinTable[1] := ImagFactor;
  UpperLimit := 3 * NumPoints SHR 2 - 1;
  for Term := 2 to UpperLimit do begin
    TermMinus1 := Term - 1;
    CosTable[Term] := CosTable[TermMinus1] * RealFactor -
                       SinTable[TermMinus1] * ImagFactor;
    SinTable[Term] := CosTable[TermMinus1] * ImagFactor +
                       SinTable[TermMinus1] * RealFactor;
  end;
end; { procedure MakeSinCosTable4 }

procedure MakeSinCosTable(NumPoints : integer;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);
begin
 case Radix of
  Radix2 : MakeSinCosTable2(NumPoints,SinTable,CosTable);
  Radix4 : MakeSinCosTable4(NumPoints,SinTable,CosTable)
 end;
end;

procedure FFT2(NumberOfBits : integer;
               NumPoints    : integer;
               Inverse      : boolean;
           var XReal        : array of double;
           var XImag        : array of double;
           var SinTable     : array of double;
           var CosTable     : array of double
               );
const
  RootTwoOverTwo = 0.707106781186548;
var
  Term, CellSeparation, NumberOfCells, NumElementsInCell, NumElInCellLess1,
  NumElInCellSHR1, NumElInCellSHR2, Element, CellElements,ElementInNextCell,
  Index : integer;
  RealRootOfUnity, ImagRootOfUnity, RealDummy, ImagDummy : double;
 {
 BitInvert
 ----------------------------------------------------------
 Input: NumberOfBits, NumPoints
 Output: XReal, XImag

 This procedure bit inverts the order of data in the
 vector X.  Bit inversion reverses the order of the
 binary representation of the indices; thus 2 indices
 will be switched.  For example, if there are 16 points,
 Index 7 (binary 0111) would be switched with Index 14
 (binary 1110).  It is necessary to bit invert the order
 of the data so that the transformation comes out in the
 correct order.
 ----------------------------------------------------------
 }
 procedure BitInvert(NumberOfBits : integer;
                     NumPoints    : integer;
                 var XReal        : array of double;
                 var XImag        : array of double);
 var
   Term, Invert, NumPointsDiv2, K : integer;
   Hold : double;
 begin
   NumPointsDiv2 := NumPoints shr 1;
   Invert := 0;
   for Term := 0 to NumPoints - 2 do begin
     if Term < Invert then begin { Switch these two indices  }
       Hold := XReal[Invert];
       XReal[Invert] := XReal[Term];
       XReal[Term] := Hold;
       Hold := XImag[Invert];
       XImag[Invert] := XImag[Term];
       XImag[Term] := Hold;
     end;
     K := NumPointsDiv2;
     while K <= Invert do begin
       Invert := Invert - K;
       K := K shr 1;
     end;
     Invert := Invert + K;
   end;
 end; { procedure BitInvert }
begin { procedure FFT }
  {
  The data must be entered in bit inverted order for the transform
  to come out in proper order
  }
  BitInvert(NumberOfBits, NumPoints, XReal, XImag);
  {
  Conjugate the input ?
  }
  if Inverse then
  for Element := 0 to NumPoints - 1 do XImag[Element] := -XImag[Element];

  NumberOfCells := NumPoints;
  CellSeparation := 1;
  for Term := 1 to NumberOfBits do begin
    { NumberOfCells halves; equals 2^(NumberOfBits - Term)  }
    NumberOfCells := NumberOfCells shr 1;
    { NumElementsInCell doubles; equals 2^(Term-1)  }
    NumElementsInCell := CellSeparation;
    { CellSeparation doubles; equals 2^Term  }
    CellSeparation := CellSeparation SHL 1;
    NumElInCellLess1 := NumElementsInCell - 1;
    NumElInCellSHR1 := NumElementsInCell shr 1;
    NumElInCellSHR2 := NumElInCellSHR1 shr 1;

    { Special case: RootOfUnity = EXP(-i 0)  }
    Element := 0;
    while Element < NumPoints do begin
      { Combine the X[Element] with the element in the identical
      location in the next cell }
      ElementInNextCell := Element + NumElementsInCell;
      RealDummy := XReal[ElementInNextCell];
      ImagDummy := XImag[ElementInNextCell];
      XReal[ElementInNextCell] := XReal[Element] - RealDummy;
      XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
      XReal[Element] := XReal[Element] + RealDummy;
      XImag[Element] := XImag[Element] + ImagDummy;
      Element := Element + CellSeparation;
    end;

    for CellElements := 1 to NumElInCellSHR2 - 1 do begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity := CosTable[Index];
      ImagRootOfUnity := SinTable[Index];
      Element := CellElements;

      while Element < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := XReal[ElementInNextCell] * RealRootOfUnity -
                     XImag[ElementInNextCell] * ImagRootOfUnity;
        ImagDummy := XReal[ElementInNextCell] * ImagRootOfUnity +
                     XImag[ElementInNextCell] * RealRootOfUnity;
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    { Special case: RootOfUnity = EXP(-i PI/4)  }
    if Term > 2 then begin
      Element := NumElInCellSHR2;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := RootTwoOverTwo * (XReal[ElementInNextCell] +
                     XImag[ElementInNextCell]);
        ImagDummy := RootTwoOverTwo * (XImag[ElementInNextCell] -
                     XReal[ElementInNextCell]);
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    for CellElements := NumElInCellSHR2 + 1 to NumElInCellSHR1 - 1 do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity := CosTable[Index];
      ImagRootOfUnity := SinTable[Index];
      Element := CellElements;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := XReal[ElementInNextCell] * RealRootOfUnity -
                     XImag[ElementInNextCell] * ImagRootOfUnity;
        ImagDummy := XReal[ElementInNextCell] * ImagRootOfUnity +
                     XImag[ElementInNextCell] * RealRootOfUnity;
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    { Special case: RootOfUnity = EXP(-i PI/2)  }
    if Term > 1 then begin
      Element := NumElInCellSHR1;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy :=  XImag[ElementInNextCell];
        ImagDummy := -XReal[ElementInNextCell];
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    for CellElements := NumElInCellSHR1 + 1 to
                        NumElementsInCell - NumElInCellSHR2 - 1 do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity := CosTable[Index];
      ImagRootOfUnity := SinTable[Index];
      Element := CellElements;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := XReal[ElementInNextCell] * RealRootOfUnity -
                     XImag[ElementInNextCell] * ImagRootOfUnity;
        ImagDummy := XReal[ElementInNextCell] * ImagRootOfUnity +
                     XImag[ElementInNextCell] * RealRootOfUnity;
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    { Special case: RootOfUnity = EXP(-i 3PI/4)  }
    if Term > 2 then begin
      Element := NumElementsInCell - NumElInCellSHR2;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := -RootTwoOverTwo * (XReal[ElementInNextCell] -
                                        XImag[ElementInNextCell]);
        ImagDummy := -RootTwoOverTwo * (XReal[ElementInNextCell] +
                                        XImag[ElementInNextCell]);
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;

    for CellElements := NumElementsInCell - NumElInCellSHR2 + 1 to
                                            NumElInCellLess1 do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity := CosTable[Index];
      ImagRootOfUnity := SinTable[Index];
      Element := CellElements;
      while Element < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        ElementInNextCell := Element + NumElementsInCell;
        RealDummy := XReal[ElementInNextCell] * RealRootOfUnity -
                     XImag[ElementInNextCell] * ImagRootOfUnity;
        ImagDummy := XReal[ElementInNextCell] * ImagRootOfUnity +
                     XImag[ElementInNextCell] * RealRootOfUnity;
        XReal[ElementInNextCell] := XReal[Element] - RealDummy;
        XImag[ElementInNextCell] := XImag[Element] - ImagDummy;
        XReal[Element] := XReal[Element] + RealDummy;
        XImag[Element] := XImag[Element] + ImagDummy;
        Element := Element + CellSeparation;
      end;
    end;
  end;

  {
  ---------------------------------------------------
    Divide all the values of the transformation
    by the square root of NumPoints. If taking the
    inverse, conjugate the output.
  ---------------------------------------------------
  }

  if Inverse then ImagDummy := -1/Sqrt(NumPoints)
             else ImagDummy :=  1/Sqrt(NumPoints);
  RealDummy := ABS(ImagDummy);
  for Element := 0 to NumPoints - 1 do begin
    XReal[Element] := XReal[Element] * RealDummy;
    XImag[Element] := XImag[Element] * ImagDummy;
  end;
end; { procedure FFT2 }


procedure FFT4(NumberOfTwoBits : integer;
               NumPoints       : integer;
               Inverse         : boolean;
           var XReal           : array of double;
           var XImag           : array of double;
           var SinTable        : array of double;
           var CosTable        : array of double
           );
const
  RootTwoOverTwo = 0.707106781186548;
var
  Term, CellSeparation, NumberOfCells, NumElementsInCell, NumElInCellLess1,
  NumElInCellDIV2, NumElInCellDIV4, CellElements, Index, Element0,
  Element1, Element2, Element3 : integer;
  RealRootOfUnity1, ImagRootOfUnity1, RealRootOfUnity2, ImagRootOfUnity2,
  RealRootOfUnity3, ImagRootOfUnity3, RealDummy0, ImagDummy0,
  RealDummy1, ImagDummy1, RealDummy2, ImagDummy2, RealDummy3, ImagDummy3,
  RealSum02, ImagSum02, RealDif02, ImagDif02, RealSum13, ImagSum13,
  RealDifi13, ImagDifi13 : double;
 {
 BitInvert
 ----------------------------------------------------------
 Input: NumberOfBits, NumPoints
 Output: XReal, XImag

 This procedure twobit inverts the order of data in the
 vector X.  Twobit inversion reverses the order of the
 base 4 representation of the indices; thus 2 indices
 will be switched.  For example, if there are 16 points,
 Index 11 (23 base 4) would be switched with Index 14
 (32 base 4).  It is necessary to twobit invert the
 order of the data so that the transformation comes out
 in the correct order.
 ---------------------------------------------------------
 }
 procedure BitInvert(NumberOfTwoBits : integer;
                     NumPoints       : integer;
                 var XReal           : array of double;
                 var XImag           : array of double);
 var
   DummyTerm, TwoBits, Term, Invert : integer;
   Hold : double;
 begin
   for Term := 1 to NumPoints - 1 do begin
     Invert := 0;
     DummyTerm := Term;
     for TwoBits := 1 to NumberOfTwoBits do begin
       Invert := Invert SHL 2 + DummyTerm MOD 4;
       DummyTerm := DummyTerm SHR 2;
     end;
     if Invert > Term then begin { Switch the two indices  }
       Hold := XReal[Invert];
       XReal[Invert] := XReal[Term];
       XReal[Term] := Hold;
       Hold := XImag[Invert];
       XImag[Invert] := XImag[Term];
       XImag[Term] := Hold;
     end;
   end;
 end; { procedure BitInvert }
begin { procedure FFT }
  {
  The data must be entered in bit inverted order for the transform
  to come out in proper order
  }
  BitInvert(NumberOfTwoBits, NumPoints, XReal, XImag);
  {
  Conjugate the input ?
  }
  if Inverse then
  for Index := 0 to NumPoints - 1 do XImag[Index] := -XImag[Index];

  NumberOfCells := NumPoints;
  CellSeparation := 1;
  for Term := 1 to NumberOfTwoBits do begin
    NumberOfCells := NumberOfCells SHR 2;
    NumElementsInCell := CellSeparation;
    CellSeparation := CellSeparation SHL 2;
    NumElInCellLess1 := NumElementsInCell - 1;
    NumElInCellDIV2 := NumElementsInCell SHR 1;
    NumElInCellDIV4 := NumElInCellDIV2 SHR 1;

    { Special case: RootOfUnity1 = EXP(-i 0)  }
    Element0 := 0;
    while Element0 < NumPoints do begin
      { Combine the X[Element] with the element in  the identical
      location in the next cell }
      Element1 := Element0 + NumElementsInCell;
      Element2 := Element1 + NumElementsInCell;
      Element3 := Element2 + NumElementsInCell;

      RealDummy0 := XReal[Element0];
      ImagDummy0 := XImag[Element0];
      RealDummy1 := XReal[Element1];
      ImagDummy1 := XImag[Element1];
      RealDummy2 := XReal[Element2];
      ImagDummy2 := XImag[Element2];
      RealDummy3 := XReal[Element3];
      ImagDummy3 := XImag[Element3];

      RealSum02 := RealDummy0 + RealDummy2;
      ImagSum02 := ImagDummy0 + ImagDummy2;
      RealSum13 := RealDummy1 + RealDummy3;
      ImagSum13 := ImagDummy1 + ImagDummy3;
      RealDif02 := RealDummy0 - RealDummy2;
      ImagDif02 := ImagDummy0 - ImagDummy2;
      RealDifi13 := ImagDummy3 - ImagDummy1;
      ImagDifi13 := RealDummy1 - RealDummy3;

      XReal[Element0] := RealSum02 + RealSum13;
      XImag[Element0] := ImagSum02 + ImagSum13;
      XReal[Element1] := RealDif02 - RealDifi13;
      XImag[Element1] := ImagDif02 - ImagDifi13;
      XReal[Element2] := RealSum02 - RealSum13;
      XImag[Element2] := ImagSum02 - ImagSum13;
      XReal[Element3] := RealDif02 + RealDifi13;
      XImag[Element3] := ImagDif02 + ImagDifi13;

      Element0 := Element0 + CellSeparation;
    end; { while }

    for CellElements := 1 to  NumElInCellDIV4 - 1 do begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity2 := CosTable[2*Index];
      ImagRootOfUnity2 := SinTable[2*Index];
      RealRootOfUnity3 := CosTable[3*Index];
      ImagRootOfUnity3 := SinTable[3*Index];
      Element0 := CellElements;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := XReal[Element2] * RealRootOfUnity2 -
                      XImag[Element2] * ImagRootOfUnity2;
        ImagDummy2 := XReal[Element2] * ImagRootOfUnity2 +
                      XImag[Element2] * RealRootOfUnity2;
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end; { for }

    { special case: RootOfUnity = EXP(-i PI/8)  }
    if Term > 1 then begin
      Index := NumElInCellDIV4 * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity3 := -ImagRootOfUnity1;
      ImagRootOfUnity3 := -RealRootOfUnity1;

      Element0 := NumElInCellDIV4;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := RootTwoOverTwo * (XReal[Element2] + XImag[Element2]);
        ImagDummy2 := RootTwoOverTwo * (XImag[Element2] - XReal[Element2]);
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end;

    for CellElements := NumElInCellDIV4 + 1 to NumElInCellDIV2 - 1 do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity2 := CosTable[2*Index];
      ImagRootOfUnity2 := SinTable[2*Index];
      RealRootOfUnity3 := CosTable[3*Index];
      ImagRootOfUnity3 := SinTable[3*Index];
      Element0 := CellElements;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := XReal[Element2] * RealRootOfUnity2 -
                      XImag[Element2] * ImagRootOfUnity2;
        ImagDummy2 := XReal[Element2] * ImagRootOfUnity2 +
                      XImag[Element2] * RealRootOfUnity2;
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end; { for }

    { Special case: RootOfUnity1 := EXP(-i PI/4)  }
    if Term > 1 then begin
      Element0 := NumElInCellDIV2;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in  }
        { the identical location in the next cell     }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := RootTwoOverTwo * (XReal[Element1] + XImag[Element1]);
        ImagDummy1 := RootTwoOverTwo * (XImag[Element1] - XReal[Element1]);
        RealDummy2 :=  XImag[Element2];
        ImagDummy2 := -XReal[Element2];
        RealDummy3 := -RootTwoOverTwo * (XReal[Element3] - XImag[Element3]);
        ImagDummy3 := -RootTwoOverTwo * (XReal[Element3] + XImag[Element3]);

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end;

    for CellElements := NumElInCellDIV2 + 1 to
        (NumElementsInCell - NumElInCellDIV4 - 1) do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity2 := CosTable[2*Index];
      ImagRootOfUnity2 := SinTable[2*Index];
      RealRootOfUnity3 := CosTable[3*Index];
      ImagRootOfUnity3 := SinTable[3*Index];
      Element0 := CellElements;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := XReal[Element2] * RealRootOfUnity2 -
                      XImag[Element2] * ImagRootOfUnity2;
        ImagDummy2 := XReal[Element2] * ImagRootOfUnity2 +
                      XImag[Element2] * RealRootOfUnity2;
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end; { for }

    { Special case: RootOfUnity = EXP(-i 3*PI/8)  }
    if Term > 1 then begin
      Element0 := NumElementsInCell - NumElInCellDIV4;
      Index := Element0 * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity3 := ImagRootOfUnity1;
      ImagRootOfUnity3 := RealRootOfUnity1;

      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := -RootTwoOverTwo * (XReal[Element2] - XImag[Element2]);
        ImagDummy2 := -RootTwoOverTwo * (XReal[Element2] + XImag[Element2]);
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end;

    for CellElements := (NumElementsInCell - NumElInCellDIV4 + 1) to
                                                 NumElInCellLess1 do
    begin
      Index := CellElements * NumberOfCells;
      RealRootOfUnity1 := CosTable[Index];
      ImagRootOfUnity1 := SinTable[Index];
      RealRootOfUnity2 := CosTable[2*Index];
      ImagRootOfUnity2 := SinTable[2*Index];
      RealRootOfUnity3 := CosTable[3*Index];
      ImagRootOfUnity3 := SinTable[3*Index];
      Element0 := CellElements;
      while Element0 < NumPoints do begin
        { Combine the X[Element] with the element in the identical
        location in the next cell }
        Element1 := Element0 + NumElementsInCell;
        Element2 := Element1 + NumElementsInCell;
        Element3 := Element2 + NumElementsInCell;

        RealDummy0 := XReal[Element0];
        ImagDummy0 := XImag[Element0];
        RealDummy1 := XReal[Element1] * RealRootOfUnity1 -
                      XImag[Element1] * ImagRootOfUnity1;
        ImagDummy1 := XReal[Element1] * ImagRootOfUnity1 +
                      XImag[Element1] * RealRootOfUnity1;
        RealDummy2 := XReal[Element2] * RealRootOfUnity2 -
                      XImag[Element2] * ImagRootOfUnity2;
        ImagDummy2 := XReal[Element2] * ImagRootOfUnity2 +
                      XImag[Element2] * RealRootOfUnity2;
        RealDummy3 := XReal[Element3] * RealRootOfUnity3 -
                      XImag[Element3] * ImagRootOfUnity3;
        ImagDummy3 := XReal[Element3] * ImagRootOfUnity3 +
                      XImag[Element3] * RealRootOfUnity3;

        RealSum02 := RealDummy0 + RealDummy2;
        ImagSum02 := ImagDummy0 + ImagDummy2;
        RealSum13 := RealDummy1 + RealDummy3;
        ImagSum13 := ImagDummy1 + ImagDummy3;
        RealDif02 := RealDummy0 - RealDummy2;
        ImagDif02 := ImagDummy0 - ImagDummy2;
        RealDifi13 := ImagDummy3 - ImagDummy1;
        ImagDifi13 := RealDummy1 - RealDummy3;

        XReal[Element0] := RealSum02 + RealSum13;
        XImag[Element0] := ImagSum02 + ImagSum13;
        XReal[Element1] := RealDif02 - RealDifi13;
        XImag[Element1] := ImagDif02 - ImagDifi13;
        XReal[Element2] := RealSum02 - RealSum13;
        XImag[Element2] := ImagSum02 - ImagSum13;
        XReal[Element3] := RealDif02 + RealDifi13;
        XImag[Element3] := ImagDif02 + ImagDifi13;

        Element0 := Element0 + CellSeparation;
      end; { while }
    end; { for }
  end; { for }

  {
  ---------------------------------------------------
    Divide all the values of the transformation
    by the square root of NumPoints. If taking the
    inverse, conjugate the output.
  ---------------------------------------------------
  }

  if Inverse then ImagDummy1 := -1 / Sqrt(NumPoints)
             else ImagDummy1 :=  1 / Sqrt(NumPoints);
  RealDummy1 := ABS(ImagDummy1);
  for Element0 := 0 to NumPoints - 1 do begin
    XReal[Element0] := XReal[Element0] * RealDummy1;
    XImag[Element0] := XImag[Element0] * ImagDummy1;
  end;
end; { procedure FFT4 }

procedure FFT(NumberOfBits : integer;
              NumPoints    : integer;
              Inverse      : boolean;
          var XReal        : array of double;
          var XImag        : array of double;
          var SinTable     : array of double;
          var CosTable     : array of double;
              Radix        : TRadix);
begin
 case Radix of
  Radix2 : FFT2(NumberOfBits,NumPoints,Inverse,XReal,XImag,SinTable,CosTable);
  Radix4 : FFT4(NumberOfBits,NumPoints,Inverse,XReal,XImag,SinTable,CosTable);
 end;
end;

 {
 internally use procedures for array copy and fill
 }

procedure CopyArray(var Dest,Source:array of double; NumPoints:integer);
var
 Index:integer;
begin
 for Index:=0 to NumPoints-1 do Dest[Index]:=Source[Index];
end;

procedure FillArray(var Dest:array of double; NumPoints:integer; Filler:double);
var
 Index:integer;
begin
 for Index:=0 to NumPoints-1 do Dest[Index]:=Filler;
end;

 {
 ---------------------------------------------------------------------------

     Turbo Pascal Numerical Methods Toolbox
     Copyright (c) 1986, 87 by Borland International, Inc.

     Modified by Kuryakin A.V. 1997

 ---------------------------------------------------------------------------
 }

procedure RealFFT(NumPoints : integer;
                  Inverse   : boolean;
              var XReal     : array of double;
              var XImag     : array of double;
              var Error     : integer;
              var DummyReal : array of double;
              var DummyImag : array of double;
              var SinTable  : array of double;
              var CosTable  : array of double;
                  Radix     : TRadix);
var
  NumberOfBits : integer; { Number of bits necessary to represent NumPoints  }
 {
 MakeRealDataComplex
 --------------------------------------------------------
 Input: NumPoints, XReal
 Output: XReal, XImag
 This procedure shuffles the real data.  There are
 2*NumPoints real data points in the vector XReal.  The
 data is shuffled so that there are NumPoints complex
 data points.  The real part of the complex data is
 made up of those points whose original array Index was
 even; the imaginary part of the complex data is made
 up of those points whose original array Index was odd.
 --------------------------------------------------------
 }
 procedure MakeRealDataComplex(NumPoints : integer;
                          var XReal     : array of double;
                          var XImag     : array of double;
                          var DummyReal : array of double;
                          var DummyImag : array of double
                              );
 var
   Index, NewIndex : integer;
 begin
   for Index := 0 to NumPoints - 1 do begin
     NewIndex := Index shl 1;
     DummyReal[Index] := XReal[NewIndex];
     DummyImag[Index] := XReal[NewIndex + 1];
   end;
   CopyArray(XReal,DummyReal,NumPoints);
   CopyArray(XImag,DummyImag,NumPoints);
 end; { procedure MakeRealDataComplex }
 {
 UnscrambleComplexOutput
 ---------------------------------------------------------
 Input: NumPoints, SinTable, CosTable, XReal, XImag
 Output: XReal, XImag

 This procedure unshuffles the complex transform.
 The transform has NumPoints elements.  This procedure
 unshuffles the transform so that it is 2*NumPoints
 elements long.  The resulting vector is symmetric
 about the element NumPoints.
 Both the forward and inverse transforms are defined
 with a 1/Sqrt(NumPoints) factor.  Since the real FFT
 algorithm operates on vectors of length NumPoints/2,
 the unscrambled vectors must be divided by Sqrt(2).
 ---------------------------------------------------------
 }
 procedure UnscrambleComplexOutput(NumPoints : integer;
                               var SinTable  : array of double;
                               var CosTable  : array of double;
                               var XReal     : array of double;
                               var XImag     : array of double;
                               var RealDummy : array of double;
                               var ImagDummy : array of double);
 var
   Index, indexSHR1, NumPointsMinusIndex, SymmetricIndex,
   NumPointsSHL1 : integer;
   Multiplier, Factor,CosFactor, SinFactor, RealSum, ImagSum, RealDif,
   ImagDif, PiOverNumPoints : double;
 begin
   NumPointsSHL1 := NumPoints shl 1;
   CopyArray(RealDummy,XReal,NumPoints);
   CopyArray(ImagDummy,XImag,NumPoints);
   PiOverNumPoints := Pi / NumPoints;
   RealDummy[0] := (XReal[0] + XImag[0]) / Sqrt(2);
   ImagDummy[0] := 0;
   RealDummy[NumPoints] := (XReal[0] - XImag[0]) / Sqrt(2);
   ImagDummy[NumPoints] := 0;
   for Index := 1 to NumPoints - 1 do begin
     Multiplier := 0.5 / Sqrt(2);
     Factor := PiOverNumPoints * Index;
     NumPointsMinusIndex := NumPoints - Index;
     SymmetricIndex := NumPointsSHL1 - Index;
     if Odd(Index) then begin
         CosFactor :=  Cos(Factor);
         SinFactor := -Sin(Factor);
     end else begin
         indexSHR1 := Index shr 1;
         CosFactor := CosTable[indexSHR1];
         SinFactor := SinTable[indexSHR1];
     end;
     RealSum := XReal[Index] + XReal[NumPointsMinusIndex];
     ImagSum := XImag[Index] + XImag[NumPointsMinusIndex];
     RealDif := XReal[Index] - XReal[NumPointsMinusIndex];
     ImagDif := XImag[Index] - XImag[NumPointsMinusIndex];
     RealDummy[Index] := Multiplier * (RealSum + CosFactor * ImagSum
                          + SinFactor * RealDif);
     ImagDummy[Index] := Multiplier * (ImagDif + SinFactor * ImagSum
                          - CosFactor * RealDif);
     RealDummy[SymmetricIndex] :=  RealDummy[Index];
     ImagDummy[SymmetricIndex] := -ImagDummy[Index];
   end;  { for }
   CopyArray(XReal,RealDummy,NumPointsSHL1);
   CopyArray(XImag,ImagDummy,NumPointsSHL1);
 end; { procedure UnscrambleComplexOutput }
begin { procedure RealFFT }
  {
  The number of complex data points will be
  half the number of real data points
  }
  NumPoints := NumPoints shr 1;
  {
  is NumPoints power of two?
  }
  TestInput(NumPoints, NumberOfBits, Error, Radix);
  {
  Ok.
  }
  if Error = 0 then begin
    MakeRealDataComplex(NumPoints, XReal, XImag, DummyReal, DummyImag);
    MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
    UnscrambleComplexOutput(NumPoints, SinTable, CosTable, XReal, XImag, DummyReal, DummyImag);
    {
    The number of complex points in the transform will be the same as
    the number of real points in input data.
    }
    {NumPoints := NumPoints shl 1;?}
  end;
end; { procedure RealFFT }

procedure RealConvolution(NumPoints : integer;
                      var XReal     : array of double;
                      var XImag     : array of double;
                      var HReal     : array of double;
                      var Error     : integer;
                      var HImag     : array of double;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);
var
  Inverse : boolean;   { Indicates inverse transform }
  NumberOfBits : integer; { Number of bits required to represent NumPoints }
 {
 Multiply
 ---------------------------------------------
 Input: NumPoints, XReal, XImag, HReal, HImag
 Output: XReal, XImag

 This procedure multiplies each element in
 X by the corresponding elementin H.
 The product is returned in X.
 ---------------------------------------------
 }
 procedure Multiply(NumPoints : integer;
                var XReal     : array of double;
                var XImag     : array of double;
                var HReal     : array of double;
                var HImag     : array of double);
 var
   Term : integer;
   Dummy : double;
 begin
   for Term := 0 to NumPoints - 1 do begin
     Dummy := XReal[Term] * HReal[Term] - XImag[Term] * HImag[Term];
     XImag[Term] := XReal[Term] * HImag[Term] + XImag[Term] * HReal[Term];
     XReal[Term] := Dummy;
   end;
 end; { procedure Multiply }
 {
 Separate transform
 ------------------------------------------------------
 Input: NumPoints, XReal, XImag
 Output: HReal, HImag

 The transforms of the real data XReal and HReal are
 stored in the vector XReal, XImag.  By using the
 symmetries of the transforms of real data, this
 procedure extracts the complex transforms.  The
 transform of XReal is returned in XReal, XImag. The
 transform of HReal is returned in HReal, HImag.
 ------------------------------------------------------
 }
 procedure SeparateTransforms(NumPoints : integer;
                          var XReal     : array of double;
                          var XImag     : array of double;
                          var HReal     : array of double;
                          var HImag     : array of double);
 var
   Term, EndTerm, NumPointsSHR1, NumPointsMinusTerm : integer;
   DummyReal, DummyImag : double;
 begin
   HReal[0] := XImag[0];
   HImag[0] := 0;
   XImag[0] := 0;
   NumPointsSHR1 := NumPoints SHR 1;
   HReal[NumPointsSHR1] := XImag[NumPointsSHR1];
   HImag[NumPointsSHR1] := 0;
   XImag[NumPointsSHR1] := 0;
   EndTerm := NumPointsSHR1 - 1;
   for Term := 1 to EndTerm do begin
     NumPointsMinusTerm := NumPoints - Term;
     HReal[Term] := 0.5 * (XImag[Term] + XImag[NumPointsMinusTerm]);
     HImag[Term] := 0.5 * (XReal[NumPointsMinusTerm] - XReal[Term]);
     DummyReal := 0.5 * (XReal[Term] + XReal[NumPointsMinusTerm]);
     DummyImag := 0.5 * (XImag[Term] - XImag[NumPointsMinusTerm]);
     XReal[Term] := DummyReal;
     XImag[Term] := DummyImag;
   end;
   for Term := 1 to EndTerm do begin
    { Make use of symmetries to calculate the rest of the transform }
     NumPointsMinusTerm := NumPoints - Term;
     XReal[NumPointsMinusTerm] :=  XReal[Term];
     XImag[NumPointsMinusTerm] := -XImag[Term];
     HReal[NumPointsMinusTerm] :=  HReal[Term];
     HImag[NumPointsMinusTerm] := -HImag[Term];
   end;
 end; { procedure SeparateTransforms }
begin { procedure RealConvolution }
  TestInput(NumPoints, NumberOfBits, Error, Radix);
  if Error = 0 then begin
    { Combine the two real transforms into one complex transform }
    CopyArray(XImag,HReal,NumPoints);
    MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
    Inverse := false;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
    SeparateTransforms(NumPoints, XReal, XImag, HReal, HImag);
    Multiply(NumPoints, XReal, XImag, HReal, HImag);
    Inverse := true;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
  end;
end; { procedure RealConvolution }

procedure RealCorrelation(NumPoints : integer;
                      var Auto      : boolean;
                      var XReal     : array of double;
                      var XImag     : array of double;
                      var HReal     : array of double;
                      var Error     : integer;
                      var HImag     : array of double;
                      var DummyReal : array of double;
                      var DummyImag : array of double;
                      var SinTable  : array of double;
                      var CosTable  : array of double;
                          Radix     : TRadix);

var
  Inverse : boolean;   { Indicates inverse transform  }
  NumberOfBits : integer; { Number of bits necessary to represent NumPoints }
 {
 SeparateTransforms
 ------------------------------------------------------
 Input: NumPoints, XReal, XImag
 Output: HReal, HImag

 The transforms of the real data XReal and HReal are
 stored in the vector XReal, XImag.  By using the
 symmetries of the transforms of real data, this
 procedure extracts the complex transforms.  The
 transform of XReal is returned in XReal, XImag. The
 transform of HReal is returned in HReal, HImag.
 ------------------------------------------------------
 }
 procedure SeparateTransforms(NumPoints : integer;
                         var XReal     : array of double;
                         var XImag     : array of double;
                         var HReal     : array of double;
                         var HImag     : array of double);
 var
  Term, EndTerm, NumPointsSHR1, NumPointsMinusTerm : integer;
  DummyReal, DummyImag : double;
 begin
  HReal[0] := XImag[0];
  HImag[0] := 0;
  XImag[0] := 0;
  NumPointsSHR1 := NumPoints SHR 1;
  HReal[NumPointsSHR1] := XImag[NumPointsSHR1];
  HImag[NumPointsSHR1] := 0;
  XImag[NumPointsSHR1] := 0;
  EndTerm := NumPointsSHR1 - 1;
  for Term := 1 to EndTerm do begin
    NumPointsMinusTerm := NumPoints - Term;
    HReal[Term] := 0.5 * (XImag[Term] + XImag[NumPointsMinusTerm]);
    HImag[Term] := 0.5 * (XReal[NumPointsMinusTerm] - XReal[Term]);
    DummyReal := 0.5 * (XReal[Term] + XReal[NumPointsMinusTerm]);
    DummyImag := 0.5 * (XImag[Term] - XImag[NumPointsMinusTerm]);
    XReal[Term] := DummyReal;
    XImag[Term] := DummyImag;
  end;
  for Term := 1 to EndTerm do begin
    { Make use of symmetries to calculate the rest of the transform }
    NumPointsMinusTerm := NumPoints - Term;
    XReal[NumPointsMinusTerm] :=  XReal[Term];
    XImag[NumPointsMinusTerm] := -XImag[Term];
    HReal[NumPointsMinusTerm] :=  HReal[Term];
    HImag[NumPointsMinusTerm] := -HImag[Term];
  end;
 end; { procedure SeparateTransforms }
 {
 Multiply
 ---------------------------------------------------
 Input: NumPoints, XReal, XImag, HReal, HImag
 Output: XReal, XImag

 This procedure performs the following operation:

     Dummy[f] := X[f] * H[-f]

 where -f is represented by NumPoints - f
 (circular correlation).  Because x and h were
 real functions, this operation is identical
 to:
                           *
    Dummy[f] := X[f] - H[f]

 The product is returned in X.
 ---------------------------------------------------
 }
 procedure Multiply(NumPoints : integer;
                var XReal     : array of double;
                var XImag     : array of double;
                var HReal     : array of double;
                var HImag     : array of double;
                var DummyReal : array of double;
                var DummyImag : array of double
                );
 var
   Term, NumPointsMinusTerm : integer;
 begin
   DummyReal[0] := XReal[0] * HReal[0] - XImag[0] * HImag[0];
   DummyImag[0] := XReal[0] * HImag[0] + XImag[0] * HReal[0];
   for Term := 1 to NumPoints - 1 do begin
     NumPointsMinusTerm := NumPoints - Term;
     DummyReal[Term] := XReal[Term] * HReal[NumPointsMinusTerm] -
                        XImag[Term] * HImag[NumPointsMinusTerm];
     DummyImag[Term] := XImag[Term] * HReal[NumPointsMinusTerm] +
                        XReal[Term] * HImag[NumPointsMinusTerm];
   end;
   CopyArray(XReal,DummyReal,NumPoints);
   CopyArray(XImag,DummyImag,NumPoints);
 end; { procedure Multiply }
begin { procedure RealCorrelation }
  TestInput(NumPoints, NumberOfBits, Error, Radix);
  if Error = 0 then begin
    if Auto then
      FillArray(XImag, NumPoints, 0)
    else    { Combine the two real transforms into one complex transform }
      CopyArray(XImag,HReal,NumPoints);
    MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
    Inverse := false;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
    if Auto then begin
      CopyArray(HReal,XReal,NumPoints);
      CopyArray(HImag,XImag,NumPoints);
    end else
      SeparateTransforms(NumPoints, XReal, XImag, HReal, HImag);
    Multiply(NumPoints, XReal, XImag, HReal, HImag, DummyReal, DummyImag);
    Inverse := true;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
  end;
end; { procedure RealCorrelation }

procedure ComplexFFT(NumPoints : integer;
                     Inverse   : boolean;
                 var XReal     : array of double;
                 var XImag     : array of double;
                 var Error     : integer;
                 var SinTable  : array of double;
                 var CosTable  : array of double;
                     Radix     : TRadix);
var
  NumberOfBits : integer; { Number of bits to represent NumPoints }
begin { procedure ComplexFFT }
 TestInput(NumPoints, NumberOfBits, Error, Radix);
 if Error = 0 then begin
  MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
  FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
 end;
end; { procedure ComplexFFT }

procedure ComplexConvolution(NumPoints : integer;
                         var XReal     : array of double;
                         var XImag     : array of double;
                         var HReal     : array of double;
                         var HImag     : array of double;
                         var Error     : integer;
                         var SinTable  : array of double;
                         var CosTable  : array of double;
                             Radix     : TRadix);
var
  Inverse : boolean;   { Indicates inverse transform  }
  NumberOfBits : integer; { Number of bits required to represent NumPoints }
 {
 Muliply
 ---------------------------------------------
 Input: NumPoints, XReal, XImag, HReal,
        HImag
 Output: XReal, XImag

 This procedure multiplies each element in
 X by the corresponding element in H.  The
 product is returned in X.
 ---------------------------------------------
 }
procedure Multiply(NumPoints : integer;
               var XReal     : array of double;
               var XImag     : array of double;
               var HReal     : array of double;
               var HImag     : array of double);

 var
   Term : integer;
   Dummy : double;
 begin
   for Term := 0 to NumPoints - 1 do
   begin
     Dummy := XReal[Term] * HReal[Term] - XImag[Term] * HImag[Term];
     XImag[Term] := XReal[Term] * HImag[Term] +
                    XImag[Term] * HReal[Term];
     XReal[Term] := Dummy;
   end;
 end; { procedure Multiply }
begin { procedure ComplexConvolution }
  TestInput(NumPoints, NumberOfBits, Error, Radix);
  if Error = 0 then begin
    MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
    Inverse := false;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
    FFT(NumberOfBits, NumPoints, Inverse, HReal, HImag, SinTable, CosTable, Radix);
    Multiply(NumPoints, XReal, XImag, HReal, HImag);
    Inverse := true;
    FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
  end;
end; { procedure ComplexConvolution }

procedure ComplexCorrelation(NumPoints : integer;
                         var Auto      : boolean;
                         var XReal     : array of double;
                         var XImag     : array of double;
                         var HReal     : array of double;
                         var HImag     : array of double;
                         var Error     : integer;
                         var DummyReal : array of double;
                         var DummyImag : array of double;
                         var SinTable  : array of double;
                         var CosTable  : array of double;
                             Radix     : TRadix);

var
  Inverse : boolean;   { Indicates inverse transform  }
  NumberOfBits : integer; { Number of bits necessary to represent the NumPoints }
 {
 Multiply
 ---------------------------------------------------
 Input: NumPoints, XReal, XImag, HReal, HImag
 Output: XReal, XImag

 This procedure performs the following operation:

     Dummy[f] := X[f] * H[-f]

 where -f is represented by NumPoints - f
 (circular correlation).

 The product is returned in X.
 ---------------------------------------------------
 }
 procedure Multiply(NumPoints : integer;
                var XReal     : array of double;
                var XImag     : array of double;
                var HReal     : array of double;
                var HImag     : array of double;
                var DummyReal : array of double;
                var DummyImag : array of double
                );
 var
   Term, NumPointsMinusTerm : integer;
 begin
   DummyReal[0] := XReal[0] * HReal[0] - XImag[0] * HImag[0];
   DummyImag[0] := XReal[0] * HImag[0] + XImag[0] * HReal[0];
   for Term := 1 to NumPoints - 1 do begin
     NumPointsMinusTerm := NumPoints - Term;
     DummyReal[Term] := XReal[Term] * HReal[NumPointsMinusTerm] -
                        XImag[Term] * HImag[NumPointsMinusTerm];
     DummyImag[Term] := XImag[Term] * HReal[NumPointsMinusTerm] +
                        XReal[Term] * HImag[NumPointsMinusTerm];
   end;
   CopyArray(XReal,DummyReal,NumPoints);
   CopyArray(XImag,DummyImag,NumPoints);
 end; { procedure Multiply }
begin { procedure ComplexCorrelation }
 TestInput(NumPoints, NumberOfBits, Error, Radix);
 if Error = 0 then begin
  MakeSinCosTable(NumPoints, SinTable, CosTable, Radix);
  Inverse := false;
  FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
  if not Auto then begin { Take the transform of HReal, HImag  }
   FFT(NumberOfBits, NumPoints, Inverse, HReal, HImag, SinTable, CosTable, Radix);
  end else begin { Autocorrelation; set H equal to X  }
   CopyArray(HReal,XReal,NumPoints);
   CopyArray(HImag,XImag,NumPoints);
  end;
  Multiply(NumPoints, XReal, XImag, HReal, HImag, DummyReal, DummyImag);
  Inverse := true;
  FFT(NumberOfBits, NumPoints, Inverse, XReal, XImag, SinTable, CosTable, Radix);
 end;
end; { procedure ComplexCorrelation }

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_fft24;
begin
end;

procedure Free_crw_fft24;
begin
end;

initialization

 Init_crw_fft24;

finalization

 Free_crw_fft24;

end.

//////////////
// END OF FILE
//////////////

