Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
15
Добавлен:
17.04.2013
Размер:
3 Кб
Скачать


                    { Љ ­®­ЁзҐбЄЁҐ д®а¬л }

 unit CANON;
   interface
       uses ALG,GB,ENEX;
       procedure CONT (n    :integer;A,B      :matr;var Sco        :matr);
       procedure OBS  (n    :integer;A,C      :matr;var Sob        :matr);
       procedure CFCON(n,m,r:integer;A,B,C,Sco:matr;var Au, Bu, Cu :matr);
       procedure CFOBS(n,m,r:integer;A,B,C,Sob:matr;var Aob,Bob,Cob:matr);


   implementation

                    {ўлзЁб«Ґ­ЁҐ ¬ ваЁжл гЇа ў«пҐ¬®бвЁ }

     procedure CONT(n:integer;A,B:matr;var Sco:matr);

              var i,j,k :integer;           {                 n-1   }
                  E,T,B1:matr;              { Sco=[B: A*B:..:A  *B] }
     begin
       for i:=1 to n do for j:=1 to n do
       begin
         E[i,j]:=0; E[i,i]:=1;
         B1[i,j]:=B[i,j];
       end;
       k:=1;
      repeat
       MUL(n,n,1,E,B1,T);
       for i:=1 to n do  Sco[i,k]:=T[i,1];
       for i:=1 to n do for j:=1 to n do
       begin
         B1[i,j]:=T[i,j];
         E[i,j]:=A[i,j];
       end;
       k:=k+1;
      until k=n+1;
     end;
     {------------------------------------------}


                  {ўлзЁб«Ґ­ЁҐ ¬ ваЁжл ­ Ў«о¤ Ґ¬®бвЁ  }

     procedure OBS(n:integer;A,C:matr;var Sob:matr);
              var i,j,k      :integer;
                  E,T,C1     :matr;
     begin
       for i:=1 to n do for j:=1 to n do
       begin
         E[i,j]:=0; E[i,i]:=1;
         C1[i,j]:=C[i,j];
       end;
       k:=1;
      repeat
       MUL(1,n,n,C1,E,T);
       for j:=1 to n do  Sob[k,j]:=T[1,j];
       for i:=1 to n do for j:=1 to n do
       begin
         C1[i,j]:=T[i,j];
         E[i,j]:=A[i,j];
       end;
       k:=k+1;
      until k=n+1;
     end;
     {------------------------------------------}


            {ЇаҐ®Ўа §®ў ­ЁҐ Є Є ­®­. д®а¬Ґ гЇа ў«пҐ¬®бвЁ}

     procedure CFCON (n,m,r:integer;A,B,C,Sco:matr;var Au, Bu, Cu :matr);
              var i,j,k          :integer;
                  E,O,T,Tk,ISco  :matr;
     begin
       INV(n,Sco,ISco);
       for j:=1 to n do O[i,j]:=0;
       MUL(1,n,n,O,ISco,T);
       for i:=1 to n do for j:=1 to n do
       if i=j then E[i,j]:=1 else E[i,j]:=0;
       k:=1;
      repeat
       MUL(1,n,n,T,E,Tk);
       for j:=1 to n do  Sco[k,j]:=Tk[k,j];
       for i:=1 to n do for j:=1 to n do E[i,j]:=A[i,j];
       k:=k+1;
      until k=n+1;
     end;
     {------------------------------------------}


               {ЇаҐ®Ўа §®ў ­ЁҐ Є Є ­®­. д®а¬Ґ ­ Ў«о¤ Ґ¬®бвЁ}

     procedure CFOBS (n,m,r:integer;A,B,C,Sob:matr;var Aob,Bob,Cob:matr);
              var ISob,Sa  :matr;
     begin
       INV(n,Sob,ISob);
       MUL(n,n,n,Sob,A,Sa);
       MUL(n,n,n,Sa,ISob,Aob);
       MUL(n,n,1,Sob,B,Bob);
       MUL(1,n,n,C,ISob,Cob);
     end;
     {------------------------------------------}
   end.











Соседние файлы в папке curstau