home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / FOURN.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.3 KB  |  53 lines
  1. PROGRAM d12r13(input,output);
  2. (* driver for routine FOURN *)
  3. CONST
  4.    ndim=3;
  5.    ndat2=1024;
  6. TYPE
  7.    gldarray = ARRAY [1..ndat2] OF real;
  8.    glnnarray = ARRAY [1..ndim] OF integer;
  9. VAR
  10.    i,isign,j,k,l,ll,ndum : integer;
  11.    data : gldarray;
  12.    nn : glnnarray;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I FOURN.PAS *)
  16.  
  17. BEGIN
  18.    ndum := 2;
  19.    FOR i := 1 to ndim DO BEGIN
  20.       ndum := ndum*2;
  21.       nn[i] := ndum
  22.    END;
  23.    FOR i := 1 to nn[3] DO BEGIN
  24.       FOR j := 1 to nn[2] DO BEGIN
  25.          FOR k := 1 to nn[1] DO BEGIN
  26.             l := k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1];
  27.             ll := 2*l-1;
  28.             data[ll] := ll;
  29.             data[ll+1] := ll+1
  30.          END
  31.       END
  32.    END;
  33.    isign := +1;
  34.    fourn(data,nn,ndim,isign);
  35.    isign := -1;
  36.    writeln('Double 3-dimensional transform');
  37.    writeln;
  38.    writeln('Double transf.':22,'Original data':24,'Ratio':20);
  39.    writeln('real':10,'imag.':13,'real':12,'imag.':13,'real':11,'imag.':13);
  40.    writeln;
  41.    fourn(data,nn,ndim,isign);
  42.    FOR i := 1 to 4 DO BEGIN
  43.       j := 2*i;
  44.       k := 2*j;
  45.       l := k+(j-1)*nn[1]+(i-1)*nn[2]*nn[1];
  46.       ll := 2*l-1;
  47.       writeln(data[ll]:12:2,data[ll+1]:12:2,ll:10,ll+1:12,
  48.          data[ll]/ll:14:2,data[ll+1]/(ll+1):12:2)
  49.    END;
  50.    writeln;
  51.    writeln('The product of transform lengths is:',nn[1]*nn[2]*nn[3]:4)
  52. END.
  53.