A A A A Автор Тема: Созвездия (Прочитано 3010 раз)

Doof · « : 13 Янв 2003 [14:26:48] »

Нужна программа, позволяющая по координатам звезды определить к какому созвездию она относится. Проще говоря, нужно описание границ созвездий, как многоугольников с координатами вершин.
Буду очень признателен, если кинете в меня интернетовской ссылкой, где это можно найти.

Анатолий Волчков · « **Ответ #1 :** 14 Янв 2003 [09:20:24] »

Следующие три процедуры на языке Паскаль решают проблему.

Процедура определения имени созвездия (автор В. Кузьмин, ГАИШ).

Unit PE_Cns;

{ Identification of a constellation from a position }
Interface
Uses Dos, PPreNew ;
Type

hms = record
h ,
m : integer;
s : Double ;
end;

procedure Identify( Epoch,
RightAccension,Declination : DOUBLE;
Var CnsIdentification : String );

Implementation

procedure Identify( Epoch,
RightAccension,Declination : DOUBLE;
Var CnsIdentification : String );

{ Ref. : Nancy G. Roman ,
Identification of a constellation from a position,
Publ. Astr. Soc. Pacific, v.99 (July 1987, # 617, pp.695-699 }

const

AbbNames : Array [1..88] of String[3] = (
'And','Ant','Aps','Aqr','Aql','Ara','Ari','Aur','Boo','Cae','Cam',
'Cnc','CVn','CMa','CMi','Cap','Car','Cas','Cen','Cep','Cet','Cha',
'Cir','Col','Com','CrA','CrB','Crv','Crt','Cru','Cyg','Del','Dor',
'Dra','Equ','Eri','For','Gem','Gru','Her','Hor','Hya','Hyi','Ind',
'Lac','Leo','LMi','Lep','Lib','Lup','Lyn','Lyr','Men','Mic','Mon',
'Mus','Nor','Oct','Oph','Ori','Pav','Peg','Per','Phe','Pic','Psc',
'PsA','Pup','Pyx','Ret','Sge','Sgr','Sco','Scl','Sct','Ser','Sex',
'Tau','Tel','Tri','TrA','Tuc','UMa','UMi','Vel','Vir','Vol','Vul'
);

Rai : array [1..358] of single = (

0.0000, 8.0000,21.0000,18.0000, 0.0000, 9.1667, 0.0000,10.6667,
17.5000,20.1667, 0.0000,11.5000,16.5333,20.1667, 7.9667, 9.1667,
13.0000, 3.1000,20.4167,11.3333, 0.0000,14.0000,23.5833,12.0000,
13.5000,23.1667, 6.1000,20.0000,20.5367, 7.0000, 7.9667,19.7667,
20.0000,22.8667, 0.0000,19.4167, 1.7000, 2.4333, 3.1000,22.3167,
5.0000,14.0333,14.4167, 3.1667,22.1333,20.6000, 0.0000, 6.1000,
12.0833,15.2500,21.9667, 3.3333,22.8667,15.7500, 2.0417,17.0000,
0.0000, 1.3667, 6.5000,23.3333,13.5000, 0.0000,23.5833,18.1750,
18.2333,19.0833, 1.6667, 8.4167, 0.1667,12.0000, 6.8000,21.9083,
21.8750,19.1667, 9.1667,10.1667,15.4333,15.7500, 9.2500, 0.0000,
2.5167,19.3583, 4.5000,21.7333,21.8750, 6.5333, 7.3667, 0.0000,
22.0000,22.8167,22.8667, 2.5667,10.7833,12.0000, 7.7500, 9.2500,
0.7167,15.1833,23.5000,12.3333,23.7500,13.9583, 2.4167, 2.7167,
4.5000,18.1750,11.0000,19.6667, 4.7500, 9.8833,13.2500, 0.0000,
1.4083, 5.8833, 7.8833,20.9167,19.2583, 1.9167,16.1667,15.0833,
15.1833,18.3667,10.7500,18.8667, 1.6667, 0.7167,10.5000,21.2500,
5.7000, 0.0667,15.9167, 5.8833,19.8333,18.8667, 0.1417,20.2500,
7.8083,20.5667,19.2500, 3.2833,18.8667, 5.7000, 6.2167,19.0000,
4.9667,15.9167,19.8333, 4.6167, 5.3333,12.8333,17.2500,11.8667,
7.5000,16.7500, 0.0000, 5.6000, 7.0000,21.1167, 6.3083,18.2500,
20.8750,21.0500,11.5167, 6.2417, 6.9333, 7.8083,23.8333, 1.6667,
20.1417,13.5000,22.7500, 7.9250, 9.2500,18.2500,18.6622,20.8333,
7.0000,18.2500,16.0833,18.2500,21.4667, 0.0000,18.5833,20.3000,
20.8333,21.3333,22.0000,21.6667, 7.0167, 3.5833, 4.6167, 7.2000,
14.6667,17.8333, 2.6500, 3.2833,15.0833, 4.6667, 5.8333,17.8333,
18.2500,18.5833,22.7500,10.7500,11.5167, 0.0000,23.8333,14.2500,
15.9167,20.0000,21.3333,17.1667, 5.8333, 4.9167, 5.0833, 8.0833,
9.5833,11.8333,17.5833,18.8667, 4.8333,20.5333,17.1667,18.2500,
8.3667,16.2667, 8.5833,10.7500,16.2667,15.6667,12.5833,12.8333,
9.0833, 1.6667, 2.6500,10.8333,11.8333,14.2500,16.2667, 0.0000,
21.3333,21.8667,23.8333, 9.7500, 4.7000, 4.8333,20.0000,10.2500,
12.5833,14.9167,15.6667, 4.5833,16.7500,17.6000,10.5833, 6.1167,
12.2500,10.8333, 3.5000, 8.3667, 4.2667,17.8333,21.3333,23.0000,
3.0000, 9.3667, 0.0000, 0.0000, 1.6667, 3.8667,23.3333,14.1667,
15.6667,16.0000, 4.8333, 5.0000, 8.0000, 3.4167,16.4208,17.8333,
19.1667,20.3333, 3.0000, 4.5000,15.3333, 0.0000, 2.6667, 4.0833,
4.2667,21.3333, 6.0000, 8.0000, 2.4167, 3.8333, 0.0000, 6.0000,
8.1667, 3.5000, 3.8333, 0.0000, 2.1667, 4.5000,15.0500, 8.4500,
6.1667,11.8333,14.1667,15.0500, 4.0000, 8.8333,11.0000,17.5000,
18.0000,22.0000, 3.2000, 5.0000, 6.5000, 0.0000, 1.3333,23.3333,
4.3333,15.3333,20.3333, 5.5000,15.1667,16.4208,14.9167,16.5833,
6.0000, 6.8333,11.2500,11.8333,12.8333,13.5000,16.7500, 2.1667,
3.2000,14.7500,16.8333,17.5000,22.0000, 4.5833,13.6667,14.7500,
0.0000, 3.5000, 6.5833, 9.0333,11.2500,18.0000,21.3333,23.3333,
0.7500, 0.0000, 7.6667,13.6667, 3.5000, 0.0000 );

Rau : array [1..358] of single = (

24.0000,14.5000,23.0000,21.0000, 8.0000,10.6667, 5.0000,14.5000,
18.0000,21.0000, 3.5083,13.5833,17.5000,20.6667, 9.1667,11.3333,
16.5333, 3.4167,20.6667,12.0000, 0.3333,15.6667,24.0000,13.5000,
14.4167,23.5833, 7.0000,20.4167,20.6000, 7.9667, 8.4167,20.0000,
20.5367,23.1667, 2.4333,19.7667, 1.9083, 3.1000, 3.1667,22.8667,
6.1000,14.4167,19.4167, 3.3333,22.3167,21.9667, 1.7000, 6.5000,
13.5000,15.7500,22.1333, 5.0000,23.3333,17.0000, 2.5167,18.2333,
1.3667, 1.6667, 6.8000,24.0000,14.0333, 1.1167,24.0000,18.2333,
19.0833,19.1667, 2.0417, 9.1667, 0.8667,12.0833, 7.3667,21.9667,
21.9083,19.4000,10.1667,10.7833,15.7500,16.3333, 9.5833, 2.5167,
2.5667,19.4000, 4.6917,21.8750,22.0000, 7.3667, 7.7500, 2.0000,
22.8167,22.8667,23.5000, 2.7167,11.0000,12.3333, 9.2500, 9.8833,
1.4083,15.4333,23.7500,13.2500,24.0000,14.0333, 2.7167, 4.5000,
4.7500,19.3583,12.0000,20.9167, 5.8833,10.5000,13.9583, 0.0667,
1.6667, 6.5333, 8.0000,21.7333,19.6667, 2.4167,16.3333,15.1833,
16.1667,18.8667,11.0000,19.2583, 1.9167, 0.8500,10.7500,21.4167,
5.8833, 0.1417,16.0333, 6.2167,20.2500,19.2500, 0.8500,20.5667,
7.8833,21.2500,19.8333, 3.3667,19.0000, 5.7667, 6.3083,19.8333,
5.3333,16.0833,20.2500, 4.9667, 5.6000,13.5000,18.2500,12.8333,
7.8083,17.2500, 0.1417, 5.7667, 7.5000,21.3333, 6.9333,18.8667,
21.0500,21.1167,11.8667, 6.3083, 7.0000, 7.9250,24.0000, 3.2833,
20.3000,15.0833,23.8333, 9.2500,10.7500,18.6622,18.8667,20.8750,
7.0167,18.4250,16.7500,18.4250,21.6667, 2.0000,18.8667,20.8333,
21.3333,21.4667,22.7500,22.0000, 7.2000, 4.6167, 4.6667, 8.0833,
15.0833,18.2500, 3.2833, 3.5833,16.2667, 5.0833, 6.2417,17.9667,
18.5833,18.8667,23.8333,11.5167,11.8333, 0.3333,24.0000,14.6667,
16.2667,20.5333,21.8667,17.9667, 8.0833, 5.0833, 5.8333, 8.3667,
10.7500,12.8333,17.6667,20.0000, 4.9167,21.3333,18.2500,18.8667,
8.5833,16.3750, 9.0833,10.8333,16.3750,15.9167,12.8333,14.2500,
9.7500, 2.6500, 3.7500,11.8333,12.5833,14.9167,16.7500, 1.6667,
21.8667,23.8333,24.0000,10.2500, 4.8333, 6.1167,21.3333,10.5833,
14.9167,15.6667,16.0000, 4.7000,17.6000,17.8333,10.8333, 7.3667,
12.5833,12.2500, 3.7500, 9.3667, 4.5833,19.1667,23.0000,23.3333,
3.5000,11.0000, 1.6667, 1.6667, 3.0000, 4.2667,24.0000,14.9167,
16.0000,16.4208, 5.0000, 6.5833, 8.3667, 3.8667,17.8333,19.1667,
20.3333,21.3333, 3.4167, 4.8333,15.6667, 2.3333, 3.0000, 4.2667,
4.5000,22.0000, 8.0000, 8.1667, 2.6667, 4.0833, 1.8333, 6.1667,
8.4500, 3.8333, 4.0000, 1.5833, 2.4167, 5.0000,15.3333, 8.8333,
6.5000,12.8333,15.0500,15.3333, 4.3333,11.0000,11.2500,18.0000,
20.3333,23.3333, 3.5000, 5.5000, 6.8333, 1.3333, 2.1667,24.0000,
4.5833,16.4208,21.3333, 6.0000,15.3333,16.5833,15.1667,16.7500,
6.8333, 9.0333,11.8333,12.8333,14.5333,13.6667,16.8333, 3.2000,
4.5833,14.9167,17.5000,18.0000,23.3333, 6.5833,14.7500,17.0000,
1.3333, 4.5833, 9.0333,11.2500,13.6667,21.3333,23.3333,24.0000,
1.3333, 3.5000,13.6667,18.0000, 7.6667,24.0000 );

Dcl : array [1..358] of single = (

88.0000, 86.5000, 86.1677, 86.0000, 85.0000, 82.0000, 80.0000, 80.0000,
80.0000, 80.0000, 77.0000, 77.0000, 75.0000, 75.0000, 73.5000, 73.5000,
70.0000, 68.0000, 67.0000, 66.5000, 66.0000, 66.0000, 66.0000, 64.0000,
63.0000, 63.0000, 62.0000, 61.5000, 60.9167, 60.0000, 60.0000, 59.5000,
59.5000, 59.0833, 58.5000, 58.0000, 57.5000, 57.0000, 57.0000, 56.2500,
56.0000, 55.5000, 55.5000, 55.0000, 55.0000, 54.8333, 54.0000, 54.0000,
53.0000, 53.0000, 52.7500, 52.5000, 52.5000, 51.5000, 50.5000, 50.5000,
50.0000, 50.0000, 50.0000, 50.0000, 48.5000, 48.0000, 48.0000, 47.5000,
47.5000, 47.5000, 47.0000, 47.0000, 46.0000, 45.0000, 44.5000, 44.0000,
43.7500, 43.5000, 42.0000, 40.0000, 40.0000, 40.0000, 39.7500, 36.7500,
36.7500, 36.5000, 36.0000, 36.0000, 36.0000, 35.5000, 35.5000, 35.0000,
35.0000, 34.5000, 34.5000, 34.0000, 34.0000, 34.0000, 33.5000, 33.5000,
33.0000, 33.0000, 32.0833, 32.0000, 31.3333, 30.7500, 30.6667, 30.6667,
30.0000, 30.0000, 29.0000, 29.0000, 28.5000, 28.5000, 28.5000, 28.0000,
28.0000, 28.0000, 28.0000, 28.0000, 27.5000, 27.2500, 27.0000, 26.0000,
26.0000, 26.0000, 25.5000, 25.5000, 25.0000, 23.7500, 23.5000, 23.5000,
22.8333, 22.0000, 22.0000, 21.5000, 21.2500, 21.0833, 21.0000, 20.5000,
20.0000, 19.5000, 19.1667, 19.0000, 18.5000, 18.0000, 17.5000, 16.1667,
16.0000, 16.0000, 15.7500, 15.5000, 15.5000, 15.0000, 14.3333, 14.0000,
13.5000, 12.8333, 12.5000, 12.5000, 12.5000, 12.5000, 12.0000, 12.0000,
11.8333, 11.8333, 11.0000, 10.0000, 10.0000, 10.0000, 10.0000, 9.9167,
8.5000, 8.0000, 7.5000, 7.0000, 7.0000, 6.2500, 6.2500, 6.0000,
5.5000, 4.5000, 4.0000, 3.0000, 2.7500, 2.0000, 2.0000, 2.0000,
2.0000, 2.0000, 2.0000, 1.7500, 1.5000, 0.0000, 0.0000, 0.0000,
0.0000, 0.0000, -1.7500, -1.7500, -3.2500, -4.0000, -4.0000, -4.0000,
-4.0000, -4.0000, -4.0000, -6.0000, -6.0000, -7.0000, -7.0000, -8.0000,
-8.0000, -9.0000, -9.0000,-10.0000,-11.0000,-11.0000,-11.0000,-11.0000,
-11.0000,-11.0000,-11.6667,-12.0333,-14.5000,-15.0000,-16.0000,-16.0000,
-17.0000,-18.2500,-19.0000,-19.0000,-19.2500,-20.0000,-22.0000,-22.0000,
-24.0000,-24.3833,-24.3833,-24.5000,-24.5000,-24.5000,-24.5833,-25.5000,
-25.5000,-25.5000,-25.5000,-26.5000,-27.2500,-27.2500,-28.0000,-29.1667,
-29.5000,-29.5000,-29.5000,-30.0000,-30.0000,-30.0000,-31.1667,-33.0000,
-33.0000,-35.0000,-36.0000,-36.7500,-37.0000,-37.0000,-37.0000,-37.0000,
-39.5833,-39.7500,-40.0000,-40.0000,-40.0000,-40.0000,-40.0000,-42.0000,
-42.0000,-42.0000,-43.0000,-43.0000,-43.0000,-44.0000,-45.5000,-45.5000,
-45.5000,-45.5000,-46.0000,-46.5000,-48.0000,-48.1667,-49.0000,-49.0000,
-49.0000,-50.0000,-50.7500,-50.7500,-51.0000,-51.0000,-51.5000,-52.5000,
-53.0000,-53.1667,-53.1667,-53.5000,-54.0000,-54.0000,-54.0000,-54.5000,
-55.0000,-55.0000,-55.0000,-55.0000,-56.5000,-56.5000,-56.5000,-57.0000,
-57.0000,-57.0000,-57.5000,-57.5000,-58.0000,-58.5000,-58.5000,-58.5000,
-59.0000,-60.0000,-60.0000,-61.0000,-61.0000,-61.0000,-63.5833,-63.5833,
-64.0000,-64.0000,-64.0000,-64.0000,-64.0000,-65.0000,-65.0000,-67.5000,
-67.5000,-67.5000,-67.5000,-67.5000,-67.5000,-70.0000,-70.0000,-70.0000,
-75.0000,-75.0000,-75.0000,-75.0000,-75.0000,-75.0000,-75.0000,-75.0000,
-76.0000,-82.5000,-82.5000,-82.5000,-85.0000,-90.0000 );

Cnumbers : array [1..358] of byte = (

84,84,84,84,20,11,20,11,
84,34,20,11,84,20,11,34,
84,18,34,34,20,84,20,34,
34,20,11,34,20,11,83,34,
20,20,18,34,18,18,11,20,
11,83,34,11,20,20,18,51,
83,34,20,11,18,34,63,34,
18,63,51,18,83,18,18,40,
34,31,63,83,18,83,51,31,
31,31,83,83,9,40,51,1,
63,52,63,31,45,8,51,1,
45,45,1,63,83,13,51,47,
1,9,1,13,1,13,80,63,
8,52,83,31,8,47,13,1,
80,8,38,31,31,80,27,9,
27,52,47,52,80,66,47,88,
78,1,76,38,88,88,1,88,
38,88,88,7,71,60,38,71,
78,40,71,78,78,25,40,25,
38,40,62,78,38,62,38,40,
32,62,46,60,38,12,62,7,
32,9,62,12,46,59,5,32,
15,76,40,59,62,66,76,32,
35,62,62,62,15,78,60,15,
86,59,21,78,76,60,60,76,
76,5,66,46,86,66,66,86,
59,5,4,59,55,36,60,42,
77,86,59,5,36,4,76,75,
42,59,42,29,59,49,28,86,
42,21,36,29,28,49,59,21,
16,4,21,42,36,48,16,42,
42,49,73,36,59,72,42,14,
42,42,37,69,36,72,67,74,
37,2,74,64,37,36,74,19,
50,73,10,24,68,36,73,26,
72,54,36,10,50,64,36,41,
10,39,68,85,36,41,64,17,
85,41,33,64,36,65,50,85,
17,19,50,57,33,85,19,6,
79,39,41,65,17,64,36,64,
33,57,44,65,23,6,23,6,
65,17,19,30,19,23,6,41,
70,23,6,61,82,33,23,81,
82,43,87,17,56,61,44,82,
82,43,22,3,53,58 );

function ArcTg( s,c : Double ): Double ;
var
ss,sc : integer;
a,pi2,pi32 : Double ;
begin
pi2 :=pi/2.0; pi32 :=3.0*pi2;

if s < 0.0 then ss:=-1 else ss:=1;
if c < 0.0 then sc:=-1 else sc:=1;
if c = 0.0 then
case ss of
1 : a :=pi2;
-1 : a :=pi32;
end
else
begin
a := ArcTan( s / c );
if sc = 1 then
begin
if ss = -1 then a :=a + 2.0 * pi
end
else
a := a + pi
end;
ArcTg :=a;
end; { ArcTg }

procedure Precess(jde1,jde2 : Double ;var X,Y,Z : Double );

{ Precess from jde1 to jde2 using 1896 precession constant }

const
hy = 36524.2198781;
t0 = 2415020.313516463;
sr = 206264.8062470964;
var
dt,dt2,dt3,t,t2,
s1,s2,s3,c1,c2,c3,
jdc1,jdc2 : Double ;
begin

jdc1:=jde1;
jdc2:=jde2;
t :=(jde1-t0)/hy;
dt:=(jde2-jde1)/hy;

t2 := t * t ;
dt2 := dt * dt ;
dt3 := dt2 * dt ;

s2 := ( 2304.253 + 1.3973 * t + 0.00006 * t2 ) * dt ;

s1:=s2 + ( 0.3023 - 0.0027 * t ) * dt2 + 0.01800 * dt3 ;
s3:=s2 + ( 1.0950 + 0.0039 * t ) * dt2 + 0.01832 * dt3 ;
s2:= ( 2004.685 - 0.8533 * t - 0.00037 * t2 ) * dt
- ( 0.4267 + 0.00037 * t ) * dt2 - 0.0418 * dt3 ;

s1:=s1/sr;
s2:=s2/sr;
s3:=s3/sr;

c1:=cos(s1);
c2:=cos(s2);
c3:=cos(s3);

s1:=sin(s1);
s2:=sin(s2);
s3:=sin(s3);

dt:= x * c1 - y * s1;
dt2:= x * s1 + y * c1;
dt3:= z;

x:= dt * c2 - dt3 * s2;
y:= dt2;
z:= dt * s2 + dt3 * c2;

dt:= x * c3 - y * s3;
dt2:= x * s3 + y * c3;
dt3:= z;

x:= dt;
y:= dt2;
z:= dt3;

end; { Precession }

var
Found : boolean;
i : integer;
X,Y,Z,
jde1,jde2,
ca,sa,
cd,sd,
a75,d75,
pi2,pi32: Double ;
begin

pi2 := pi / 2.0 ;
pi32 := pi2 * 3.0 ;

jde1 := 2433282.4234555134 ; { 1950.0 }
jde2 := jde1 - 75.0 * 365.242198781 ; { 1875 }
PreNew ( Epoch, jde1, RightAccension, Declination ) ;

ca := cos ( RightAccension );
sa := sin ( RightAccension );

cd := cos ( Declination );
sd := sin ( Declination );

X:= ca * cd;
Y:= sa * cd;
Z:= sd;

Precess (jde1,jde2,X,Y,Z);
a75:= ArcTg ( y, x );
d75:= ArcTan ( z / sqrt ( x * x + y * y ) );
a75:= a75 * 12.0 / pi;
d75:= d75 * 180.0 / pi;

{ Identification }

Found:=false;
i:=0;
repeat
i:=i+1;
if Dcl <= d75 then
if Rau > a75 then
if Rai <= a75 then
if Rau >= a75 then
Found:=true;
until Found OR ( i = 358 );

{ Identified ? }
if NOT Found then
CnsIdentification := ' ? '
else
CnsIdentification := AbbNames [ Cnumbers [ i ] ] ;

end; { Identify }

end.

Анатолий Волчков · « **Ответ #2 :** 14 Янв 2003 [09:23:32] »

Авторы следующих двух процедур А. Волчков, К. Куимов (ГАИШ)

UNIT PPreNew ;

INTERFACE

   PROCEDURE PreNew ( JDE1, JDE2 : DOUBLE ;
VAR RA, DECL : DOUBLE ) ;

IMPLEMENTATION

Uses PAtan2 ;

   PROCEDURE PreNew ( JDE1, JDE2 : DOUBLE ;
VAR RA, DECL : DOUBLE ) ;
CONST

HY : Double = 36525.0 ;
T0 : Double = 2451545.0 ;
SR : Double = 206264.8062470964 ;
Pi2 : Double = Pi + Pi ;

CC1 : Double = 2306.2181 ;
CC2 : Double = 1.39656 ;
CC3 : Double = 0.000139 ;
CC4 : Double = 0.30188 ;
CC5 : Double = 0.000344 ;
CC6 : Double = 0.017998 ;
CC7 : Double = 1.09468 ;
CC8 : Double = 0.000066 ;
CC9 : Double = 0.018203 ;
CC10 : Double = 2004.3109 ;
CC11 : Double = 0.85330 ;
CC12 : Double = 0.000217 ;
CC13 : Double = 0.42665 ;
CC14 : Double = 0.000217 ;
CC15 : Double = 0.041833 ;

VAR

DT,DT2,DT3,T,T2,S1,S2,S3,C1,C2,C3,
X, Y, Z,
SRA, CRA,
XEkl, YEkl, ZEkl, Eps, SEps, CEps ,
LEkl, BEkl : Double ;

BEGIN

T := ( JDE1 - T0 ) / HY ;
DT := ( JDE2 - JDE1 ) / HY ;

Z := SIN ( DECL ) ;
Y := SQRT ( 1.0 - Z * Z ) ;
SRA := SIN ( RA ) ;
CRA := COS ( RA ) ;
X := CRA * Y ;
Y := SRA * Y ;

If ( Abs ( DT ) <= 10.0 ) Then
Begin

T2 := T * T ;
DT2 := DT * DT ;
DT3 := DT2 * DT ;

S2 := ( CC1 + CC2 * T - CC3 * T2 ) * DT ;
S1 := S2 + ( CC4 - CC5 * T ) * DT2 + CC6 * DT3 ;
S3 := S2 + ( CC7 + CC8 * T ) * DT2 + CC9 * DT3 ;
S2 := ( CC10 - CC11 * T - CC12 * T2 ) * DT ;
S2 := S2 - ( CC13 + CC14 * T ) * DT2 - CC15 * DT3 ;

S1 := S1 / SR ;
S2 := S2 / SR ;
S3 := S3 / SR ;

C1 := COS ( S1 ) ;
C2 := COS ( S2 ) ;
C3 := COS ( S3 ) ;

S1 := SIN ( S1 ) ;
S2 := SIN ( S2 ) ;
S3 := SIN ( S3 ) ;

DT := X * C1 - Y * S1 ;
DT2 := X * S1 + Y * C1 ;
DT3 := Z ;

X := DT * C2 - DT3 * S2 ;
Y := DT2 ;
Z := DT * S2 + DT3 * C2 ;

DT := X * C3 - Y * S3 ;
DT2 := X * S3 + Y * C3 ;
DT3 := Z ;

X := DT ;
Y := DT2 ;
Z := DT3 ;

End
Else
Begin

     T := ( ( JDE1 + JDE2 ) / 2.0 - 2451545.0 ) / 36525.0;

    Eps:= ( 84381.448 ) / SR ;

    SEps := Sin ( Eps );
    CEps := Cos ( Eps );

XEkl := X ;
YEkl := Y * CEps + Z * SEps ;
    ZEkl := - Y * SEps + Z * CEps ;

LEkl := ATan2 ( YEkl , XEkl ) ;
BEkl := Atan2 ( ZEkl , Sqrt ( Sqr ( XEkl ) + Sqr ( YEkl ) ) ) ;
If ( BEkl > Pi ) Then
BEkl := BEkl - Pi2 ;

LEkl := LEkl + 5029.0966 * DT / SR ;

ZEkl := Cos ( BEkl ) ;
XEkl := Cos ( LEkl ) * ZEkl ;
YEkl := Sin ( LEkl ) * ZEkl ;
ZEkl := Sin ( BEkl ) ;

X := XEkl ;
Y := YEkl * CEps - ZEkl * SEps ;
    Z := YEkl * SEps + ZEkl * CEps ;

End ;

Ra := ATan2 ( Y , X ) ;
Decl := Atan2 ( Z , Sqrt ( Sqr ( X ) + Sqr ( Y ) ) ) ;
If ( Decl > Pi ) Then
Decl := Decl - Pi2 ;

END ;

END.

Unit PAtan2 ;

InterFace

   Function Atan2 ( S, C : Double ) : Double ;

Implementation

   Function Atan2 ( S, C : Double ) : Double ;

Const
C20 : Double = 2.0 ;
Pi2 : Double = Pi * 2.0 ;
Pid2 : Double = Pi / 2.0 ;
Pi270 : Double = Pi * 2.0 - Pi / 2.0 ;

Var
A : Double ;

Begin

If ( ( S = 0.0 )
And ( C = 0.0 ) )
Then
Begin
ATan2 := 0.0 ;
End
Else
Begin
If ( Abs ( C ) > 0.0 )
Then
Begin
If ( Abs ( C ) > Abs ( S ) )
Then
Begin
A := ArcTan ( S / C ) ;
End
Else
Begin
If ( ( C / S ) < 0.0 )
Then A := Pi270 - ArcTan ( C / S )
Else A := Pid2 - ArcTan ( C / S ) ;
End ;

If ( C < 0.0 ) Then A := A + Pi ;
If ( A < 0.0 ) Then A := A + Pi2 ;
If ( A > Pi2 ) Then A := A - Pi2 ;

End
Else
Begin
If ( S > 0.0 )
Then A := Pi / C20
Else A := Pi270 ;
End ;

ATan2 := A ;

End ;

End ;

End.

Круговой ArcTan имеется и в процедуре определения созвездия, так что можно немного упростить комплекс. Это удобно сделать при отладке программы, а "теоретически" убирать не хочу, так как можно ошибиться.

Процедура PreNew работает и для интервалов времени в десятки тысяч лет.

Doof · « **Ответ #3 :** 14 Янв 2003 [11:09:51] »

Большое спасибо! Будем разбираться

AstroNick · « **Ответ #4 :** 15 Янв 2003 [11:38:26] »

http://hea.iki.rssi.ru/AZT22/RUS/cgi-bin/c_prec1.htm
Калькулятор на JavaScript по расчету прецесии, вычисляет и созвездие. Весь алгоритм определения созвездия вынесен в подпрограмму cns_pick(al_1875,de_1875) в отдельном файле cnst.js, к ней обращаются с координатами на эпоху 1875.0.

Doof · « **Ответ #5 :** 15 Янв 2003 [18:56:54] »

Всем спасибо еще раз! К исходу второго дня удалось конвертировать это дело в формат, удобный для FoxPro.
JavaScript сконвертировался лучше

Новости:

A A A A Автор Тема: Созвездия (Прочитано 3010 раз)

Doof

Созвездия

Анатолий Волчков

Re:Созвездия

Анатолий Волчков

Re:Созвездия

Doof

Re:Созвездия

AstroNick

Re:Созвездия

Doof

Re:Созвездия