Лабораторные работы / Программы (Pascal, ПРИМЕРЫ) - 2001 / GIDRA / MYSTAT / MY_STAT1

program stat;
uses crt;
const
np=10; nk=7; nv=11;
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..nk] of real;
fx:real;
begin
h[1]:=x;
p[9]:=pn * hg[1] / (hg[1] - h[1]);
p[7]:=p[9] + ro * g * h[1] *0.000001;
v[1]:=ak[1] * SGN(p[1] - p[7]) * SQRt(ABS(p[1] - p[7]));
v[2]:=ak[2] * SGN(p[2] - p[7]) * SQRt(ABS(p[2] - p[7]));
v[4]:=ak[4] * SGN(p[7] - p[4]) * SQRT(ABS(p[7] - p[4]));
v[7]:=v[1] + v[2] - v[4];
p[8]:=p[7] - SGN(v[7]) * sqr(v[7] / ak[7]);
v[3]:=ak[3] * SGN(p[3] - p[8]) * SQRt(ABS(p[3] - p[8]));
v[5]:=ak[5] * SGN(p[8] - p[5]) * SQRt(ABS(p[8] - p[5]));
v[6]:=ak[6] * SGN(p[8] - p[6]) * SQRt(ABS(p[8] - p[6]));
fx:=(v[3] + v[7] - v[5] - v[6]) * ro;
FOR i:=1 TO nk do
vm[i]:=v[i] * ro;
IF kl = 0 THEN goto 400;
IF kl = 1 THEN goto 300;
writeln;
writeln( h[1]:nv:5, p[7]:nv:5, vm[1]:nv:5);
writeln(' ', p[8]:nv:5, vm[2]:nv:5);
writeln(' ', p[9]:nv:5, vm[3]:nv:5);
writeln(' ', vm[4]:nv:5);
writeln(' ', vm[5]:nv:5);
writeln(' ', vm[6]:nv:5);
writeln(' ', vm[7]:nv:5);
300: writeln('x = ', x, ' fx = ', fx);
400: FUNC := fx;
end;

procedure MPD(a,b,eps:real; var bu:boolean; var xcon:real);
var fa,fb,x,fx:real;
begin
fa:=func(a);
fb:=func(b);
if fa*fb>0 then
begin
writeln('!!! ђ……Ќ€џ Ќ…’ ');
bu:=false;
end
else
begin
repeat
x:=(a+b)/2;
fx:=func(x);
if fx*fa<0
then b:=x
else
begin
a:=x;
fa:=fx
end;
until abs(a-b)<eps;
xcon:=(a+b)/2;
bu:=true;
end;
end;


begin
ClrScr;
writeln('Ћ’ЌЋ‘€’…‹њЌЂџ ЏЋѓђ…ЌЋ‘’њ ( % ) = '); readln(e);
writeln('‚›‘Ћ’Ђ …ЊЉЋ‘’€ (1,2) /Њ/ = '); read(hg[1], hg[2]);
writeln('Џ‹Ћ’ЌЋ‘’њ /ЄЈ/¬3/ = '); readln(ro);
writeln('ЌЂ—. „Ђ‚‹…Ќ€… /ЊЇ / = ');readln(pn);
writeln('„Ђ‚‹…Ќ€… (1-6) /ЊЇ / = ');
FOR i := 1 TO 6 do read(p[i]);
writeln('ЉЋќ”. ЏђЋЏ“‘ЉЌЋ‰ ‘ЏЋ‘ЋЃЌЋ‘’€ (1-7) = ');
FOR i := 1 TO 7 do read(ak[i]);
writeln('‚›‚Ћ„ ЏђЋЊ…†“’Ћ—. : Ќ…’ - 0 —Ђ‘’ - 1 ЏЋ‹Ќ - 2 '); read(kl);
IF kl = 2 THEN writeln(' h p(7-9) 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[8] - ro * g * hg[2] *0.000001;
c:= (p[8] - pn) * hg[2];
h[2]:= (-b - SQRt(sqr(b) - 4 * a * c)) / (2 * a);
p[10]:= pn * hg[2] / (hg[2] - h[2]);
FOR i := 1 TO 7 do vm[i]:= v[i] * ro;
writeln;
writeln('ђ…‡“‹њ’Ђ’');
writeln(' h p(7-10) vm');
writeln(h[1]:nv:5, p[7]:nv:5, vm[1]:nv:5);
writeln(h[2]:nv:5, p[8]:nv:5, vm[2]:nv:5);
writeln(' ', p[9]:nv:5, vm[3]:nv:5);
writeln(' ', p[10]:nv:5, vm[4]:nv:5);
writeln(' ', vm[5]:nv:5);
writeln(' ', vm[6]:nv:5);
writeln(' ', vm[7]:nv:5);
end
else
begin
kl:=2;
writeln('a=',a:12:5);
writeln(' h p(7-9) vm');
x:=func(a);
writeln('fa= ',x);
writeln('b=',b:12:5);
writeln(' h p(5-7) vm');
x:=func(b);
writeln('fb= ',x);
end;
end.