Uses CRT;
type
 real=extended;

const
  matrixA: array[1..3,1..3] of real  = ((-19/20,1/5,  3/5),
                                      (-1    ,0.1,  0.5),
                                      (-0.01 ,0  ,1/200));
  One: array [1..3,1..3] of real = ((1,0,0),
                                    (0,1,0),
                                    (0,0,1));
  U:array[1..3] of real = (1,1,1.1);

  var
   i,j,k,q:byte;
   A,At,A1,A2,Ar,One1:array[1..3,1..3] of real;
   delta,Det,S,alpha:real;
   B,Z,U1:array[1..3] of real;
   f:text;

   Procedure TransA;
    begin
     for i:=1 to 3 do
      for j:=1 to 3 do
         At[i,j]:=A[j,i]
    end;

   Function Koef(par1,par2:byte):real;
    var
     Sum:byte;
     Tmp:real;
      begin
       Sum:=par1+par2;
       Tmp:=1;
       for k:=1 to sum do
        Tmp:=Tmp*(-1);
       Koef:=Tmp;
      end;

   Function AlAdd(par1,par2:byte):real;
    type
     element=record
             value:real;
             flag:boolean;
             end;
    var
     BB:array[1..2,1..2] of real;
     AA:array[1..3,1..3] of element;
     k,v,w:byte;
     N:array[1..4] of real;
     P1:real;
    begin
     for v:=1 to 3 do
      for w:=1 to 3 do begin
       AA[v,w].value:=A2[v,w];
       AA[v,w].flag:=true
      end;
     for v:=1 to 3 do AA[par1,v].flag:=false;
     for v:=1 to 3 do AA[v,par2].flag:=false;
     { for v:=1 to 3 do begin
      for w:=1 to 3 do write(AA[i,j].value:2:3,' ');
      writeln
     end; }
     k:=1;
     for v:=1 to 3 do
      for w:=1 to 3 do
       begin
       if AA[v,w].flag then
        begin
         N[k]:=AA[v,w].value;
      {   writeln(N[k]);}
         k:=k+1
        end;
       end;
     BB[1,1]:=N[1];  BB[1,2]:=N[2];
     BB[2,1]:=N[3];  BB[2,2]:=N[4];
{     writeln('alg dop',par1,par2,' ',BB[1,1]*BB[2,2]-BB[1,2]*BB[2,1]);}
     AlAdd:=BB[1,1]*BB[2,2]-BB[1,2]*BB[2,1];
    end;

    Function DetCount:real;
     var
       S1:real;
       z:byte;
     begin
      S1:=0;
      for z:=1 to 3 do S1:=S1+A2[1,z]*Koef(1,z)*AlAdd(1,z);
      DetCount:=S1;
     end;

    Procedure RevMatr;
     begin
       for i:=1 to 3 do
        for j:=1 to 3 do
         Ar[j,i]:=Koef(i,j)*AlAdd(i,j)/DetCount;
{       for i:=1 to 3 do begin
        for j:=1 to 3 do write(Ar[i,j],' ');
        writeln;
       end;}
     end;

     Function AllRight:boolean;
      begin
       writeln(f,'*Ґўп§Є  Ї® 1-¬г н«-вг',(abs(U[1]-U1[1])));
       writeln(f,'*Ґўп§Є  Ї® 2-¬г н«-вг',(abs(U[2]-U1[2])));
       writeln(f,'*Ґўп§Є  Ї® 3-¬г н«-вг',(abs(U[3]-U1[3])));
       writeln(F);
       if (abs(U[1]-U1[1])<0.001) and (abs(U[2]-U1[2])<0.001) and
          (abs(U[3]-U1[3])<0.001) then AllRight:=true
          else AllRight:=false
      end;

     Function Pow(par1:real;par2:byte):real;
      var
       S2:real;
       z:byte;
      begin
       S2:=1;
       if par2=0 then begin
        Pow:=1;
        exit
       end
         else
           for z:=1 to par2 do S2:=S2*par1;
       Pow:=S2;
      end;

      BEGIN
       clrscr;
       Assign(f,'c:\tikh.txt');
       Rewrite(f);
       for i:=1 to 3 do
        for j:=1 to 3 do
         A[i,j]:=matrixA[i,j];
       TransA;
       Det:=0.000125;
       {----------------------------}
       for i:=1 to 3 do begin
        S:=0;
        for j:=1 to 3 do begin
          S:=S+At[i,j]*U[j];
          B[i]:=S
         end;
       end;
       {----------------------------}
       for i:=1 to 3 do
        for j:=1 to 3 do
         begin
          S:=0;
           for k:=1 to 3 do begin
            S:=S+At[i,k]*A[k,j];
            A1[i,j]:=S
           end
         end;
       {-----------------------------}
       q:=1;
      repeat
       alpha:=q/pow(4,q);
       for i:=1 to 3 do
        for j:=1 to 3 do
         One1[i,j]:=One[i,j]*alpha;
       for i:=1 to 3 do
        for j:=1 to 3 do
         A2[i,j]:=One1[i,j]+A1[i,j];
       RevMatr;
       {------------------------------}
       for i:=1 to 3 do begin
        S:=0;
        for j:=1 to 3 do begin
          S:=S+Ar[i,j]*B[j];
          Z[i]:=S
         end;
       end;
       for i:=1 to 3 do begin
        S:=0;
         for j:=1 to 3 do begin
          S:=S+A[i,j]*Z[j];
          U1[i]:=S
         end
       end;
       q:=q+1;
       until AllRight;
       {------------------------------}
       clrscr;
       writeln('ЏаЁЎ«Ё¦Ґ*ЁҐ Є *®а¬ «м*®¬г аҐиҐ*Ёо');
       for i:=1 to 3 do writeln('Z(',i,')=',z[i]);
       writeln;
       writeln('‡* зҐ*ЁҐ Їа ў®© з бвЁ ЇаЁ Ї®¤бв *®ўЄҐ ЇаЁЎ«. аҐиҐ*Ёп');
       for i:=1 to 3 do writeln('U1(',i,')=',U1[i]);
       writeln;
       writeln('‡* зҐ*ЁҐ Ї а ¬Ґва  аҐЈг«паЁ§ жЁЁ:');
       writeln(alpha);
       Close(f);
       readln;
      END.