home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / SOLVEQ.ZIP / SOLVEQ.PRG
Encoding:
Text File  |  1993-04-12  |  2.9 KB  |  97 lines
  1. program Solveq;  { Linear Equation Solver}
  2.    uses crt;
  3.  
  4. const
  5.    NumEqn = 3;                                          {Mod. #1}
  6.  
  7.    {  The above constant must be set correctly by you.  }
  8.    {    NumEqn = The number of equations to be solved.  }
  9.  
  10.    NumEqnPlus1 = NumEqn + 1;
  11.    ColSize     = NumEqnPlus1;
  12.    RowSize     = NumEqn;
  13.    MatrixSize  = NumEqn;
  14.  
  15. type
  16.    Array2Type = array[1..RowSize, 1..ColSize] of real;
  17.    MatrixType = array[1..MatrixSize, 1..MatrixSize] of real;
  18.  
  19. var
  20.    EqnArray                               : Array2Type;
  21.    EqnCount, J, K                         : integer;
  22.    OK                                     : boolean;
  23.    Reply                                  : char;
  24.    CoeffMatrix, RHSMatrix, InvertedMatrix : MatrixType;
  25.    AnswerMatrix                           : MatrixType;
  26.  
  27. {$I GetReply.PSL}
  28. {$I Key2Arr.PSL}
  29. {$I MatInv.PSL}
  30. {$I MatMult.PSL}
  31. {$I Show2Arr.PSL}
  32. {$I WaitKey.PSL}
  33.  
  34. BEGIN
  35.    clrscr;
  36.    writeln('SIMULEQN - A simultaneous linear equation solver');
  37.    writeln;
  38.    if (NumEqnPlus1 <> NumEqn + 1) or (NumEqn < 1) then
  39.       begin
  40.          writeln(chr(7));
  41.          writeln('** Bad settings in the const block **');
  42.          exit
  43.       end;
  44.    writeln('The program is currently set to do', NumEqn:2,
  45.            ' equations in', NumEqn:2, ' unknowns.');
  46.    writeln;
  47.    writeln('The data must now be input.  You will be prompted');
  48.    writeln('for the coefficients and right-hand side of each');
  49.    writeln('equation (or row) one at a time.  The notation');
  50.    writeln('Entry [A,B] means coefficient B of equation A.');
  51.    writeln('When B =', NumEqnPlus1:2,
  52.            ', provide the right-hand side.');
  53.    Reply := '0';
  54.    repeat
  55.       writeln;
  56.       EqnCount := 0;
  57.       Key2Arr(EqnArray, EqnCount);
  58.       writeln;
  59.       writeln('You now have a chance to review the data.');
  60.       WaitKey;
  61.       Show2Arr(EqnArray, EqnCount, 8, 4, 4);
  62.       writeln;
  63.       writeln('This is the data you entered.  Is it correct?');
  64.       writeln;
  65.       writeln('  1 - Yes it is; please continue.');
  66.       writeln('  2 - No it''s not; let me reenter it.');
  67.       writeln('  3 - No it''s not; please abort the program.');
  68.       writeln;
  69.       GetReply('1', '3', Reply);
  70.       writeln(Reply)
  71.    until
  72.       Reply <> '2';
  73.    if Reply = '3' then
  74.       exit;
  75.    writeln;
  76.    for J := 1 to NumEqn do
  77.       for K := 1 to NumEqn do
  78.          CoeffMatrix[J,K] := EqnArray[J,K];
  79.    for J := 1 to NumEqn do
  80.       RHSMatrix[J,1] := EqnArray[J,NumEqnPlus1];
  81.    for J := 1 to NumEqn do
  82.       for K := 2 to NumEqn do
  83.          RHSMatrix[J,K] := 0.0;
  84.    MatInv(CoeffMatrix, InvertedMatrix, OK);
  85.    if not OK then
  86.       begin
  87.          writeln(chr(7));
  88.          writeln('Bad input, no solution is possible.');
  89.          exit
  90.       end;
  91.    MatMult(InvertedMatrix, RHSMatrix, AnswerMatrix);
  92.    writeln('The solution is');
  93.    writeln;
  94.    for J := 1 to NumEqn do
  95.       writeln('Unknown', J:2, ' = ', AnswerMatrix[J,1])
  96. END.
  97.