1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
SUBROUTINE sla_AMPQK (RA, DA, AMPRMS, RM, DM)
*+
* - - - - - -
* A M P Q K
* - - - - - -
*
* Convert star RA,Dec from geocentric apparent to mean place
*
* The mean coordinate system is the post IAU 1976 system,
* loosely called FK5.
*
* Use of this routine is appropriate when efficiency is important
* and where many star positions are all to be transformed for
* one epoch and equinox. The star-independent parameters can be
* obtained by calling the sla_MAPPA routine.
*
* Given:
* RA d apparent RA (radians)
* DA d apparent Dec (radians)
*
* AMPRMS d(21) star-independent mean-to-apparent parameters:
*
* (1) time interval for proper motion (Julian years)
* (2-4) barycentric position of the Earth (AU)
* (5-7) heliocentric direction of the Earth (unit vector)
* (8) (grav rad Sun)*2/(Sun-Earth distance)
* (9-11) ABV: barycentric Earth velocity in units of c
* (12) sqrt(1-v**2) where v=modulus(ABV)
* (13-21) precession/nutation (3,3) matrix
*
* Returned:
* RM d mean RA (radians)
* DM d mean Dec (radians)
*
* References:
* 1984 Astronomical Almanac, pp B39-B41.
* (also Lederle & Schwan, Astron. Astrophys. 134,
* 1-6, 1984)
*
* Notes:
*
* 1) The accuracy is limited by the routine sla_EVP, called
* by sla_MAPPA, which computes the Earth position and
* velocity using the methods of Stumpff. The maximum
* error is about 0.3 milliarcsecond.
*
* 2) Iterative techniques are used for the aberration and
* light deflection corrections so that the routines
* sla_AMP (or sla_AMPQK) and sla_MAP (or sla_MAPQK) are
* accurate inverses; even at the edge of the Sun's disc
* the discrepancy is only about 1 nanoarcsecond.
*
* Called: sla_DCS2C, sla_DIMXV, sla_DVDV, sla_DVN, sla_DCC2S,
* sla_DRANRM
*
* P.T.Wallace Starlink 21 June 1993
*
* Copyright (C) 1995 Rutherford Appleton Laboratory
*-
IMPLICIT NONE
DOUBLE PRECISION RA,DA,AMPRMS(21),RM,DM
INTEGER I,J
DOUBLE PRECISION GR2E,AB1,EHN(3),ABV(3),P3(3),P2(3),
: AB1P1,P1DV,P1DVP1,P1(3),W,PDE,PDEP1,P(3)
DOUBLE PRECISION sla_DVDV,sla_DRANRM
* Unpack scalar and vector parameters
GR2E = AMPRMS(8)
AB1 = AMPRMS(12)
DO I=1,3
EHN(I) = AMPRMS(I+4)
ABV(I) = AMPRMS(I+8)
END DO
* Apparent RA,Dec to Cartesian
CALL sla_DCS2C(RA,DA,P3)
* Precession and nutation
CALL sla_DIMXV(AMPRMS(13),P3,P2)
* Aberration
AB1P1 = AB1+1D0
DO I=1,3
P1(I) = P2(I)
END DO
DO J=1,2
P1DV = sla_DVDV(P1,ABV)
P1DVP1 = 1D0+P1DV
W = 1D0+P1DV/AB1P1
DO I=1,3
P1(I) = (P1DVP1*P2(I)-W*ABV(I))/AB1
END DO
CALL sla_DVN(P1,P3,W)
DO I=1,3
P1(I) = P3(I)
END DO
END DO
* Light deflection
DO I=1,3
P(I) = P1(I)
END DO
DO J=1,5
PDE = sla_DVDV(P,EHN)
PDEP1 = 1D0+PDE
W = PDEP1-GR2E*PDE
DO I=1,3
P(I) = (PDEP1*P1(I)-GR2E*EHN(I))/W
END DO
CALL sla_DVN(P,P2,W)
DO I=1,3
P(I) = P2(I)
END DO
END DO
* Mean RA,Dec
CALL sla_DCC2S(P,RM,DM)
RM = sla_DRANRM(RM)
END
|
