forked from scottransom/pyslalib
-
Notifications
You must be signed in to change notification settings - Fork 0
/
dtp2v.f
73 lines (67 loc) · 2 KB
/
dtp2v.f
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
SUBROUTINE sla_DTP2V (XI, ETA, V0, V)
*+
* - - - - - -
* D T P 2 V
* - - - - - -
*
* Given the tangent-plane coordinates of a star and the direction
* cosines of the tangent point, determine the direction cosines
* of the star.
*
* (double precision)
*
* Given:
* XI,ETA d tangent plane coordinates of star
* V0 d(3) direction cosines of tangent point
*
* Returned:
* V d(3) direction cosines of star
*
* Notes:
*
* 1 If vector V0 is not of unit length, the returned vector V will
* be wrong.
*
* 2 If vector V0 points at a pole, the returned vector V will be
* based on the arbitrary assumption that the RA of the tangent
* point is zero.
*
* 3 This routine is the Cartesian equivalent of the routine sla_DTP2S.
*
* P.T.Wallace Starlink 11 February 1995
*
* Copyright (C) 1995 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., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
*-
IMPLICIT NONE
DOUBLE PRECISION XI,ETA,V0(3),V(3)
DOUBLE PRECISION X,Y,Z,F,R
X=V0(1)
Y=V0(2)
Z=V0(3)
F=SQRT(1D0+XI*XI+ETA*ETA)
R=SQRT(X*X+Y*Y)
IF (R.EQ.0D0) THEN
R=1D-20
X=R
END IF
V(1)=(X-(XI*Y+ETA*X*Z)/R)/F
V(2)=(Y+(XI*X-ETA*Y*Z)/R)/F
V(3)=(Z+ETA*R)/F
END