asd / корзина / лекции по TP / Lecture_Pascal / graph / SISTEM

  uses crt;
  const n=4;
        m=n+1;
        t=' main matrix';
  type stroka=array[1..m] of real;
     matr=  array[1..n] of stroka;
  var {a:matr;}
      c:real;
      i,j:integer;
      x:stroka;
      const a:matr=((0,4,5,0,4),(0,6,7,2,3),(1,3,4,3,4),(1,3,4,5,6));
{                      PRINT                                 }
  procedure print(l:string);
      var i,j:integer;
      begin
         writeln(l);
         for i:=1 to n do begin
                          for j:=1 to m do write('   ',a[i,j]:7:3);
                          writeln
                          end
      end;
{                       END PRINT                            }
{                       FORM                                 }
      procedure form;
        var i,j:integer;
        const d:word=5;
        begin
          randomize;
          for i:=1 to n do
               for j:=1 to m+1 do a[i,j]:=random(d)
        end;
{                       END FORM                             }
      procedure Glavny_Element(k:integer);
        var i,j,r:integer;
            c:real;
        begin    r:=k;
             for i:=r to n-1 do
                      if a[r,r]=0 then
                                 for j:=r to m do begin c:=a[r,j];
                                                        a[r,j]:=a[i+1,j];
                                                        a[i+1,j]:=c
                                                   end
        end;
{                       END Glavny_Element                   }
      procedure Iscl(k:integer);
          var i,j,r:integer;
          begin
              r:=k;
              Glavny_Element(r);
              for j:=r+1 to m do a[r,j]:=a[r,j]/a[r,r]; a[r,r]:=1;
               for i:=r+1 to n do if a[i,r]<>0 then begin a[i,r]:=0;
                        for j:=r+1 to m do a[i,j]:=a[i,j]-a[r,j]
                                                    end
          end;
{                       END ISCL                             }
      procedure Iscl2(k:integer);
           var i,j,r,t1:integer;
               g:real;
           begin
               for i:=2 to k do
                     for t1:=1 to i-1 do
               begin g:=a[i-t1,i];
                      for j:=i+1 to m do a[i-t1,j]:=a[i-t1,j]-a[i,j]*g;
                      a[i-t1,i]:=a[i-t1,i]-g
                                 end
           end;
{                       END ISCL2                            }
       procedure Neviaz;
           var i,j:integer;
               s:real;
           begin
                for i:=1 to n do x[i]:=a[i,m];
                for i:=1 to n do write('  x[',i,']=',x[i]:5:1);
                writeln;
               for i:=1 to n do begin s:=0;
                      for j:=1 to n do s:=a[i,j]*x[j]+s;
                      writeln(' neviazka=',s-a[i,m]:8)
                                 end
           end;
{                       MAIN PROGRAMM                        }
      begin
             ClrScr;
             {form;}
             print(t);
             for i:=1 to n-1 do Iscl(i);
             a[n,n]:=a[n,n]/a[n,n]; a[n,m]:=a[n,m]/a[n,n];
             print(t);
             Iscl2(n);
             print(t);
             Neviaz
      end.