1 /* unormg.f -- translated by f2c (version 19980913).
2    You must link the resulting object file with the libraries:
3 	-lf2c -lm   (in that order)
4 */
5 
6 #include "f2c.h"
7 
8 /* $Procedure      UNORMG ( Unit vector and norm, general dimension ) */
unormg_(doublereal * v1,integer * ndim,doublereal * vout,doublereal * vmag)9 /* Subroutine */ int unormg_(doublereal *v1, integer *ndim, doublereal *vout,
10 	doublereal *vmag)
11 {
12     /* System generated locals */
13     integer v1_dim1, vout_dim1, i__1, i__2, i__3;
14 
15     /* Builtin functions */
16     integer s_rnge(char *, integer, char *, integer);
17 
18     /* Local variables */
19     integer i__;
20     extern doublereal vnormg_(doublereal *, integer *);
21 
22 /* $ Abstract */
23 
24 /*     Normalize a double precision vector of arbitrary dimension and */
25 /*     return its magnitude. */
26 
27 /* $ Disclaimer */
28 
29 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
30 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
31 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
32 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
33 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
34 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
35 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
36 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
37 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
38 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
39 
40 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
41 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
42 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
43 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
44 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
45 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
46 
47 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
48 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
49 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
50 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
51 
52 /* $ Required_Reading */
53 
54 /*     None. */
55 
56 /* $ Keywords */
57 
58 /*     VECTOR */
59 
60 /* $ Declarations */
61 /* $ Brief_I/O */
62 
63 /*     VARIABLE  I/O  DESCRIPTION */
64 /*     --------  ---  -------------------------------------------------- */
65 /*     V1         I   Vector to be normalized. */
66 /*     NDIM       I   Dimension of V1 (and also VOUT). */
67 /*     VOUT       O   Unit vector V1 / |V1|. */
68 /*                    If V1 = 0, VOUT will also be zero. */
69 /*     VMAG       O   Magnitude of V1, that is, |V1|. */
70 
71 /* $ Detailed_Input */
72 
73 /*     V1      This variable may contain any vector of arbitrary */
74 /*             dimension, including the zero vector. */
75 /*     NDIM    This is the dimension of V1 and VOUT. */
76 
77 /* $ Detailed_Output */
78 
79 /*     VOUT    This variable contains the unit vector in the direction */
80 /*             of V1.  If V1 is the zero vector, then VOUT will also be */
81 /*             the zero vector. */
82 /*     VMAG    This is the magnitude of V1. */
83 
84 /* $ Parameters */
85 
86 /*     None. */
87 
88 /* $ Exceptions */
89 
90 /*     Error free. */
91 
92 /* $ Files */
93 
94 /*     None. */
95 
96 /* $ Particulars */
97 
98 /*     UNORMG references a function called VNORMG (which itself is */
99 /*     numerically stable) to calculate the norm of the input vector V1. */
100 /*     If the norm is equal to zero, then each component of the output */
101 /*     vector VOUT is set to zero.  Otherwise, VOUT is calculated by */
102 /*     dividing V1 by the norm.  No error detection or correction is */
103 /*     implemented. */
104 
105 /* $ Examples */
106 
107 /*     The following table shows how selected V1 implies VOUT and MAG. */
108 
109 /*        V1                    NDIM   VOUT                   MAG */
110 /*        -------------------------------------------------------- */
111 /*        (5, 12)               2      (5/13, 12/13)          13 */
112 /*        (1D-7, 2D-7, 2D-7)    3      (1/3, 2/3, 2/3)        3D-7 */
113 
114 /* $ Restrictions */
115 
116 /*     No error checking is implemented in this subroutine to guard */
117 /*     against numeric overflow. */
118 
119 /* $ Literature_References */
120 
121 /*     None. */
122 
123 /* $ Author_and_Institution */
124 
125 /*     W.M. Owen       (JPL) */
126 /*     W.L. Taber      (JPL) */
127 
128 /* $ Version */
129 
130 /* -    SPICELIB Version 1.0.2, 23-APR-2010 (NJB) */
131 
132 /*        Header correction: assertions that the output */
133 /*        can overwrite the input have been removed. */
134 
135 /* -    SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
136 
137 /*        Comment section for permuted index source lines was added */
138 /*        following the header. */
139 
140 /* -    SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */
141 
142 /* -& */
143 /* $ Index_Entries */
144 
145 /*     n-dimensional unit vector and norm */
146 
147 /* -& */
148 /* $ Revisions */
149 
150 /* -    Beta Version 1.0.1, 10-JAN-1989 (WLT) */
151 
152 /*     Error free specification added. */
153 
154 /* -& */
155 
156 /*  Obtain the magnitude of V1 */
157 
158     /* Parameter adjustments */
159     vout_dim1 = *ndim;
160     v1_dim1 = *ndim;
161 
162     /* Function Body */
163     *vmag = vnormg_(v1, ndim);
164 
165 /*   If VMAG is nonzero, then normalize.  Note that this process is */
166 /*   numerically stable: overflow could only happen if VMAG were small, */
167 /*   but this could only happen if each component of V1 were also small. */
168 /*   In fact, the magnitude of any vector is never less than the */
169 /*   magnitude of any component. */
170 
171     if (*vmag > 0.) {
172 	i__1 = *ndim;
173 	for (i__ = 1; i__ <= i__1; ++i__) {
174 	    vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge(
175 		    "vout", i__2, "unormg_", (ftnlen)161)] = v1[(i__3 = i__ -
176 		    1) < v1_dim1 && 0 <= i__3 ? i__3 : s_rnge("v1", i__3,
177 		    "unormg_", (ftnlen)161)] / *vmag;
178 	}
179     } else {
180 	i__1 = *ndim;
181 	for (i__ = 1; i__ <= i__1; ++i__) {
182 	    vout[(i__2 = i__ - 1) < vout_dim1 && 0 <= i__2 ? i__2 : s_rnge(
183 		    "vout", i__2, "unormg_", (ftnlen)165)] = 0.;
184 	}
185     }
186 
187     return 0;
188 } /* unormg_ */
189 
190