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 poˆudniem' else k:='po poˆudniu'; 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 ukˆadami 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(' wyj˜cie (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 dˆugo˜† geograficzn¥ (2)'); readln(q); repeat if not ((q='1') or (q='2')) then begin write('podaj prawidˆow¥ 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 dˆugo˜† 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 dˆugo˜† geograficzn¥ (2)'); readln(q); repeat if not ((q='1') or (q='2')) then begin write('podaj prawidˆow¥ 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 dˆugo˜† 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(' wyj˜cie - q'); readln(z); until (z='q'); end.