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

             { “а ў­Ґ­ЁҐ ђ€ЉЉЂ’€ }


 unit RC;
   interface
       uses ALG,GB;
       procedure RICC (n:integer;l:real;A,B,Q:matr;var P,R:matr);
       procedure CALM (n:integer;A,C:matr;var Kr:matr);

   implementation

          { аҐиҐ­ЁҐ га ў­Ґ­Ёп ђЁЄЄ вЁ }

     procedure RICC (n:integer;l:real;A,B,Q:matr;var P,R:matr);
              var i,j                                  :integer;
                  At,AtP,AtPA,AtPB,AtPBR,
                  Bt,BtP,BtPA,BtPB,Q1,P1,P2,P3,P4,DP   :matr;
                  lb,ndp                               :real;
     begin
       for i:=1 to n do for j:=1 to n do
       begin
         At[i,j]:=A[j,i];Bt[i,j]:=B [j,i];
         Q1[i,j]:=Q[i,j];P [i,j]:=Q1[i,j];
       end;
      repeat
       MUL(1,n,n,Bt,P,BtP);
       MUL(1,n,n,BtP,B,BtPB);
       MUL(1,n,n,BtP,A,BtPA);
       lb:=1/(l+BtPB[1,1]);
       for i:=1 to n do for j:=1 to n do R[i,j]:=lb*BtPA[i,j];
       MUL(n,n,n,At,P,AtP);
       MUL(n,n,n,AtP,A,AtPA);
       MUL(n,n,1,AtP,B,AtPB);
       MUL(n,1,n,AtPB,R,AtPBR);
       for i:=1 to n do for j:=1 to n do P1[i,j]:=-AtPBR[i,j];
       ADD(n,n,Q,AtPA,P2);
       ADD(n,n,P2,P1,P3);
       for i:=1 to n do for j:=1 to n do P4[i,j]:=-P3[i,j];
       ADD(n,n,P,P4,DP);
       ndp:=0;
       for i:=1 to n do for j:=1 to n do ndp:=ndp+sqr(DP[i,j]);
       ndp:=sqrt(ndp);
       for i:=1 to n do for j:=1 to n do P[i,j]:=P3[i,j];
      until ndp<0.00001;
     end;
     {----------------------------------------}

                  { дЁ«мва Љ «¬ ­  }

     procedure CALM (n:integer;A,C:matr;var Kr:matr);
             var i,j                  :integer;
                 At,CA,CAt,B,E,Q,P,R  :matr;
     begin
       MUL(1,n,n,C,A,CA);
       for i:=1 to n do for j:=1 to n do
       begin
         At[i,j]:=A  [i,j]; A[i,j]:=At[j,i]; CAt[i,j]:=CA[j,i];
         B [i,j]:=CAt[i,j]; E[i,j]:=0; E[i,i]:=1;Q[i,j]:=0;
       end;
       RICC(n,1,A,B,Q,P,R);
       for i:=1 to n do for j:=1 to n do
       begin
         P[i,j]:=P[j,i]; Kr[i,j]:=R[j,i];
       end;
     end;
     {----------------------------------------}


   end.








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