home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tmtp100o.zip / EXAMPLES / LIN_EQ / LIN_EQ.PAS
Pascal/Delphi Source File  |  1996-12-04  |  2KB  |  69 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Copyright (C) 1996    T M T   Corporation       }
  4. {                                                       }
  5. {*******************************************************}
  6.  
  7. program lin_eq;
  8.  
  9. uses debug;
  10.  
  11. procedure print_vector (v: array (1) of double);
  12. var i: integer;
  13. begin
  14.     for i := 0 to high (v) [0] do write (v [i]:10:6, ' ');
  15.     writeln;
  16. end;
  17.  
  18. procedure print_matrix (m: array (2) of double);
  19. var i: integer;
  20. begin
  21.     for i := 0 to high (m) [0] do print_vector (m [i]);
  22.     writeln;
  23. end;
  24.  
  25. procedure solve (
  26.         a: array (2) of double;
  27.         b: array (1) of double;
  28.     var x: array (1) of double);
  29.  
  30. var i, j, k, n: integer;
  31.  
  32. begin
  33.     n := high (a) [1];
  34.  
  35.     for i := 0 to n - 1 do begin
  36.  
  37.         for j := i+1 to n do
  38.             a [i,j] := a [i,j] / a [i,i];
  39.  
  40.         b [i] := b [i] / a [i,i];
  41.         a [i,i] := 1;
  42.  
  43.         for j := i + 1 to n do begin
  44.             b [j] := b [j] - b [i] * a [j, i];
  45.             for k := n downto i do
  46.                 a [j, k] := a [j, k] - a [i, k] * a [j, i];
  47.         end;
  48.     end;
  49.  
  50.     for i := n downto 0 do declare
  51.         var s: double;
  52.     begin
  53.         s := b [i];
  54.         for j := n downto i + 1 do
  55.             s := s - a [i,j] * x [j];
  56.         x [i] := s / a [i, i];
  57.     end
  58. end;
  59.  
  60. const a: array [1..3, 1..3] of double = ((1,0,2),(2,1,0),(1,2,1));
  61.       b: array [1..3] of double = (1, 1, 1);
  62. var   x: array [1..3] of double;
  63.  
  64. begin
  65.     solve (a, b, x);
  66.     print_matrix (a); print_vector (b); writeln;
  67.     writeln ('result is: ');
  68.     print_vector (x);
  69. end.