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
128
129
130
131
132
133
134
135
136
137
138
139
140
|
SUBROUTINE slAMPQ (RA, DA, AMPRMS, RM, DM)
*+
* - - - - - -
* A M P Q
* - - - - - -
*
* 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 slMAPA 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)
*
* Note:
*
* Iterative techniques are used for the aberration and
* light deflection corrections so that the routines
* slAMP (or slAMPQ) and slMAP (or slMAPQ) are
* accurate inverses; even at the edge of the Sun's disc
* the discrepancy is only about 1 nanoarcsecond.
*
* Called: slDS2C, slDIMV, slDVDV, slDVN, slDC2S,
* slDA2P
*
* P.T.Wallace Starlink 7 May 2000
*
* Copyright (C) 2000 Rutherford Appleton Laboratory
*
* License:
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program (see SLA_CONDITIONS); if not, write to the
* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA
*
* Copyright (C) 1995 Association of Universities for Research in Astronomy Inc.
*-
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 slDVDV,slDA2P
* 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 slDS2C(RA,DA,P3)
* Precession and nutation
CALL slDIMV(AMPRMS(13),P3,P2)
* Aberration
AB1P1 = AB1+1D0
DO I=1,3
P1(I) = P2(I)
END DO
DO J=1,2
P1DV = slDVDV(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 slDVN(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 = slDVDV(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 slDVN(P,P2,W)
DO I=1,3
P(I) = P2(I)
END DO
END DO
* Mean RA,Dec
CALL slDC2S(P,RM,DM)
RM = slDA2P(RM)
END
|
