You are here:
Foswiki
>
Main Web
>
TWikiUsers
>
PawelWolak
>
ProgWspolrzedne
(26 May 2004,
PawelWolak
)
(raw view)
E
dit
A
ttach
<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 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. </verbatim>
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 26 May 2004,
PawelWolak
Main
Log In
or
Register
Toolbox
Create New Topic
Index
Search
Changes
Notifications
RSS Feed
Statistics
Preferences
Users
Groups
Webs
Cosmo
Main
Sandbox
System
English
Français
Polski
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