1 /* sytrni.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 SYTRNI (Transpose two values associated with a symbol) */
sytrni_(char * name__,integer * i__,integer * j,char * tabsym,integer * tabptr,integer * tabval,ftnlen name_len,ftnlen tabsym_len)9 /* Subroutine */ int sytrni_(char *name__, integer *i__, integer *j, char *
10 tabsym, integer *tabptr, integer *tabval, ftnlen name_len, ftnlen
11 tabsym_len)
12 {
13 /* System generated locals */
14 integer i__1;
15
16 /* Local variables */
17 integer nsym;
18 extern integer cardc_(char *, ftnlen);
19 integer n;
20 extern /* Subroutine */ int chkin_(char *, ftnlen);
21 extern integer sumai_(integer *, integer *);
22 extern /* Subroutine */ int swapi_(integer *, integer *);
23 extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
24 integer locval;
25 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
26 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
27 ftnlen);
28 integer locsym;
29 extern logical return_(void);
30
31 /* $ Abstract */
32
33 /* Transpose two values associated with a particular symbol in an */
34 /* integer symbol table. */
35
36 /* $ Disclaimer */
37
38 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
39 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
40 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
41 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
42 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
43 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
44 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
45 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
46 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
47 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
48
49 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
50 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
51 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
52 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
53 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
54 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
55
56 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
57 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
58 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
59 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
60
61 /* $ Required_Reading */
62
63 /* SYMBOLS */
64
65 /* $ Keywords */
66
67 /* SYMBOLS */
68
69 /* $ Declarations */
70 /* $ Brief_I/O */
71
72 /* VARIABLE I/O DESCRIPTION */
73 /* -------- --- -------------------------------------------------- */
74 /* NAME I Name of the symbol whose associated values are to */
75 /* be transposed. */
76 /* I I Index of the first associated value to be */
77 /* transposed. */
78 /* J I Index of the second associated value to be */
79 /* transposed. */
80
81 /* TABSYM, */
82 /* TABPTR, */
83 /* TABVAL I/O Components of the symbol table. */
84
85 /* $ Detailed_Input */
86
87 /* NAME is the name of the symbol whose associated values are */
88 /* to be transposed. If NAME is not in the symbol table, */
89 /* the symbol tables are not modified. */
90
91 /* I is the index of the first associated value to be */
92 /* transposed. */
93
94 /* J is the index of the second associated value to be */
95 /* transposed. */
96
97 /* TABSYM, */
98 /* TABPTR, */
99 /* TABVAL are components of the integer symbol table. */
100
101 /* $ Detailed_Output */
102
103 /* TABSYM, */
104 /* TABPTR, */
105 /* TABVAL are components of the integer symbol table. */
106 /* If the symbol NAME is not in the symbol table */
107 /* the symbol tables are not modified. Otherwise, */
108 /* the values that I and J refer to are transposed */
109 /* in the value table. */
110
111 /* $ Parameters */
112
113 /* None. */
114
115 /* $ Files */
116
117 /* None. */
118
119 /* $ Exceptions */
120
121 /* 1) If I < 1, J < 1, I > the dimension of NAME, or J > the */
122 /* dimension of NAME, the error SPICE(INVALIDINDEX) is signaled. */
123
124 /* 2) If NAME is not in the symbol table, the symbol tables are not */
125 /* modified. */
126
127 /* $ Particulars */
128
129 /* None. */
130
131 /* $ Examples */
132
133 /* The contents of the symbol table are: */
134
135 /* books --> 5 */
136 /* erasers --> 6 */
137 /* pencils --> 12 */
138 /* 18 */
139 /* 24 */
140 /* pens --> 10 */
141 /* 20 */
142 /* 30 */
143 /* 40 */
144
145 /* The call, */
146
147 /* CALL SYTRNI ( 'pens', 2, 3, TABSYM, TABPTR, TABVAL ) */
148
149 /* modifies the contents of the symbol table to be: */
150
151 /* books --> 5 */
152 /* erasers --> 6 */
153 /* pencils --> 12 */
154 /* 18 */
155 /* 24 */
156 /* pens --> 10 */
157 /* 30 */
158 /* 20 */
159 /* 40 */
160 /* The next call, */
161
162 /* CALL SYTRNI ( 'pencils', 2, 4, TABSYM, TABPTR, TABVAL ) */
163
164 /* causes the error SPICE(INVALIDINDEX) to be signaled. */
165
166 /* $ Restrictions */
167
168 /* None. */
169
170 /* $ Literature_References */
171
172 /* None. */
173
174 /* $ Author_and_Institution */
175
176 /* N.J. Bachman (JPL) */
177 /* H.A. Neilan (JPL) */
178 /* I.M. Underwood (JPL) */
179
180 /* $ Version */
181
182 /* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */
183
184 /* Updated so no "exchange" occurs if I equals J. */
185
186 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
187
188 /* Comment section for permuted index source lines was added */
189 /* following the header. */
190
191 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
192
193 /* -& */
194 /* $ Index_Entries */
195
196 /* transpose two values associated with a symbol */
197
198 /* -& */
199 /* $ Revisions */
200
201 /* - SPICELIB Version 1.1.0, 09-SEP-2005 (NJB) */
202
203 /* Updated so no "exchange" occurs if I equals J. */
204
205 /* - Beta Version 2.0.0, 16-JAN-1989 (HAN) */
206
207 /* If one of the indices of the values to be transposed is */
208 /* invalid, an error is signaled and the symbol table is */
209 /* not modified. */
210
211 /* -& */
212
213 /* SPICELIB functions */
214
215
216 /* Local variables */
217
218
219 /* Standard SPICE error handling. */
220
221 if (return_()) {
222 return 0;
223 } else {
224 chkin_("SYTRNI", (ftnlen)6);
225 }
226
227 /* How many symbols? */
228
229 nsym = cardc_(tabsym, tabsym_len);
230
231 /* Is this symbol even in the table? */
232
233 locsym = bsrchc_(name__, &nsym, tabsym + tabsym_len * 6, name_len,
234 tabsym_len);
235 if (locsym > 0) {
236
237 /* Are there enough values associated with the symbol? */
238
239 n = tabptr[locsym + 5];
240
241 /* Are the indices valid? */
242
243 if (*i__ >= 1 && *i__ <= n && *j >= 1 && *j <= n) {
244
245 /* Exchange the values in place. */
246
247 if (*i__ != *j) {
248 i__1 = locsym - 1;
249 locval = sumai_(&tabptr[6], &i__1) + 1;
250 swapi_(&tabval[locval + *i__ + 4], &tabval[locval + *j + 4]);
251 }
252 } else {
253 setmsg_("The first index was *. The second index was *.", (ftnlen)
254 46);
255 errint_("*", i__, (ftnlen)1);
256 errint_("*", j, (ftnlen)1);
257 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
258 }
259 }
260 chkout_("SYTRNI", (ftnlen)6);
261 return 0;
262 } /* sytrni_ */
263
264