home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l042 / 1.ddi / CHAP6.ARC / GAUSELIM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-30  |  6.7 KB  |  208 lines
  1. program Gaussian_Elimination_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 solve a system of     -}
  9. {-                 linear equations with Gaussian elimination.            -}
  10. {-                                                                        -}
  11. {-       Unit    : Matrix    procedure Gaussian_Elimination               -}
  12. {-                                                                        -}
  13. {--------------------------------------------------------------------------}
  14.  
  15. {$R+}                  { Enable range checking }
  16. {$I-}                  { Disable I/O checking }
  17.  
  18. uses
  19.   Matrix, Dos, Crt, Common;
  20.  
  21. var
  22.   Dimen : integer;          { Dimen of the square matrix }
  23.   Coefficients : TNmatrix;  { The matrix }
  24.   Constants : TNvector;     { Constant terms in the equations }
  25.   Solution : TNvector;      { Solution to the set of equations }
  26.   Error : byte;             { Flags if something went wrong }
  27.  
  28. procedure Initial(var Dimen        : integer;
  29.                   var Coefficients : TNmatrix;
  30.                   var Constants    : TNvector);
  31.  
  32. {----------------------------------------------------------}
  33. {- Output: Dimen, Coefficients, Constants                 -}
  34. {-                                                        -}
  35. {- This procedure intializes the above variables to zero. -}
  36. {----------------------------------------------------------}
  37.  
  38. begin
  39.   Dimen := 0;
  40.   FillChar(Coefficients, SizeOf(Coefficients), 0);
  41.   FillChar(Constants, SizeOf(Constants), 0);
  42. end; { procedure Initial }
  43.  
  44. procedure GetData(var Dimen        : integer;
  45.                   var Coefficients : TNmatrix;
  46.                   var Constants    : TNvector);
  47.  
  48. {-----------------------------------------------------------}
  49. {- Output: Dimen, Coefficients, Constants                  -}
  50. {-                                                         -}
  51. {- This procedure sets the value of Dimen, Coefficients    -}
  52. {- and Constants from either keyboard input or file input. -}
  53. {-----------------------------------------------------------}
  54.  
  55. var
  56.   Ch : char;
  57.  
  58. procedure GetDataFromKeyboard(var Dimen        : integer;
  59.                               var Coefficients : TNmatrix;
  60.                               var Constants    : TNvector);
  61.  
  62. {--------------------------------------------------}
  63. {- Output: Dimen, Coefficients, Constants         -}
  64. {- This procedure sets the value of Dimen,        -}
  65. {- Coefficients and Constants from keyboard input -}
  66. {--------------------------------------------------}
  67.  
  68. var
  69.   Row, Column : integer;
  70.  
  71. begin
  72.   Writeln;
  73.   repeat
  74.     Write('Dimension of the coefficient matrix (1-', TNArraySize,')? ');
  75.     Readln(Dimen);
  76.     IOCheck;
  77.   until not IOerr and (Dimen >= 1) and (Dimen <= TNArraySize);
  78.   Writeln;
  79.   for Row := 1 to Dimen do
  80.     for Column := 1 to Dimen do
  81.       repeat
  82.         Write('Matrix[', Row, ', ', Column, ']: ');
  83.         Readln(Coefficients[Row, Column]);
  84.         IOCheck;
  85.       until not IOerr;
  86.   Writeln;
  87.   Writeln('Now enter the constant terms:');
  88.   for Row := 1 to Dimen do
  89.   repeat
  90.     Write('Vector[', Row, ']: ');
  91.     Readln(Constants[Row]);
  92.     IOCheck;
  93.   until not IOerr;
  94. end; { procedure GetDataFromKeyboard }
  95.  
  96. procedure GetDataFromFile(var Dimen        : integer;
  97.                           var Coefficients : TNmatrix;
  98.                           var Constants    : TNvector);
  99.  
  100. {--------------------------------------------------}
  101. {- Output: Dimen, Coefficients, Constants         -}
  102. {-                                                -}
  103. {- This procedure sets the value of Dimen,        -}
  104. {- Coefficients and Constants from file input     -}
  105. {--------------------------------------------------}
  106.  
  107. var
  108.   FileName : string[255];
  109.   InFile : text;
  110.   Row, Column : integer;
  111.  
  112. begin
  113.   Writeln;
  114.   repeat
  115.     Writeln;
  116.     repeat
  117.       Write('File name? ');
  118.       Readln(FileName);
  119.       Assign(InFile, FileName);
  120.       Reset(InFile);
  121.       IOCheck;
  122.     until not IOerr;
  123.     Read(InFile, Dimen);
  124.     IOCheck;
  125.     Row := 0;
  126.     while (not IOerr) and (Row < Dimen) do
  127.     begin
  128.       Row := Succ(Row);
  129.       Column := 0;
  130.       while (not IOerr) and (Column < Dimen) do
  131.       begin
  132.         Column := Succ(Column);
  133.         Read(InFile, Coefficients[Row, Column]);
  134.         IOCheck;
  135.       end;
  136.     end;
  137.     Row := 0;
  138.     while (not IOerr) and (Row < Dimen) do
  139.     begin
  140.       Row := Succ(Row);
  141.       Read(InFile, Constants[Row]);
  142.       IOCheck;
  143.     end;
  144.   until not IOerr;
  145.   Close(InFile);
  146. end; { procedure GetDataFromFile }
  147.  
  148. begin { procedure GetData }
  149.   case InputChannel('Input Data From') of
  150.     'K' : GetDataFromKeyboard(Dimen, Coefficients, Constants);
  151.     'F' : GetDataFromFile(Dimen, Coefficients, Constants);
  152.   end;
  153.   GetOutputFile(OutFile);
  154. end; { procedure GetData }
  155.  
  156. procedure Results(Dimen        : integer;
  157.               var Coefficients : TNmatrix;
  158.               var Constants    : TNvector;
  159.               var Solution     : TNvector;
  160.                   Error        : byte);
  161.  
  162. {------------------------------------------------------------}
  163. {- This procedure outputs the results to the device OutFile -}
  164. {------------------------------------------------------------}
  165.  
  166. var
  167.   Column, Row : integer;
  168.  
  169. begin
  170.   Writeln(OutFile);
  171.   Writeln(OutFile);
  172.   Writeln(OutFile, 'The coefficients: ');
  173.   for Row := 1 to Dimen do
  174.   begin
  175.     for Column := 1 to Dimen do
  176.       Write(OutFile, Coefficients[Row, Column]:13:9);
  177.     Writeln(OutFile);
  178.   end;
  179.   Writeln(OutFile);
  180.   Writeln(OutFile, 'The constants:');
  181.   for Row := 1 to Dimen do
  182.     Writeln(OutFile, Constants[Row]);
  183.   Writeln(OutFile);
  184.   if Error >= 1 then
  185.     DisplayError;
  186.   case Error of
  187.     0 : begin
  188.           Writeln(OutFile, 'The solution:');
  189.           for Row := 1 to Dimen do
  190.             Writeln(OutFile, Solution[Row]);
  191.           Writeln(OutFile);
  192.         end;
  193.  
  194.     1 : Writeln(OutFile, 'The dimension of the matrix must be greater than 1.');
  195.  
  196.     2 : Writeln(OutFile, 'There is no solution to this set of equations.');
  197.  
  198.   end; { case }
  199. end; { procedure Results }
  200.  
  201. begin { program Gaussian_Elimination }
  202.   ClrScr;
  203.   Initial(Dimen, Coefficients, Constants);
  204.   GetData(Dimen, Coefficients, Constants);
  205.   Gaussian_Elimination(Dimen, Coefficients, Constants, Solution, Error);
  206.   Results(Dimen, Coefficients, Constants, Solution, Error);
  207.   Close(OutFile);
  208. end. { program Gaussian_Elimination }