witam wszystkich programistów Pascala. Mam pewien problem mam program w którym zrąbany jest moduł graficzny czy byłby ktoś w stanie mi pomóc. pozdrawiam.
To jest kod programu
program mes10;
uses Crt,Printer,Graph,modules;
const
lsmax=10;
nfmax=3;
nnmax=22;
nmax=20;
npmax=23;
m1max=4;
lymax=4;
frmax=44;
nsmax=5;
label wybierz,poczatek;
var opis:string;
mod1,mod2,alarm,kx,ky,driver,mode:integer;
ls,nf,nn,n,np,m1,bs,ly,nj,fr,ns,i,j,mn,mm,m,ir,z2,k2:integer;
m3,m4,m5,m8,m6,m2,m7,n9,n8,i3,z4,x,y,z,ii,le,jj,xk:integer;
xm1,j1,i1,mg,tr,ac,n1,n2,k,kk,k1,yl,ij,ji,z3i,z1i,fi,fj,fk,y9:integer;
grmax,k4,sm,y1,sg,x3,czn,di,te,o,e,rh,ff,nu,et,r1,r2,z1r,ra,rb:real;
skala,licz,xm,r3,r4,r5,r6,r7,r8,p1,p2,cn,d,r,xi,xk1,z3r,skl1,skl2:real;
igt:array[1..nmax] of integer;
nst:array[1..nfmax] of integer;
tt:array[1..lymax] of real;
at,avt:array[1..nnmax,1..nnmax] of real;
xxt:array[1..nnmax,1..npmax] of real;
vct:array[1..nmax,1..m1max] of real;
amt:array[1..m1max] of real;
zt,xt,vet:array[1..nmax] of real;
rat:array[1..nnmax] of real;
stt,smt,kt,cmt,ctt,sst,sht:array[1..4,1..4] of real;
st:array[1..frmax,1..nnmax] of real;
ht:array[1..frmax,1..frmax] of real;
vmt:array[1..nnmax,1..frmax] of real;
nft:array[1..nsmax] of integer;
dnt:array[1..2,1..4] of real;
drt,dzt,mxt,nbt:array[1..4] of real;
xc,ch:char;
druk,pyt,wyniki:boolean;
kolumna1:string[12];
procedure model;
begin
cleardevice;
grmax:=et;
for mod1:=1 to ly do grmax:=grmax+tt[mod1];
skala:=280/grmax;
if skala>600/rat[ls+1] then skala:=600/rat[ls+1];
draw(20+round(rat[1]skala),290,20+round(rat[ls+1]skala),290,2);
draw(20+round(rat[1]skala),290-round(etskala),
20+round(rat[ls+1]skala),290-round(etskala),2);
for mod1:=1 to ls+1 do
draw(20+round(rat[mod1]skala),290,
20+round(rat[mod1]skala),290-round(grmaxskala),2);
for mod1:=1 to ls do
fillshape(20+round((skala(rat[mod1]+rat[mod1+1])/2)),
290-round(skala(et/2)),14,2);
grmax:=et;
for mod1:=1 to ly do
begin
grmax:=grmax+tt[mod1];
draw(20+round(rat[1]skala),290-round(grmaxskala),
20+round(rat[ls+1]skala),290-round(grmaxskala),2);
end;
grmax:=et;
for mod1:=1 to ly do
begin
grmax:=grmax+tt[mod1];
for mod2:=1 to ls do
begin
fillshape(20+round(skala(rat[mod2]+rat[mod2+1])/2),
290-round(skala*(grmax-tt[mod1]/2)),1,2);
end;
end;
draw(20,290,640,290,9);
draw(20,0,20,290,9);
draw(640,290,638,288,9);
draw(640,290,638,292,9);
draw(20,0,18,2,9);
draw(20,0,22,2,9);
settextstyle(triplexfont,horizdir,1);
outtextxy(25,10,'Z');
outtextxy(625,270,'R');
end;
procedure sub1;
begin
for ii:=1 to ns do
begin
for jj:=1 to fr do
begin
ht[nft[ii],jj]:=0;
ht[jj,nft[ii]]:=0
end;
ht[nft[ii],nft[ii]]:=1
end;
n9:=fr-1;
for x:=1 to fr do
begin
di:=ht[x,1];
if di=0 then
begin
clrscr;
writeln('Macierz H ukladu jest osobliwa');
exit
end;
for y:=1 to n9 do
begin
y9:=y+1;
ht[x,y]:=ht[x,y9]/di
end;
ht[x,fr]:=1/di;
for z:=1 to fr do
if z<>x then
begin
o:=ht[z,1];
for y:=1 to n9 do
begin
y9:=y+1;
ht[z,y]:=ht[z,y9]-ht[x,y]o
end;
ht[z,fr]:=-ht[x,fr]o
end;
end;
for ii:=1 to nn do
begin
for jj:=1 to fr do vmt[ii,jj]:=0;
for jj:=1 to fr do for kk:=1 to fr do
vmt[ii,jj]:=vmt[ii,jj]+st[kk,ii]ht[kk,jj]
end;
for ii:=1 to nn do
begin
for jj:=1 to nn do avt[ii,jj]:=0;
for jj:=1 to nn do for kk:=1 to fr do
avt[ii,jj]:=avt[ii,jj]+vmt[ii,kk]st[kk,jj]
end;
for ii:=1 to nn do for jj:=1 to nn do
xxt[ii,jj]:=xxt[ii,jj]+avt[ii,jj]bs/ff
end;
procedure sub2;
begin
for yl:=1 to ly do
begin
if yl=1 then
begin
for jj:=1 to 4 do for kk:=1 to 4 do sst[jj,kk]:=0;
for ij:=1 to 2 do
begin
case ij of
1: xi:=-0.57735027;
2: xi:=0.57735037
end;
r:=r1(1-xi)/2+r2(1+xi)/2;
mxt[1]:=1;
mxt[2]:=r;
mxt[3]:=rr;
mxt[4]:=rrr;
for jj:=1 to 4 do
begin
nbt[jj]:=0;
for kk:=1 to 4 do nbt[jj]:=nbt[jj]+mxt[kk]cmt[kk,jj]
end;
for jj:=1 to 4 do nbt[jj]:=nbt[jj]rffpi*(r2-r1);
mxt[1]:=(1-xi)/2;
mxt[2]:=(1+xi)/2;
mxt[3]:=0;
mxt[4]:=0;
for jj:=1 to 4 do
begin
for kk:=1 to 4 do kt[jj,kk]:=0;
for kk:=1 to 4 do kt[jj,kk]:=kt[jj,kk]+mxt[jj]nbt[kk]
end;
for jj:=1 to 4 do for kk:=1 to 4 do
sst[jj,kk]:=sst[jj,kk]+kt[jj,kk]
end;
fi:=i;
fj:=j;
fk:=ylnj+fj;
i1:=2i-2;
j1:=2j-2;
for jj:=1 to 2 do
begin
tr:=i1+jj;
xk:=j1+jj;
for kk:=1 to 2 do
begin
mg:=fi-1+kk;
ac:=fk+1-kk;
st[mg,tr]:=st[mg,tr]+sst[kk,jj];
st[mg,xk]:=st[mg,xk]+sst[kk,jj+2];
st[ac,tr]:=st[ac,tr]+sst[kk+2,jj];
st[ac,xk]:=st[ac,xk]+sst[kk+2,jj+2]
end;
end;
end;
for jj:=1 to 4 do for kk:=1 to 4 do sht[jj,kk]:=0;
z3r:=0;
for jj:=1 to yl do z3r:=z3r+tt[yl];
z1r:=z3r-tt[yl];
for ij:=1 to 2 do
begin
case ij of
1: xi:=-0.57735027;
2: xi:=0.57735027
end;
for ji:=1 to 2 do
begin
case ji of
1: te:=-0.57735027;
2: te:=0.57735027
end;
r:=r1*(1-xi)/2+r2*(1+xi)/2;
dnt[1,1]:=-(1-te)/4;
dnt[1,2]:=(1-te)/4;
dnt[1,3]:=(1+te)/4;
dnt[1,4]:=-(1+te)/4;
dnt[2,1]:=-(1-xi)/4;
dnt[2,2]:=-(1+xi)/4;
dnt[2,3]:=(1+xi)/4;
dnt[2,4]:=(1-xi)/4;
for jj:=1 to 4 do
begin
drt[jj]:=dnt[1,jj]2/(r2-r1);
dzt[jj]:=dnt[2,jj]2/(z3r-z1r)
end;
for jj:=1 to 4 do
begin
for kk:=1 to 4 do kt[jj,kk]:=0;
for kk:=1 to 4 do
begin
czn:=drt[jj]drt[kk]+dzt[jj]dzt[kk];
kt[jj,kk]:=kt[jj,kk]+cznpir(r2-r1)(z3r-z1r)/2
end;
end;
for jj:=1 to 4 do for kk:=1 to 4 do
sht[jj,kk]:=sht[jj,kk]+kt[jj,kk]
end;
end;
fi:=(yl-1)nj+i;
fk:=njyl+j;
for jj:=1 to 2 do
begin
for kk:=1 to 2 do
begin
ht[fi+jj-1,fi+kk-1]:=ht[fi+jj-1,fi+kk-1]+sht[jj,kk];
ht[fi+jj-1,fk-kk+1]:=ht[fi+jj-1,fk-kk+1]+sht[jj,kk+2];
ht[fk-jj+1,fi+kk-1]:=ht[fk-jj+1,fi+kk-1]+sht[jj+2,kk];
ht[fk-jj+1,fk-kk+1]:=ht[fk-jj+1,fk-kk+1]+sht[jj+2,kk+2]
end;
end;
end;
end;
procedure sub3;
begin
for ii:=1 to 4 do for jj:=1 to 4 do cmt[ii,jj]:=0;
cmt[1,1]:=1;
cmt[3,1]:=1;
cmt[2,2]:=1;
cmt[4,2]:=1;
cmt[1,2]:=r1;
cmt[1,3]:=r1r1;
cmt[1,4]:=r1r1r1;
cmt[2,3]:=2r1;
cmt[2,4]:=3cmt[1,3];
cmt[3,2]:=r2;
cmt[3,3]:=r2r2;
cmt[3,4]:=r2r2r2;
cmt[4,3]:=2r2;
cmt[4,4]:=3cmt[3,3];
n9:=3;
for x:=1 to 4 do
begin
di:=cmt[x,1];
if di=0 then
begin
clrscr;
writeln('Macierz C ukladu jest osobliwa');
exit
end;
for y:=1 to n9 do
begin
y9:=y+1;
cmt[x,y]:=cmt[x,y9]/di
end;
cmt[x,4]:=1/di;
for z:=1 to 4 do
begin
if z<>x then
begin
o:=cmt[z,1];
for y:=1 to n9 do
begin
y9:=y+1;
cmt[z,y]:=cmt[z,y9]-cmt[x,y]o
end;
cmt[z,4]:=-cmt[x,4]o
end;
end;
end;
for x:=1 to 4 do for y:=1 to 4 do ctt[x,y]:=cmt[y,x];
for ii:=1 to 4 do
begin
for jj:=1 to 4 do kt[ii,jj]:=0;
for jj:=1 to 4 do for kk:=1 to 4 do
kt[ii,jj]:=kt[ii,jj]+stt[ii,kk]cmt[kk,jj]
end;
for ii:=1 to 4 do
begin
for jj:=1 to 4 do stt[ii,jj]:=0;
for jj:=1 to 4 do for kk:=1 to 4 do
stt[ii,jj]:=stt[ii,jj]+ctt[ii,kk]kt[kk,jj]
end;
for ii:=1 to 4 do
begin
for jj:=1 to 4 do kt[ii,jj]:=0;
for jj:=1 to 4 do for kk:=1 to 4 do
kt[ii,jj]:=kt[ii,jj]+smt[ii,kk]cmt[kk,jj]
end;
for ii:=1 to 4 do
begin
for jj:=1 to 4 do smt[ii,jj]:=0;
for jj:=1 to 4 do for kk:=1 to 4 do
smt[ii,jj]:=smt[ii,jj]+ctt[ii,kk]kt[kk,jj]
end;
end;
procedure sub4;
begin
y1:=100000;
for i:=1 to nn do xt[i]:=1;
xm:=-100000;
xm1:=1;
repeat
if xm1>1 then y1:=xm;
for i:=1 to nn do
begin
sg:=0;
for j:=1 to nn do sg:=sg+at[i,j]xt[j];
zt[i]:=sg
end;
xm:=0;
for i:=1 to nn do if abs(xm)<abs(zt[i]) then xm:=zt[i];
for i:=1 to nn do xt[i]:=zt[i]/xm;
xm1:=xm1+1;
until abs((y1-xm)/xm)<=d;
x3:=0;
for i:=1 to nn do if abs(x3)<abs(xt[i]) then x3:=xt[i];
for i:=1 to nn do xt[i]:=xt[i]/x3
end;
procedure sub5;
begin
n9:=n-1;
for x:=1 to n do
begin
di:=at[x,1];
if di=0 then
begin
clrscr;
writeln('Macierz A ukladu jest osobliwa');
exit
end;
for y:=1 to n9 do
begin
y9:=y+1;
at[x,y]:=at[x,y9]/di
end;
at[x,n]:=1/di;
for z:=1 to n do
if z<>x then
begin
o:=at[z,1];
for y:=1 to n9 do
begin
y9:=y+1;
at[z,y]:=at[z,y9]-at[x,y]o
end;
at[z,n]:=-at[x,n]o
end;
end;
end;
begin
driver:=detect;
poczatek:
initgraph(driver,mode,'');
if graphresult <> grOK then halt(1);
settextstyle(triplexfont,horizdir,8);
outtextxy(0,0,' PROGRAM');
outtextxy(0,100,' MES 10');
settextstyle(smallfont,horizdir,9);
outtextxy(0,300,' Andrzej Sluzalec & Andrzej Kysiak');
repeat until keypressed;
closegraph;
ls:=0;nf:=0;nn:=0;n:=0;np:=0;m1:=0;bs:=0;ly:=0;nj:=0;fr:=0;ns:=0;i:=0;j:=0;
mn:=0;mm:=0;m:=0;ir:=0;z1r:=0;z1i:=0;z2:=0;k2:=0;
m3:=0;m4:=0;m5:=0;m8:=0;m6:=0;m2:=0;m7:=0;
n9:=0;n8:=0;i3:=0;z3r:=0;z3i:=0;z4:=0;x:=0;y:=0;z:=0;ii:=0;le:=0;jj:=0;xk:=0;
xm1:=0;j1:=0;i1:=0;mg:=0;tr:=0;ac:=0;n1:=0;n2:=0;k:=0;kk:=0;k1:=0;
yl:=0;ij:=0;ji:=0;fi:=0;fj:=0;fk:=0;y9:=0;
k4:=0;sm:=0;y1:=0;sg:=0;x3:=0;czn:=0;di:=0;
te:=0;o:=0;e:=0;rh:=0;ff:=0;nu:=0;et:=0;r1:=0;r2:=0;ra:=0;rb:=0;
xm:=0;r3:=0;r4:=0;r5:=0;r6:=0;r7:=0;r8:=0;p1:=0;p2:=0;cn:=0;d:=0;r:=0;
skl1:=0;skl2:=0;xi:=0;xk1:=0;
for i:=1 to nmax do igt[i]:=0;
for i:=1 to nfmax do nst[i]:=0;
for i:=1 to lymax do tt[i]:=0;
for i:=1 to nmax do for j:=1 to nnmax do at[i,j]:=0;
for i:=1 to nmax do for j:=1 to nnmax do avt[i,j]:=0;
for i:=1 to nmax do for j:=1 to npmax do xxt[i,j]:=0;
for i:=1 to nmax do for j:=1 to m1max do vct[i,j]:=0;
for i:=1 to m1max do amt[i]:=0;
for i:=1 to nmax do zt[i]:=0;
for i:=1 to nmax do xt[i]:=0;
for i:=1 to nmax do vet[i]:=0;
for i:=1 to nnmax do rat[i]:=0;
for i:=1 to 4 do for j:=1 to 4 do
begin
stt[i,j]:=0;smt[i,j]:=0;kt[i,j]:=0;cmt[i,j]:=0;ctt[i,j]:=0;
sst[i,j]:=0;sht[i,j]:=0
end;
for i:=1 to frmax do for j:=1 to nnmax do st[i,j]:=0;
for i:=1 to frmax do for j:=1 to frmax do ht[i,j]:=0;
for i:=1 to nnmax do for j:=1 to frmax do vmt[i,j]:=0;
for i:=1 to nsmax do nft[i]:=0;
for i:=1 to 2 do for j:=1 to 4 do dnt[i,j]:=0;
for i:=1 to 4 do
begin
drt[i]:=0;dzt[i]:=0;mxt[i]:=0;nbt[i]:=0
end;
while keypressed do xc:=readkey;
liczbainteger('Liczba elementow , LS = ',ls);
liczbainteger('Liczba ustalonych przemieszczen ustroju, NF = ',nf);
nn:=2ls+2;
n:=nn-nf;
np:=nn+1;
repeat
liczbainteger('Liczba zrodel wymuszajacych (musi byc <= N), M1 = ',m1);
liczbainteger('Liczba pow. styku plyty z plynem (musi byc 0,1 lub 2), BS = ',bs);
until (bs=0) or (bs=1) or (bs=2);
if bs<>0 then
begin
liczbainteger('Liczba warstw plynu, LY = ',ly);
nj:=ls+1;
fr:=nj(ly+1);
liczbainteger('Liczba ustalonych przemieszczen plynu, NS = ',ns);
end;
for i:=1 to nn do
begin
for j:=1 to nn do at[i,j]:=0.0;
for j:=1 to (nn+1) do xxt[i,j]:=0.0
end;
for i:=1 to nf do
begin
str(i,opis);
opis:='Pozycja wezlowa '+opis+' przemieszczenia ustalonego ustroju, NS = ';
liczbainteger(opis,nst[i]);
end;
if bs<>0 then
for i:=1 to ns do
begin
str(i,opis);
opis:='Pozycja wezlowa '+opis+' przemieszczenia ustalonego plynu, NF = ';
liczbainteger(opis,nft[i]);
end;
liczbareal('Modul sprezystosci [N/m2], E = ',e);
liczbareal('Gestosc ustroju [kg/m3], RH = ',RH);
if bs<>0 then liczbareal('Gestosc plynu [kg/m3], FF = ',ff);
liczbareal('Wspolczynnik Poissona, NU = ',nu);
liczbareal('Grubosc plyty [m], ET = ',et);
for ii:=1 to (ls+1) do
begin
str(ii,opis);
opis:='Promien dla wezla '+opis+', RA = ';
liczbareal(opis,rat[ii])
end;
if bs<>0 then
for ii:=1 to ly do
begin
str(ii,opis);
opis:='Grubosc '+opis+' warstwy plynu [m], TT = ';
liczbareal(opis,tt[ii]);
end;
wybierz:
initgraph(driver,mode,'');
klawisz(7,61);
klawisz(125,61);
klawisz(243,61);
klawisz(361,61);
klawisz(479,61);
outtextxy(54,30,'F1');
outtextxy(30,40,'DRUKARKA');
outtextxy(168,30,'F2');
outtextxy(160,40,'MODEL');
outtextxy(288,30,'F3');
outtextxy(272,40,'WYNIKI');
outtextxy(406,30,'F4');
outtextxy(390,40,'POWROT');
outtextxy(524,30,'F5');
outtextxy(506,40,'WYJSCIE');
wyniki:=false;
repeat
ch:=readkey;
if (ch=#0) then
begin
ch:=readkey;
case ord(ch) of
59: begin
drukarka(druk);
closegraph;
goto wybierz;
end;
61: wyniki:=true;
60: begin
model;
while keypressed do xc:=readkey;
repeat until keypressed;
closegraph;
goto wybierz;
end;
62: begin
pytanie(pyt);
case pyt of
true: begin
closegraph;
goto poczatek;
end;
false: begin
closegraph;
goto wybierz;
end;
end;
end;
63:
begin
pytanie(pyt);
case pyt of
true: exit;
false:begin
closegraph;
goto wybierz;
end;
end;
end;
end;
end;
until (wyniki=true) and (ord(ch)=61);
closegraph;
for le:=1 to ls do
begin
i:=le;
j:=i+1;
r1:=rat[i];
r2:=rat[j];
for ii:=1 to 4 do
begin
for jj:=1 to 4 do
begin
stt[ii,jj]:=0;
smt[ii,jj]:=0
end;
end;
ra:=r2-r1;
rb:=r2r2-r1r1;
r3:=r2r2r2-r1r1r1;
r4:=r2r2r2r2-r1r1r1r1;
r5:=r2r2r2r2r2-r1r1r1r1r1;
r6:=r2r2r2r2r2r2-r1r1r1r1r1r1;
r7:=r2r2r2r2r2r2r2-r1r1r1r1r1r1r1;
skl1:=r2r2r2r2;
skl2:=r1r1r1r1;
r8:=skl1skl1-skl2skl2;
p1:=1+nu;
p2:=1+2nu;
stt[2,2]:=ln(r2/r1);
stt[2,3]:=2p1ra;
stt[3,2]:=stt[2,3];
stt[2,4]:=1.5p2rb;
stt[4,2]:=stt[2,4];
stt[3,3]:=4p1rb;
stt[3,4]:=6p1r3;
stt[4,3]:=stt[3,4];
stt[4,4]:=9*(1.25+nu)r4;
cn:=pieetetet/(6(1-nunu));
for ii:=1 to 4 do for jj:=1 to 4 do stt[ii,jj]:=stt[ii,jj]cn;
for ii:=1 to 4 do for jj:=1 to 4 do smt[ii,jj]:=0;
smt[1,1]:=rb/2;
smt[1,2]:=r3/3;
smt[1,3]:=r4/4;
smt[1,4]:=r5/5;
smt[2,2]:=r4/4;
smt[2,3]:=r5/5;
smt[2,4]:=r6/6;
smt[3,3]:=r6/6;
smt[3,4]:=r7/7;
smt[4,4]:=r8/8;
for ii:=1 to 4 do
for jj:=ii to 4 do
if ii<>jj then smt[jj,ii]:=smt[ii,jj];
cn:=2pirhet;
for ii:=1 to 4 do for jj:=1 to 4 do smt[ii,jj]:=smt[ii,jj]cn;
sub3;
if bs<>0 then sub2;
i1:=2i-2;
j1:=2j-2;
for ii:=1 to 2 do
begin
for jj:=1 to 2 do
begin
mg:=i1+ii;
tr:=i1+jj;
ac:=j1+ii;
xk:=j1+jj;
at[mg,tr]:=at[mg,tr]+stt[ii,jj];
xxt[mg,tr]:=xxt[mg,tr]+smt[ii,jj];
at[ac,tr]:=at[ac,tr]+stt[ii+2,jj];
xxt[ac,tr]:=xxt[ac,tr]+smt[ii+2,jj];
at[mg,xk]:=at[mg,xk]+stt[ii,jj+2];
xxt[mg,xk]:=xxt[mg,xk]+smt[ii,jj+2];
at[ac,xk]:=at[ac,xk]+stt[ii+2,jj+2];
xxt[ac,xk]:=xxt[ac,xk]+smt[ii+2,jj+2]
end;
end;
end;
if bs<>0 then sub1;
mm:=0;
for i:=1 to nf do
begin
n1:=nst[i];
mm:=mm+1;
n1:=n1-mm+1;
n2:=nn-mm;
if n2>=n1 then
begin
for ii:=n1 to n2 do
for jj:=n1 to n2 do
begin
at[ii,jj]:=at[ii+1,jj+1];
xxt[ii,jj]:=xxt[ii+1,jj+1]
end;
end;
if n1<>1 then
begin
for ii:=1 to (n1-1) do
for jj:=n1 to n2 do
begin
at[ii,jj]:=at[ii,jj+1];
xxt[ii,jj]:=xxt[ii,jj+1];
at[jj,ii]:=at[jj+1,ii];
xxt[jj,ii]:=xxt[jj+1,ii]
end;
end;
end;
sub5;
for i:=1 to n do
begin
for j:=1 to n do
begin
vet[j]:=0;
for k:=1 to n do vet[j]:=vet[j]+at[i,k]xxt[k,j]
end;
for j:=1 to n do at[i,j]:=vet[j]
end;
d:=0.001;
mn:=n;
nn:=n;
sub4;
m:=1;
for i:=1 to nn do
begin
vct[i,m]:=xt[i];
xxt[i,m]:=vct[i,m]
end;
amt[m]:=xm;
case m1<2 of
true: begin
clrscr;
writeln(' Postac drgan ',i);
writeln('______________________');
writeln('Wartosc wlasna = ',amt[i]8);
writeln('Czestosc wlasna = ',sqrt(1/amt[i])/(2pi)5);
writeln;
writeln('Wektor postaci drgan:');
writeln;
writeln('---------------------------------------');
writeln('| w [m] | ',chr(233),' [rad] |');
writeln('---------------------------------------');
if druk=true then
begin
writeln(lst);
writeln(lst,' Postac drgan ',i);
writeln(lst,'______________________');
writeln(lst,'Wartosc wlasna = ',amt[i]8);
writeln(lst,'Czestosc wlasna = ',sqrt(1/amt[i])/(2pi)5);
writeln(lst);
writeln(lst,'Wektor postaci drgan:');
writeln(lst);
writeln(lst,'---------------------------------------');
writeln(lst,'| w [m] | O [rad] |');
writeln(lst,'---------------------------------------');
end;
licz:=-1;
for j:=1 to n do
begin
if licz=-1 then
begin
str(vct[j,i]10,kolumna1);
write('| ',kolumna1,' |');
end;
if licz=1 then
begin
str(vct[j,i]10,kolumna1);
writeln(' ',kolumna1,' |');
end;
if druk=true then
begin
begin
str(vct[j,i]10,kolumna1);
write(lst,'| ',kolumna1,' |');
end;
if licz=1 then
begin
str(vct[j,i]10,kolumna1);
writeln(lst,' ',kolumna1,' |');
end;
end;
licz:=licz(-1)
end;
writeln('---------------------------------------');
if druk=true then
writeln(lst,'---------------------------------------');
ekran
end;
false: begin
for m:=2 to m1 do
begin
for i:=1 to nn do
begin
k4:=abs(xxt[i,m-1]-1);
if k4<0.00001 then ir:=i
end;
igt[m-1]:=ir;
for i:=1 to nn do xxt[mn-i+1,mn-m+3]:=at[ir,i];
for i:=1 to nn do
for j:=1 to nn do
begin
z1i:=mn-j+1;
z2:=mn-m+3;
at[i,j]:=at[i,j]-xxt[i,m-1]xxt[z1i,z2]
end;
for i:=1 to nn do
begin
if i<>ir then
begin
if i>ir then k1:=i-1;
if i<=ir then k1:=i;
for j:=1 to nn do
begin
if j<>ir then
begin
if j>ir then k2:=j-1;
if j<=ir then k2:=j;
at[k1,k2]:=at[i,j]
end;
end;
end;
end;
nn:=nn-1;
m3:=nn;
if m=mn then
begin
xm:=at[1,1];
xt[1]:=1
end;
if m<>mn then sub4;
for i:=1 to nn do xxt[i,m]:=xt[i];
amt[m]:=xm;
m4:=m-1;
m5:=1000-m4;
for m8:=m5 to 999 do
begin
m6:=m3+1;
m2:=1000-m8;
m7:=igt[m2]+1;
if m6>=m7 then
begin
n9:=1000-m7;
n8:=1000-m6;
for i3:=n8 to n9 do
begin
i:=1000-i3;
xt[i]:=xt[i-1]
end;
end;
j:=igt[m2];
xt[j]:=0;
sm:=0;
for i:=1 to m6 do
begin
z3i:=mn-i+1;
z4:=mn-m2+2;
sm:=sm+xxt[z3i,z4]xt[i]
end;
xk1:=(amt[m2]-xm)/sm;
for i:=1 to m6 do xt[i]:=xxt[i,m2]-xk1xt[i];
sm:=0;
for i:=1 to m6 do if abs(sm)<abs(xt[i]) then sm:=xt[i];
for i:=1 to m6 do xt[i]:=xt[i]/sm;
m3:=m3+1;
if m2=1 then for i:=1 to m3 do vct[i,m]:=xt[i]
end;
end;
end;
end;
if m1>=2 then for i:=1 to m1 do
begin
clrscr;
writeln(' Postac drgan ',i);
writeln('____________________');
writeln;
writeln('Wartosc wlasna = ',amt[i]8);
writeln('Czestosc wlasna = ',sqrt(1/amt[i])/(2pi)5);
writeln('Wektor postaci drgan:');
writeln;
writeln('---------------------------------------');
writeln('| w [m] | ',chr(233),' [rad] |');
writeln('---------------------------------------');
if druk=true then
begin
writeln(lst);
writeln(lst,' Postac drgan ',i);
writeln(lst,'____________________');
writeln(lst);
writeln(lst,'Wartosc wlasna = ',amt[i]8);
writeln(lst,'Czestosc wlasna = ',sqrt(1/amt[i])/(2pi)5);
writeln(lst,'Wektor postaci drgan:');
writeln(lst);
writeln(lst,'---------------------------------------');
writeln(lst,'| w [m] | O [rad] |');
writeln(lst,'---------------------------------------');
end;
licz:=-1;
for j:=1 to n do
begin
if licz=-1 then
begin
str(vct[j,i]10,kolumna1);
write('| ',kolumna1,' |');
end;
if licz=1 then
begin
str(vct[j,i]10,kolumna1);
writeln(' ',kolumna1,' |');
end;
if druk=true then
begin
if licz=-1 then
begin
str(vct[j,i]10,kolumna1);
write(lst,'| ',kolumna1,' |');
end;
if licz=1 then
begin
str(vct[j,i]10,kolumna1);
writeln(lst,' ',kolumna1,' |');
end;
end;
licz:=licz(-1)
end;
writeln('---------------------------------------');
if druk=true then
writeln(lst,'---------------------------------------');
ekran
end;
end.