diff options
author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-03-04 21:21:30 -0500 |
---|---|---|
committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-03-04 21:21:30 -0500 |
commit | d54fe7c1f704a63824c5bfa0ece65245572e9b27 (patch) | |
tree | afc52015ffc2c74e0266653eecef1c8ef8ba5d91 /src/slalib/v2tp.f | |
download | calfuse-d54fe7c1f704a63824c5bfa0ece65245572e9b27.tar.gz |
Initial commit
Diffstat (limited to 'src/slalib/v2tp.f')
-rw-r--r-- | src/slalib/v2tp.f | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/src/slalib/v2tp.f b/src/slalib/v2tp.f new file mode 100644 index 0000000..c072bc8 --- /dev/null +++ b/src/slalib/v2tp.f @@ -0,0 +1,78 @@ + SUBROUTINE sla_V2TP (V, V0, XI, ETA, J) +*+ +* - - - - - +* V 2 T P +* - - - - - +* +* Given the direction cosines of a star and of the tangent point, +* determine the star's tangent-plane coordinates. +* +* (single precision) +* +* Given: +* V r(3) direction cosines of star +* V0 r(3) direction cosines of tangent point +* +* Returned: +* XI,ETA r tangent plane coordinates of star +* J i status: 0 = OK +* 1 = error, star too far from axis +* 2 = error, antistar on tangent plane +* 3 = error, antistar too far from axis +* +* Notes: +* +* 1 If vector V0 is not of unit length, or if vector V is of zero +* length, the results will be wrong. +* +* 2 If V0 points at a pole, the returned XI,ETA 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_S2TP. +* +* P.T.Wallace Starlink 27 November 1996 +* +* Copyright (C) 1996 Rutherford Appleton Laboratory +*- + + IMPLICIT NONE + + REAL V(3),V0(3),XI,ETA + INTEGER J + + REAL X,Y,Z,X0,Y0,Z0,R2,R,W,D + + REAL TINY + PARAMETER (TINY=1E-6) + + + X=V(1) + Y=V(2) + Z=V(3) + X0=V0(1) + Y0=V0(2) + Z0=V0(3) + R2=X0*X0+Y0*Y0 + R=SQRT(R2) + IF (R.EQ.0.0) THEN + R=1E-20 + X0=R + END IF + W=X*X0+Y*Y0 + D=W+Z*Z0 + IF (D.GT.TINY) THEN + J=0 + ELSE IF (D.GE.0.0) THEN + J=1 + D=TINY + ELSE IF (D.GT.-TINY) THEN + J=2 + D=-TINY + ELSE + J=3 + END IF + D=D*R + XI=(Y*X0-X*Y0)/D + ETA=(Z*R2-Z0*W)/D + + END |