ProgWspolrzedne < Main

<verbatim>

program wspolrzedne;
uses crt;
type   zbior= set of char;
       tab= array [1..8] of real;
       data= array [1..3] of integer;
       str= string [230];
var A , h , fi ,l  : real;
    alfa, lambda,delta, t, czas  , LST ,GST : tab;
    d: data;
    c, z,q  :char;
    zb: zbior;
    k:str;
 label 1;
{ArcSin(x) = ArcTan (x/sqrt (1-sqr (x)))
ArcCos(x) = ArcTan (sqrt (1-sqr(x)) /x)  }


{procedure deg_na_rad(var x , r :real);
begin
r:=x*(Pi/180);
end;

procedure rad_na_deg(var r , x :real);
begin
x:=r*(180/Pi);
end;   }
procedure poludnie(var czas:tab;var k:str);
begin
if czas[1]<12 then
k:='przed poudniem'
else
k:='po poudniu';
end;


procedure deg_na_hms(var hmshd :tab );
begin
hmshd[1]:=int(hmshd[5]/15);
hmshd[2]:=int((60*frac(hmshd[5]/15)));
hmshd[3]:=60*frac((60*frac(hmshd[5]/15)));
end;

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

procedure hms_na_h(var hmshd :tab);
begin
hmshd[4]:=hmshd[1];
hmshd[4]:=hmshd[4]+(hmshd[2]/60);
hmshd[4]:=hmshd[4]+(hmshd[3]/3600);
end;

procedure h_na_hms(var hmshd :tab);
begin
hmshd[1]:=int(hmshd[4]);
hmshd[2]:=int((frac(hmshd[4]))*60);
hmshd[3]:=(frac((frac(hmshd[4]))*60))*60;
end;

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

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





procedure GST_0UT(var d:data; var czas ,GST: tab; var l:real ); {ddmmrr,h,.}
  type mies= array [1..12] of integer;
  var
  m :mies;
  p,q,r :real;
  i: integer;

  begin
   m[1]:=31; m[3]:=31; m[5]:=31; m[7]:=31; m[8]:=31; m[10]:=31; m[12]:=31;
   m[4]:=30; m[6]:=30; m[9]:=30; m[11]:=30;
   m[2]:=28;

   l:=0;

   p:=(d[3]-2000);
   q:=(int(p/4))+1;
   r:=frac(d[3]/4);
   if r<>0 then
   l:=(365*(p-q))+(366*q);
   if d[3]<>2000 then
   begin
       if r=0  then
       l:=(365*(p-q+1))+(366*(q-1));
   end;
   if r=0 then m[2]:=29;
   if d[2]<>1 then
    begin
    for i:=1 to (d[2]-1)  do
       l:=l + m[i];
    end ;
   l:=l+d[1]-0.5;     {liczone od 12 gogziny UT 1 stycznia 2000 }
   if czas[1]<12 then
   l:=l-0.5 else
   l:=l+0.5;
   p:=l/36525;
   GST[4]:=6.69737455833333 + (2400.051336907222*p)+(0.00002586222*p*p)-(0.000000001722222*p*p*p);
   GST[4]:=GST[4] - ((int(GST[4]/24))*24);
end;

procedure alfa_na_t(var alfa,lambda,czas,GST,LST,t:tab; var q:char  );  {h/d,h,h,h,h/d   }
begin
if q='1' then
  begin
    t[5]:=LST[5]-alfa[5];
    if t[5]<0 then t[5]:=t[5]+360;
  end;
if q='2' then
   begin
   LST[4]:=GST[4] + (1.002737*czas[4]) + lambda[4];
   if LST[4]<0 then  LST[4]:=LST[4] - (((int(LST[4]/24))+1)*24);
   LST[4]:=LST[4] - ((int(LST[4]/24))*24);
   t[4]:=LST[4]-alfa[4];
    if t[4]<0 then t[4]:=t[4]+24;           {w godzinach}
   end;

end;

procedure t_na_alfa(var alfa,lambda,czas,GST,LST,t:tab; var q:char  );  {h/d,h,h,h,h/d   }
begin
if q='1' then
  begin
    alfa[5]:=LST[5]-t[5];
    if alfa[5]<0 then t[5]:=alfa[5]+360;
    deg_na_hms(alfa);
  end;
if q='2' then
   begin
   LST[4]:=GST[4] + (1.002737*czas[4]) + lambda[4];
   if LST[4]<0 then  LST[4]:=LST[4] - (((int(LST[4]/24))+1)*24);
   LST[4]:=LST[4] - ((int(LST[4]/24))*24);
   alfa[4]:=LST[4]-t[4];
    if alfa[4]<0 then alfa[4]:=alfa[4]+24;
   h_na_hms(alfa);
   end;

end;

procedure top_na_rownI(var A, h, fi:real ;var t,delta:tab );  {w stopniach}
var p, q ,x :real;
begin
A:=180-A;   {azymut A liczomy z p˘nocy na zach˘d !!!!!!!!!!!!!!!!}


A:=A*(Pi/180);
h:=h*(Pi/180);
fi:=fi*(Pi/180);

p:=(cos(h))*(sin(A));
q:=((cos(fi))*(sin(h)))+((sin(fi))*(cos(h))*(cos(A)));
t[5]:=ArcTan(p/q);
{sin(delta)=}x:=((sin(h))*(sin(fi)))-((cos(fi))*(cos(h))*(cos(A)));
delta[5]:=ArcTan (x/sqrt (1-sqr(x)));

t[5]:=t[5]*(180/Pi);
delta[5]:=delta[5]*(180/Pi);

if (p>0) and (q<0) then {II wiartka}
  t[5]:=180-abs(t[5]);
if (p<0) and (q<0) then {III wiartka}
  t[5]:=180+abs(t[5]);
if (p<0) and (q>0) then {IV wiartka}
  t[5]:=360-abs(t[5]);
end;

procedure rownI_na_top(var t,delta:tab;var fi, A, h :real);  {in/out w stopniach}
var p, q ,x :real;
begin



t[5]:=t[5]*(Pi/180);
delta[5]:=delta[5]*(Pi/180);
fi:=fi*(Pi/180);

p:=(cos(delta[5]))*(sin(t[5]));
q:=((sin(fi))*(cos(delta[5]))*(cos(t[5])))-((cos(fi))*(sin(delta[5])));
A:=ArcTan(p/q);
{sin(delta)=}x:=((sin(delta[5]))*(sin(fi)))+((cos(fi))*(cos(delta[5]))*(cos(t[5])));
h:=ArcTan (x/sqrt (1-sqr(x)));

A:=A*(180/Pi);
h:=h*(180/Pi);

if (p>0) and (q<0) then {II wiartka}
  A:=180-abs(A);
if (p<0) and (q<0) then {III wiartka}
  A:=180+abs(A);
if (p<0) and (q>0) then {IV wiartka}
  A:=360-abs(A);
                if A<180 then
                A:=180-A;  {azymut A liczomy z p˘nocy na zach˘d !!!!!!!!!!!!!!!!}
                if A>180 then
                A:=540-A;
end;




begin
zb:= [ '1' , '2' , '3' ,'4' , 'q' ];
repeat
  begin
  repeat
        textcolor(green);
        writeln('===============================================================================');

        writeln('  Program dokonuje transformacji wsp˘rzŠdnych zadanego obiektu miŠdzy');
        writeln('  nastŠpujĽcymi ukadami wsp˘rzŠdnych');
        writeln;
        writeln('                                                     wybierz:');
        writeln('                    horyzontalne na r˘wnikowe  I       (1)');
        writeln('                    r˘wnikowe I  na horyzontalne       (2)');
        writeln('                    r˘wnikowe II na horyzontalne       (3)');
        writeln('                    horyzontalne na r˘wnikowe II       (4)');
        writeln;
        writeln('                    wyjcie                            (q)');
        writeln;
        writeln('                                               (Uwaga - azymut A liczony jest');
        writeln('                                                od  p˘nocy  na  zach˘d)');
        writeln;
        writeln('===============================================================================');
        writeln;
        readln(c);
        if not  (c in   zb) then
            writeln('podej poprawnĽ warto');
        normvideo;
  until (c in zb) ;

  writeln;
     if c='q' then
        goto 1 ;

     if c='1' then
     begin
     write('Podaj azymut obiektu   A=');
     readln(A);
     write('podaj wysoko obiektu h=');
     readln(h);
     write('podaj szeroko geograficznĽ fi=');
     readln(fi);

            top_na_rownI(A,h,fi,t,delta);
            deg_na_hms(t);
            deg_na_oms(delta);
     writeln;
     writeln('--------------------------------------------------------------');
     writeln('       kĽt godzinny obiektu    t= ',t[1]:2:0,'h ',t[2]:2:0,'m ',t[3]:4:2,'s');
     writeln('       deklinacja obiektu  delta= ',delta[6]:2:0,'o ',delta[7]:2:0,'m ',delta[8]:4:2,'s');
     writeln('--------------------------------------------------------------');
     end;
     if c='2' then
     begin
     writeln('poaj kĽt godzinny obiektu ( h m s)');
     writeln;
     write('                             h '); read(t[1]);
     write('                             m '); read(t[2]);
     write('                             s '); read(t[3]);
     writeln;
     write('podaj deklinacjŠ obiaktu     delta =');
       writeln;
      write('                             o ');  read(delta[6]);
      write('                             om '); read(delta[7]);
      write('                             os '); read(delta[8]);
      writeln;
     oms_na_deg(delta);
     write('podaj szeroko geograficznĽ fi=');
     readln(fi);

           hms_na_deg(t);
           rownI_na_top(t,delta,fi,A,h);

     writeln('--------------------------------------------------------------');
     writeln('          azymut obiektu   A =',A:5:3);
     writeln('        wysoko obiektu   h =',h:5:3);
     writeln('--------------------------------------------------------------');
     end;
     if c='3' then
        begin

        writeln('podaj rektascencjŠ obiektu alfa=');
        writeln;
        write('                             h '); read(alfa[1]);
        write('                             m '); read(alfa[2]);
        write('                             s '); read(alfa[3]);
        writeln;

        writeln('podaj deklinacjŠ obiaktu     delta =');
        writeln;
        write('                             o ');  read(delta[6]);
        write('                             om '); read(delta[7]);
        write('                             os '); read(delta[8]);
        writeln;
        oms_na_deg(delta);

        write('podaj szeroko geograficznĽ fi=');
        readln(fi);

        writeln('podaj czas gwiazdowy (1) lub datŠ obserwacji i dugo geograficznĽ (2)');
        readln(q);
            repeat
                if not  ((q='1') or (q='2'))  then
                begin
                 write('podaj prawidowĽ warto  ');
                 readln(q);
                end;
            until ((q='1') or (q='2'));

              if q='1'  then
               begin
               writeln('Podaj lokalny czas gwiazdowy  LST=');
               writeln;
               write('                             h '); read(LST[1]);
               write('                             m '); read(LST[2]);
               write('                             s '); read(LST[3]);
               writeln;
               hms_na_deg(alfa);
               hms_na_deg(LST);
               end;
              if q='2' then
              begin
              writeln('podaj dzieä ,miesiĽc , rok');
              writeln;
               write('                             dzieä '); read(d[1]);
               write('                           miesiĽc '); read(d[2]);
               write('                               rok '); read(d[3]);
               writeln;
              writeln('podaj godzinŠ obserwacji [UT] ');
              writeln;
               write('                             h '); read(czas[1]);
               write('                             m '); read(czas[2]);
               write('                             s '); read(czas[3]);
               writeln;
              write('Podaj dugo gegraficznĽ lambda=');
              readln(lambda[5]);
              GST_0UT(d,czas,GST,l);
              hms_na_h(alfa);
              hms_na_h(czas);
              deg_na_hms(lambda);
              hms_na_h(lambda)

             end;
           alfa_na_t(alfa,lambda,czas,GST,LST,t,q);
           if q='2' then
              begin
              h_na_hms(t);
              hms_na_deg(t);
              h_na_hms(LST);
              h_na_hms(GST);
              poludnie(czas,k);
              writeln('   Liczba dni od J2000 do dnia ',d[1]:2,' ',d[2]:2,' ',d[3]:2,' ',k,' wynosi ',l:10:0);
              writeln('  Czas gwiazdowy Greenwitch o 0 UT, GST= ',GST[1]:2:0,'h ',GST[2]:2:0,'m ',GST[3]:4:2,'s');
              writeln('  Lokalny czas gwiazdowy  LST= ',LST[1]:2:0,'h ',LST[2]:2:0,'m ',LST[3]:4:2,'s');
              writeln('  kĽt godzinny obiektu      t= ',t[1]:2:0,'h ',t[2]:2:0,'m ',t[3]:4:2,'s');
              end;
              rownI_na_top(t,delta,fi,A,h);
              writeln('--------------------------------------------------------------');
              writeln('          azymut obiektu   A =',A:5:3);
              writeln('        wysoko obiektu   h =',h:5:3);
              writeln('--------------------------------------------------------------');
     end;
     if c='4' then
        begin
        write('Podaj azymut obiektu         A=');
        readln(A);
        write('podaj wysoko obiektu       h=');
        readln(h);
        write('podaj szeroko geograficznĽ fi=');
        readln(fi);

                       top_na_rownI(A,h,fi,t,delta);

        writeln('podaj czas gwiazdowy (1) lub datŠ obserwacji i dugo geograficznĽ (2)');
        readln(q);
              repeat
                if not  ((q='1') or (q='2'))  then
                begin
                 write('podaj prawidowĽ warto  ');
                 readln(q);
                end;
              until ((q='1') or (q='2'));

              if q='1'  then
               begin
               writeln('Podaj lokalny czas gwiazdowy  LST=');
               writeln;
               write('                             h '); read(LST[1]);
               write('                             m '); read(LST[2]);
               write('                             s '); read(LST[3]);
               writeln;
               hms_na_deg(LST);
               end;
                if q='2' then
                begin
                writeln('podaj dzieä ,miesiĽc , rok');
                writeln;
                write('                             dzieä '); read(d[1]);
                write('                           miesiĽc '); read(d[2]);
                write('                               rok '); read(d[3]);
                writeln;
                writeln('podaj godzinŠ obserwacji [UT] ');
                writeln;
                write('                             h '); read(czas[1]);
                write('                             m '); read(czas[2]);
                write('                             s '); read(czas[3]);
                writeln;
                write('Podaj dugo gegraficznĽ lambda=');
                readln(lambda[5]);
                GST_0UT(d,czas,GST,l);
                hms_na_h(czas);
                deg_na_hms(lambda);
                hms_na_h(lambda);
                deg_na_hms(t);
                hms_na_h(t);
                h_na_hms(GST);
                poludnie(czas,k);
                writeln('   Liczba dni od J2000 do ',d[1]:2,' ',d[2]:2,' ',d[3]:2,' ',k,' wynosi ',l:10:0);
                writeln('  Czas gwiazdowy Greenwitch o 0 UT, GST= ',GST[1]:2:0,'h ',GST[2]:2:0,'m ',GST[3]:4:2,'s');

             end;
                       t_na_alfa(alfa,lambda,czas,GST,LST,t,q);



                if q='1' then deg_na_hms(t);
                if q='2' then
                 begin
                  h_na_hms(LST);
                  writeln('  Lokalny czas gwiazdowy  LST= ',LST[1]:2:0,'h ',LST[2]:2:0,'m ',LST[3]:4:2,'s');
                 end;
             deg_na_oms(delta);
             writeln('  kĽt godzinny obiektu      t= ',t[1]:2:0,'h ',t[2]:2:0,'m ',t[3]:4:2,'s');
             writeln;
             writeln('--------------------------------------------------------------');
             writeln('       rektascencja obiektu  alfa= ',alfa[1]:2:0,'h ',alfa[2]:2:0,'m ',alfa[3]:4:2,'s');
             writeln('       deklinacja obiektu    delta= ',delta[6]:2:0,'o ',delta[7]:2:0,'m ',delta[8]:4:2,'s');
             writeln('--------------------------------------------------------------');
     end;




   end;

      1: writeln('           dalej     - dowolny klawisz ');
         writeln('           wyjcie   - q');
         readln(z);

until  (z='q');

end.








</verbatim>
This topic: Main > TWikiUsers > PawelWolak > ProgWspolrzedne
Topic revision: 26 May 2004, PawelWolak (raw view)
Copyright © 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