From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001
From: Joe Hunkeler <jhunkeler@gmail.com>
Date: Tue, 11 Aug 2015 16:51:37 -0400
Subject: Repatch (from linux) of OSX IRAF

---
 math/slalib/pda2h.f | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 118 insertions(+)
 create mode 100644 math/slalib/pda2h.f

(limited to 'math/slalib/pda2h.f')

diff --git a/math/slalib/pda2h.f b/math/slalib/pda2h.f
new file mode 100644
index 00000000..ea8a3425
--- /dev/null
+++ b/math/slalib/pda2h.f
@@ -0,0 +1,118 @@
+      SUBROUTINE slPDAH (P, D, A, H1, J1, H2, J2)
+*+
+*     - - - - - -
+*      P D A H
+*     - - - - - -
+*
+*  Hour Angle corresponding to a given azimuth
+*
+*  (double precision)
+*
+*  Given:
+*     P       d        latitude
+*     D       d        declination
+*     A       d        azimuth
+*
+*  Returned:
+*     H1      d        hour angle:  first solution if any
+*     J1      i        flag: 0 = solution 1 is valid
+*     H2      d        hour angle:  second solution if any
+*     J2      i        flag: 0 = solution 2 is valid
+*
+*  Called:  slDA1P
+*
+*  P.T.Wallace   Starlink   6 October 1994
+*
+*  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., 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 P,D,A,H1
+      INTEGER J1
+      DOUBLE PRECISION H2
+      INTEGER J2
+
+      DOUBLE PRECISION DPI
+      PARAMETER (DPI=3.141592653589793238462643D0)
+      DOUBLE PRECISION D90
+      PARAMETER (D90=DPI/2D0)
+      DOUBLE PRECISION TINY
+      PARAMETER (TINY=1D-12)
+      DOUBLE PRECISION PN,AN,DN,SA,CA,SASP,QT,QB,HPT,T
+      DOUBLE PRECISION slDA1P
+
+
+*  Preset status flags to OK
+      J1=0
+      J2=0
+
+*  Adjust latitude, azimuth, declination to avoid critical values
+      PN=slDA1P(P)
+      IF (ABS(ABS(PN)-D90).LT.TINY) THEN
+         PN=PN-SIGN(TINY,PN)
+      ELSE IF (ABS(PN).LT.TINY) THEN
+         PN=TINY
+      END IF
+      AN=slDA1P(A)
+      IF (ABS(ABS(AN)-DPI).LT.TINY) THEN
+         AN=AN-SIGN(TINY,AN)
+      ELSE IF (ABS(AN).LT.TINY) THEN
+         AN=TINY
+      END IF
+      DN=slDA1P(D)
+      IF (ABS(ABS(DN)-ABS(P)).LT.TINY) THEN
+         DN=DN-SIGN(TINY,DN)
+      ELSE IF (ABS(ABS(DN)-D90).LT.TINY) THEN
+         DN=DN-SIGN(TINY,DN)
+      ELSE IF (ABS(DN).LT.TINY) THEN
+         DN=TINY
+      END IF
+
+*  Useful functions
+      SA=SIN(AN)
+      CA=COS(AN)
+      SASP=SA*SIN(PN)
+
+*  Quotient giving sin(h+t)
+      QT=SIN(DN)*SA*COS(PN)
+      QB=COS(DN)*SQRT(CA*CA+SASP*SASP)
+
+*  Any solutions?
+      IF (ABS(QT).LE.QB) THEN
+
+*     Yes: find h+t and t
+         HPT=ASIN(QT/QB)
+         T=ATAN2(SASP,-CA)
+
+*     The two solutions
+         H1=slDA1P(HPT-T)
+         H2=slDA1P(-HPT-(T+DPI))
+
+*     Reject unless h and A different signs
+         IF (H1*AN.GT.0D0) J1=-1
+         IF (H2*AN.GT.0D0) J2=-1
+      ELSE
+         J1=-1
+         J2=-1
+      END IF
+
+      END
-- 
cgit