Program RungeKutta;
uses crt,graph;
Var
janafl:Text;
s,i,k:integer;
a,b,x0,y0,x1,x2,z,h,xmax,ymax,xmin,ymin:real;
u,q1,q2,q3,q4,l1,l2,l3,l4:real;
ImeFl:string;
x,y,Q,L,P:array[0..1100] of real;
c:array[1..1500,1..2] of real;
smetka : boolean;
Function f(x,y:real):real;
begin
f:=y/x+sqr(y)+sqr(x);
end;
Procedure Vavej; {Procedure za vavejdane na dannite ot klaviatura }
Begin
k:=0;
writeln;
writeln('Reshavane na uravnenieto');
writeln;
writeln(' ','y/x+ya*ya+x*x');
writeln;
write('Dolna Granica: ');readln(a);
write('Gorna Granica: ');readln(b);
u:=x[0];
write('Nachalna Stoinost - X: ');
readln(x0);
write('Nachalna Stoinost - Y: ');
readln(y0);
write('Vavedi stupkata h: ');readln(h);
readln;
ClrScr;
smetka := false;
End;
Procedure Izv; {Procedura za izvejdane na vhodnite danni}
Begin
writeln;
writeln('Reshavane na uravnenieto');
writeln;
writeln(' ','y/x+ya*ya+x*x');
writeln;
writeln('S nachalni stoinosti:');
writeln;
writeln(' Dolna Granica = ',a:9:3);
writeln(' Gorna Granica = ',b:9:3);
writeln(' Nachalna Stoinost (X) = ',x0:9:3);
writeln(' Nachalna Stoinost (Y) = ',y0:9:3);
writeln;
writeln(' Stupka: h= ',h:9:3);
readln;
ClrScr
End;
procedure Calculate(a, b, x0, y0, h: real);
var
x, y, xi, yi: real;
k1, k2, k3, k4: real;
M, i: integer;
begin
M:=round((b-a)/h);
for i := 1 to M do
begin c[i,1]:=0; c[i,2]:=0; end;
xi:=x0; yi:=y0;
xmax := -maxint; ymax := -maxint;
xmin := maxint; ymin := maxint;
c[1,1] := x0; c[1,2] := y0;
for i:=2 to M do begin
k1:=h*F(xi, yi);
k2:=h*F(xi+h/2, y+k1/2);
k3:=h*F(xi+h/2, y+k2/2);
k4:=h*F(xi+h, yi+k3);
xi:=xi+h;
yi:=yi+(k1+2*k2+2*k3+k4)/6;
if Xi>Xmax then Xmax:=xi;
if Xi<Xmin then Xmin:=Xi;
if Yi>Ymax then Ymax:=Yi;
if Yi<Ymin then Ymin:=Yi;
c[i,1]:= xi; c[i,2]:= yi;
end;
end;
Procedure Rezul; {Procedura za izvejdane na rezultata}
var row,M : integer;
Begin
{Calculate(a,b,x0,y0,h);}
Writeln;
writeln('Resheniata na uravnenieto');
writeln;
writeln(' ','y/x+ya*ya+x*x');
writeln;
writeln(' sa :');
writeln;
writeln('--------------------------------------------');
M:=round((b-a)/h);
for row := 1 to M do
begin
writeln(' ',row,': X = ',C[row,1]:3:3,' , Y = ', C[row,2]:3:3);
if row mod 30 = 0 then
begin
writeln;
write('Natisni ENTER za produljenie!'); readln;
writeln;
end;
end;
readln;
ClrScr
End;
Procedure ZapFile; {Procedura za zapisvane vuv fail vavedenite danni}
Begin
writeln;
write(' Ime na faila:'); {zadava se ime na faila janafl se svurzva s imeto , faila se suzdava}
readln(imefl);
assign(janafl,imefl);
rewrite(janafl);
writeln(janafl,a:3:3);
writeln(janafl,b:3:3);
writeln(janafl,x0:3:3);
writeln(janafl,y0:3:3);
writeln(janafl,h:3:3);
close(janafl); {faila se zatvarq}
writeln('faila e sazdaden');readln;
ClrScr;
End;
Procedure RezultFile; {Procedura,koqto zapisva v fail reshenoto uravn}
var m:integer;
Begin
writeln;
write('Ime na faila: ');
{zadava se ime na faila janafl se svurzva s
imeto,faila se sazdava}
readln(imefl);
assign(janafl,imefl);
rewrite(janafl);
writeln(janaFl,' Tochka X Y ');
writeln(janafl,'-------------------------------------');
M:=round((b-a)/h);
for i := 1 to M do
writeln(janafl,i,' ',C[i,1]:3:3,' ',C[i,2]:3:3);
close(janafl); {zatvarq se faila}
writeln('faila e sazdaden');readln;
ClrScr
End;
Procedure InFile; {Procedura koqto vavejda vhodnite danni ot faila}
Begin
k:=0;
writeln;
write('Vavedete ime na faila: '); {vavejda se ime na faila i se proverqva
dali tozi fail sashtestvuva}
readln(imefl);
assign(janafl,imefl);{$I-}
reset(janafl);{$I+}
If ioresult=0 then begin
writeln;
readln(janafl,a,b,x0,y0,h);
writeln(' Dannite sa vavedeni');
close(janaFl);End;
readln;
ClrScr;
End;
Procedure Graphh;
var
GrD,grm:integer;
p,j,M:integer;
x,y,z:real;
mx,my,hh,sf,oy,ox:real;
fl:boolean;
i : integer;
begin
x := 0;
GrD:=Detect;
InitGraph(grd,grm,'C:\bp\bgi');
p:=getmaxx-20;
j:=getmaxy-20;
mx:=p/(b-a);
my:=j/(ymax-ymin);
setcolor(red);
oy:=10+ mx*(0+abs(abs(b)-abs(a)));
Line (round(oy),0,round(oy),j);
ox:=10+ j-(abs(ymin))*my;
Line (0,round(ox),p,round(ox));
setcolor(green);
OutTextXY(p-10,round(ox)-20, 'X');
OutTextXY( round(oy)+10,10, 'Y');
fl:=true;
setcolor(15);
M:=round((b-a)/h);
for i := 1 to M do
begin
if i = 1 then moveto(round(10+mx*(C[i,1])),round(40-(c[i,2])*my));
lineto(round(10+oy+mx*(C[i,1])),round(ox-(c[i,2])*my));
end;
readln;
CloseGraph;
end;
{glavna programa}
BEGIN
Repeat {suzdava se cikal za izvejdane na menu}
Repeat
writeln;
writeln(' programa za reshavane na obiknoveno diferenc. uravnenie');
WRITELN(' po metoda na Runge-Kuta ');
writeln;
writeln;
writeln('':34,'Slednoto Menu: ');
writeln;
writeln('':15,'1-za vuvejdane na vhodnite danni ot klaviaturata');
writeln('':15,'2-za vuvejdane na vhodnite danni ot tekstov fail');
writeln('':15,'3-za zapis na vhodnnite danni v tekstov fail');
writeln('':15,'4-za izvejdane na vhodnnite danni na ekrana ');
writeln('':15,'5-za presmqtane na uravnenieto');
writeln('':15,'6-za izvejdane na rezultata ot presmetnatoto uravnenie');
writeln('':15,'7-za zapisvane na resultata v tekstov fail');
writeln('':15,'8-za izvejdane na grafika');
writeln;
writeln('':18,'0 - I Z H O D ot P R O G R A M A T A');
{sazdava se cikal koito sledi dali se vavejdat korektni danni}
writeln;
write('':20,'Posochete operaciq: ');{$I-}
readln(S);
ClrScr;
{$I+}
Until(Ioresult=0) and(S>-1) and(S<9);
Case S of
1 : Vavej;
2 : InFile;
3 : ZapFile;
4 : Izv;
5 : Calculate(a,b,x0,y0,h);
6 : Rezul;
7 : RezultFile;
8 : graphh;
end;
Until S=0;
END. {Krai na programata}