home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP7.ARC / JACOBI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  6.8 KB  |  224 lines
  1. program Jacobi_Prog;
  2.  
  3. {----------------------------------------------------------------------------}
  4. {-                                                                          -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                               -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.                -}
  7. {-                                                                          -}
  8. {-       Purpose : to demonstrate procedure Jacobi for approximating        -}
  9. {-                 all the eigenvalues of a matrix.                         -}
  10. {-                                                                          -}
  11. {-       Unit    : EigenVal    procedure Jacobi                             -}
  12. {-                                                                          -}
  13. {----------------------------------------------------------------------------}
  14.  
  15. {$R+}                  { Enable range checking }
  16. {$I-}                  { Disable I/O checking }
  17. {$M 24576, 0, 655360}  { Set MinStack:MinHeap:MaxHeap }
  18.  
  19. uses
  20.   EigenVal, Dos, Crt, Common;
  21.  
  22. var
  23.   Dimen : integer;          { Size of the square matrix }
  24.   Mat : TNmatrix;           { The matrix }
  25.   MaxIter : integer;        { Maximum number iterations allowed }
  26.   Tolerance : Float;        { Tolerance }
  27.   Eigenvectors : TNmatrix;  { Eigenvectors of the matrix }
  28.   Eigenvalues : TNvector;   { Associated eigenvalues }
  29.   Iter : integer;           { Number of iterations }
  30.   Error : byte;             { Flags if something went wrong }
  31.  
  32. procedure GetData(var Dimen     : integer;
  33.                   var Mat       : TNmatrix;
  34.                   var Tolerance : Float;
  35.                   var MaxIter   : integer);
  36.  
  37. {--------------------------------------------------------------}
  38. {- Output: Dimen, Mat, Tolerance, MaxIter                     -}
  39. {-                                                            -}
  40. {- This procedure reads in the data.  The dimension and the   -}
  41. {- matrix, Mat can be read in from either a file or the       -}
  42. {- keyboard.  The Tolerance and MaxIter are read in from      -}
  43. {- the keyboard.                                              -}
  44. {--------------------------------------------------------------}
  45.  
  46. var
  47.   Ch : char;
  48.  
  49. procedure GetDataFromKeyboard(var Dimen : integer;
  50.                               var Mat   : TNmatrix);
  51.  
  52.  
  53. {-------------------------------------}
  54. {- Output: Dimen, Mat                -}
  55. {-                                   -}
  56. {- This procedure reads in the above -}
  57. {- variables from the keyboard.      -}
  58. {-------------------------------------}
  59.  
  60. var
  61.   Row, Column : integer;
  62.  
  63. begin
  64.   Writeln;
  65.   repeat
  66.     Write('Dimension of the matrix (1-', TNArraySize, ')? ');
  67.     Readln(Dimen);
  68.     IOCheck;
  69.   until (not IOerr) and (Dimen >= 1) and (Dimen <= TNArraySize);
  70.   Writeln;
  71.   for Row := 1 to Dimen do
  72.     for Column := 1 to Dimen do
  73.       repeat
  74.         Write('Matrix[', Row, ', ', Column, ']: ');
  75.         Readln(Mat[Row, Column]);
  76.         IOCheck;
  77.       until not IOerr;
  78.   Writeln;
  79. end; { procedure GetDataFromKeyboard }
  80.  
  81. procedure GetDataFromFile(var Dimen : integer;
  82.                           var Mat   : TNmatrix);
  83.  
  84. var
  85.   FileName : string[255];
  86.   InFile : text;
  87.   Row, Column : integer;
  88.  
  89. begin
  90.   Writeln;
  91.   repeat
  92.     Writeln;
  93.     repeat
  94.       Write('File name? ');
  95.       Readln(FileName);
  96.       Assign(InFile, FileName);
  97.       Reset(InFile);
  98.       IOCheck;
  99.     until not IOerr;
  100.     Read(InFile, Dimen);
  101.     IOCheck;
  102.     Row := 0;
  103.     while (not IOerr) and (Row < Dimen) do
  104.     begin
  105.       Row := Succ(Row);
  106.       Column := 0;
  107.       while (not IOerr) and (Column < Dimen) do
  108.       begin
  109.         Column := Succ(Column);
  110.         Read(InFile, Mat[Row, Column]);
  111.         IOCheck;
  112.       end;
  113.     end;
  114.   until not IOerr;
  115.   Close(InFile);
  116. end; { procedure GetDataFromFile }
  117.  
  118. begin { procedure GetData }
  119.   Dimen := 0;
  120.   FillChar(Mat, SizeOf(Mat), 0);
  121.   case InputChannel('Input Data From') of
  122.     'K' : GetDataFromKeyboard(Dimen, Mat);
  123.     'F' : GetDataFromFile(Dimen, Mat);
  124.   end;
  125.   Writeln;
  126.   Tolerance := 1E-6;
  127.   repeat
  128.     Write('Tolerance (> 0): ');
  129.     ReadFloat(Tolerance);
  130.     IOCheck;
  131.     if Tolerance <= 0 then
  132.     begin
  133.       IOerr := true;
  134.       Tolerance := 1E-6;
  135.     end;
  136.   until not IOerr;
  137.   Writeln;
  138.   MaxIter := 200;
  139.   repeat
  140.     Write('Maximum number of iterations (> 0): ');
  141.     ReadInt(MaxIter);
  142.     IOCheck;
  143.     if MaxIter <= 0 then
  144.     begin
  145.       IOerr := true;
  146.       MaxIter := 200;
  147.     end;
  148.   until not IOerr;
  149.   GetOutputFile(OutFile);
  150. end; { procedure GetData }
  151.  
  152. procedure Results(Dimen        : integer;
  153.               var Mat          : TNmatrix;
  154.                   Tolerance    : Float;
  155.                   MaxIter      : integer;
  156.               var Eigenvalues  : TNvector;
  157.               var Eigenvectors : TNmatrix;
  158.                   Iter         : integer;
  159.                   Error        : byte);
  160.  
  161. {-----------------------}
  162. {- Output the results! -}
  163. {-----------------------}
  164.  
  165. var
  166.   Index, Column, Row : integer;
  167.  
  168. begin
  169.   Writeln(OutFile);
  170.   Writeln(OutFile);
  171.   Writeln(OutFile, 'The matrix: ');
  172.   for Row := 1 to Dimen do
  173.   begin
  174.     for Column := 1 to Dimen do
  175.       Write(OutFile, Mat[Row, Column]:13:9);
  176.     Writeln(OutFile);
  177.   end;
  178.   Writeln(OutFile);
  179.   Writeln(OutFile, 'Tolerance: ' : 31, Tolerance);
  180.   Writeln(OutFile, 'Maximum number of iterations: ' : 31, MaxIter);
  181.   Writeln(OutFile);
  182.   if Error = 5 then
  183.     DisplayWarning;
  184.   if Error in [1, 2, 3, 4] then
  185.     DisplayError;
  186.   case Error of
  187.     0 : Writeln(OutFile, 'Number of iterations: ' : 31, Iter : 3);
  188.  
  189.     1 : Writeln(OutFile, 'The matrix must be of dimension greater than 1.');
  190.  
  191.     2 : Writeln(OutFile, 'The tolerance must be greater than zero.');
  192.  
  193.     3 : Writeln(OutFile,
  194.                 'Maximum number of iterations must be greater than zero.');
  195.  
  196.     4 : Writeln(OutFile, 'The matrix must be symmetric.');
  197.  
  198.     5 : begin
  199.           Writeln(OutFile, 'Convergence did not occur after ',
  200.                            Iter, 'iterations.');
  201.           Writeln(OutFile, 'The results of the last iteration are:');
  202.         end;
  203.   end; { case }
  204.   if Error in [0, 5] then
  205.     for Index := 1 to Dimen do
  206.     begin
  207.       Writeln(OutFile);
  208.       Writeln(OutFile, 'The approximate eigenvector:' : 30);
  209.       for Row := 1 to Dimen do
  210.         Writeln(OutFile, Eigenvectors[Index, Row]);
  211.       Writeln(OutFile);
  212.       Writeln(OutFile, 'The associated eigenvalue: ': 31, Eigenvalues[Index]);
  213.     end;
  214. end; { procedure Results }
  215.  
  216. begin { program Jacobi }
  217.   ClrScr;
  218.   GetData(Dimen, Mat, Tolerance, MaxIter);
  219.   Jacobi(Dimen, Mat, MaxIter, Tolerance,
  220.          Eigenvalues, Eigenvectors, Iter, Error);
  221.   Results(Dimen, Mat, Tolerance, MaxIter,
  222.           Eigenvalues, Eigenvectors, Iter, Error);
  223.   Close(OutFile);
  224. end. { program Jacobi }