fixrts.dem

Delphi Pascal 数据挖掘领域算法包 数值算法大全

PROGRAM d12r11(input,output);
(* driver for routine FIXRTS *)
CONST
   npoles=6;
   twonp=12;   (* twonp=2*npoles *)
   twonp2=14;   (* twonp2=twonp+2 *)
TYPE
   gl2array = ARRAY [1..2] OF real;
   glnparray = ARRAY [1..npoles] OF real;
   glcarray = ARRAY [1..twonp2] OF real;
VAR
   i,j : integer;
   dum : real;
   polish : boolean;
   d : glnparray;
   sixth : gl2array;
   zcoef,zeros : glcarray;

(*$I MODFILE.PAS *)
(*$I LAGUER.PAS *)

(*$I ZROOTS.PAS *)

(*$I FIXRTS.PAS *)

BEGIN
   d[1] := 6.0; d[2] := -15.0; d[3] := 20.0;
   d[4] := -15.0; d[5] := 6.0; d[6] := 0.0;
   polish := true;
   (* finding roots of (z-1.0)^6 := 1.0 *)
   (* first write roots *)
   zcoef[2*npoles+1] := 1.0;
   zcoef[2*npoles+2] := 0.0;
   FOR i := npoles DOWNTO 1 DO BEGIN
      zcoef[2*i-1] := -d[npoles+1-i];
      zcoef[2*i] := 0.0
   END;
   zroots(zcoef,npoles,zeros,polish);
   writeln('Roots of (z-1.0)^6 = 1.0');
   writeln('Root':22,'(z-1.0)^6':27);
   FOR i := 1 to npoles DO BEGIN
      sixth[1] := 1.0;
      sixth[2] := 0.0;
      FOR j := 1 to 6 DO BEGIN
         dum := sixth[1];
         sixth[1] := sixth[1]*(zeros[2*i-1]-1.0)
            -sixth[2]*zeros[2*i];
         sixth[2] := dum*zeros[2*i]
            +sixth[2]*(zeros[2*i-1]-1.0)
      END;
      writeln(i:6,zeros[2*i-1]:12:6,zeros[2*i]:12:6,
         sixth[1]:12:6,sixth[2]:12:6)
   END;
   (* now fix them to lie within unit circle *)
   fixrts(d,npoles);
   (* check results *)
   zcoef[2*npoles+1] := 1.0;
   zcoef[2*npoles+2] := 0.0;
   FOR i := npoles DOWNTO 1 DO BEGIN
      zcoef[2*i-1] := -d[npoles+1-i];
      zcoef[2*i] := 0.0
   END;
   zroots(zcoef,npoles,zeros,polish);
   writeln;
   writeln('Roots reflected in unit circle');
   writeln('Root':22,'(z-1.0)^6':27);
   FOR i := 1 to npoles DO BEGIN
      sixth[1] := 1.0;
      sixth[2] := 0.0;
      FOR j := 1 to 6 DO BEGIN
         dum := sixth[1];
         sixth[1] := sixth[1]*(zeros[2*i-1]-1.0)
            -sixth[2]*zeros[2*i];
         sixth[2] := dum*zeros[2*i]
            +sixth[2]*(zeros[2*i-1]-1.0)
      END;
      writeln(i:6,zeros[2*i-1]:12:6,zeros[2*i]:12:6,
         sixth[1]:12:6,sixth[2]:12:6)
   END
END.