Курсовые / curstau / SAMP

              { ¤ЁбЄаҐвЁ§ жЁп га ў­Ґ­Ё© б®бв®п­Ёп }


 unit SAMP;
   interface
       uses ALG,GB,ENEX;
       procedure EXP (tk:real;n:integer;A:matr;var FT:matr);
       procedure SMP (tk:real;n,r:integer;A,B:matr;var Ad,Bd:matr);

   implementation

                      {¬ ваЁз­л© нЄбЇ®­Ґ­жЁ «}
     procedure EXP ;
              var i,j,k,m       :integer;
                  nf            :real;
                  E,A1,F,F1,FT1 :matr;
     begin
       for i:=1 to n do  for j:=1 to n do
       begin
         if i=j then E [i,j]:=1 else E[i,j]:=0;
         F [i,j]:=E[i,j];
         FT[i,j]:=E[i,j];
       end;
       m:=1;
      repeat
       nf:=0;
       for i:=1 to n do  for j:=1 to n do A1[i,j]:=A[i,j]*tk/m;
       MUL(n,n,n,F,A1,F1);
       ADD(n,n,FT,F1,FT1);
       for i:=1 to n do  for j:=1 to n do
       begin
         nf:=nf+sqr(F1[i,j]);
         F[i,j]:=F1[i,j];
         FT [i,j]:=FT1[i,j];
       end;
       nf:=sqrt(nf);
       m:=m+1;
      until nf<0.0001;
     end;
     {---------------------------------------}

     procedure SMP ;
              var i,j,k,m                      :integer;
                  E,EI,AI,A1,A2,F1,F2,F3,B1,B2,FT :matr;
                  dd,d,dt                         :real;
     begin
       EXP(tk,n,A,Ad);
       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;
       DET(n,A,dd);
       if abs(dd)>0.0001 then
       begin
         INV(n,A,AI);
         for i:=1 to n do for j:=1 to n do EI[i,j]:=-E[i,j];
         ADD(n,n,Ad,EI,A1);
         MUL(n,n,n,AI,A1,A2);
         MUL(n,n,r,A2,B,Bd);
       end else
       begin
         for i:=1 to n do for j:=1 to n do
         begin
           B1[i,j]:=0;
           F1[i,j]:=0;
         end;
         d:=0.01*tk;
         m:=1;
        repeat
         dt:=m*d;
         EXP(dt,n,A,F2);
         ADD(n,n,F1,F2,F3);
         for i:=1 to n do for j:=1 to n do F3[i,j]:=F3[i,j]*d/2;
         ADD(n,n,B1,F3,B2);
         for i:=1 to n do for j:=1 to n do
         begin
           B1[i,j]:=B2[i,j];
           F1[i,j]:=F2[i,j];
         end;
         m:=m+1;
        until m=101;
         MUL(n,n,r,B1,B,Bd);
       end;
     end;
     {---------------------------------------}

   end.