home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP6.ARC / GAUSSIDL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  9.0 KB  |  278 lines
  1. program Gauss_Seidel_Prog;
  2.  
  3. {--------------------------------------------------------------------------}
  4. {-                                                                        -}
  5. {-     Turbo Pascal Numerical Methods Toolbox                             -}
  6. {-     Copyright (c) 1986, 87 by Borland International, Inc.              -}
  7. {-                                                                        -}
  8. {-       Purpose : This program demonstrates how to iteratively solve a   -}
  9. {-                 system of linear equation with the Gauss Seidel        -}
  10. {-                 iterative method.                                      -}
  11. {-                                                                        -}
  12. {-       Unit    : Matrix    procedure Gauss_Seidel                       -}
  13. {-                                                                        -}
  14. {--------------------------------------------------------------------------}
  15.  
  16. {$R+}                  { Enable range checking }
  17. {$I-}                  { Disable I/O checking }
  18. {$M 32768, 0, 655360}  { Set MinStack:MinHeap:MaxHeap }
  19.  
  20. uses
  21.   Matrix, Dos, Crt, Common;
  22.  
  23. var
  24.   Dimen : integer;          { Size of the square matrix }
  25.   Coefficients : TNmatrix;  { The matrix }
  26.   Constants : TNvector;     { Constant terms in the equations }
  27.   MaxIter : integer;        { Maximum number of iterations allowed }
  28.   Tol : Float;              { Tolerance }
  29.   Solution : TNvector;      { Solution to the set of equations }
  30.   Iter : integer;           { Number of iterations }
  31.   Error : byte;             { Flags if something went wrong }
  32.  
  33. procedure Initial(var Dimen        : integer;
  34.                   var Coefficients : TNmatrix;
  35.                   var Constants    : TNvector);
  36.  
  37. {----------------------------------------------------------}
  38. {- Output: Dimen, Coefficients, Constants                 -}
  39. {-                                                        -}
  40. {- This procedure intializes the above variables to zero. -}
  41. {----------------------------------------------------------}
  42.  
  43. begin
  44.   Dimen := 0;
  45.   FillChar(Coefficients, SizeOf(Coefficients), 0);
  46.   FillChar(Constants, SizeOf(Constants), 0);
  47. end; { procedure Initial }
  48.  
  49. procedure GetData(var Dimen        : integer;
  50.                   var Coefficients : TNmatrix;
  51.                   var Constants    : TNvector;
  52.                   var Tol          : Float;
  53.                   var MaxIter      : integer);
  54.  
  55. {---------------------------------------------------------}
  56. {- Output: Dimen, Coefficients, Constants, Tol, MaxIter  -}
  57. {-                                                       -}
  58. {- This procedure sets the value of Dimen, Coefficients, -}
  59. {- and Constants from either keyboard or file input.     -}
  60. {- Tol and MaxIter are read in from the keyboard.        -}
  61. {---------------------------------------------------------}
  62.  
  63. var
  64.   Ch : char;
  65.  
  66. procedure GetDataFromKeyboard(var Dimen        : integer;
  67.                               var Coefficients : TNmatrix;
  68.                               var Constants    : TNvector);
  69.  
  70. {--------------------------------------}
  71. {- Output: Dimen, Coefficients,       -}
  72. {-         Constants                  -}
  73. {-                                    -}
  74. {- This procedure sets the value of   -}
  75. {- Dimen, Coefficients and Constants  -}
  76. {- from keyboard input                -}
  77. {--------------------------------------}
  78.  
  79. var
  80.   Row, Column : integer;
  81.  
  82. begin
  83.   Writeln;
  84.   repeat
  85.     Write('Dimension of the coefficient matrix (1-', TNArraySize,')? ');
  86.     Readln(Dimen);
  87.     IOCheck;
  88.   until not IOerr and (Dimen >= 1) and (Dimen <= TNArraySize);
  89.   Writeln;
  90.   for Row := 1 to Dimen do
  91.     for Column := 1 to Dimen do
  92.       repeat
  93.         Write('Matrix[', Row, ', ', Column, ']: ');
  94.         Readln(Coefficients[Row, Column]);
  95.         IOCheck;
  96.       until not IOerr;
  97.   Writeln;
  98.   Writeln('Now enter the constant terms:');
  99.   for Row := 1 to Dimen do
  100.   repeat
  101.     Write('Vector[', Row, ']: ');
  102.     Readln(Constants[Row]);
  103.     IOCheck;
  104.   until not IOerr;
  105. end; { procedure GetDataFromKeyboard }
  106.  
  107. procedure GetDataFromFile(var Dimen        : integer;
  108.                           var Coefficients : TNmatrix;
  109.                           var Constants    : TNvector);
  110.  
  111. {--------------------------------------}
  112. {- Dimen, Coefficients, Constants     -}
  113. {-                                    -}
  114. {- This procedure sets the value of   -}
  115. {- Dimen, Coefficients and Constants  -}
  116. {- from file input.                   -}
  117. {--------------------------------------}
  118.  
  119. var
  120.   FileName : string[255];
  121.   InFile : text;
  122.   Row, Column : integer;
  123.  
  124. begin
  125.   Writeln;
  126.   repeat
  127.     Writeln;
  128.     repeat
  129.       Write('File name? ');
  130.       Readln(FileName);
  131.       Assign(InFile, FileName);
  132.       Reset(InFile);
  133.       IOCheck;
  134.     until not IOerr;
  135.     Read(InFile, Dimen);
  136.     IOCheck;
  137.     Row := 0;
  138.     while (not IOerr) and (Row < Dimen) do
  139.     begin
  140.       Row := Succ(Row);
  141.       Column := 0;
  142.       while (not IOerr) and (Column < Dimen) do
  143.       begin
  144.         Column := Succ(Column);
  145.         Read(InFile, Coefficients[Row, Column]);
  146.         IOCheck;
  147.       end;
  148.     end;
  149.     Row := 0;
  150.     while (not IOerr) and (Row < Dimen) do
  151.     begin
  152.       Row := Succ(Row);
  153.       Read(InFile, Constants[Row]);
  154.       IOCheck;
  155.     end;
  156.   until not IOerr;
  157.   Close(InFile);
  158. end; { procedure GetDataFromFile }
  159.  
  160. begin { procedure GetData }
  161.   case InputChannel('Input Data From') of
  162.     'K' : GetDataFromKeyboard(Dimen, Coefficients, Constants);
  163.     'F' : GetDataFromFile(Dimen, Coefficients, Constants);
  164.   end;
  165.   Writeln;
  166.   repeat
  167.     Tol := 1E-8;
  168.     Write('Tolerance (> 0):');
  169.     ReadFloat(Tol);
  170.     IOCheck;
  171.     if Tol <= 0 then
  172.     begin
  173.       IOerr := true;
  174.       Tol := 1E-8;
  175.     end;
  176.   until not IOerr;
  177.   Writeln;
  178.   repeat
  179.     MaxIter := 100;
  180.     Write('Maximum number of iterations (> 0): ');
  181.     ReadInt(MaxIter);
  182.     IOCheck;
  183.     if MaxIter <= 0 then
  184.     begin
  185.       IOerr := true;
  186.       MaxIter := 100;
  187.     end;
  188.   until not IOerr;
  189.   GetOutputFile(OutFile);
  190. end; { procedure GetData }
  191.  
  192. procedure Results(Dimen        : integer;
  193.               var Coefficients : TNmatrix;
  194.               var Constants    : TNvector;
  195.                   Tol          : Float;
  196.                   MaxIter      : integer;
  197.               var Solution     : TNvector;
  198.                   Iter         : integer;
  199.                   Error        : byte);
  200.  
  201. {------------------------------------------------------------}
  202. {- This procedure outputs the results to the device OutFile -}
  203. {------------------------------------------------------------}
  204.  
  205. var
  206.   Column, Row : integer;
  207.  
  208. begin
  209.   Writeln(OutFile);
  210.   Writeln(OutFile);
  211.   Writeln(OutFile, 'The coefficients: ');
  212.   for Row := 1 to Dimen do
  213.   begin
  214.     for Column := 1 to Dimen do
  215.       Write(OutFile, Coefficients[Row, Column]:13:9);
  216.     Writeln(OutFile);
  217.   end;
  218.   Writeln(OutFile);
  219.   Writeln(OutFile, 'The constants:');
  220.   for Row := 1 to Dimen do
  221.     Writeln(OutFile, Constants[Row]);
  222.   Writeln(OutFile);
  223.   Writeln(OutFile, 'Tolerance: ' : 30, Tol);
  224.   Writeln(OutFile, 'Maximum number of iterations: ' : 30, MaxIter);
  225.   Writeln(OutFile);
  226.   if Error in [1, 2, 7] then
  227.     DisplayWarning;
  228.   if (Error >= 3) and (Error <> 7) then
  229.     DisplayError;
  230.   case Error of
  231.     1 : begin
  232.           Writeln(OutFile, 'The matrix is not diagonally dominant which');
  233.           Writeln(OutFile, 'indicates that convergence may be impossible.');
  234.           Writeln(OutFile, 'Convergence did not occur after ', Iter,
  235.                            ' iterations.');
  236.         end;
  237.  
  238.     2 : Writeln(OutFile, 'Convergence did not occur after ',
  239.                           Iter, ' iterations.');
  240.  
  241.     3 : Writeln(OutFile, 'The dimension of the matrix must be greater than 1.');
  242.  
  243.     4 : Writeln(OutFile, 'The tolerance must be greater than zero.');
  244.  
  245.     5 : Writeln(OutFile,
  246.                 'Maximum number of iterations must be greater than zero.');
  247.  
  248.     6 : begin
  249.           Writeln(OutFile, 'The diagonal of the matrix contains a zero. The');
  250.           Writeln(OutFile,
  251.                   'Gauss-Seidel method may not be used to solve this system.');
  252.         end;
  253.  
  254.     7 : begin
  255.           Writeln(OutFile, 'The sequence is diverging. The Gauss-Seidel');
  256.           Writeln(OutFile, 'may not be used to solve this system.');
  257.         end;
  258.   end; { case }
  259.   if (Error <= 2) or (Error = 7) then
  260.   begin
  261.     Writeln(OutFile);
  262.     Writeln(OutFile, 'Number of iterations: ' : 30, Iter : 3);
  263.     Writeln(OutFile, 'The Result:');
  264.     for Row := 1 to Dimen do
  265.       Writeln(OutFile, Solution[Row]);
  266.     Writeln(OutFile);
  267.   end;
  268. end; { procedure Results }
  269.  
  270. begin { program Gauss_Seidel }
  271.   ClrScr;
  272.   Initial(Dimen, Coefficients, Constants);
  273.   GetData(Dimen, Coefficients, Constants, Tol, MaxIter);
  274.   Gauss_Seidel(Dimen, Coefficients, Constants,
  275.                Tol, MaxIter, Solution, Iter, Error);
  276.   Results(Dimen, Coefficients, Constants, Tol, MaxIter, Solution, Iter, Error);
  277.   Close(OutFile);
  278. end. { program Gauss_Seidel }