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

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

                writeln;
               for i:=1 to n do begin s:=0;
                      for j:=1 to n do s:=a1[i,j]*x[j]+s;
                      writeln(' neviazka=',s-b1[i]:8);
                      r[i]:=s
                                 end
           end;
           function Flag:boolean;
            var i:integer;
            begin Flag:=true;
                    i:=0;
                  while flag do begin
                        i:=i+1;
                        if abs(r[i])> e then Flag:=false
                                 end
            end;
            procedure print1(l:string);
           var i:integer;
           begin
                writeln(l);
                for i:=1 to n do write(' x[',i,']=',x[i]:5:2);
                writeln
           end;
{                       MAIN PROGRAMM                        }
      begin
             ClrScr;
              for i:=1 to n do begin
                     for j:=1 to n do a1[i,j]:=a[i,j];
                               b1[i]:=b[i]
                               end;
             {form;}
             print(a,b,t);
             Iscl(a,b);
             print(a,b,t);
             Iscl2(a,b);
             print(a,b,t);
             dr;
             k:=0;
             y:=x;
             for i:=1 to n do b[i]:=b1[i]-r[i];
             for i:=1 to n do a[i]:=a1[i];
             Iscl(a,b);
             Iscl2(a,b);
             print1(k,' - iteration');
             while not flag and (k <= 5) do
                       begin
                       k:=k+1;  y:=x:  dr;
                       b:=b1-r;
                       for i:=1 to n do a[i]:=a1[i];
                       Iscl(a,b);
                       Iscl2(a,b);
                       print1(k,' - iteration');
                       end
      end.