Скачиваний:
75
Добавлен:
03.10.2013
Размер:
3.73 Кб
Скачать

program stat;

uses crt;

const

np=9; nk=6; k=10;

var

vm,v,ak:array[1..nk] of real; p:array[1..np] of real;

hg,h:array[1..2] of real;

a,b,c,e,ro,pn,g,x:real;

i,kl:integer;

bu:boolean;

FUNCTION SGN(ab:real):integer;

begin

if ab>0 then sgn:=1;

if ab<0 then sgn:=-1;

if ab=0 then sgn:=0;

end;

FUNCTION FUNC (x:real):real;

label 300,400;

var vm:array[1..6] of real;fx:real;

begin

h[1]:=x;

p[8]:=pn * hg[1] / (hg[1] - h[1]);

p[4]:=p[8] + ro * g * h[1] *0.000001;

v[1]:=ak[1] * SGN(p[1] - p[4]) * SQRt(ABS(p[1] - p[4]));

v[2]:=ak[2] * SGN(p[4] - p[2]) * SQRt(ABS(p[4] - p[2]));

v[3]:=ak[3] * SGN(p[4] - p[3]) * SQRT(ABS(p[4] - p[3]));

v[4]:=v[1] - v[3] - v[2];

p[7]:=p[4] - SGN(v[4]) * sqr(v[4] / ak[4]);

v[6]:=ak[6] * SGN(p[7] - p[6]) * SQRt(ABS(p[7] - p[6]));

v[5]:=ak[5] * SGN(p[7] - p[5]) * SQRT(ABS(p[7] - p[5]));

fx:=(v[5] + v[6] - v[4]) * ro;

FOR i:=1 TO 6 do

vm[i]:=v[i] * ro;

IF kl = 0 THEN FUNC:=fx;

IF kl = 1 THEN writeln('x = ', x, ' fx = ', fx);

end;

PROCEDURE MPD(a,b,eps:real; var bu:boolean; var xcon:real);

var fa,fb,x,fx:real;

label met;

begin

fa:=func(a);

fb:=func(b);

if fa*fb>0 then

begin

writeln(' '); bu:=false; goto met

end;

repeat

x:=(a+b)/2; fx:=func(x);

if fx*fa<0 then b:=x else a:=x;

until abs(a-b)<eps;

xcon:=abs(a+b)/2; bu:=true;

met:

end;

begin

clrscr;

writeln(' e = (%)');

read(e);

writeln(' 1() = ');

read( hg[1]);

writeln('VICOTA EMKOCTI 2(M) = ');

read( hg[2]);

writeln(' ro = (/3)');

read(ro);

writeln('. pn = (P) ');

read(pn);

for i := 1 to 3 do

begin

writeln ('DAVLENIE p[',i,'] = ');

read(p[i]);

end;

for i := 5 to 6 do

begin

writeln ('DAVLENIE p[',i,'] = ');

read(p[i]);

end;

for i:=1 to 6 do

begin

writeln (' KOEFICIENT PROPUCKNOI CPOCOBNOCTI ak[',i,'] = ');

read(ak[i]);

end;

writeln(' . : - 0 - 1 - 2 ');

read(kl);

IF kl = 2 THEN writeln(' h p(5-7) vm');

g:= 9.815;

e:= e / 100;

a:= 0;

b:= hg[1] * (1 - e);

MPD(a, b, e,bu, x);

if bu then

begin

a:= ro * g * 0.000001;

b:= p[7] + ro * g * hg[2] *0.000001;

c:= (p[7] - pn) * hg[2];

h[2]:= (b - SQRt(b *b - 4 * a * c)) / 2 / a;

p[9]:= pn * hg[2] / (hg[2] - h[2]);

FOR i := 1 TO 6 do

vm[i]:= v[i] * ro;

writeln('VIVOD REZULTATA');

for i:=1 to 2 do

writeln('VICOTA h[',i,'] = ',h[i]:k:k);

writeln('DAVLENIE p[4] =',p[4]:k:K);

for i:=7 to 9 do

writeln('DAVLENIE p[',i,'] =',p[i]:k:k);

for i:=1 to 6 do

writeln('PACXOD vm[',i,'] =',vm[i]:k:k);

end

else

begin

kl:=2;

writeln('a=',a:k:k);

writeln(' h p(5-7) vm');

x:=func(a);

writeln('fa= ',x);

writeln('b=',b);

writeln(' h p(5-7) vm');

x:=func(b);

writeln('fb= ',x);

end;

repeat until keypressed

END.

Соседние файлы в папке Лабораторные работы - 2003