1 /* remlad.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 REMLAD (Remove elements from a double precision array) */
remlad_(integer * ne,integer * loc,doublereal * array,integer * na)9 /* Subroutine */ int remlad_(integer *ne, integer *loc, doublereal *array,
10 integer *na)
11 {
12 /* System generated locals */
13 integer i__1;
14
15 /* Local variables */
16 integer i__;
17 extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *,
18 ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen),
19 errint_(char *, integer *, ftnlen);
20 extern logical return_(void);
21
22 /* $ Abstract */
23
24 /* Remove one or more elements from a double precision array at the */
25 /* indicated location. */
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 /* ARRAY, ASSIGNMENT */
59
60 /* $ Declarations */
61 /* $ Brief_I/O */
62
63 /* VARIABLE I/O DESCRIPTION */
64 /* -------- --- -------------------------------------------------- */
65 /* NE I Number of elements to be removed. */
66 /* LOC I Location of the first removed element. */
67 /* ARRAY I/O Input/output array. */
68 /* NA I/O Number of elements in the input/output array. */
69
70 /* $ Detailed_Input */
71
72 /* NE is the number of elements to be removed. */
73
74 /* LOC is the location in the array at which the first */
75 /* element is to be removed. */
76
77 /* ARRAY on input, is the original array. */
78
79 /* NA on input, is the number of elements in ARRAY. */
80
81 /* $ Detailed_Output */
82
83 /* ARRAY on output, is the original array with elements */
84 /* LOC through LOC+NE-1 removed. Succeeding elements */
85 /* are moved forward to fill the vacated spaces. */
86
87 /* NA on output, is the number of elements in ARRAY. */
88
89 /* $ Parameters */
90
91 /* None. */
92
93 /* $ Particulars */
94
95 /* The elements in positions LOC through LOC+NE-1 are overwritten */
96 /* as the elements beginning at LOC+NE are moved back. */
97
98 /* $ Examples */
99
100 /* Let */
101
102 /* NA = 7 ARRAY(1) = 1.0D0 */
103 /* ARRAY(2) = 2.0D0 */
104 /* ARRAY(3) = 3.0D0 */
105 /* ARRAY(4) = 4.0D0 */
106 /* ARRAY(5) = 5.0D0 */
107 /* ARRAY(6) = 6.0D0 */
108 /* ARRAY(7) = 7.0D0 */
109
110 /* Then the call */
111
112 /* CALL REMLAD ( 3, 3, ARRAY, NA ) */
113
114 /* yields the following result: */
115
116 /* NA = 4 ARRAY(1) = 1.0D0 */
117 /* ARRAY(2) = 2.0D0 */
118 /* ARRAY(3) = 6.0D0 */
119 /* ARRAY(4) = 7.0D0 */
120
121
122 /* The following calls would signal errors: */
123
124 /* CALL REMLAD ( 3, 1, ARRAY, -1 ) */
125 /* CALL REMLAD ( 3, -1, ARRAY, 7 ) */
126 /* CALL REMLAD ( 3, 6, ARRAY, 7 ) */
127
128 /* $ Restrictions */
129
130 /* None. */
131
132 /* $ Exceptions */
133
134 /* 1) If LOC is not in the interval [1, NA], the error */
135 /* SPICE(INVALIDINDEX) is signalled. */
136
137 /* 2) If the number of elements to be removed is greater than the */
138 /* number of elements that can be removed, the error */
139 /* SPICE(NONEXISTELEMENTS) is signalled. */
140
141 /* 3) If NE is less than one, the array is not modified. */
142
143 /* 4) If NA is less than one, any location is invalid, and the */
144 /* error SPICE(INVALIDINDEX) is signalled. */
145
146 /* $ Files */
147
148 /* None. */
149
150 /* $ Author_and_Institution */
151
152 /* H.A. Neilan (JPL) */
153 /* I.M. Underwood (JPL) */
154
155 /* $ Literature_References */
156
157 /* None. */
158
159 /* $ Version */
160
161 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
162
163 /* Comment section for permuted index source lines was added */
164 /* following the header. */
165
166 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
167
168 /* -& */
169 /* $ Index_Entries */
170
171 /* remove elements from a d.p. array */
172
173 /* -& */
174 /* $ Revisions */
175
176 /* - Beta Version 2.0.0, 1-JAN-1989 (HAN) */
177
178 /* Code was added to handle the following exceptinoal */
179 /* inputs. */
180
181 /* If the dimension of the array is less than one, any */
182 /* value of LOC is invalid. The old verison did not check */
183 /* the dimension of the array, and as a result, its output */
184 /* was unpredictable. */
185
186 /* If the location at which the elements are to be removed is */
187 /* not in the interval [1, NA], an error is signalled. */
188 /* Locations not within that interval refer to non-existent */
189 /* array elements. The old routine did not signal an error. */
190 /* It just returned the original array. */
191
192 /* If the number of elements to be removed is greater than the */
193 /* number of elements can be removed, an error is signalled. */
194 /* In the old version, only those elements that could be */
195 /* removed were removed, and no error was signalled. */
196
197 /* -& */
198
199 /* SPICELIB functions */
200
201
202 /* Local variables */
203
204
205 /* Standard SPICE error handling. */
206
207 if (return_()) {
208 return 0;
209 } else {
210 chkin_("REMLAD", (ftnlen)6);
211 }
212
213 /* If LOC does not point to an actual element, signal an error and */
214 /* check out. If the dimension of the array is less than one, any */
215 /* value of LOC is invalid, and an error is signalled. */
216
217 if (*loc < 1 || *loc > *na) {
218 setmsg_("Location was *.", (ftnlen)15);
219 errint_("*", loc, (ftnlen)1);
220 sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
221 chkout_("REMLAD", (ftnlen)6);
222 return 0;
223
224 /* Don't try to remove non-existent elements. */
225
226 } else if (*ne > *na - *loc + 1) {
227 setmsg_("Trying to remove non-existent elements.", (ftnlen)39);
228 sigerr_("SPICE(NONEXISTELEMENTS)", (ftnlen)23);
229 chkout_("REMLAD", (ftnlen)6);
230 return 0;
231
232 /* If there are elements to be removed, remove them. Otherwise, */
233 /* do not modify the array. */
234
235 } else if (*ne > 0) {
236
237 /* Move the elements forward. */
238
239 i__1 = *na - *ne;
240 for (i__ = *loc; i__ <= i__1; ++i__) {
241 array[i__ - 1] = array[i__ + *ne - 1];
242 }
243
244 /* Update the number of elements in the array. */
245
246 *na -= *ne;
247 }
248 chkout_("REMLAD", (ftnlen)6);
249 return 0;
250 } /* remlad_ */
251
252