1 /* zzektcnv.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 static integer c__0 = 0;
12 static integer c__3 = 3;
13
14 /* $Procedure ZZEKTCNV ( Private: EK, time conversion ) */
zzektcnv_(char * timstr,doublereal * et,logical * error,char * errmsg,ftnlen timstr_len,ftnlen errmsg_len)15 /* Subroutine */ int zzektcnv_(char *timstr, doublereal *et, logical *error,
16 char *errmsg, ftnlen timstr_len, ftnlen errmsg_len)
17 {
18 /* System generated locals */
19 integer i__1;
20
21 /* Builtin functions */
22 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
23
24 /* Local variables */
25 doublereal tvec[10];
26 logical mods;
27 char type__[32];
28 extern integer posr_(char *, char *, integer *, ftnlen, ftnlen);
29 extern /* Subroutine */ int sct2e_(integer *, doublereal *, doublereal *);
30 integer clkid;
31 extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
32 ftnlen, ftnlen), repmc_(char *, char *, char *, char *, ftnlen,
33 ftnlen, ftnlen, ftnlen);
34 integer ntvec;
35 extern integer rtrim_(char *, ftnlen);
36 extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
37 scn2id_(char *, integer *, logical *, ftnlen), str2et_(char *,
38 doublereal *, ftnlen);
39 extern logical failed_(void);
40 doublereal sclkdp;
41 char modify[32*10], sclmsg[160];
42 logical succes, yabbrv;
43 extern /* Subroutine */ int scpars_(integer *, char *, logical *, char *,
44 doublereal *, ftnlen, ftnlen), chkout_(char *, ftnlen), suffix_(
45 char *, integer *, char *, ftnlen, ftnlen);
46 char locstr[80], pictur[80];
47 extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *,
48 ftnlen, ftnlen, ftnlen);
49 extern logical return_(void);
50 extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char
51 *, char *, logical *, logical *, logical *, char *, char *,
52 ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
53 logical fnd;
54 integer loc;
55
56 /* $ Abstract */
57
58 /* SPICE Private routine intended solely for the support of SPICE */
59 /* routines. Users should not call this routine directly due */
60 /* to the volatile nature of this routine. */
61
62 /* Convert time strings from EK query to ephemeris time. */
63
64 /* $ Disclaimer */
65
66 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
67 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
68 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
69 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
70 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
71 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
72 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
73 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
74 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
75 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
76
77 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
78 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
79 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
80 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
81 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
82 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
83
84 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
85 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
86 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
87 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
88
89 /* $ Required_Reading */
90
91 /* EK */
92
93 /* $ Keywords */
94
95 /* EK */
96 /* PRIVATE */
97
98 /* $ Declarations */
99 /* $ Disclaimer */
100
101 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
102 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
103 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
104 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
105 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
106 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
107 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
108 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
109 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
110 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
111
112 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
113 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
114 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
115 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
116 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
117 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
118
119 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
120 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
121 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
122 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
123
124
125 /* Include Section: EK Data Types */
126
127 /* ektype.inc Version 1 27-DEC-1994 (NJB) */
128
129
130 /* Within the EK system, data types of EK column contents are */
131 /* represented by integer codes. The codes and their meanings */
132 /* are listed below. */
133
134 /* Integer codes are also used within the DAS system to indicate */
135 /* data types; the EK system makes no assumptions about compatibility */
136 /* between the codes used here and those used in the DAS system. */
137
138
139 /* Character type: */
140
141
142 /* Double precision type: */
143
144
145 /* Integer type: */
146
147
148 /* `Time' type: */
149
150 /* Within the EK system, time values are represented as ephemeris */
151 /* seconds past J2000 (TDB), and double precision numbers are used */
152 /* to store these values. However, since time values require special */
153 /* treatment both on input and output, and since the `TIME' column */
154 /* has a special role in the EK specification and code, time values */
155 /* are identified as a type distinct from double precision numbers. */
156
157
158 /* End Include Section: EK Data Types */
159
160 /* $ Brief_I/O */
161
162 /* Variable I/O Description */
163 /* -------- --- -------------------------------------------------- */
164 /* TIMSTR I Time string. */
165 /* ET O Ephemeris time in seconds past J2000, TDB. */
166 /* ERROR O Error flag. */
167 /* ERRMSG O Error message. */
168
169 /* $ Detailed_Input */
170
171 /* TIMSTR is a string representing a time value. The value */
172 /* make be an SCLK string in the form */
173
174 /* <clock name> SCLK <clock string> */
175
176 /* or may be any string acceptable to ST2ET. */
177
178 /* $ Detailed_Output */
179
180 /* ET is the ephemeris time equivalent to the input */
181 /* time. */
182
183 /* ERROR is a logical flag indicating whether an error was */
184 /* detected. Note that a time string might be */
185 /* syntactically valid, but incapable of being */
186 /* converted to ET if the appropriate time kernels */
187 /* (Leapseconds or SCLK) are not loaded. */
188
189 /* ERRMSG is an error message describing an error in the */
190 /* input query, if one was detected. */
191
192 /* $ Parameters */
193
194 /* None. */
195
196 /* $ Exceptions */
197
198 /* 1) If any sort of time conversion error occurs, the output flag */
199 /* ERROR is set, and an error message is returned. */
200
201 /* The routine attempts to avoid causing errors that must */
202 /* be trapped by SPICELIB error handling. Time string syntax */
203 /* errors or missing kernel files, for example, should not trip */
204 /* SPICELIB error handling. */
205
206 /* $ Files */
207
208 /* None. */
209
210 /* $ Particulars */
211
212 /* Strings representing time values are interpreted as follows: */
213
214 /* 1) The string is first examined to see whether it's an */
215 /* SCLK string for a recognized clock; if it is, the */
216 /* string is converted to the equivalent ET. */
217
218 /* 2) If the string is not a SCLK string, it is expected */
219 /* to be some sort of standard time representation. */
220 /* The string is checked to see whether it's in a format */
221 /* that TPARTV can handle. If TPARTV can't deal with it, */
222 /* the string is considered to be invalid. */
223
224 /* $ Examples */
225
226 /* See ZZEKTRES. */
227
228 /* $ Restrictions */
229
230 /* 1) A leapseconds kernel must be loaded at the time this routine */
231 /* is called. */
232
233 /* 2) In order to convert SCLK strings, an appropriate SCLK kernel */
234 /* must be loaded at the time this routine is called. */
235
236 /* $ Literature_References */
237
238 /* None. */
239
240 /* $ Author_and_Institution */
241
242 /* N.J. Bachman (JPL) */
243
244 /* $ Version */
245
246 /* - SPICELIB Version 2.0.0, 12-AUG-2001 (NJB) */
247
248 /* Now converts standard time strings to ET via STR2ET instead */
249 /* of the less general routines ISO2UTC and UTC2ET. */
250
251 /* Bug fix: modified algorithm to handle case where string */
252 /* "SCLK" appears in SCLK name. */
253
254 /* Bug fix: construction of error messages in case where */
255 /* FAILED() returns .TRUE. has been changed so that REPMC is */
256 /* not called. Instead, the error-free routine SUFFIX is */
257 /* used. */
258
259 /* - SPICELIB Version 1.0.0, 11-OCT-1995 (NJB) */
260
261 /* -& */
262 /* $ Revisions */
263
264 /* - SPICELIB Version 2.0.0, 12-AUG-2001 (NJB) */
265
266 /* Now converts standard time strings to ET via STR2ET instead */
267 /* of the less general routines ISO2UTC and UTC2ET. */
268
269 /* Bug fix: modified algorithm to handle case where string */
270 /* "SCLK" appears in SCLK name. */
271
272 /* Bug fix: construction of error messages in case where */
273 /* FAILED() returns .TRUE. has been changed so that REPMC is */
274 /* not called. Instead, the error-free routine SUFFIX is */
275 /* used. */
276
277 /* -& */
278
279 /* SPICELIB functions */
280
281
282 /* Local parameters */
283
284
285 /* Local variables */
286
287 if (return_()) {
288 return 0;
289 }
290 chkin_("ZZEKTCNV", (ftnlen)8);
291
292 /* No error to start with. */
293
294 *error = FALSE_;
295 s_copy(errmsg, " ", errmsg_len, (ftnlen)1);
296
297 /* Get a left-justified, compressed, upper-case copy of */
298 /* the string, so we can easily search it for substrings */
299 /* that would identify it as SCLK. If we do find a */
300 /* match, remove the identifying substring (of the form */
301 /* 'MO SCLK', 'VGR1 SCLK', etc.). */
302
303 cmprss_(" ", &c__1, timstr, locstr, (ftnlen)1, timstr_len, (ftnlen)80);
304 ljust_(locstr, locstr, (ftnlen)80, (ftnlen)80);
305 ucase_(locstr, locstr, (ftnlen)80, (ftnlen)80);
306 i__1 = rtrim_(locstr, (ftnlen)80);
307 loc = posr_(locstr, "SCLK", &i__1, (ftnlen)80, (ftnlen)4);
308 if (loc > 0) {
309
310 /* It's a SCLK string. Find the ID code, if we can. */
311
312 scn2id_(locstr, &clkid, &fnd, loc + 3);
313 if (! fnd) {
314
315 /* We don't recognize this SCLK type. */
316
317 *error = TRUE_;
318 if (loc > 1) {
319 s_copy(errmsg, "Time conversion failed; SCLK type <#> was no"
320 "t recognized.", errmsg_len, (ftnlen)57);
321 repmc_(errmsg, "#", timstr, errmsg, errmsg_len, (ftnlen)1,
322 loc - 1, errmsg_len);
323 } else {
324 s_copy(errmsg, "Time conversion failed; SCLK name was not su"
325 "pplied.", errmsg_len, (ftnlen)51);
326 }
327 chkout_("ZZEKTCNV", (ftnlen)8);
328 return 0;
329 }
330
331 /* If we got this far, we recognized the SCLK type. */
332 /* Convert the time to ET. */
333
334 i__1 = loc + 3;
335 scpars_(&clkid, locstr + i__1, error, sclmsg, &sclkdp, 80 - i__1, (
336 ftnlen)160);
337 if (failed_()) {
338
339 /* We'll arrive here if the required SCLK kernel hasn't */
340 /* been loaded. */
341
342 *error = TRUE_;
343 s_copy(errmsg, "Unexpected SPICELIB error encountered while atte"
344 "mpting to parse the string <", errmsg_len, (ftnlen)76);
345 suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len);
346 suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len);
347 chkout_("ZZEKTCNV", (ftnlen)8);
348 return 0;
349 } else if (*error) {
350 s_copy(errmsg, "The string <#> didn't parse as a spacecraft cloc"
351 "k string.", errmsg_len, (ftnlen)57);
352 repmc_(errmsg, "#", timstr, errmsg, errmsg_len, (ftnlen)1,
353 timstr_len, errmsg_len);
354 suffix_(sclmsg, &c__3, errmsg, (ftnlen)160, errmsg_len);
355 chkout_("ZZEKTCNV", (ftnlen)8);
356 return 0;
357 } else {
358 sct2e_(&clkid, &sclkdp, et);
359 if (failed_()) {
360 *error = TRUE_;
361 s_copy(errmsg, "Unexpected SPICELIB error encountered while "
362 "attempting to parse the string <", errmsg_len, (
363 ftnlen)76);
364 suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len);
365 suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len);
366 chkout_("ZZEKTCNV", (ftnlen)8);
367 return 0;
368 }
369 }
370 } else {
371
372 /* We could have a standard time string. Make sure that the */
373 /* time string is acceptable before actually calling STR2ET. */
374
375 tpartv_(locstr, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes,
376 pictur, errmsg, (ftnlen)80, (ftnlen)32, (ftnlen)32, (ftnlen)
377 80, errmsg_len);
378 if (succes) {
379
380 /* It's safe to pass the string to STR2ET. */
381
382 str2et_(locstr, et, (ftnlen)80);
383 if (failed_()) {
384 *error = TRUE_;
385 s_copy(errmsg, "Unexpected SPICELIB error encountered while "
386 "attempting to parse the string <", errmsg_len, (
387 ftnlen)76);
388 suffix_(timstr, &c__0, errmsg, timstr_len, errmsg_len);
389 suffix_(">", &c__0, errmsg, (ftnlen)1, errmsg_len);
390 chkout_("ZZEKTCNV", (ftnlen)8);
391 return 0;
392 }
393 } else {
394
395 /* The string cannot be parsed by STR2ET. The error message */
396 /* was set by TPARTV. */
397
398 *error = TRUE_;
399 chkout_("ZZEKTCNV", (ftnlen)8);
400 return 0;
401 }
402
403 /* We're done with the standard time string case. */
404
405 }
406
407 /* We've parsed a time string, if it was an SCLK or standard string. */
408
409 chkout_("ZZEKTCNV", (ftnlen)8);
410 return 0;
411 } /* zzektcnv_ */
412
413