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