DataMuseum.dk

top - metrics - download

    Length: 5248 (0x1480)
    Types: TextFile
    Names: »HARMON.PAS«

└─⟦a1337913c⟧ Bits:30002679 PGM1 - indeholder forskellige undervisningsprogrammer
    └─⟦this⟧ »HARMON.PAS« 

TextFile

program harmonisk_svingning;
(*$I gsx*)
type tekst =string(.40.);

var h,k,f,xscale,yscale,xmin,xmax,ymin,ymax,xny,yny,vny :real; 
    dt,tmax, xstart,vstart,a1,a2:real;
    n, i :integer;
    svar : char;
    k1,m:real;
     n1,  xenhed,yenhed, amplitude,svingtid :real;

procedure forklaring;
begin
writeln(clrhom,'                     HARMONISK SVINGNING.');
WRITELN;
writeln('   Programmet foretager en løsning af bevægelsesligningen for en har');
writeln('monisk svingning : ');
writeln('                  x''''= k/m*x-f*x''    ');
writeln;
writeln('Til at fastlægge ligningen skal masse,fjederkonstant og friktion');
writeln('indtastes.Ligeledes skal begyndelsespunktet angives med sted og ');
writeln('hastighed.');
writeln('Til bestemmelse af beregningen skal sluttidspunktet angives.');
writeln('Grafen tegnes som rette linier mellem de beregnede punkter.');
writeln('Tidsrummet mellem disse skal derfor også angives. Antallet af underindelinger');
writeln('skal ligeledes indtastes. Dette kan ofte være 1');
writeln;
writeln('For at kunne tegne koordinatsystemet skal enhederne opgives.');
writeln;
writeln('   Overalt vil programmet selv foreslå nogle værdier.');
writeln('Disse vælges ved tryk på <RETURN> ellers tastes den nye værdi.');
writeln('Til en vis grad vil programmet selv frasortere tåbelige værdier.');
writeln('Bemærk dog, at vælges antallet af underindelinger stort vil beregningerne');
writeln('tage lang tid.');
writeln;
write('tast <RETURN> når du er klar.');readln;
end;

function g(x,y,v:real):real;
  begin
   g:=-k*y-f*v;
  end;

function fv(x,y,v:real):real;
  begin
   fv:=v;   
  end;

procedure takeastep;
 var k1,l1,k2,l2,k3,l3,k4,l4,x,y,v,xgl,ygl,vgl :real;
 begin
   xgl:=xny;  ygl:=yny;   vgl:=vny;
   k1:=fv(xgl,ygl,vgl);     l1:=g(xgl,ygl,vgl);
   x:=xgl+h/2;   y:=ygl+h*k1/2;    v:=vgl+h*l1/2;
   k2:=fv(x,y,v);          l2:=g(x,y,v);
   y:=ygl+h*k2/2;         v:=vgl+h*l2/2;
   k3:=fv(x,y,v);          l3:=g(x,y,v);
   x:=xgl+h;      y:=ygl+h*k3;       v:=vgl+h*l3;
   k4:=fv(x,y,v);          l4:=g(x,y,v);
   xny:=x;
   yny:=ygl+h*(k1+2*k2+2*k3+k4)/6;
   vny:=vgl+h*(l1+2*l2+2*l3+l4)/6;
 end;
 
 procedure draw(a1,a2,b1,b2 :real);
 (* procedure der tegner en linie fra (a1,a2) til (b1,b2) *)
  var a:array(.1..2.) of coor;
  begin
    if a1<xmin then a1:=xmin; if b1<xmin then b1:=xmin;
    if a1>xmax then a1:=xmax;if b1>xmax then b1:=xmax;
    if a2<ymin then a2:=ymin;if b2<ymin then b2:=ymin;
    if a2>ymax then a2:=ymax;if b2>ymax then b2:=ymax;
    a(.1.).x:=round((a1-xmin)*xscale);
    a(.1.).y:=round((a2-ymin)*yscale);
    a(.2.).x:=round((b1-xmin)*xscale);
    a(.2.).y:=round((b2-ymin)*yscale);
    polyline(2,a);
  end;    
     
procedure koordinatsystem(xcentrum,ycentrum,xenhed,yenhed :real);
 var x,y : real;
 begin
   (*x-aksen tegnes *)
   draw(xmin,0,xmax,0);
   x:=xcentrum;
   while x>=xmin+xenhed do x:=x-xenhed;
   while x<=xmax do
     begin
       draw(x,0,x,(ymax-ymin)/60);
       x:=x+xenhed;
     end;
    (*y-aksen tegnes *)
    draw(0,ymin,0,ymax);
    y:=ycentrum;
    while y>=ymin+yenhed do y:=y-yenhed;
    while y<=ymax do
      begin
        draw(0,y,xmax/80,y);
        y:=y+yenhed;
      end;
   end;
   
procedure inputat(x,y:integer;s:tekst;var tal:real);
begin
 gotoxy(x,y);write(s,' ---> ',tal:4:2,' nyt tal ---> ' );readln(tal);
end;

function dekade(x:real):real;
 begin
  dekade:=pwrten(trunc(ln(x)/ln(10)));
 end;
     
begin (*   HOVEDPROGRAM  *)
 forklaring;
 k1:=18;m:=0.2;f:=0;xstart:=9;vstart:=0;
 repeat
  write(chr(27),chr(69));
  inputat(5,2,'Indtast fjederkonstanten ',k1);
  inputat(5,4,'Indtast massen           ',m );
  inputat(5,6,'Indtast friktionen       ',f);
  inputat(5,8,'Indtast startsted        ',xstart);
  inputat(5,10,'Indtast starthastighed   ',vstart);
  svingtid:=2*pi*sqrt(m/k1); k:=k1/m;
  amplitude:=sqrt(sqr(xstart)+m*sqr(vstart)/k1);tmax:=round(10*svingtid+0.5);
  ymax:=round(amplitude+0.5);ymin:=-ymax;xmax:=tmax;
  xenhed:=dekade(xmax);yenhed:=dekade(ymax);
  writeln('     Beregnet svingningstid    :',svingtid:4:2,' sek');
  writeln('     Beregnet maximalt udsving :',amplitude :4:2,' m');
  inputat(5,14,'Indtast sluttidspunktet  ',tmax);
  if tmax<=0 then tmax:=svingtid;
  dt:=tmax/150;xmin:=0;
  inputat(5,16,'Indtast tidsrum mellem punkter ',dt);
  n1:=1;n:=round(n1);
  inputat(5,18,'Indtast antallet af underindelinger' ,n1);
  if n1>1 then n:=round(n1);
  inputat(5,20,'Indtast enhed på tidsaksen ',xenhed);
  inputat(5,21,'Indtast enhed på x-aksen   ',yenhed);

  h:=dt/n;xmax:=tmax;
  
  xscale:=maxint/(xmax-xmin); yscale:=maxint/(ymax-ymin);
  xny:=0;yny:=xstart;vny:=vstart;
  
  openws(1);
  koordinatsystem(0,0,xenhed,yenhed) ;
  while xny<tmax do
   begin
     a1:=xny;a2:=yny;
     for i:=1 to n do takeastep;
     if (xny>=xmin) and (xny<=xmax) and (yny>=ymin) and (yny<=ymax) then
     draw(a1,a2,xny,yny);
   end;
   gtext(50,0,'<RETURN>'); readln;
   closews;
   write('Tast q for at slutte programmet ');read(kbd,svar);
  until svar in (.'Q','q'.);

 end.   «eof»