program precesja;
type     tab= array [1..8] of real;
var      a, a0, d, d0:tab;
         data:integer;
         s:string[3];
         c:char;
procedure deg_na_hms(var hmsrdoms :tab );
begin
hmsrdoms[1]:=int(hmsrdoms[5]/15);
hmsrdoms[2]:=int((60*frac(hmsrdoms[5]/15)));
hmsrdoms[3]:=60*frac((60*frac(hmsrdoms[5]/15)));
end;

procedure hms_na_deg(var hmsrdoms:tab);
begin
hmsrdoms[5]:=15*hmsrdoms[1];
hmsrdoms[5]:=hmsrdoms[5]+(hmsrdoms[2]/4);
hmsrdoms[5]:=hmsrdoms[5]+(hmsrdoms[3]/60)/4;
end;

procedure deg_na_rad(var hmsrdoms:tab);
begin
hmsrdoms[4]:=(pi*hmsrdoms[5])/180;
end;

procedure rad_na_deg(var hmsrdoms:tab);
begin
hmsrdoms[5]:=(180*hmsrdoms[4])/pi;
end;

procedure oms_na_deg(var hmsrdoms :tab);
begin
hmsrdoms[5]:=hmsrdoms[6]+(hmsrdoms[7]/60)+(hmsrdoms[8]/3600);
end;

procedure deg_na_oms(var hmsrdoms :tab);
begin
hmsrdoms[6]:=int(hmsrdoms[5]);
hmsrdoms[7]:=int((frac(hmsrdoms[5]))*60);
hmsrdoms[8]:=(frac((frac(hmsrdoms[5]))*60))*60;
end;


procedure preces(var data:integer;var a0,d0,a,d :tab);
var
   t,dzeta,teta,z,sind,s,c:real;
begin
   t:=(data-2000)/100;

   dzeta:=((0.6406161*t)+(0.0000839*t*t)+(0.000005*t*t*t))*(pi/180);
       z:=((0.6406161*t)+(0.0003041*t*t)+(0.0000051*t*t*t))*(pi/180);
    teta:=((0.5567530*t)-(0.0001585*t*t)-(0.0000116*t*t*t))*(pi/180);

   s:=cos(d0[4])*sin(a0[4]+dzeta);
   c:=(cos(teta)*cos(d0[4])*cos(dzeta+a0[4]))-( sin(teta)*sin(d0[4]) );
   sind:=(sin(teta)*cos(d0[4])*cos(a0[4]+dzeta))+( cos(teta)*sin(d0[4]) );
   a[4]:=arctan(abs(s/c));
   d[4]:=ArcTan (sind/sqrt (1-sqr(sind)));

   if (s>0) and (c<0) then {II ćwiartka}
   a[4]:=pi-abs(a[4]);
   if (s<0) and (c<0) then {III ćwiartka}
   a[4]:=pi+abs(a[4]);
   if (s<0) and (c>0) then {IV ćwiartka}
   a[4]:=(2*pi)-abs(a[4]);

   a[4]:=a[4]-z;
   if a[4]<0 then a[4]:=a[4]+(2*pi);
end;

begin
repeat

write ('Podaj datę (jeżeli pne to ze znakiem -).    rok  ');
readln(data);
writeln('podaj rektascencję alfa0  obiektu w eopce J2000 ( h m s)');
     writeln;
     write('                             h '); read(a0[1]);
     write('                             m '); read(a0[2]);
     write('                             s '); read(a0[3]);
     writeln;
writeln('podaj deklinację delta0 obiektu w eopce J2000   ( stopnie)');
     writeln;
      write('                             o '); read(d0[6]);
      write('                             om '); read(d0[7]);
      write('                             os '); read(d0[8]);
      writeln;

hms_na_deg(a0);
deg_na_rad(a0);
oms_na_deg(d0);
deg_na_rad(d0);

preces(data,a0,d0,a,d);

rad_na_deg(a);
rad_na_deg(d);
deg_na_hms(a);
deg_na_oms(d);
if data<0 then s:='pne' else s:='ne';

writeln(' Współrzędne obiektu na rok ',data,' ',s);
writeln;
writeln(' rektascencja    alfa= ',a[1]:2:0,'h ',a[2]:2:0,'m ',a[3]:4:2,'s');
writeln(' deklinacja     delta= ',d[6]:2:0,'o ',d[7]:2:0,'om ',d[8]:4:2,'os');
writeln;
readln;
writeln('dalej - dowolny klawisz, wyjście - q') ;
readln(c);
until  c='q';
end.
Topic revision: r1 - 26 May 2004, PawelWolak
 
This site is powered by FoswikiCopyright © CC-BY-SA by the contributing authors. All material on this collaboration platform is copyrighted under CC-BY-SA by the contributing authors unless otherwise noted.
Ideas, requests, problems regarding Foswiki? Send feedback