Скачиваний:
72
Добавлен:
03.10.2013
Размер:
3 Кб
Скачать
program dinam;
   const  m=2 (*Є®«ЁзҐбвў® аҐи Ґ¬ле Ћ„“*); np=8; nk=5; nv=11;
   type areal=array [1..m] of real;
   var del (* и Ј*),k,x0 (*­ з «м­®Ґ §­ зҐ­ЁҐ  аЈг¬Ґ­в  *),x1 :real;
   y0 (*­ з «м­лҐ §­ зҐ­Ёп дг­ЄжЁ© *),y1 :areal;
   n (* зЁб«® и Ј®ў *), kv (* Єа в­®бвм ўлў®¤  *),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);
           (*а бзҐв Їа®Ё§ў®¤­ле(pr) ¤«п ⥪гйЁе 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);
               (*и Ј Ё­вҐЈаЁа®ў ­Ёп:Ї® X Ё Y а бзҐв X1 Ё 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('ўлб®вл Ґ¬Є®б⥩ (1,2) /¬/ = ');read( hg[1], hg[2]);
      writeln('Ї«®й ¤Ё ®б­®ў ­Ё© (1,2) /¬^2/ =');read(s[1],s[2]);
      writeln('Ї«®в­®бвм ¦Ё¤Є®бвЁ /ЄЈ/¬^3/ = ');read(ro);
      writeln('­ з «м­®Ґ ¤ ў«Ґ­ЁҐ /ЊЏЂ/ = ');read(pn);
      writeln('¤ ў«Ґ­Ёп (1-4) /ЊЏЂ/ = ');    FOR i := 1 TO 4 do read(p[i]);
      writeln('Є®нддЁжЁҐ­вл бг¦ ойЁе гбва®©бвў(1-5) = ');
      FOR i := 1 TO 5 do read(ak[i]);
  10: writeln('­.г: x0,y0[1],y0[2]'); read(x0,y0[1],y0[2]);
  20: writeln('зЁб«® и Ј®ў,Єа ва®бвм ўлў®¤  ,del'); read(n,kv,del);
      writeln('ўлў®¤ Їа®¬Ґ¦гв®з.: ­Ґв - 0  з бвЁз. - 1 Ї®«­.- 2 ');read(kl1);
      writeln('ўлў®¤ १г«мв в®ў:   з бвЁз. - 1  Ї®«­.- 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('Џђ€  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('ЇаҐЄа йҐ­ЁҐ бзҐв  - 0;  Їа®¤®«¦Ґ­ЁҐ - 1; бзҐв б ­®ўл¬Ё ­.г.- 2 ');
   read(kl);
   if kl=1 then goto 20; if kl=2 then goto 10;
end.
Соседние файлы в папке GIDRA