1 /* sepool.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__1 = 1;
11
12 /* $Procedure SEPOOL ( String from pool ) */
sepool_(char * item,integer * fidx,char * contin,char * string,integer * size,integer * lidx,logical * found,ftnlen item_len,ftnlen contin_len,ftnlen string_len)13 /* Subroutine */ int sepool_(char *item, integer *fidx, char *contin, char *
14 string, integer *size, integer *lidx, logical *found, ftnlen item_len,
15 ftnlen contin_len, ftnlen string_len)
16 {
17 /* Builtin functions */
18 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
19 integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
20
21 /* Local variables */
22 integer comp;
23 logical more;
24 char part[80];
25 integer room, n;
26 extern /* Subroutine */ int chkin_(char *, ftnlen);
27 integer clast, csize;
28 logical gotit;
29 extern integer rtrim_(char *, ftnlen);
30 integer putat;
31 extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
32 *, char *, logical *, ftnlen, ftnlen);
33 integer cfirst;
34 extern /* Subroutine */ int chkout_(char *, ftnlen);
35 extern logical return_(void);
36
37 /* $ Abstract */
38
39 /* Retrieve the string starting at the FIDX element of the kernel */
40 /* pool variable, where the string may be continued across several */
41 /* components of the kernel pool variable. */
42
43 /* $ Disclaimer */
44
45 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
46 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
47 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
48 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
49 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
50 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
51 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
52 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
53 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
54 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
55
56 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
57 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
58 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
59 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
60 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
61 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
62
63 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
64 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
65 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
66 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
67
68 /* $ Required_Reading */
69
70 /* None. */
71
72 /* $ Keywords */
73
74 /* POOL */
75
76 /* $ Declarations */
77 /* $ Brief_I/O */
78
79 /* VARIABLE I/O DESCRIPTION */
80 /* -------- --- -------------------------------------------------- */
81 /* ITEM I name of the kernel pool variable */
82 /* FIDX I index of the first component of the string */
83 /* CONTIN I character sequence used to indicate continuation */
84 /* STRING O a full string concatenated across continuations */
85 /* SIZE O the number of character in the full string value */
86 /* LIDX O index of the last component of the string */
87 /* FOUND O flag indicating success or failure of request */
88
89 /* $ Detailed_Input */
90
91 /* ITEM is the name of a kernel pool variable for which */
92 /* the caller wants to retrieve a full (potentially */
93 /* continued) string. */
94
95 /* FIDX is the index of the first component (the start) of */
96 /* the string in ITEM. */
97
98 /* CONTIN is a sequence of characters which (if they appear as */
99 /* the last non-blank sequence of characters in a */
100 /* component of a value of a kernel pool variable) */
101 /* indicate that the string associated with the */
102 /* component is continued into the next literal */
103 /* component of the kernel pool variable. */
104
105 /* If CONTIN is blank, all of the components of ITEM */
106 /* will be retrieved as a single string. */
107
108 /* $ Detailed_Output */
109
110 /* STRING is the full string starting at the FIDX element of the */
111 /* kernel pool variable specified by ITEM. */
112
113 /* Note that if STRING is not sufficiently long to hold */
114 /* the fully continued string, the value will be */
115 /* truncated. You can determine if STRING has been */
116 /* truncated by examining the variable SIZE. */
117
118 /* SIZE is the index of last non-blank character of */
119 /* continued string as it is represented in the */
120 /* kernel pool. This is the actual number of characters */
121 /* needed to hold the requested string. If STRING */
122 /* contains a truncated portion of the full string, */
123 /* RTRIM(STRING) will be less than SIZE. */
124
125 /* If the value of STRING should be a blank, then */
126 /* SIZE will be set to 1. */
127
128 /* LIDX is the index of the last component (the end) of */
129 /* the retrieved string in ITEM. */
130
131 /* FOUND is a logical variable indicating success of the */
132 /* request to retrieve the string. */
133
134 /* $ Parameters */
135
136 /* None. */
137
138 /* $ Exceptions */
139
140 /* 1) If the variable specified by ITEM is not present in the */
141 /* kernel pool or is present but is not character valued, STRING */
142 /* will be returned as a blank, SIZE will be returned with the */
143 /* value 0 and FOUND will be set to .FALSE. In particular if NTH */
144 /* is less than 1, STRING will be returned as a blank, SIZE will */
145 /* be zero and FOUND will be FALSE. */
146
147 /* 2) If the variable specified has a blank string associated */
148 /* with its full string starting at FIDX, STRING will be blank, */
149 /* SIZE will be 1 and FOUND will be set to .TRUE. */
150
151 /* 3) If STRING is not long enough to hold all of the characters */
152 /* associated with the NTH string, it will be truncated on the */
153 /* right. */
154
155 /* 4) If the continuation character is a blank, every component */
156 /* of the variable specified by ITEM will be inserted into */
157 /* the output string. */
158
159 /* 5) If the continuation character is blank, then a blank component */
160 /* of a variable is treated as a component with no letters. */
161 /* For example: */
162
163 /* STRINGS = ( 'This is a variable' */
164 /* 'with a blank' */
165 /* ' ' */
166 /* 'component.' ) */
167
168 /* Is equivalent to */
169
170
171 /* STRINGS = ( 'This is a variable' */
172 /* 'with a blank' */
173 /* 'component.' ) */
174
175 /* from the point of view of SEPOOL if CONTIN is set to the */
176 /* blank character. */
177
178 /* $ Files */
179
180 /* None. */
181
182 /* $ Particulars */
183
184 /* The SPICE Kernel Pool provides a very convenient interface */
185 /* for supplying both numeric and textual data to user application */
186 /* programs. However, any particular component of a character */
187 /* valued component of a kernel pool variable is limited to 80 */
188 /* or fewer characters in length. */
189
190 /* This routine allows you to overcome this limitation by */
191 /* "continuing" a character component of a kernel pool variable. */
192 /* To do this you need to select a continuation sequence */
193 /* of characters and then insert this sequence as the last non-blank */
194 /* set of characters that make up the portion of the component */
195 /* that should be continued. */
196
197 /* For example, you may decide to use the sequence '//' to indicate */
198 /* that a string should be continued to the next component of */
199 /* a kernel pool variable. Then set up the */
200 /* kernel pool variable as shown below */
201
202 /* LONG_STRINGS = ( 'This is part of the first component //' */
203 /* 'that needs more than one line when //' */
204 /* 'inserting it into the kernel pool.' */
205 /* 'This is the second string that is split //' */
206 /* 'up as several components of a kernel pool //' */
207 /* 'variable.' ) */
208
209 /* When loaded into the kernel pool, the variable LONG_STRINGS */
210 /* will have six literal components: */
211
212 /* COMPONENT (1) = 'This is part of the first component //' */
213 /* COMPONENT (2) = 'that needs more than one line when //' */
214 /* COMPONENT (3) = 'inserting it into the kernel pool.' */
215 /* COMPONENT (4) = 'This is the second string that is split //' */
216 /* COMPONENT (5) = 'up as several components of a kernel pool //' */
217 /* COMPONENT (6) = 'variable.' */
218
219 /* These are the components that would be retrieved by the call */
220
221 /* CALL GCPOOL ( 'LONG_STRINGS', 1, 6, N, COMPONENT, FOUND ) */
222
223 /* However, using the routine SEPOOL you can view the variable */
224 /* LONG_STRINGS as having two long components. */
225
226 /* STRING (1) = 'This is part of the first component that ' */
227 /* . // 'needs more than one line when inserting ' */
228 /* . // 'it into the kernel pool. ' */
229
230 /* STRING (2) = 'This is the second string that is split ' */
231 /* . // 'up as several components of a kernel pool ' */
232 /* . // 'variable. ' */
233
234
235 /* These string components would be retrieved by the following two */
236 /* calls. */
237
238 /* FIDX = 1 */
239 /* CALL SEPOOL ( 'LONG_STRINGS', FIDX, '//', */
240 /* . STRING(1), SIZE, LIDX, FOUND ) */
241 /* FIDX = LIDX+1 */
242 /* CALL SEPOOL ( 'LONG_STRINGS', FIDX, '//', */
243 /* . STRING(2), SIZE, LIDX, FOUND ) */
244
245 /* $ Examples */
246
247 /* Example 1. Retrieving file names. */
248
249 /* Suppose a you have used the kernel pool as a mechanism for */
250 /* specifying SPK files to load at startup but that the full */
251 /* names of the files are too long to be contained in a single */
252 /* text line of a kernel pool assignment. */
253
254 /* By selecting an appropriate continuation character ('*' for */
255 /* example) you can insert the full names of the SPK files */
256 /* into the kernel pool and then retrieve them using this */
257 /* routine. */
258
259 /* First set up the kernel pool specification of the strings */
260 /* as shown here: */
261
262 /* SPK_FILES = ( 'this_is_the_full_path_specification_*' */
263 /* 'of_a_file_with_a_long_name' */
264 /* 'this_is_the_full_path_specification_*' */
265 /* 'of_a_second_file_with_a_very_long_*' */
266 /* 'name' ) */
267
268 /* Now to retrieve and load the SPK_FILES one at a time, */
269 /* exercise the following loop. */
270
271 /* INTEGER FILSIZ */
272 /* PARAMETER ( FILSIZ = 255 ) */
273
274 /* CHARACTER*(FILSIZ) FILE */
275 /* INTEGER I */
276 /* INTEGER LIDX */
277
278 /* I = 1 */
279
280 /* CALL SEPOOL ( 'SPK_FILES', I, '*', FILE, SIZE, LIDX, FOUND ) */
281
282 /* DO WHILE ( FOUND .AND. RTRIM(FILE) .EQ. SIZE ) */
283
284 /* CALL SPKLEF ( FILE, HANDLE ) */
285 /* I = LIDX + 1 */
286 /* CALL SEPOOL ( 'SPK_FILES', I, '*', FILE, SIZE, LIDX, FOUND ) */
287 /* END DO */
288
289 /* IF ( FOUND .AND. RTRIM(FILE) .NE. SIZE ) THEN */
290 /* WRITE (*,*) 'The ', I, '''th file name was too long.' */
291 /* END IF */
292
293
294 /* Example 2. Retrieving all components as a string. */
295
296
297 /* Occasionally, it may be useful to retrieve the entire */
298 /* contents of a kernel pool variable as a single string. To */
299 /* do this you can use the blank character as the */
300 /* continuation character. For example if you place the */
301 /* following assignment in a text kernel */
302
303 /* COMMENT = ( 'This is a long note ' */
304 /* ' about the intended ' */
305 /* ' use of this text kernel that ' */
306 /* ' can be retrieved at run time.' ) */
307
308 /* you can retrieve COMMENT as single string via the call below. */
309
310 /* CALL SEPOOL ( 'COMMENT', 1, ' ', COMMNT, SIZE, LIDX, FOUND ) */
311
312 /* The result will be that COMMNT will have the following value. */
313
314 /* COMMNT = 'This is a long note about the intended use of ' */
315 /* . // 'this text kernel that can be retrieved at run ' */
316 /* . // 'time. ' */
317
318 /* Note that the leading blanks of each component of COMMENT are */
319 /* significant, trailing blanks are not significant. */
320
321 /* If COMMENT had been set as */
322
323 /* COMMENT = ( 'This is a long note ' */
324 /* 'about the intended ' */
325 /* 'use of this text kernel that ' */
326 /* 'can be retrieved at run time.' ) */
327
328 /* Then the call to SEPOOL above would have resulted in several */
329 /* words being run together as shown below. */
330
331
332 /* COMMNT = 'This is a long noteabout the intendeduse of ' */
333 /* . // 'this text kernel thatcan be retrieved at run ' */
334 /* . // 'time. ' */
335
336
337 /* resulted in several words being run together as shown below. */
338
339 /* $ Restrictions */
340
341 /* None. */
342
343 /* $ Literature_References */
344
345 /* None. */
346
347 /* $ Author_and_Institution */
348
349 /* W.L. Taber (JPL) */
350 /* B.V. Semenov (JPL) */
351
352 /* $ Version */
353
354 /* - SPICELIB Version 1.0.0, 12-APR-2012 (WLT)(BVS) */
355
356
357 /* -& */
358 /* $ Index_Entries */
359
360 /* Retrieve a continued string value from the kernel pool */
361
362 /* -& */
363 /* SPICELIB Variables */
364
365
366 /* Standard SPICE error handling. */
367
368 if (return_()) {
369 return 0;
370 }
371
372 /* Return empty output if the input index is bad. */
373
374 if (*fidx < 1) {
375 *found = FALSE_;
376 s_copy(string, " ", string_len, (ftnlen)1);
377 *size = 0;
378 *lidx = 0;
379 return 0;
380 }
381
382 /* Check in. */
383
384 chkin_("SEPOOL", (ftnlen)6);
385
386 /* Check if the first component exists. Return empty output if not. */
387
388 gcpool_(item, fidx, &c__1, &n, part, &gotit, item_len, (ftnlen)80);
389 gotit = gotit && n > 0;
390 if (! gotit) {
391 *found = FALSE_;
392 s_copy(string, " ", string_len, (ftnlen)1);
393 *size = 0;
394 *lidx = 0;
395 chkout_("SEPOOL", (ftnlen)6);
396 return 0;
397 }
398
399 /* Fetch the string using Bill's algorithm from STPOOL 'as is'. */
400
401 room = i_len(string, string_len);
402 csize = rtrim_(contin, contin_len);
403 putat = 1;
404 comp = *fidx;
405 more = TRUE_;
406 s_copy(string, " ", string_len, (ftnlen)1);
407 n = 0;
408 while(more) {
409 gcpool_(item, &comp, &c__1, &n, part, &more, item_len, (ftnlen)80);
410 more = more && n > 0;
411 if (more) {
412 *found = TRUE_;
413 clast = rtrim_(part, (ftnlen)80);
414 cfirst = clast - csize + 1;
415 if (cfirst < 0) {
416 if (putat <= room) {
417 s_copy(string + (putat - 1), part, string_len - (putat -
418 1), clast);
419 }
420 putat += clast;
421 more = FALSE_;
422 } else if (s_cmp(part + (cfirst - 1), contin, clast - (cfirst - 1)
423 , contin_len) != 0) {
424 if (putat <= room) {
425 s_copy(string + (putat - 1), part, string_len - (putat -
426 1), clast);
427 }
428 putat += clast;
429 more = FALSE_;
430 } else if (cfirst > 1) {
431 if (putat <= room) {
432 s_copy(string + (putat - 1), part, string_len - (putat -
433 1), cfirst - 1);
434 }
435 putat = putat + cfirst - 1;
436 }
437 }
438 ++comp;
439 }
440
441 /* We are done. Get the size of the full string and the index of its */
442 /* last component and checkout. */
443
444 *size = putat - 1;
445 *lidx = comp - 1;
446 chkout_("SEPOOL", (ftnlen)6);
447 return 0;
448 } /* sepool_ */
449
450