1 /* zzsrfini.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__0 = 0;
11
12 /* $Procedure ZZSRFINI ( Private --- Surface-Code Hash Initialization ) */
zzsrfini_(char * nornam,integer * codes,integer * bodies,integer * nvals,integer * maxval,integer * snmhls,integer * snmpol,integer * snmidx,integer * sidhls,integer * sidpol,integer * sididx,ftnlen nornam_len)13 /* Subroutine */ int zzsrfini_(char *nornam, integer *codes, integer *bodies,
14 integer *nvals, integer *maxval, integer *snmhls, integer *snmpol,
15 integer *snmidx, integer *sidhls, integer *sidpol, integer *sididx,
16 ftnlen nornam_len)
17 {
18 /* Builtin functions */
19 integer s_cmp(char *, char *, ftnlen, ftnlen);
20
21 /* Local variables */
22 integer head, node;
23 logical full;
24 extern /* Subroutine */ int zzhscini_(integer *, integer *, integer *),
25 zzhsiini_(integer *, integer *, integer *);
26 integer i__;
27 extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
28 ftnlen, ftnlen);
29 logical idnew;
30 extern /* Subroutine */ int cleari_(integer *, integer *);
31 integer itemat;
32 logical namnew, lfound;
33 integer lookat;
34 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
35 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
36 ftnlen), cmprss_(char *, integer *, char *, char *, ftnlen,
37 ftnlen, ftnlen);
38 char sqshnm[36];
39 extern integer zzhash2_(char *, integer *, ftnlen), zzhashi_(integer *,
40 integer *);
41
42 /* $ Abstract */
43
44 /* SPICE Private routine intended solely for the support of SPICE */
45 /* routines. Users should not call this routine directly due to the */
46 /* volatile nature of this routine. */
47
48 /* Initialize the name-based and ID-based hashes used for efficient */
49 /* access to surface-name mapping arrays. This routine should be */
50 /* called by ZZSRFTRN and ZZSRFKER only. */
51
52 /* $ Disclaimer */
53
54 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
55 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
56 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
57 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
58 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
59 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
60 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
61 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
62 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
63 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
64
65 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
66 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
67 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
68 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
69 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
70 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
71
72 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
73 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
74 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
75 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
76
77 /* $ Required_Reading */
78
79 /* None. */
80
81 /* $ Keywords */
82
83 /* UTILITY */
84
85 /* $ Declarations */
86 /* $ Abstract */
87
88 /* Declare public surface name/ID mapping parameters. */
89
90 /* $ Disclaimer */
91
92 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
93 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
94 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
95 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
96 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
97 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
98 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
99 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
100 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
101 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
102
103 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
104 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
105 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
106 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
107 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
108 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
109
110 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
111 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
112 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
113 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
114
115 /* $ Required_Reading */
116
117 /* NAIF_IDS */
118
119 /* $ Keywords */
120
121 /* CONVERSION */
122 /* NAME */
123 /* STRING */
124 /* SURFACE */
125
126 /* $ Restrictions */
127
128 /* None. */
129
130 /* $ Author_and_Institution */
131
132 /* N.J. Bachman (JPL) */
133
134 /* $ Literature_References */
135
136 /* None. */
137
138 /* $ Version */
139
140 /* - SPICELIB Version 1.0.0, 02-DEC-2015 (NJB) */
141
142 /* -& */
143
144 /* Maximum number of surface name/ID mapping entries: */
145
146
147 /* Maximum length of a surface name string: */
148
149
150 /* End of file srftrn.inc. */
151
152 /* $ Abstract */
153
154 /* SPICE private include file intended solely for the support of */
155 /* SPICE routines. User software should not include this file */
156 /* due to the volatile nature of this file. */
157
158 /* Declare private surface name/ID mapping parameters. */
159
160 /* $ Disclaimer */
161
162 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
163 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
164 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
165 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
166 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
167 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
168 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
169 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
170 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
171 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
172
173 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
174 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
175 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
176 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
177 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
178 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
179
180 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
181 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
182 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
183 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
184
185 /* $ Required_Reading */
186
187 /* NAIF_IDS */
188
189 /* $ Keywords */
190
191 /* CONVERSION */
192 /* NAME */
193 /* STRING */
194 /* SURFACE */
195
196 /* $ Restrictions */
197
198 /* None. */
199
200 /* $ Author_and_Institution */
201
202 /* N.J. Bachman (JPL) */
203
204 /* $ Literature_References */
205
206 /* None. */
207
208 /* $ Version */
209
210 /* - SPICELIB Version 1.0.0, 04-FEB-2017 (NJB) */
211
212 /* Original version 03-DEC-2015 (NJB) */
213
214 /* -& */
215
216 /* Size of the lists and hashes storing the POOL-defined name/ID */
217 /* mappings. To ensure efficient hashing, this size is set to the */
218 /* first prime number greater than MXNSRF defined in the public */
219 /* include file */
220
221 /* srftrn.inc. */
222
223
224 /* Singly-linked list pool lower bound: */
225
226
227 /* End of file zzsrftrn.inc. */
228
229 /* $ Brief_I/O */
230
231 /* Variable I/O Description */
232 /* -------- --- -------------------------------------------------- */
233 /* NORNAM I Array of normalized surface names */
234 /* CODES I Array of surface ID codes for NAMES/NORNAM */
235 /* BODIES I Array of body ID codes */
236 /* NVALS I Length of NAMES, NORNAM, and CODES arrays */
237 /* MAXVAL I Size of the hash arrays */
238 /* SNMHLS O Surface name-based hash head node pointer list */
239 /* SNMPOL O Surface name-based hash node collision list */
240 /* SNMIDX O Surface name-based hash index storage array */
241 /* SIDHLS O Surface ID-based hash head node pointer list */
242 /* SIDPOL O Surface ID-based hash node collision list */
243 /* SIDIDX O Surface ID-based hash index storage array */
244 /* LBSNGL P Lower bound of hash pool arrays */
245 /* SFNMLN P Maximum length of surface name strings */
246
247 /* $ Detailed_Input */
248
249 /* NORNAM is the array of normalized surface names, made from */
250 /* elements of NAMES by upper-casing, left-justifying, and */
251 /* compressing groups of spaces to a single space. This */
252 /* represents the canonical member of the equivalence */
253 /* class to which each parallel entry in NAMES belongs. */
254
255 /* This array is parallel to CODES and BODIES. */
256
257 /* CODES is the array of surface codes extracted. This array is */
258 /* parallel to NAMES and NORNAM. */
259
260 /* BODIES is the array of body ID codes associated with the input */
261 /* surface names. */
262
263 /* NVALS is the number of items contained in NAMES, NORNAM, */
264 /* CODES. */
265
266 /* MAXVAL is the output hash size. */
267
268 /* $ Detailed_Output */
269
270 /* All output arrays must be declared with the dimension MAXVAL. */
271 /* MAXVAL must be greater than or equal to NVALS. */
272
273 /* SNMHLS */
274 /* SNMPOL are the surface name-based hash head node pointer and */
275 /* collision lists. Together with the arrays SNMIDX, */
276 /* NORNAM and BODIES, they enable mapping pairs of */
277 /* normalized surface names and body ID codes to surface */
278 /* ID codes. */
279
280 /* SNMIDX is the surface name-based hash index storage array. It */
281 /* maps nodes in the name collision list to entries in the */
282 /* parallel NORNAM and BODIES arrays. */
283
284 /* SIDHLS */
285 /* SIDPOL are the surface ID-based hash head node pointer and */
286 /* collision lists. Together with the arrays SIDIDX, */
287 /* CODES and BODIES, they enable mapping pairs of */
288 /* surface ID codes and body ID codes to surface */
289 /* names. */
290
291 /* SIDIDX is the surface ID-based hash index storage array. It */
292 /* maps nodes in the ID collision list to entries in the */
293 /* parallel CODES and BODIES arrays. */
294
295 /* $ Parameters */
296
297 /* LBSNGL is the lower bound of the hashes' collision list array. */
298
299 /* SFNMLN is the maximum length of a surface name. Defined in the */
300 /* include file 'srftrn.inc'. */
301
302 /* $ Exceptions */
303
304 /* 1) If the input number of bodies NVALS is not less than or equal */
305 /* to the size of the output hash, the error 'SPICE(BUG1)' will be */
306 /* signaled. */
307
308 /* 2) If registering an ID in the output ID-based hash fails, the */
309 /* error 'SPICE(BUG2)' will be signaled. */
310
311 /* 3) If registering a name in the output name-based hash fails, */
312 /* the error 'SPICE(BUG3)' will be signaled. */
313
314 /* $ Files */
315
316 /* None. */
317
318 /* $ Particulars */
319
320 /* This is a utility routine used for initializing the hashes */
321 /* facilitating efficient surface name-ID translation in ZZSRFTRN. */
322
323 /* The order of mappings in the input arrays determines their */
324 /* priority, with the mapping having the lowest priority being first */
325 /* and the mapping with the highest priority being last. */
326 /* If more than one entry with a particular normalized name and body */
327 /* ID is present in the input arrays, only the latest entry is */
328 /* registered in the name-based hash. */
329
330 /* If more than one entry with a particular surface ID and body ID */
331 /* is present in the input arrays, only the latest entry that maps */
332 /* to a not-yet-registered normalized name is registered in the */
333 /* ID-based hash. Registering IDs only for not-yet-registered names */
334 /* achieves masking all IDs with the lower priority in cases when a */
335 /* single normalized name and body ID map to more than one surface */
336 /* ID. */
337
338 /* $ Examples */
339
340 /* See the routine ZZSRFTRN. */
341
342 /* $ Restrictions */
343
344 /* 1) This routine is intended only for use by ZZSRFTRN and */
345 /* ZZSRFKER. */
346
347 /* 2) All output hash arrays must be declared with the same */
348 /* dimension which is greater than or equal to MAXVAL. */
349
350 /* 3) The order of mappings in the input arrays determines the */
351 /* priority, with the mapping with the lowest priority being the */
352 /* first and the mapping with the highest priority being the */
353 /* last. */
354
355 /* $ Literature_References */
356
357 /* None. */
358
359 /* $ Author_and_Institution */
360
361 /* B.V. Semenov (JPL) */
362 /* M.J. Spencer (JPL) */
363 /* W.L. Taber (JPL) */
364 /* F.S. Turner (JPL) */
365 /* E.D. Wright (JPL) */
366
367 /* $ Version */
368
369 /* - SPICELIB Version 1.0.0, 03-DEC-2015 (NJB) (BVS) (EDW) */
370
371 /* -& */
372
373 /* SPICELIB functions. */
374
375
376 /* Hash control area items. */
377
378
379 /* Local Variables */
380
381
382 /* Consistency check. */
383
384 if (*maxval < *nvals) {
385 chkin_("ZZSRFINI", (ftnlen)8);
386 setmsg_("There is an inconsistency between the number of input bodie"
387 "s and the size of the output hashes. The number of input bod"
388 "ies was #. The size of the output hashes was #.", (ftnlen)166)
389 ;
390 errint_("#", nvals, (ftnlen)1);
391 errint_("#", maxval, (ftnlen)1);
392 sigerr_("SPICE(BUG1)", (ftnlen)11);
393 chkout_("ZZSRFINI", (ftnlen)8);
394 return 0;
395 }
396
397 /* Initialize output hashes. Set all collision list pointers */
398 /* to 0, which is the null value. */
399
400 zzhsiini_(maxval, sidhls, sidpol);
401 zzhscini_(maxval, snmhls, snmpol);
402 cleari_(&sidpol[5], &sidpol[6]);
403 cleari_(&snmpol[5], &snmpol[6]);
404
405 /* Loop through the input arrays to populate hashes. We do it */
406 /* backwards to pick and register only the highest priority (latest) */
407 /* values for each pair of normalized surface name and body ID code. */
408
409 for (i__ = *nvals; i__ >= 1; --i__) {
410
411 /* Register this normalized surface name and body ID, but only if */
412 /* this pair is not already in the hash. */
413
414 /* We must traverse the collision list for the normalized surface */
415 /* name "manually," since we have to check the body ID for each */
416 /* matching name. */
417
418 /* Use hash function to get index of the head node. */
419
420 cmprss_(" ", &c__0, nornam + (i__ - 1) * nornam_len, sqshnm, (ftnlen)
421 1, nornam_len, (ftnlen)36);
422 lookat = zzhash2_(sqshnm, &snmpol[5], (ftnlen)36);
423 head = snmhls[lookat - 1];
424
425 /* Indicate name and body were not found to begin with. */
426
427 lfound = FALSE_;
428 itemat = 0;
429 namnew = TRUE_;
430
431 /* See if this normalized name and corresponding body ID are, */
432 /* respectively, in the normalized name list and body ID list. */
433 /* Note that the body ID list is not a parallel array to the */
434 /* normalized name array: we use the name pool pointer array */
435 /* SNMIDX to indicate the location of the body ID corresponding */
436 /* to a name. */
437
438 node = head;
439 if (node > 0) {
440
441 /* Start at the head node and check each normalized name saved */
442 /* for this hash value until we find a name and body ID that */
443 /* match or run out of items in the collision list. */
444
445 while(node > 0 && ! lfound) {
446 lfound = s_cmp(nornam + (snmidx[node - 1] - 1) * nornam_len,
447 nornam + (i__ - 1) * nornam_len, nornam_len,
448 nornam_len) == 0 && bodies[snmidx[node - 1] - 1] ==
449 bodies[i__ - 1];
450 itemat = node;
451 node = snmpol[node + 5];
452 }
453
454 /* ITEMAT is the value of the last node in the list, or */
455 /* 0 if the list is empty. */
456
457 namnew = ! lfound;
458 }
459 if (namnew) {
460
461 /* We need to add the current normalized name and BODY ID */
462 /* to the hash. Make sure there's room. */
463
464 full = snmpol[4] > snmpol[5];
465 if (full) {
466 chkin_("ZZSRFINI", (ftnlen)8);
467 setmsg_("Could not add name # body ID # to the hash.", (
468 ftnlen)43);
469 errch_("#", nornam + (i__ - 1) * nornam_len, (ftnlen)1,
470 nornam_len);
471 errint_("#", &bodies[i__ - 1], (ftnlen)1);
472 sigerr_("SPICE(BUG2)", (ftnlen)11);
473 chkout_("ZZSRFINI", (ftnlen)8);
474 return 0;
475 } else {
476
477 /* Store the item at the first free location in */
478 /* the collision pool. */
479
480 node = snmpol[4];
481 ++snmpol[4];
482 if (head > 0) {
483
484 /* Link the new entry at the tail of the applicable */
485 /* collision list. The index of the tail node is ITEMAT. */
486
487 snmpol[itemat + 5] = node;
488 } else {
489
490 /* Insert the new head node into the head list. */
491
492 snmhls[lookat - 1] = node;
493 }
494
495 /* Set the index in the data arrays for the new pool */
496 /* entry. */
497
498 snmidx[node - 1] = i__;
499 }
500
501 /* NAMNEW indicates that the Ith normalized name and body ID */
502 /* pair was not in the hash prior to the above block of code. */
503
504 /* We may have a situation when a single normalized surface */
505 /* name and body ID pair maps to more than one surface ID. In */
506 /* such cases we want to completely mask all surface IDs with */
507 /* the lower priority. This is easy to do by simply not */
508 /* attempting to register any more surface IDs if the name is */
509 /* already registered. */
510
511 /* Register this surface ID and body ID pair, but only if it */
512 /* is not already in the hash. */
513
514 /* We must traverse the collision list for the normalized */
515 /* surface name "manually," since we have to check the body ID */
516 /* for each matching surface ID. */
517
518 /* Use hash function to get index of the head node. */
519
520 lookat = zzhashi_(&codes[i__ - 1], &sidpol[5]);
521 head = sidhls[lookat - 1];
522
523 /* Indicate surface ID and body were not found to begin with. */
524
525 lfound = FALSE_;
526 itemat = 0;
527 idnew = TRUE_;
528
529 /* See if this surface ID and corresponding body ID are, */
530 /* respectively, in the surface ID list and body ID list. */
531
532 node = head;
533 if (node > 0) {
534
535 /* Start at the head node and check each surface ID saved */
536 /* for this hash value until we find a surface ID and body */
537 /* ID that match or run out of items in this collision */
538 /* list. */
539
540 while(node > 0 && ! lfound) {
541 lfound = codes[sididx[node - 1] - 1] == codes[i__ - 1] &&
542 bodies[sididx[node - 1] - 1] == bodies[i__ - 1];
543 itemat = node;
544 node = sidpol[node + 5];
545 }
546
547 /* ITEMAT is the value of the last node in the list, or */
548 /* 0 if the list is empty. */
549
550 idnew = ! lfound;
551 }
552 if (idnew) {
553
554 /* We need to add the current surface ID and BODY ID */
555 /* to the hash. Make sure there's room. */
556
557 full = sidpol[4] > sidpol[5];
558 if (full) {
559 chkin_("ZZSRFINI", (ftnlen)8);
560 setmsg_("Could not add surface ID # body ID # to the has"
561 "h.", (ftnlen)49);
562 errint_("#", &codes[i__ - 1], (ftnlen)1);
563 errint_("#", &bodies[i__ - 1], (ftnlen)1);
564 sigerr_("SPICE(BUG3)", (ftnlen)11);
565 chkout_("ZZSRFINI", (ftnlen)8);
566 return 0;
567 } else {
568
569 /* Store the item at the first free location in the */
570 /* collision pool. */
571
572 node = sidpol[4];
573 ++sidpol[4];
574 if (head > 0) {
575
576 /* Link the new entry at the tail of the applicable */
577 /* collision list. The index of the tail node is */
578 /* ITEMAT. */
579
580 sidpol[itemat + 5] = node;
581 } else {
582
583 /* Insert the new head node into the head list. */
584
585 sidhls[lookat - 1] = node;
586 }
587
588 /* Set the index in the data arrays for the new pool */
589 /* entry. */
590
591 sididx[node - 1] = i__;
592 }
593 }
594
595 /* We've processed the new (surface ID, body ID) pair. */
596
597 }
598
599 /* We've processed the Ith mapping between (surface name, body */
600 /* ID) and (surface ID, body ID). */
601
602 }
603 return 0;
604 } /* zzsrfini_ */
605
606