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

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,p1,p4,hg1:real;
   i,j,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;


procedure DoAllEvaluations;
begin
   IF kl = 2 THEN writeln('    h         p(7-9)          vm');
   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(7-9)          vm');
         x:=func(b);
         writeln('fb= ',x);
        end;
   readkey;
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);
   g:= 9.815;
   e:= e / 100;
   p1:=p[1];
   p4:=p[4];
   hg1:=hg[1];
   readkey;
   ClrScr;
   WriteLn('ђ бзҐв ¤«п Ёб室­ле ўҐ«ЁзЁ­');
   DoAllEvaluations;
   ClrScr;
   WriteLn('‚ амЁа㥬 P1');
   for j:=-2 to 2 do
      begin
         WriteLn('P1+(',10*j,'%)');
         p[1]:=(1+0.1*j)*p1;
         WriteLn('P1=',p[1]:nv:5);
         DoAllEvaluations;
         ClrScr;
      end;
   p[1]:=p1;
   WriteLn('‚ амЁа㥬 P4');
   for j:=-2 to 2 do
      begin
         WriteLn('P4+(',10*j,'%)');
         p[4]:=(1+0.1*j)*p4;
         WriteLn('P4=',p[4]:nv:5);
         DoAllEvaluations;
         ClrScr;
      end;
   p[4]:=p4;
   WriteLn('‚ амЁа㥬 HG1');
   for j:=-2 to 2 do
      begin
         WriteLn('HG1+(',10*j,'%)');
         hg[1]:=(1+0.1*j)*hg1;
         WriteLn('hg1=',hg[1]:nv:5);
         DoAllEvaluations;
         ClrScr;
      end;

end.