1 /* mxmt.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 /* Table of constant values */
9
10 static integer c__9 = 9;
11
12 /* $Procedure MXMT ( Matrix times matrix transpose, 3x3 ) */
mxmt_(doublereal * m1,doublereal * m2,doublereal * mout)13 /* Subroutine */ int mxmt_(doublereal *m1, doublereal *m2, doublereal *mout)
14 {
15 /* System generated locals */
16 integer i__1, i__2, i__3, i__4, i__5, i__6, i__7;
17
18 /* Builtin functions */
19 integer s_rnge(char *, integer, char *, integer);
20
21 /* Local variables */
22 integer i__, j;
23 extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
24 doublereal prodm[9] /* was [3][3] */;
25
26 /* $ Abstract */
27
28 /* Multiply a 3x3 matrix and the transpose of another 3x3 matrix. */
29
30 /* $ Disclaimer */
31
32 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
33 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
34 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
35 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
36 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
37 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
38 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
39 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
40 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
41 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
42
43 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
44 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
45 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
46 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
47 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
48 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
49
50 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
51 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
52 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
53 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
54
55 /* $ Required_Reading */
56
57 /* None. */
58
59 /* $ Keywords */
60
61 /* MATRIX */
62
63 /* $ Declarations */
64 /* $ Brief_I/O */
65
66 /* VARIABLE I/O DESCRIPTION */
67 /* -------- --- -------------------------------------------------- */
68 /* M1 I 3x3 double precision matrix. */
69 /* M2 I 3x3 double precision matrix. */
70 /* MOUT O 3x3 double precision matrix. MOUT is the */
71 /* product M1 * M2**T. */
72
73 /* $ Detailed_Input */
74
75 /* M1 is an arbitrary 3x3 double precision matrix. */
76
77 /* M2 is an arbitrary 3x3 double precision matrix. */
78 /* Typically, M2 will be a rotation matrix since */
79 /* then its transpose is its inverse (but this is */
80 /* NOT a requirement). */
81
82 /* $ Detailed_Output */
83
84 /* MOUT is a 3x3 double precision matrix. MOUT is the */
85 /* product (M1) x (M2**T). */
86
87 /* $ Parameters */
88
89 /* None. */
90
91 /* $ Exceptions */
92
93 /* Error free. */
94
95 /* $ Files */
96
97 /* None. */
98
99 /* $ Particulars */
100
101 /* The code reflects precisely the following mathematical expression */
102
103 /* For each value of the subscripts I and J from 1 to 3: */
104
105 /* MOUT(I,J) = Summation from K=1 to 3 of ( M1(I,K) * M2(J,K) ) */
106
107 /* Note that the reversal of the K and J subscripts in the right- */
108 /* hand matrix M2 is what makes MOUT the product of the TRANSPOSE of */
109 /* M2 and not simply of M2 itself. */
110
111 /* $ Examples */
112
113 /* Let M1 = | 0.0D0 1.0D0 0.0D0 | */
114 /* | | */
115 /* | -1.0D0 0.0D0 0.0D0 | */
116 /* | | */
117 /* | 0.0D0 0.0D0 1.0D0 | */
118
119
120 /* M2 = | 0.0D0 1.0D0 0.0D0 | */
121 /* | | */
122 /* | -1.0D0 0.0D0 0.0D0 | */
123 /* | | */
124 /* | 0.0D0 0.0D0 1.0D0 | */
125
126 /* then the call */
127
128 /* CALL MXMT ( M1, M2, MOUT ) */
129
130 /* produces the matrix */
131
132
133 /* MOUT = | 1.0D0 0.0D0 0.0D0 | */
134 /* | | */
135 /* | 0.0D0 1.0D0 0.0D0 | */
136 /* | | */
137 /* | 0.0D0 0.0D0 1.0D0 | */
138
139
140 /* $ Restrictions */
141
142 /* The user is responsible for checking the magnitudes of the */
143 /* elements of M1 and M2 so that a floating point overflow does */
144 /* not occur. (In the typical use where M1 and M2 are rotation */
145 /* matrices, this not a risk at all.) */
146
147 /* $ Literature_References */
148
149 /* None. */
150
151 /* $ Author_and_Institution */
152
153 /* W.M. Owen (JPL) */
154
155 /* $ Version */
156
157 /* - SPICELIB Version 1.0.2, 22-APR-2010 (NJB) */
158
159 /* Header correction: assertions that the output */
160 /* can overwrite the input have been removed. */
161
162 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
163
164 /* Comment section for permuted index source lines was added */
165 /* following the header. */
166
167 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WMO) */
168
169 /* -& */
170 /* $ Index_Entries */
171
172 /* matrix times matrix_transpose 3x3_case */
173
174 /* -& */
175
176 /* Local variables */
177
178
179 /* Perform the matrix multiplication */
180
181 for (i__ = 1; i__ <= 3; ++i__) {
182 for (j = 1; j <= 3; ++j) {
183 prodm[(i__1 = i__ + j * 3 - 4) < 9 && 0 <= i__1 ? i__1 : s_rnge(
184 "prodm", i__1, "mxmt_", (ftnlen)174)] = m1[(i__2 = i__ -
185 1) < 9 && 0 <= i__2 ? i__2 : s_rnge("m1", i__2, "mxmt_", (
186 ftnlen)174)] * m2[(i__3 = j - 1) < 9 && 0 <= i__3 ? i__3 :
187 s_rnge("m2", i__3, "mxmt_", (ftnlen)174)] + m1[(i__4 =
188 i__ + 2) < 9 && 0 <= i__4 ? i__4 : s_rnge("m1", i__4,
189 "mxmt_", (ftnlen)174)] * m2[(i__5 = j + 2) < 9 && 0 <=
190 i__5 ? i__5 : s_rnge("m2", i__5, "mxmt_", (ftnlen)174)] +
191 m1[(i__6 = i__ + 5) < 9 && 0 <= i__6 ? i__6 : s_rnge(
192 "m1", i__6, "mxmt_", (ftnlen)174)] * m2[(i__7 = j + 5) <
193 9 && 0 <= i__7 ? i__7 : s_rnge("m2", i__7, "mxmt_", (
194 ftnlen)174)];
195 }
196 }
197
198 /* Move the result into MOUT */
199
200 moved_(prodm, &c__9, mout);
201 return 0;
202 } /* mxmt_ */
203
204