Repatch (from linux) of OSX IRAF

1 files changed, 64 insertions, 0 deletions

diff --git a/math/slalib/vn.f b/math/slalib/vn.f
new file mode 100644
index 00000000..8bbb33d9
--- /dev/null
+++ b/math/slalib/vn.f
@@ -0,0 +1,64 @@
+      SUBROUTINE slVN (V, UV, VM)
+*+
+*     - - -
+*      V N
+*     - - -
+*
+*  Normalizes a 3-vector also giving the modulus (single precision)
+*
+*  Given:
+*     V       real(3)      vector
+*
+*  Returned:
+*     UV      real(3)      unit vector in direction of V
+*     VM      real         modulus of V
+*
+*  If the modulus of V is zero, UV is set to zero as well
+*
+*  P.T.Wallace   Starlink   23 November 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., 51 Franklin Street, Fifth Floor,
+*    Boston, MA  02110-1301  USA
+*
+*  Copyright (C) 1995 Association of Universities for Research in Astronomy Inc.
+*-
+
+      IMPLICIT NONE
+
+      REAL V(3),UV(3),VM
+
+      INTEGER I
+      REAL W1,W2
+
+
+*  Modulus
+      W1=0.0
+      DO I=1,3
+         W2=V(I)
+         W1=W1+W2*W2
+      END DO
+      W1=SQRT(W1)
+      VM=W1
+
+*  Normalize the vector
+      IF (W1.LE.0.0) W1=1.0
+      DO I=1,3
+         UV(I)=V(I)/W1
+      END DO
+
+      END