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


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


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.






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