Лабораторные работы / Программы (Pascal) - 1994 / GIDRA / DINA1Lat

program dinam;
   const  m=2 (*kolichestvo reshaemyh ODU*); np=8; nk=5; nv=11;
   type areal=array [1..m] of real;
   var del (* шаг*),k,x0 (*nachalnoe znachenie argumenta *),x1 :real;
   y0 (*nachalnie znacheniya funktsij *),y1 :areal;
   n (* chislo shagov *), kv (* kratnost vyvoda *),i,kl,kl1,kl2   :integer;
   vm,v,ak:array[1..nk] of real; p:array[1..np] of real;
    hg,h,s,pr:areal;    ro,pn,g,x:real;
    label 10,20;
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;
procedure dydx(x:real;y:areal; var pr:areal);
           (*raschet proizvodnyh(pr) dlya tekuschih x,y*)
label 300,400;    var  vm:array[1..5] of real; i:integer;
begin
        h:=y; p[7]:=pn * hg[1] / (hg[1] - h[1]); p[8]:=pn*hg[2]/(hg[2]-h[2]);
        p[5]:=p[7] + ro * g * h[1] *0.000001; p[6]:=p[8]+ro*g*h[2]*0.000001;
        v[1]:=ak[1] * SGN(p[1] - p[5]) * SQRt(ABS(p[1] - p[5]));
        v[3]:=ak[3] * SGN(p[5] - p[3]) * SQRt(ABS(p[5] - p[3]));
        v[5]:=ak[5]*sgn(p[5]-p[6])*sqrt(abs(p[5]-p[6]));
        v[2]:=ak[2] * SGN(p[2] - p[6]) * SQRt(ABS(p[2] - p[6]));
        v[4]:=ak[4] * SGN(p[6] - p[4]) * SQRt(ABS(p[6] - p[4]));
        pr[1]:=(v[1]-v[3]-v[5])/s[1]; pr[2]:=(v[2] + v[5] - v[4])/s[2];
        FOR i:=1 TO 5 do        vm[i]:=v[i] * ro;
        IF kl = 0 THEN goto 400;        IF kl = 1 THEN goto 300;
        writeln;         writeln('              p(5-7)          vm');
        writeln('           ', p[5]:nv:5, vm[1]:nv:5);
        writeln('           ', p[6]:nv:5, vm[2]:nv:5);
        writeln('           ', p[7]:nv:5, vm[3]:nv:5);
        writeln('                      ', vm[4]:nv:5);
        writeln('                      ', vm[5]:nv:5);
   300: writeln('x = ', x:nv:2, ' y[1]=',y[1]:nv:5,' y[2]=',y[2]:nv:5);
        writeln('pr[1]=',pr[1],' pr[2]=',pr[2]);
   400:
end;
procedure step(x:real;y:areal; del:real;var x1:real; var y1:areal);
               (*shag integrirovaniya: po X i Y raschet X1 i y1*)
      var pr,y12:areal; i:integer ;
begin
      dydx(x,y,pr);  for i:=1 to m do y12[i]:=y[i]+del*pr[i]/2;
      dydx(x+del/2,y12,pr); x1:=x+del; for i:=1 to m do y1[i]:=y[i]+del*pr[i];
end;
begin
      writeln('vysoty emkostei (1,2) /m/ = ');read( hg[1], hg[2]);
      writeln('ploschadi osnovanij (1,2) /m^2/ =');read(s[1],s[2]);
      writeln('plotnost zhidkosti /kg/m^3/ = ');read(ro);
      writeln('nachalnoe davlenie /MPA/ = ');read(pn);
      writeln('davleniya (1-4) /MPA/ = ');    FOR i := 1 TO 4 do read(p[i]);
      writeln('koeffitsienty suzhauschih ustroistv(1-5) = ');
      FOR i := 1 TO 5 do read(ak[i]);
  10: writeln('n.u.: x0,y0[1],y0[2]'); read(x0,y0[1],y0[2]);
  20: writeln('chislo shagov,kratnost vyvoda ,del'); read(n,kv,del);
      writeln('vyvod promezhutoch.: net - 0  chastich. - 1 poln.- 2 ');read(kl1);
      writeln('vyvod rezultatov:   chastich. - 1  poln.- 2 ');read(kl2);
   for i:=1 to n do
   begin
     kl:=kl1; step(x0,y0,del,x1,y1);
          x0:=x1;  y0:=y1;
     if (i div kv) =(i/kv) then
      begin
        write('PRI  i=',i:3);
        if kl2=1 then writeln(' x=',x0:10:5,' y[1]=',y0[1]:nv:5,' y[2]=',y0[2]:nv:5);
        if kl2=2 then begin kl:=kl2; dydx(x0,y0,pr);end
      end
   end;
   writeln('prekraschenie scheta - 0;  prodolzhenie - 1; schet s novymi n.u.- 2 ');
   read(kl);
   if kl=1 then goto 20; if kl=2 then goto 10;
end.