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

                 {  Ђ«ЈҐЎа  ¬ ваЁж  }


 unit ALG;
   interface
      uses GB;
      procedure ADD(n,m:integer;A,B:matr;var C:matr);
      procedure MUL(n,m,p:integer;A,B:matr;var C:matr);
      procedure MULV(n,m:integer;A:matr;V:vect;var U:vect);
      procedure DET(n:integer;A:matr;var d:real);
      procedure INV(n:integer;A:matr;var B:matr);

    implementation

                  { б«®¦Ґ­ЁҐ ¬ ваЁж }

      procedure ADD(n,m:integer;A,B:matr;var C:matr);
             var i,j   :integer;
      begin
        for i:=1 to n do for j:=1 to m do
        begin
          C[i,j]:=0;
          C[i,j]:=A[i,j]+B[i,j];
        end;
      end;
      {--------------------------------------------------------}


                  { г¬­®¦Ґ­ЁҐ ¬ ваЁж }

      procedure MUL(n,m,p:integer;A,B:matr;var C:matr);
             var i,j,k   :integer;
      begin
        for i:=1 to n do for j:=1 to p do
        begin
          C[i,j]:=0;
          for k:=1 to m do C[i,j]:=C[i,j]+A[i,k]*B[k,j];
        end;
      end;
      {--------------------------------------------------------}


                  { г¬­®¦Ґ­ЁҐ ¬ ваЁжл ­  ўҐЄв®а }

      procedure MULV(n,m:integer;A:matr;V:vect;var U:vect);
             var i,j   :integer;
      begin
        for i:=1 to n do
        begin
          U[i]:=0;
          for j:=1 to m do U[i]:=U[i]+A[i,j]*V[j];
        end;
      end;
      {--------------------------------------------------------}


                  { ўлзЁб«Ґ­ЁҐ ¤ҐвҐа¬Ё­ ­в }

      procedure DET(n:integer;A:matr;var d:real);
             label 1;
             var i,j,k,pr  :integer;
                 pa        :real;
                 X,Y,Z     :matr;
      begin
        If n>1 then
        begin
         repeat
          pr:=0;
          for i:=1 to n do if abs(A[1,i])>0.00001 then pr:=1;
          if pr =0 then goto 1 else
          begin
            k:=0;
           repeat
            k:=k+1;
           until (abs(A[1,k])>0.00001) or (k=n);
            for i:=1 to n do for j:=1 to n do
            begin
              X[i,j]:=0;Y[i,j]:=0;Z[i,j]:=0;
            end;
            if k>1 then for i:=1 to n do
            begin
              Z[i,1]:=-A[i,k];
              A[i,k]:=A[i,1];
              A[i,1]:=Z[i,1];
            end;
            pa:=1;
            if n>2 then for i:=1 to n-2 do pa:=pa*A[1,1];
            for i:=1 to n-1 do for j:=1 to n-1 do
            begin
              X[i,j]:=A[1,1]*A[i+1,j+1]-A[i+1,1]*A[1,j+1];
              X[i,1]:=X[i,1]/pa;
              Y[i,j]:=X[i,j];
            end;
            n:=n-1;
            for i:=1 to n do  for j:=1 to n do A[i,j]:=Y[i,j];
          end;
         until n=1;
        end;
      1:d:=A[1,1];
      end;
      {--------------------------------------------------------}


                  { ®Ўа йҐ­ЁҐ ¬ ваЁжл }

      procedure INV(n:integer;A:matr;var B:matr);
             var i,j,ii,jj   :integer;
                 d,dc        :real;
                 C           :matr;
      begin
        DET(n,A,d);
        for i:=1 to n do for j:=1 to n do B[j,i]:=0;
        for i:=1 to n do for j:=1 to n do
        begin
          for ii:=1 to n do for jj:=1 to n do C[ii,jj]:=0;
          for ii:=1 to n do for jj:=1 to n do
          begin
            C[ii,jj]:=A[ii,jj];
            C[i,jj]:=0;
            C[ii,j]:=0;
          end;
          C[i,j]:=1;
          DET(n,C,dc);
          B[j,i]:=dc/d;
        end;
      end;
      {--------------------------------------------------------}
    end.








Соседние файлы в папке curstau
  • #
    17.04.20134 Кб15ALG.PAS
  • #
    17.04.20135 Кб15ALG.TPU
  • #
    17.04.201374 Кб17ANSYS.EXE
  • #
    17.04.20133 Кб15CANON.PAS
  • #
    17.04.20134 Кб15CANON.TPU
  • #
    17.04.2013216 б15CHKLIST.MS