1 /* srfcss.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 SRFCSS ( Surface ID and body string to surface string ) */
srfcss_(integer * code,char * bodstr,char * srfstr,logical * isname,ftnlen bodstr_len,ftnlen srfstr_len)9 /* Subroutine */ int srfcss_(integer *code, char *bodstr, char *srfstr,
10 logical *isname, ftnlen bodstr_len, ftnlen srfstr_len)
11 {
12 extern /* Subroutine */ int zzsrfc2n_(integer *, integer *, char *,
13 logical *, ftnlen), chkin_(char *, ftnlen), bods2c_(char *,
14 integer *, logical *, ftnlen);
15 extern logical failed_(void);
16 integer bodyid;
17 extern /* Subroutine */ int chkout_(char *, ftnlen);
18 extern logical return_(void);
19 extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
20
21 /* $ Abstract */
22
23 /* Translate a surface ID code, together with a body string, to the */
24 /* corresponding surface name. If no such surface name exists, */
25 /* return a string representation of the surface ID code. */
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 /* DSK */
55 /* NAIF_IDS */
56
57 /* $ Keywords */
58
59 /* CONVERSION */
60 /* DSK */
61 /* ID */
62 /* NAME */
63 /* STRING */
64 /* SURFACE */
65
66 /* $ Declarations */
67 /* $ Brief_I/O */
68
69 /* Variable I/O Description */
70 /* -------- --- -------------------------------------------------- */
71 /* CODE I Integer surface ID code to translate to a string. */
72 /* BODSTR I Name or ID of body associated with surface. */
73 /* SRFSTR O String corresponding to surface ID code. */
74 /* ISNAME O Flag indicating whether output is a surface name. */
75 /* SFNMLN P Maximum length of surface name. */
76
77 /* $ Detailed_Input */
78
79 /* CODE is an integer ID code for a surface associated with a */
80 /* specified body. */
81
82
83 /* BODSTR is a string designating the body associated with the */
84 /* input surface ID code. BODSTR may contain a body name */
85 /* or a string representation of the body's integer ID */
86 /* code. For example, BODSTR may contain */
87
88 /* '1000012' */
89
90 /* instead of */
91
92 /* '67P/CHURYUMOV-GERASIMENKO (1969 R1)' */
93
94 /* Case and leading and trailing blanks in a name are not */
95 /* significant. Sequences of consecutive embedded blanks */
96 /* are considered equivalent to a single blank. That is, */
97 /* all of the following strings are equivalent names: */
98
99 /* '67P/CHURYUMOV-GERASIMENKO (1969 R1)' */
100 /* '67P/Churyumov-Gerasimenko (1969 R1)' */
101 /* '67P/CHURYUMOV-GERASIMENKO (1969 R1) ' */
102 /* '67P/CHURYUMOV-GERASIMENKO (1969 R1)' */
103 /* ' 67P/CHURYUMOV-GERASIMENKO (1969 R1)' */
104
105 /* However, '67P/CHURYUMOV-GERASIMENKO(1969R1)' */
106 /* is not equivalent to the names above. */
107
108
109 /* $ Detailed_Output */
110
111 /* SRFSTR the name of the surface identified by CODE, for the */
112 /* body designated by BODSTR, if for this body an */
113 /* association exists between the input surface ID and a */
114 /* surface name. */
115
116 /* If CODE has more than one translation, then the most */
117 /* recently defined surface name corresponding to CODE is */
118 /* returned. SRFSTR will have the exact format (case and */
119 /* embedded blanks) used in the definition of the */
120 /* name/code association. */
121
122 /* If the input surface ID code and body name do not map */
123 /* to a surface name, SRFSTR is set to the string */
124 /* representation of CODE. */
125
126 /* SRFSTR should be declared with length SFNMLN (see the */
127 /* Parameters section below). */
128
129
130 /* ISNAME is a logical flag that is .TRUE. if a surface name */
131 /* corresponding to the input ID codes was found and */
132 /* .FALSE. otherwise. When ISNAME is .FALSE., the output */
133 /* string SRFSTR contains a string representing the */
134 /* integer CODE. */
135
136 /* $ Parameters */
137
138 /* SFNMLN is the maximum length of a surface name. This */
139 /* parameter is declared in the SPICELIB include file */
140
141 /* srftrn.inc */
142
143 /* $ Exceptions */
144
145 /* 1) If the input body string cannot be mapped to a body name, the */
146 /* output SRFSTR is set to a string representation of the */
147 /* surface ID code. The output ISNAME is set to .FALSE. */
148
149 /* This case is not treated as an error. */
150
151 /* 2) If the input surface code cannot be mapped to a surface name, */
152 /* the output SRFSTR is set to a string representation of the */
153 /* surface ID code. The input body string is ignored. The output */
154 /* ISNAME is set to .FALSE. */
155
156 /* This case is not treated as an error. */
157
158 /* $ Files */
159
160 /* Surface name-to-ID mappings may be defined at run time by loading */
161 /* text kernels containing kernel variable assignments of the form */
162
163 /* NAIF_SURFACE_NAME += ( <surface name 1>, ... ) */
164 /* NAIF_SURFACE_CODE += ( <surface code 1>, ... ) */
165 /* NAIF_SURFACE_BODY += ( <body code 1>, ... ) */
166
167 /* Above, the Ith elements of the lists on the assignments' right */
168 /* hand sides together define the Ith surface name/ID mapping. */
169
170 /* The same effect can be achieved using assignments formatted as */
171 /* follows: */
172
173 /* NAIF_SURFACE_NAME += <surface name 1> */
174 /* NAIF_SURFACE_CODE += <surface code 1> */
175 /* NAIF_SURFACE_BODY += <body code 1> */
176
177 /* NAIF_SURFACE_NAME += <surface name 2> */
178 /* NAIF_SURFACE_CODE += <surface code 2> */
179 /* NAIF_SURFACE_BODY += <body code 2> */
180
181 /* ... */
182
183 /* Note the use of the */
184
185 /* += */
186
187 /* operator; this operator appends to rather than overwrites the */
188 /* kernel variable named on the left hand side of the assignment. */
189
190 /* $ Particulars */
191
192 /* Surfaces are always associated with bodies (which usually are */
193 /* ephemeris objects). For any given body, a mapping between surface */
194 /* names and surface ID codes can be established. */
195
196 /* Bodies serve to disambiguate surface names and ID codes: the set */
197 /* of surface names and surface ID codes for a given body can be */
198 /* thought of as belonging to a name space. A given surface ID code */
199 /* or surface name may be used for surfaces of multiple bodies, */
200 /* without conflict. */
201
202 /* Associations between surface names and ID codes are always made */
203 /* via kernel pool assignments; there are no built-in associations. */
204
205 /* SRFCSS is one of four related subroutines: */
206
207 /* SRFS2C Surface string and body string to surface ID code */
208 /* SRFSCC Surface string and body ID code to surface ID code */
209 /* SRFC2S Surface ID code and body ID code to surface string */
210 /* SRFCSS Surface ID code and body string to surface string */
211
212 /* SRFS2C, SRFC2S, SRFSCC, and SRFCSS perform translations between */
213 /* surface strings and their corresponding integer ID codes. */
214
215 /* Refer to naif_ids.req for details concerning adding new surface */
216 /* name/code associations at run time by loading text kernels. */
217
218 /* $ Examples */
219
220 /* The formatting of the results shown for this example may differ */
221 /* across platforms. */
222
223 /* 1) Supposed a text kernel has been loaded that contains */
224 /* the following assignments: */
225
226 /* NAIF_SURFACE_NAME += ( 'MGS MOLA 64 pixel/deg', */
227 /* 'MGS MOLA 128 pixel/deg', */
228 /* 'PHOBOS GASKELL Q512' ) */
229 /* NAIF_SURFACE_CODE += ( 1, 2, 1 ) */
230 /* NAIF_SURFACE_BODY += ( 499, 499, 401 ) */
231
232 /* Translate each surface and body ID code pair to the */
233 /* associated surface name. Also perform a translation */
234 /* for a surface ID having no matching name. */
235
236 /* Use the meta-kernel shown below to define the required SPICE */
237 /* kernel variables: */
238
239
240 /* KPL/MK */
241
242 /* File: srfcss_ex1.tm */
243
244 /* This meta-kernel is intended to support operation of SPICE */
245 /* example programs. The file contents shown here should not be */
246 /* assumed to contain adequate or correct versions of data */
247 /* required by SPICE-based user applications. */
248
249
250 /* \begindata */
251
252 /* NAIF_SURFACE_NAME += ( 'MGS MOLA 64 pixel/deg', */
253 /* 'MGS MOLA 128 pixel/deg', */
254 /* 'PHOBOS GASKELL Q512' ) */
255 /* NAIF_SURFACE_CODE += ( 1, 2, 1 ) */
256 /* NAIF_SURFACE_BODY += ( 499, 499, 401 ) */
257
258 /* \begintext */
259
260
261 /* Example code begins here. */
262
263
264 /* PROGRAM EX1 */
265 /* IMPLICIT NONE */
266
267 /* INCLUDE 'srftrn.inc' */
268
269 /* INTEGER FILSIZ */
270 /* PARAMETER ( FILSIZ = 255 ) */
271
272 /* INTEGER NCASE */
273 /* PARAMETER ( NCASE = 5 ) */
274
275 /* INTEGER BDNMLN */
276 /* PARAMETER ( BDNMLN = 36 ) */
277
278 /* CHARACTER*(BDNMLN) BODSTR ( NCASE ) */
279 /* CHARACTER*(FILSIZ) META */
280 /* CHARACTER*(SFNMLN) SRFNAM */
281
282 /* INTEGER I */
283 /* INTEGER SURFID ( NCASE ) */
284
285 /* LOGICAL ISNAME */
286
287
288 /* DATA ( SURFID(I), BODSTR(I), I = 1, NCASE ) / */
289 /* . */
290 /* . 1, 'MARS', */
291 /* . 1, 'PHOBOS', */
292 /* . 2, '499', */
293 /* . 3, 'MARS', */
294 /* . 1, 'ZZZ' / */
295
296
297 /* META = 'srfcss_ex1.tm' */
298
299 /* CALL FURNSH ( META ) */
300
301 /* WRITE (*,*) ' ' */
302
303 /* DO I = 1, NCASE */
304
305 /* CALL SRFCSS ( SURFID(I), BODSTR(I), */
306 /* . SRFNAM, ISNAME ) */
307
308 /* WRITE (*,*) 'surface ID = ', SURFID(I) */
309 /* WRITE (*,*) 'body string = ', BODSTR(I) */
310 /* WRITE (*,*) 'name found = ', ISNAME */
311 /* WRITE (*,*) 'surface string = ', SRFNAM */
312 /* WRITE (*,*) ' ' */
313
314 /* END DO */
315
316 /* END */
317
318
319 /* When this program was executed on a PC/Linux/gfortran/64-bit */
320 /* platform, the output was: */
321
322
323 /* surface ID = 1 */
324 /* body string = MARS */
325 /* name found = T */
326 /* surface string = MGS MOLA 64 pixel/deg */
327
328 /* surface ID = 1 */
329 /* body string = PHOBOS */
330 /* name found = T */
331 /* surface string = PHOBOS GASKELL Q512 */
332
333 /* surface ID = 2 */
334 /* body string = 499 */
335 /* name found = T */
336 /* surface string = MGS MOLA 128 pixel/deg */
337
338 /* surface ID = 3 */
339 /* body string = MARS */
340 /* name found = F */
341 /* surface string = 3 */
342
343 /* surface ID = 1 */
344 /* body string = ZZZ */
345 /* name found = F */
346 /* surface string = 1 */
347
348
349 /* $ Restrictions */
350
351 /* None. */
352
353 /* $ Literature_References */
354
355 /* None. */
356
357 /* $ Author_and_Institution */
358
359 /* N.J. Bachman (JPL) */
360 /* B.V. Semenov (JPL) */
361 /* E.D. Wright (JPL) */
362
363 /* $ Version */
364
365 /* - SPICELIB Version 1.0.0, 14-JAN-2016 (NJB) (EDW) (BVS) */
366
367 /* -& */
368 /* $ Index_Entries */
369
370 /* surface ID code and body string to surface string */
371
372 /* -& */
373
374 /* SPICELIB functions */
375
376
377 /* Local variables */
378
379 if (return_()) {
380 return 0;
381 }
382 chkin_("SRFCSS", (ftnlen)6);
383
384 /* No name has been found yet. */
385
386 *isname = FALSE_;
387
388 /* Convert the body string to an ID code. */
389
390 bods2c_(bodstr, &bodyid, isname, bodstr_len);
391 if (failed_()) {
392 chkout_("SRFCSS", (ftnlen)6);
393 return 0;
394 }
395 if (*isname) {
396
397 /* Try to translate the surface and body codes to a known surface */
398 /* name. */
399
400 zzsrfc2n_(code, &bodyid, srfstr, isname, srfstr_len);
401 if (failed_()) {
402 chkout_("SRFCSS", (ftnlen)6);
403 return 0;
404 }
405 }
406
407 /* If either the body string or surface code could not be */
408 /* translated, convert the surface ID code to a string */
409 /* representation. */
410
411 if (! (*isname)) {
412 intstr_(code, srfstr, srfstr_len);
413 }
414 chkout_("SRFCSS", (ftnlen)6);
415 return 0;
416 } /* srfcss_ */
417
418