1 /* tpartv.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__300 = 300;
11 static integer c__1 = 1;
12 static integer c__0 = 0;
13 static integer c__8 = 8;
14
15 /* $Procedure TPARTV ( Time string ---parse to a time vector) */
tpartv_(char * string,doublereal * tvec,integer * ntvec,char * type__,char * modify,logical * mods,logical * yabbrv,logical * succes,char * pictur,char * error,ftnlen string_len,ftnlen type_len,ftnlen modify_len,ftnlen pictur_len,ftnlen error_len)16 /* Subroutine */ int tpartv_(char *string, doublereal *tvec, integer *ntvec,
17 char *type__, char *modify, logical *mods, logical *yabbrv, logical *
18 succes, char *pictur, char *error, ftnlen string_len, ftnlen type_len,
19 ftnlen modify_len, ftnlen pictur_len, ftnlen error_len)
20 {
21 /* Initialized data */
22
23 static logical first = TRUE_;
24 static char zones[3*8] = "EST" "EDT" "CST" "CDT" "MST" "MDT" "PST" "PDT";
25 static char offset[6*8] = "UTC-5 " "UTC-4 " "UTC-6 " "UTC-5 " "UTC-7 "
26 "UTC-6 " "UTC-8 " "UTC-7 ";
27
28 /* System generated locals */
29 integer i__1, i__2, i__3;
30
31 /* Builtin functions */
32 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
33 integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
34 ftnlen, ftnlen), s_rnge(char *, integer, char *, integer);
35
36 /* Local variables */
37 extern logical zztokns_(char *, char *, ftnlen, ftnlen);
38 static integer begs[5], ends[5], from, b, e;
39 extern /* Subroutine */ int zzinssub_(char *, char *, integer *, char *,
40 ftnlen, ftnlen, ftnlen);
41 static integer i__, r__;
42 static char delim[1*3];
43 extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen),
44 repmc_(char *, char *, char *, char *, ftnlen, ftnlen, ftnlen,
45 ftnlen);
46 static integer mapto, b1, b2, e1, e2;
47 static char known[12*300];
48 extern integer rtrim_(char *, ftnlen);
49 extern logical zzist_(char *, ftnlen);
50 static integer to;
51 extern integer bsrchc_(char *, integer *, char *, ftnlen, ftnlen);
52 static char meanng[12*300];
53 static logical havera;
54 extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
55 static logical havapm;
56 extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen,
57 ftnlen);
58 extern integer intmax_(void);
59 static logical havwdy;
60 extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
61 ftnlen);
62 static logical havzon;
63 extern logical zzcmbt_(char *, char *, logical *, ftnlen, ftnlen);
64 static integer nknown;
65 static logical resolv, havsys;
66 extern logical zzgrep_(char *, ftnlen);
67 static logical l2r, r2l;
68 extern logical zznote_(char *, integer *, integer *, ftnlen), zzvalt_(
69 char *, integer *, integer *, char *, ftnlen, ftnlen), zzremt_(
70 char *, ftnlen), zzrept_(char *, char *, logical *, ftnlen,
71 ftnlen), zzsubt_(char *, char *, logical *, ftnlen, ftnlen),
72 zzispt_(char *, integer *, integer *, ftnlen);
73 static char rep[12];
74 static integer use;
75 extern logical zzunpck_(char *, logical *, doublereal *, integer *, char *
76 , char *, char *, ftnlen, ftnlen, ftnlen, ftnlen), zztpats_(
77 integer *, integer *, char *, char *, ftnlen, ftnlen);
78
79 /* $ Abstract */
80
81 /* This routine returns the components of a time supplied */
82 /* as a string and returns a vector of the components of */
83 /* that string together with an array of modifiers that may */
84 /* have been supplied with the string that may alter */
85 /* the interpretation of the components. */
86
87 /* $ Disclaimer */
88
89 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
90 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
91 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
92 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
93 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
94 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
95 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
96 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
97 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
98 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
99
100 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
101 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
102 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
103 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
104 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
105 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
106
107 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
108 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
109 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
110 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
111
112 /* $ Required_Reading */
113
114 /* None. */
115
116 /* $ Keywords */
117
118 /* TIME */
119
120 /* $ Declarations */
121 /* $ Brief_I/O */
122
123 /* VARIABLE I/O DESCRIPTION */
124 /* -------- --- -------------------------------------------------- */
125 /* STRING I A string to be parsed as a time */
126 /* TVEC O A vector giving the components of the time. */
127 /* NTVEC O The number of components supplied for TVEC */
128 /* TYPE O The type of the "time vector" TVEC */
129 /* MODIFY O A list of modifiers present in STRING. */
130 /* MODS O A logical indicating the presence of a modifier */
131 /* YABBRV O A logical indicating that a year was abbreviated */
132 /* SUCCES O A logical indicating whether STRING was parsed. */
133 /* PICTUR O A time format picture associated with STRING */
134 /* ERROR O A diagnostic message if STRING couldn't be parsed */
135
136 /* The function returns */
137
138 /* $ Detailed_Input */
139
140 /* STRING is a character string that represents some */
141 /* julian or calendar epoch. */
142
143 /* $ Detailed_Output */
144
145 /* TVEC is a vector of double precision numbers that represent */
146 /* the input string. The number and meaning of the */
147 /* components of TVEC depend upon the input string. This */
148 /* meaning can be determined from the output variable */
149 /* TYPE. */
150
151 /* TYPE NTVEC TVEC Components */
152 /* ------------------------------------------------------- */
153 /* YMD 3 to 6 TVEC(1) is the calendar year */
154 /* TVEC(2) is the numeric value of the */
155 /* month (1-12) */
156 /* TVEC(3) is the day of the month */
157 /* TVEC(4) is the hour of the day */
158 /* TVEC(5) is the minute of the hour */
159 /* TVEC(6) is the second of the minute */
160
161 /* YD 2 to 5 TVEC(1) is the calendar year */
162 /* TVEC(2) is the day of the year */
163 /* TVEC(3) is the hour of the day */
164 /* TVEC(4) is the minute of the hour */
165 /* TVEC(5) is the second of the minute */
166
167 /* JD 1 TVEC(1) is the julian date */
168
169 /* Note that the values of TVEC are not forced into the */
170 /* normal ranges used in daily conversation. TPARTV */
171 /* simply reports what's found in the string and does */
172 /* not pass judgement on the "correctness" of these */
173 /* components. */
174
175 /* NTVEC is the actual number of components that were present */
176 /* in the string. For example a user might have */
177 /* supplied only year, month and day of an epoch. */
178 /* In such a case NTVEC will be set to 3. The components */
179 /* actually supplied will be 1 through NTVEC. Values */
180 /* not supplied are set to zero. */
181
182 /* TYPE is the type of time string supplied. This is a function */
183 /* of whether the string contains year, month and day, */
184 /* day of year, or julian date. */
185
186 /* MODIFY is an array of character strings that indicate */
187 /* whether a modifier to the calendar string was supplied. */
188 /* If a particular modifier was not supplied, the */
189 /* value of that component of MODIFY will be set to */
190 /* a blank. Modifiers are used to change the meaning */
191 /* of time strings. */
192
193 /* For example 12:12:29 Jan 1, 1996 means 12 hours past */
194 /* midnight on Jan 1, 1996 in the UTC time system. But */
195 /* if we modify the string to be: */
196
197 /* 12:12:29 A.M. Jan 1, Tuesday PDT 1996 B.C. */
198
199 /* the string takes on an entirely different meaning. */
200
201 /* Five different modifiers are recognized by TPARTV: */
202 /* the era associated with the epoch, day of week of */
203 /* the epoch, time zone of an epoch, AM/PM used in */
204 /* daily time usage, and the system (UTC, TDB, or TDT). */
205
206 /* Again whether or not modifiers are compatible with the */
207 /* time and date components or with each other is not */
208 /* determined by TPARTV. TPARTV simply reports what is */
209 /* present in the string, leaving the task of deciding */
210 /* the meaning of the string to the calling routine. */
211
212 /* The components of MODIFY, their meaning and possible */
213 /* values are given below. */
214
215 /* Component Meaning Possible Non-blank Modifier Values */
216 /* --------- ------- ---------------------------------- */
217 /* 1 ERA 'A.D.', 'B.C.' */
218 /* 2 Weekday 'SUN', 'MON', ... etc. */
219 /* 3 Time Zone 'UTC+i:i', 'UTC-i:i' */
220 /* 4 AM/PM 'A.M.', 'P.M.' */
221 /* 5 System 'UTC', 'TDB', 'TDT' */
222
223 /* TPARTV recognizes the standard abbreviations of */
224 /* all continental U.S. time zones. */
225
226 /* PDT --- Pacific Daylight Time (UTC-07:00) */
227 /* PST --- Pacific Standard Time (UTC-08:00) */
228 /* MDT --- Mountain Daylight Time (UTC-06:00) */
229 /* MST --- Mountain Standard Time (UTC-07:00) */
230 /* CDT --- Central Daylight Time (UTC-05:00) */
231 /* CST --- Central Standard Time (UTC-06:00) */
232 /* EDT --- Eastern Daylight Time (UTC-04:00) */
233 /* EST --- Eastern Standard Time (UTC-05:00) */
234
235 /* In addition it recognizes offsets from UTC expressed */
236 /* as UTC+/-HR:MN. Note that through out SPICELIB */
237 /* the minutes component of the UTC offset are always */
238 /* regarded as positive offsets from the hour offset. */
239
240 /* All Time zones are returned in MODIFY as UTC offsets */
241 /* as indicated in the table above. */
242
243 /* MODS is TRUE if some non-blank modifier was supplied. */
244
245 /* YABBRV is TRUE if a year was supplied in the abbreviated */
246 /* form 'YR where YR is a two digit integer. */
247
248 /* SUCCES is TRUE if the string was successfully parsed. */
249 /* Otherwise it is set to FALSE and a diagnostic */
250 /* is supplied in the argument ERROR. */
251
252 /* PICTUR is a string that gives a format picture that can */
253 /* be used by the routine TIMOUT to construct a time */
254 /* string of the same form as the input time string. */
255
256 /* If some component of the input string could not be */
257 /* identified, PICTUR is returned as a blank. However, */
258 /* if all components of the input string could be */
259 /* identified and the string is simply ambiguous, PICTUR */
260 /* will contain a format picture that corresponds to */
261 /* the ambiguous input. Consequently, you must check */
262 /* the value of PICTUR to determine if TPARTV has */
263 /* been able to construct a format picture. */
264
265 /* ERROR is blank if the string was successfully parsed. */
266 /* Otherwise a human readable diagnostic is returned */
267 /* in ERROR. */
268
269 /* $ Parameters */
270
271 /* None. */
272
273 /* $ Files */
274
275 /* None. */
276
277 /* $ Exceptions */
278
279 /* Error Free. */
280
281 /* 1) All problems are diagnosed via the variables SUCCES and */
282 /* ERROR. */
283
284 /* $ Particulars */
285
286 /* This routine parses in input string that represents some */
287 /* epoch in some time system. In addition it constructs a */
288 /* format picture that describes the position and meaning */
289 /* of the various components of the string. */
290
291 /* This routine is intended to be used in close conjunction with */
292 /* the routines TTRANS and TIMOUT. */
293
294 /* The string is parsed by first determining its recognizable */
295 /* substrings (integers, punctuation marks, names of months, */
296 /* names of weekdays, time systems, time zones, etc.) These */
297 /* recognizable substrings are called the tokens of the input */
298 /* string. The meaning of some tokens are immediately determined. */
299 /* For example named months, weekdays, time systems have clear */
300 /* meanings. However, the meanings of numeric components must */
301 /* be deciphered from their magnitudes and location in */
302 /* the string relative to the immediately recognized components */
303 /* of the input string. */
304
305 /* To determine the meaning of the numeric tokens in the input */
306 /* string, a set of "productions rules" and transformations are */
307 /* applied to the full set of tokens in the string. These */
308 /* transformations are repeated until the meaning of every token */
309 /* has been determined or until further transformations yield */
310 /* no new clues into the meaning of the numeric tokens. */
311
312 /* 1) Unless the substring JD or jd is present the string is */
313 /* assumed to be a calendar format (day-month-year or year and */
314 /* day of year). If the substring JD or jd is present, the */
315 /* string is assumed to represent a julian date. */
316
317 /* 2) If the julian date specifier is not present, any integer */
318 /* greater than 999 is regarded as being a year specification. */
319
320 /* 3) A dash '-' can represent a minus sign only if it is precedes */
321 /* the first digit in the string and the string contains */
322 /* the julian date specifier (JD). (No negative years, */
323 /* months, days, etc are allowed). */
324
325 /* 4) Numeric components of a time string must be separated */
326 /* by a character that is not a digit or decimal point. */
327 /* Only one decimal component is allowed. For example */
328 /* 1994219.12819 is sometimes interpreted as the */
329 /* 219th day of 1994 + 0.12819 days. TPARTV does not */
330 /* support such strings. */
331
332 /* No exponential components are allowed. For example you */
333 /* can't input 1993 Jun 23 23:00:01.202E-4 you have */
334 /* to explicitly list all zeros that follow the decimal */
335 /* point: i.e. 1993 Jun 23 23:00:00.0001202 */
336
337 /* 5) The single colon (:) when used to separate numeric */
338 /* components of a string is interpreted as separating */
339 /* Hours, Minutes, and Seconds of time. */
340
341 /* 6) If a double slash (//) or double colon (::) follows */
342 /* a pair of integers, those integers are assumed to */
343 /* represent the year and day of year. */
344
345 /* 7) A quote followed by an integer less than 100 is regarded */
346 /* as an abbreviated year. For example: '93 would be regarded */
347 /* as the 93rd year of the reference century. See TEXPYR */
348 /* for further discussion of abbreviated years. */
349
350 /* 8) An integer followed by 'B.C.' or 'A.D.' is regarded as */
351 /* a year in the era associated with that abbreviation. */
352
353 /* 9) All dates are regarded as belonging to the extended */
354 /* Gregorian Calendar (the Gregorian calendar is the calendar */
355 /* currently used by western society). See the routine JUL2GR */
356 /* for converting from Julian Calendar to the */
357 /* Gregorian Calendar. */
358 /* western society). */
359
360 /* 10) If the ISO date-time separator (T) is present in the string */
361 /* ISO allowed token patterns are examined for a match */
362 /* with the current token list. If no match is found the */
363 /* search is abandoned and appropriate diagnostic messages */
364 /* are generated. */
365
366 /* 11) If two delimiters are found in succession in the time */
367 /* string, the time string is diagnosed as an erroneous */
368 /* string. ( Delimiters are comma, white space, dash, slash, */
369 /* period, day of year mark ) */
370
371 /* Note the delimiters do not have to be the same. The pair */
372 /* of characters ",-" counts as two successive delimiters. */
373
374 /* 12) White space, commas serve only to delimit tokens in the */
375 /* input string. They do not affect the meaning of any */
376 /* of the tokens. */
377
378 /* 13) When the size of the integer components does not clearly */
379 /* specify a year the following patterns are assumed */
380
381 /* Calendar Format */
382
383 /* Year Month Day */
384 /* Month Day Year */
385 /* Year Day Month */
386
387 /* Where Month is the name of a month, not its numeric */
388 /* value. */
389
390 /* When integer components are separated by slashes (/) */
391 /* as in 3/4/5. Month, Day, Year is assumed (2005 March 4) */
392
393 /* Day of Year Format. */
394
395 /* If a day of year marker is present (// or ::) the */
396 /* pattern */
397
398 /* I-I// or I-I:: (where I stands for and integer) */
399 /* is interpreted as Year Day-of-Year. However, I-I/ is */
400 /* regarded as ambiguous. */
401
402
403 /* The table below gives a list of abbreviations used to */
404 /* classify tokens. */
405
406 /* / --- slash punctuation mark */
407 /* H --- hour */
408 /* M --- Minute */
409 /* S --- Second */
410 /* Y --- year */
411 /* d --- day of year marker */
412 /* i --- unsigned integer */
413 /* m --- month */
414 /* n --- unsigned decimal number */
415 /* y --- day of year */
416 /* - --- dash punctuation mark */
417 /* D --- day of month */
418 /* : --- colon punctuation mark */
419
420 /* Given these abbreviations the following (rather lengthy) */
421 /* table gives the set of built in token patterns that */
422 /* are recognized and the associated interpretation of that */
423 /* pattern. */
424
425 /* Pattern Meaning Pattern Meaning */
426 /* ------------------------ ------------------------- */
427 /* Y-i-it......... YmD i/i/ii:i:n..... mDYHMS */
428 /* Y-i-iti........ YmDH i/i/ii:n....... mDYHM */
429 /* Y-i-iti:i...... YmDHM i/i/ii:n....... mDYHM */
430 /* Y-i-iti:i:i.... YmDHMS i:i:ii-i-Y..... HMSmDY */
431 /* Y-i-iti:i:n.... YmDHMS i:i:ii/i/Y..... HMSmDY */
432 /* Y-i-iti:n...... YmDHM i:i:ii/i/i..... HMSmDY */
433 /* Y-i-itn........ YmDH i:i:iimY....... HMSDmY */
434 /* Y-i/........... Yy i:i:imiY....... HMSmDY */
435 /* Y-i/i:i........ YyHM i:i:ni-i-Y..... HMSmDY */
436 /* Y-i/i:i:i...... YyHMS i:i:ni/i/Y..... HMSmDY */
437 /* Y-i/i:i:n...... YyHMS i:i:ni/i/i..... HMSmDY */
438 /* Y-i/i:n........ YyHM i:i:nimY....... HMSDmY */
439 /* Y-id........... Yy i:i:nmiY....... HMSmDY */
440 /* Y-idi:i........ YyHM i:ii-i-Y....... HMmDY */
441 /* Y-idi:i:i...... YyHMS i:ii/i/Y....... HMmDY */
442 /* Y-idi:i:n...... YyHMS i:ii/i/i....... HMmDY */
443 /* Y-idi:n........ YyHM i:iimY......... HMDmY */
444 /* Y-it........... Yy i:imiY......... HMmDY */
445 /* Y-iti.......... YyH i:ni-i-Y....... HMmDY */
446 /* Y-iti:i........ YyHM i:ni/i/Y....... HMmDY */
447 /* Y-iti:i:i...... YyHMS i:ni/i/i....... HMmDY */
448 /* Y-iti:i:n...... YyHMS i:nimY......... HMDmY */
449 /* Y-iti:n........ YyHM i:nmiY......... HMmDY */
450 /* Y-itn.......... YyH iYd............ yY */
451 /* Yid............ Yy iYdi:i......... yYHM */
452 /* Yidi:i......... YyHM iYdi:i:i....... yYHMS */
453 /* Yidi:i:i....... YyHMS iYdi:i:n....... yYHMS */
454 /* Yidi:i:n....... YyHMS iYdi:n......... yYHM */
455 /* Yidi:n......... YyHM iiY............ mDY */
456 /* Yii............ YmD iiYi........... mDYH */
457 /* Yiii........... YmDH iiYi:i......... mDYHM */
458 /* Yiii:i......... YmDHM iiYi:i:i....... mDYHMS */
459 /* Yiii:i:i....... YmDHMS iiYi:i:n....... mDYHMS */
460 /* Yiii:i:n....... YmDHMS iiYi:n......... mDYHM */
461 /* Yiii:n......... YmDHM iiYn........... mDYH */
462 /* Yiiii.......... YmDHM iid............ Yy */
463 /* Yiiiii......... YmDHMS iidi:i......... YyHM */
464 /* Yiiiin......... YmDHMS iidi:i:i....... YyHMS */
465 /* Yiiin.......... YmDHM iidi:i:n....... YyHMS */
466 /* Yiin........... YmDH iidi:n......... YyHM */
467 /* Yim............ YDm iim............ YDm */
468 /* Yimi........... YDmH iimi........... YDmH */
469 /* Yimi:i......... YDmHM iimi:i......... YDmHM */
470 /* Yimi:i:i....... YDmHMS iimi:i:i....... YDmHMS */
471 /* Yimi:i:n....... YDmHMS iimi:i:n....... YDmHMS */
472 /* Yimi:n......... YDmHM iimi:n......... YDmHM */
473 /* Yimn........... YDmH iimii.......... YDmHM */
474 /* Yin............ YmD iimiii......... YDmHMS */
475 /* Ymi............ YmD iimiin......... YDmHMS */
476 /* Ymii........... YmDH iimin.......... YDmHM */
477 /* Ymii:i......... YmDHM iimn........... YDmH */
478 /* Ymii:i:i....... YmDHMS imY............ DmY */
479 /* Ymii:i:n....... YmDHMS imYi........... DmYH */
480 /* Ymii:n......... YmDHM imYi:i......... DmYHM */
481 /* Ymin........... YmDH imYi:i:i....... DmYHMS */
482 /* Ymn............ YmD imYi:i:n....... DmYHMS */
483 /* Ynm............ YDm imYi:n......... DmYHM */
484 /* i-Y/........... yY imYn........... DmYH */
485 /* i-Y/i:i........ yYHM imi............ YmD */
486 /* i-Y/i:i:i...... yYHMS imi:i:iY....... DmHMSY */
487 /* i-Y/i:i:n...... yYHMS imi:i:nY....... DmHMSY */
488 /* i-Y/i:n........ yYHM imi:iY......... DmHMY */
489 /* i-Yd........... yY imi:nY......... DmHMY */
490 /* i-Ydi:i........ yYHM imii........... YmDH */
491 /* i-Ydi:i:i...... yYHMS imii:i......... YmDHM */
492 /* i-Ydi:i:n...... yYHMS imii:i:i....... YmDHMS */
493 /* i-Ydi:n........ yYHM imii:i:n....... YmDHMS */
494 /* i-i-Y.......... mDY imii:n......... YmDHM */
495 /* i-i-Yi:i....... mDYHM imiii.......... YmDHM */
496 /* i-i-Yi:i:i..... mDYHMS imiiii......... YmDHMS */
497 /* i-i-Yi:i:n..... mDYHMS imiiin......... YmDHMS */
498 /* i-i-Yi:n....... mDYHM imiin.......... YmDHM */
499 /* i-i-it......... YmD imin........... YmDH */
500 /* i-i-iti........ YmDH imn............ YmD */
501 /* i-i-iti:i...... YmDHM inY............ mDY */
502 /* i-i-iti:i:i.... YmDHMS inm............ YDm */
503 /* i-i-iti:i:n.... YmDHMS miY............ mDY */
504 /* i-i-iti:n...... YmDHM miYi........... mDYH */
505 /* i-i-itn........ YmDH miYi:i......... mDYHM */
506 /* i-i/i:i........ YyHM miYi:i:i....... mDYHMS */
507 /* i-i/i:i:i...... YyHMS miYi:i:n....... mDYHMS */
508 /* i-i/i:i:n...... YyHMS miYi:n......... mDYHM */
509 /* i-i/i:n........ YyHM miYn........... mDYH */
510 /* i-idi:i........ YyHM mii............ mDY */
511 /* i-idi:i:i...... YyHMS mii:i:iY....... mDHMSY */
512 /* i-idi:i:n...... YyHMS mii:i:nY....... mDHMSY */
513 /* i-idi:n........ YyHM mii:iY......... mDHMY */
514 /* i-it........... Yy mii:nY......... mDHMY */
515 /* i-iti.......... YyH miii........... mDYH */
516 /* i-iti:i........ YyHM miii:i......... mDYHM */
517 /* i-iti:i:i...... YyHMS miii:i:i....... mDYHMS */
518 /* i-iti:i:n...... YyHMS miii:i:n....... mDYHMS */
519 /* i-iti:n........ YyHM miii:n......... mDYHM */
520 /* i-itn.......... YyH miiii.......... mDYHM */
521 /* i/i/Y.......... mDY miiiii......... mDYHMS */
522 /* i/i/Y/i:n...... mDYHM miiiin......... mDYHMS */
523 /* i/i/Yi:i....... mDYHM miiin.......... mDYHM */
524 /* i/i/Yi:i:i..... mDYHMS miin........... mDYH */
525 /* i/i/Yi:i:n..... mDYHMS mnY............ mDY */
526 /* i/i/i.......... mDY mni............ mDY */
527 /* i/i/ii:i....... mDYHM nmY............ DmY */
528 /* i/i/ii:i:i..... mDYHMS */
529
530 /* $ Examples */
531
532 /* Suppose you need to convert various time strings to ephemeris */
533 /* seconds past J2000. The following pair of calls shows */
534 /* how you would use this routine together with the routines */
535 /* TCHECK and TTRANS to perform this task. */
536
537
538 /* CALL TPARTV ( STRING, */
539 /* . TVEC, NTVEC, TYPE, */
540 /* . MODIFY, MODS, YABBRV, SUCCES, */
541 /* . PICTUR, ERROR ) */
542
543
544 /* IF ( .NOT. SUCCES ) THEN */
545
546 /* Use the SPICE error handling facility to post an */
547 /* error message and signal an error. */
548
549 /* CALL SETMSG ( ERROR ) */
550 /* CALL SIGERR ( 'MYCHECK(BADTIME)' ) */
551 /* CALL CHKOUT ( 'MYROUTINE' ) */
552 /* RETURN */
553 /* END IF */
554
555 /* Check the components of TVEC to make sure everything */
556 /* makes sense. */
557
558 /* CALL TCHECK( TVEC, TYPE, MODS, MODIFY, OK, ERROR ) */
559
560 /* IF ( .NOT. OK ) THEN */
561
562 /* Use the SPICE error handling facility to post an */
563 /* error message and signal an error. */
564
565 /* CALL SETMSG ( ERROR ) */
566 /* CALL SIGERR ( 'MYCHECK(BADTIME)' ) */
567 /* CALL CHKOUT ( 'MYROUTINE' ) */
568 /* RETURN */
569 /* END IF */
570
571 /* CALL TTRANS ( TYPE, 'ET', TVEC ) */
572
573 /* ET = TVEC(1) */
574
575 /* $ Restrictions */
576
577 /* None. */
578
579 /* $ Author_and_Institution */
580
581 /* W.L. Taber (JPL) */
582
583 /* $ Literature_References */
584
585 /* None. */
586
587 /* $ Version */
588
589 /* - SPICELIB Version 3.1.0, 15-AUG-2002 (WLT) */
590
591 /* Replaced the call to INSSUB with ZZINSSUB so that this */
592 /* routine can legitimately be called error free. */
593
594 /* - SPICELIB Version 3.0.0, 10-MAY-1999 (WLT) */
595
596 /* The routine was modified so that weekday followed by a comma */
597 /* is recognized as a legitimate pattern when parsing. */
598
599 /* - SPICELIB Version 2.0.0, 16-APR-1997 (WLT) */
600
601 /* The routine was modified so that last-chance removal of */
602 /* delimiters ',', '-', and '/' are removed one at a time */
603 /* (instead of all at once as in version 1.0.0) and the */
604 /* resulting representation checked against */
605 /* the built-in list. */
606
607 /* In addition the set of built-in patterns was increased */
608 /* from 185 to 203. See ZZTPATS for more details. */
609
610 /* - SPICELIB Version 1.0.0, 10-AUG-1996 (WLT) */
611
612
613 /* -& */
614 /* $ Index_Entries */
615
616 /* Parse a time string into a vector of components */
617
618 /* -& */
619
620 /* SPICELIB Functions */
621
622
623 /* Private Functions */
624
625
626 /* Parameters */
627
628
629 /* ERA */
630 /* WDAY */
631 /* ZONE */
632 /* AMPM */
633 /* SYSTEM */
634
635
636 /* Local Variables. */
637
638 /* The number of known time patterns NKNOWN comes from the include */
639 /* file timepars.inc */
640
641
642 /* Time Zone Variables */
643
644
645 /* Standard SPICE error handling. */
646
647
648 /* So far there are no modifiers to the time string. */
649
650 *mods = FALSE_;
651 *yabbrv = FALSE_;
652 for (i__ = 1; i__ <= 5; ++i__) {
653 s_copy(modify + (i__ - 1) * modify_len, " ", modify_len, (ftnlen)1);
654 }
655
656 /* On the first call to this routine we load the built in */
657 /* representation patterns. */
658
659 if (first) {
660 if (zztpats_(&c__300, &nknown, known, meanng, (ftnlen)12, (ftnlen)12))
661 {
662 first = FALSE_;
663 } else {
664 s_copy(pictur, " ", pictur_len, (ftnlen)1);
665 *succes = FALSE_;
666 s_copy(error, "There is an incompatibility between ZZTPATS and t"
667 "he room allocated for KNOWN in TPARTV.", error_len, (
668 ftnlen)87);
669 return 0;
670 }
671 }
672
673 /* First step is to tokenize the string. The new representation */
674 /* is maintained in ZZTIME. We'll get it later if we need it. */
675
676 resolv = zztokns_(string, error, string_len, error_len);
677 if (! resolv) {
678 *succes = FALSE_;
679 *ntvec = 0;
680 s_copy(type__, " ", type_len, (ftnlen)1);
681 s_copy(pictur, " ", pictur_len, (ftnlen)1);
682 return 0;
683 }
684
685 /* The result of tokenizing the string will be a representation */
686 /* that contains the following letters. */
687
688 /* ' The quote character */
689 /* [ The left parenthesis */
690 /* ] The right parenthesis */
691 /* , The comma */
692 /* - The dash */
693 /* . The decimal point */
694 /* / The slash---used to separate date components. */
695 /* : The colon (used to separate time components) */
696 /* N --- stands for one of the symbols A.M. or P.M. */
697 /* O stands for the symbol UTC+ */
698 /* Z --- stands for a time zone such as PDT, PSD, CDT, etc. */
699 /* b stands for a block of white space */
700 /* d stands for the day of year marker (// or ::) */
701 /* e --- stands for the era (B.C. or A.D.) */
702 /* j stands for julian date */
703 /* m stands for a month */
704 /* o stands for the symbol UTC- */
705 /* s --- stands for a time system (UTC, TDT, TDB) */
706 /* t stands the ISO date-T-time separator. */
707 /* w --- stands for the day of the week. */
708 /* i stands for a sequence of digits */
709
710 /* We will gradually remove many of these and replace the i, i. */
711 /* and i.i with the following items */
712
713 /* n stands for a decimal number */
714 /* Y stands for a year */
715 /* D stands for the day in a month */
716 /* y stands for the day of the year */
717 /* H stands for hours */
718 /* M stands for minutes */
719 /* S stands for seconds. */
720
721
722 /* We will use the following logical functions to modify */
723 /* the tokenized representation: */
724
725 /* ZZTOKNS --- breaks the string down into a list of recognized */
726 /* tokens and stores an internal model for this */
727 /* list. The begins and ends of the substrings */
728 /* associated with the tokenization are maintained */
729 /* inside the routine ZZTIME (which ZZTOKNS is an */
730 /* entry point to). If some substring cannot be */
731 /* recognized, ZZTOKNS returns the value FALSE */
732 /* together with a diagnostic indicating what */
733 /* was wrong with the input string. */
734
735 /* ZZCMBT --- combines one or more tokens into a single token. */
736 /* this is performed only once and is done either */
737 /* scanning left to right or right to left. */
738 /* It returns TRUE if a combination is performed. */
739
740 /* ZZREMT --- removes all instances of a token from the tokenized */
741 /* representation. It returns TRUE is an item */
742 /* is removed. */
743
744 /* ZZSUBT --- substitutes the first occurrence of a */
745 /* subpattern (scanning left to right or right to */
746 /* left) with another pattern of the same length. */
747 /* This is where we attach new meaning to the */
748 /* tokenized pattern. It returns TRUE if a */
749 /* substitution is performed. */
750
751 /* ZZREPT --- is a combination of the ZZSUBT and ZZREMT */
752 /* This performs ZZSUBT on the string, but then */
753 /* remove all occurrences of the special character */
754 /* * from the tokenized list. It returns TRUE */
755 /* is a substitution is performed. */
756
757 /* ZZNOTE --- returns the begin and end of the first occurrence */
758 /* of some token, and then removes the token */
759 /* from the tokenized representation. We use this */
760 /* primarily to extract modifiers from the tokenized */
761 /* string. These should occur only once and once */
762 /* removed allow us to more easily attach meaning */
763 /* to the remaining tokens. The value of ZZNOTE */
764 /* is true if the requested item could be found, */
765 /* otherwise it is false and the begin and end */
766 /* of the requested substring are set to 0. */
767
768 /* ZZIST --- returns TRUE if the specified token is present */
769 /* in the tokenized substring. */
770
771 /* ZZISPT --- returns true is a pair of consecutive tokens */
772 /* from a list are located in the representation */
773 /* of the tokenized string. This is used to */
774 /* locate consecutive pairs of delimiters in the */
775 /* input string. It returns TRUE if a pair of */
776 /* consecutive items is located. Otherwise */
777 /* it returns FALSE. */
778
779 /* ZZVALT --- allows you to substitute a new token for any */
780 /* integer (i) that lies within a specified range */
781 /* of values. This is primarily used to recognize */
782 /* years in the input string. */
783
784 /* ZZGREP --- is used to get the current representation of the */
785 /* tokenized string (with all processing resulting */
786 /* from use of the manipulation routines taken into */
787 /* account). */
788
789 /* ZZTPATS --- is used to set up the large list of canned patterns */
790 /* that are recognized as legitimate tokenizations. */
791 /* Almost all legitimate time strings when tokenized */
792 /* will match one of these patterns. */
793
794 /* ZZUNPCK --- uses STRING together with the current */
795 /* representation of it's tokens to return a */
796 /* time vector. If a problem is encountered with */
797 /* the current tokens, it returns a diagnostic */
798 /* message that indicates why the string */
799 /* could not be parsed. Note ZZUNPCK should be */
800 /* called only after all string modifiers have */
801 /* been retrieved via a call to ZZNOTE (or by */
802 /* manually removing them). */
803
804 /* Next Step is to combine some tokens so that we won't run */
805 /* into problems later on. We may introduce some new components */
806 /* in the process. */
807
808 l2r = TRUE_;
809 r2l = ! l2r;
810 if (zzcmbt_("Oi", "z", &l2r, (ftnlen)2, (ftnlen)1)) {
811 resolv = zzcmbt_("z:i", "Z", &l2r, (ftnlen)3, (ftnlen)1);
812 resolv = zzsubt_("z", "Z", &l2r, (ftnlen)1, (ftnlen)1);
813 }
814 if (zzcmbt_("oi", "z", &l2r, (ftnlen)2, (ftnlen)1)) {
815 resolv = zzcmbt_("z:i", "Z", &l2r, (ftnlen)3, (ftnlen)1);
816 resolv = zzsubt_("z", "Z", &l2r, (ftnlen)1, (ftnlen)1);
817 }
818
819 /* Next we resolve any months, or weekdays that are followed */
820 /* by periods. */
821
822 resolv = zzrept_("m.", "m*", &l2r, (ftnlen)2, (ftnlen)2);
823 resolv = zzrept_("w.", "w*", &l2r, (ftnlen)2, (ftnlen)2);
824 resolv = zzrept_("w,", "w*", &l2r, (ftnlen)2, (ftnlen)2);
825
826 /* Now convert the right most integer-decimal-point pair to the */
827 /* number representation. */
828
829 if (zzcmbt_("i.i", "n", &r2l, (ftnlen)3, (ftnlen)1)) {
830
831 /* We aren't going to do anything here. We are simply */
832 /* using the IF-THEN...ELSE IF ... ENDIF to make sure */
833 /* we only replace one decimal place. */
834
835 } else if (zzcmbt_("i.", "n", &r2l, (ftnlen)2, (ftnlen)1)) {
836
837 /* Same as the previous comment. */
838
839 }
840
841 /* Remove any white space from the tokenization. */
842
843 resolv = zzremt_("b", (ftnlen)1);
844
845 /* User Custom Formats (this still needs a modicum of work). */
846 /* ---------------------------------------------------------------- */
847 /* ================================================================ */
848
849
850 /* RESOLV = ZZGREP ( REP ) */
851 /* USE = ISRCHC ( REP, NCUSTM, CUSTOM ) */
852
853 /* IF ( USE .GT. 0 ) THEN */
854 /* RESOLV = ZZREPT ( CUSTM(USE), CMEANS(USE), L2R ) */
855 /* ELSE */
856 /* RESOLV = .FALSE. */
857 /* END IF */
858
859 /* IF ( RESOLV ) THEN */
860
861 /* SUCCES = ZZUNPCK ( STRING, YABBRV, ... */
862 /* TVEC, NTVEC, TYPE, PICTUR, ERROR ) */
863 /* ERROR = ' ' */
864
865 /* RETURN */
866 /* END IF */
867
868
869
870 /* Julian Date */
871 /* ---------------------------------------------------------------- */
872 /* ================================================================ */
873
874 if (zzist_("j", (ftnlen)1)) {
875
876 /* This is some form of Julian Date. Handle this case */
877 /* right here and return. */
878
879 resolv = zzrept_("[s]", "*s*", &l2r, (ftnlen)3, (ftnlen)3);
880 *mods = *mods || zznote_("s", &b, &e, (ftnlen)1);
881 if (*mods) {
882 ucase_(string + (b - 1), modify + (modify_len << 2), e - (b - 1),
883 modify_len);
884 }
885 resolv = zzrept_("[j]", "*j*", &l2r, (ftnlen)3, (ftnlen)3);
886 resolv = zzremt_("j", (ftnlen)1);
887 if (! zzist_("n", (ftnlen)1)) {
888 resolv = zzsubt_("i", "n", &l2r, (ftnlen)1, (ftnlen)1);
889 }
890 resolv = zzcmbt_("-n", "n", &l2r, (ftnlen)2, (ftnlen)1);
891 resolv = zzsubt_("n", "J", &l2r, (ftnlen)1, (ftnlen)1);
892
893 /* We let ZZUNPK handle the parsing or diagnosis of any problems. */
894
895 *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error,
896 string_len, type_len, pictur_len, error_len);
897 if (i_indx(pictur, "JULIAND.", pictur_len, (ftnlen)8) > 0) {
898 suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len);
899 }
900 if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) !=
901 0) {
902 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
903 suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len,
904 pictur_len);
905 }
906 return 0;
907 }
908
909 /* Calendar Date Formats. */
910 /* ---------------------------------------------------------------- */
911 /* ================================================================ */
912
913 /* Replace any integers greater than 1000 by Y. */
914
915 b = 1000;
916 e = intmax_();
917 resolv = zzvalt_(string, &b, &e, "Y", string_len, (ftnlen)1);
918
919 /* If the ISO time delimiter 't' is present we don't perform */
920 /* any further simplifications. */
921
922 if (zzist_("t", (ftnlen)1)) {
923 resolv = zzgrep_(rep, (ftnlen)12);
924 use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12);
925 if (use != 0) {
926 resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ?
927 i__1 : s_rnge("known", i__1, "tpartv_", (ftnlen)1011)) *
928 12, meanng + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 :
929 s_rnge("meanng", i__2, "tpartv_", (ftnlen)1011)) * 12, &
930 l2r, (ftnlen)12, (ftnlen)12);
931 *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur,
932 error, string_len, type_len, pictur_len, error_len);
933 if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) {
934 suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len);
935 }
936 if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1)
937 != 0) {
938 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
939 suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len,
940 pictur_len);
941 }
942 if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1)
943 != 0) {
944 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
945 suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len,
946 pictur_len);
947 }
948 } else {
949 *succes = FALSE_;
950 *ntvec = 0;
951 *mods = FALSE_;
952 s_copy(type__, " ", type_len, (ftnlen)1);
953 s_copy(pictur, " ", pictur_len, (ftnlen)1);
954 s_copy(error, "The input string uses the ISO \"T\" date/time de"
955 "limiter but does not match any of the accepted ISO forma"
956 "ts. ", error_len, (ftnlen)107);
957 }
958 return 0;
959 }
960
961 /* If we reach this point, either we didn't have any custom */
962 /* formats supplied or we didn't match any of them. */
963 /* Resolve any abbreviated years. We've already set integers */
964 /* that are 1000 or greater to 'Y' Only 1 or 2 digit integers */
965 /* can be year abbreviations. We replace the 3 digit integers */
966 /* with I temporarily; locate any abbreviated years; reset all */
967 /* the 3-digit back to 'i'. (Note 3-digit means value between */
968 /* 100 and 999. 003 is not regarded as a 3 digit number). */
969
970 b = 100;
971 e = 1000;
972 resolv = zzvalt_(string, &b, &e, "I", string_len, (ftnlen)1);
973 *yabbrv = zzrept_("'i", "*Y", &l2r, (ftnlen)2, (ftnlen)2);
974 while(zzsubt_("I", "i", &l2r, (ftnlen)1, (ftnlen)1)) {
975 ++b;
976 }
977
978 /* Resolve the system, and other text components. */
979
980 resolv = zzrept_("[e]", "*e*", &l2r, (ftnlen)3, (ftnlen)3);
981 resolv = zzrept_("[w]", "*w*", &l2r, (ftnlen)3, (ftnlen)3);
982 resolv = zzrept_("[N]", "*N*", &l2r, (ftnlen)3, (ftnlen)3);
983 resolv = zzrept_("[Z]", "*Z*", &l2r, (ftnlen)3, (ftnlen)3);
984 resolv = zzrept_("[s]", "*s*", &l2r, (ftnlen)3, (ftnlen)3);
985 resolv = zzsubt_("ie", "Ye", &l2r, (ftnlen)2, (ftnlen)2);
986
987 /* Note the positions of ERA, WEEKDAY, TIME-ZONE, AMPM marker */
988 /* and time SYSTEM. */
989
990 havera = zznote_("e", begs, ends, (ftnlen)1);
991 havwdy = zznote_("w", &begs[1], &ends[1], (ftnlen)1);
992 havzon = zznote_("Z", &begs[2], &ends[2], (ftnlen)1);
993 havapm = zznote_("N", &begs[3], &ends[3], (ftnlen)1);
994 havsys = zznote_("s", &begs[4], &ends[4], (ftnlen)1);
995 *mods = havera || havwdy || havzon || havapm || havsys;
996 if (*mods) {
997 for (i__ = 1; i__ <= 5; ++i__) {
998 if (begs[(i__1 = i__ - 1) < 5 && 0 <= i__1 ? i__1 : s_rnge("begs",
999 i__1, "tpartv_", (ftnlen)1093)] != 0) {
1000 i__1 = begs[(i__2 = i__ - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge(
1001 "begs", i__2, "tpartv_", (ftnlen)1094)] - 1;
1002 ucase_(string + i__1, modify + (i__ - 1) * modify_len, ends[(
1003 i__3 = i__ - 1) < 5 && 0 <= i__3 ? i__3 : s_rnge(
1004 "ends", i__3, "tpartv_", (ftnlen)1094)] - i__1,
1005 modify_len);
1006 }
1007 }
1008 if (havera) {
1009 if (*(unsigned char *)&modify[0] == 'A') {
1010 s_copy(modify, "A.D.", modify_len, (ftnlen)4);
1011 } else {
1012 s_copy(modify, "B.C.", modify_len, (ftnlen)4);
1013 }
1014 }
1015 if (havapm) {
1016 if (*(unsigned char *)&modify[modify_len * 3] == 'A') {
1017 s_copy(modify + modify_len * 3, "A.M.", modify_len, (ftnlen)4)
1018 ;
1019 } else {
1020 s_copy(modify + modify_len * 3, "P.M.", modify_len, (ftnlen)4)
1021 ;
1022 }
1023 }
1024 s_copy(modify + (modify_len + 3), " ", modify_len - 3, (ftnlen)1);
1025 if (havzon) {
1026 mapto = isrchc_(modify + (modify_len << 1), &c__8, zones,
1027 modify_len, (ftnlen)3);
1028 if (mapto != 0) {
1029 s_copy(modify + (modify_len << 1), offset + ((i__1 = mapto -
1030 1) < 8 && 0 <= i__1 ? i__1 : s_rnge("offset", i__1,
1031 "tpartv_", (ftnlen)1121)) * 6, modify_len, (ftnlen)6);
1032 }
1033 }
1034 }
1035
1036 /* Try our built in formats without any further substitution. */
1037
1038 resolv = zzgrep_(rep, (ftnlen)12);
1039 use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12);
1040 if (use > 0) {
1041 resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ? i__1 :
1042 s_rnge("known", i__1, "tpartv_", (ftnlen)1136)) * 12, meanng
1043 + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 : s_rnge("mean"
1044 "ng", i__2, "tpartv_", (ftnlen)1136)) * 12, &l2r, (ftnlen)12, (
1045 ftnlen)12);
1046 *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error,
1047 string_len, type_len, pictur_len, error_len);
1048 if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) {
1049 suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len);
1050 }
1051 if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) !=
1052 0) {
1053 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1054 suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len,
1055 pictur_len);
1056 }
1057 if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) !=
1058 0) {
1059 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1060 suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len,
1061 pictur_len);
1062 }
1063 return 0;
1064 }
1065
1066 /* Make sure we don't have a pair of successive delimiters */
1067 /* or a delimiter at either end of the input string. */
1068
1069 if (zzispt_(",/-:d.", &from, &to, (ftnlen)6)) {
1070 *succes = FALSE_;
1071 *ntvec = 0;
1072 s_copy(type__, " ", type_len, (ftnlen)1);
1073 s_copy(error, string, error_len, string_len);
1074 i__1 = to + 1;
1075 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1076 zzinssub_(error, "<", &from, error, error_len, (ftnlen)1, error_len);
1077 prefix_("There are two successive delimiters <#> in the input string"
1078 ". This is an ambiguous input. ' ", &c__0, error, (ftnlen)92,
1079 error_len);
1080 repmc_(error, "#", string + (from - 1), error, error_len, (ftnlen)1,
1081 to - (from - 1), error_len);
1082 suffix_("'", &c__0, error, (ftnlen)1, error_len);
1083 s_copy(pictur, " ", pictur_len, (ftnlen)1);
1084 return 0;
1085 }
1086
1087 /* A delimiter hanging at either end of the string shall be */
1088 /* regarded as an error. */
1089
1090 resolv = zzgrep_(rep, (ftnlen)12);
1091 r__ = rtrim_(rep, (ftnlen)12);
1092 if (i_indx(",/-:.", rep, (ftnlen)5, (ftnlen)1) > 0) {
1093 resolv = zzsubt_(rep, "Q", &l2r, (ftnlen)1, (ftnlen)1);
1094 resolv = FALSE_;
1095 } else if (i_indx(",/-:.", rep + (r__ - 1), (ftnlen)5, (ftnlen)1) > 0) {
1096 resolv = zzsubt_(rep + (r__ - 1), "Q", &l2r, (ftnlen)1, (ftnlen)1);
1097 resolv = FALSE_;
1098 }
1099 if (! resolv) {
1100 resolv = zznote_("Q", &from, &to, (ftnlen)1);
1101 s_copy(error, string, error_len, string_len);
1102 i__1 = to + 1;
1103 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1104 zzinssub_(error, "<", &from, error, error_len, (ftnlen)1, error_len);
1105 prefix_("An unexpected delimiter ('#') was encountered in the input "
1106 "string. ' ", &c__0, error, (ftnlen)69, error_len);
1107 suffix_("'", &c__0, error, (ftnlen)1, error_len);
1108 repmc_(error, "#", string + (from - 1), error, error_len, (ftnlen)1,
1109 to - (from - 1), error_len);
1110 s_copy(pictur, " ", pictur_len, (ftnlen)1);
1111 *succes = FALSE_;
1112 return 0;
1113 }
1114
1115 /* We probably made it unscathed through the check above. */
1116 /* Remove delimiters ',', '/', and '-' and retry the built-in */
1117 /* patterns. */
1118
1119 *(unsigned char *)&delim[0] = ',';
1120 *(unsigned char *)&delim[1] = '-';
1121 *(unsigned char *)&delim[2] = '/';
1122 for (i__ = 1; i__ <= 3; ++i__) {
1123 resolv = zzremt_(delim + ((i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 :
1124 s_rnge("delim", i__1, "tpartv_", (ftnlen)1227)), (ftnlen)1);
1125 resolv = zzgrep_(rep, (ftnlen)12);
1126 use = bsrchc_(rep, &nknown, known, (ftnlen)12, (ftnlen)12);
1127 if (use > 0) {
1128 resolv = zzrept_(known + ((i__1 = use - 1) < 300 && 0 <= i__1 ?
1129 i__1 : s_rnge("known", i__1, "tpartv_", (ftnlen)1234)) *
1130 12, meanng + ((i__2 = use - 1) < 300 && 0 <= i__2 ? i__2 :
1131 s_rnge("meanng", i__2, "tpartv_", (ftnlen)1234)) * 12, &
1132 l2r, (ftnlen)12, (ftnlen)12);
1133 *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur,
1134 error, string_len, type_len, pictur_len, error_len);
1135 if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) {
1136 suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len);
1137 }
1138 if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1)
1139 != 0) {
1140 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1141 suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len,
1142 pictur_len);
1143 }
1144 if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1)
1145 != 0) {
1146 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1147 suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len,
1148 pictur_len);
1149 }
1150 return 0;
1151 }
1152 }
1153
1154 /* If we make it to this point, we must have a pretty funky */
1155 /* time string. There are some obvious incompatibilities. We */
1156 /* check them now */
1157
1158 if (zznote_("e", &b, &e, (ftnlen)1)) {
1159 } else if (zznote_("s", &b, &e, (ftnlen)1)) {
1160 } else if (zznote_("Z", &b, &e, (ftnlen)1)) {
1161 } else if (zznote_("w", &b, &e, (ftnlen)1)) {
1162 } else if (zznote_("N", &b, &e, (ftnlen)1)) {
1163 }
1164
1165 /* If B is non-zero the item in question is a duplicate */
1166 /* modifier. */
1167
1168 if (b > 0) {
1169 *succes = FALSE_;
1170 *ntvec = 0;
1171 s_copy(type__, " ", type_len, (ftnlen)1);
1172 s_copy(error, string, error_len, string_len);
1173 i__1 = e + 1;
1174 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1175 zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len);
1176 prefix_("The substring \"#\" is a duplicate modifier of the input st"
1177 "ring: ' ", &c__0, error, (ftnlen)65, error_len);
1178 suffix_("'", &c__0, error, (ftnlen)1, error_len);
1179 repmc_(error, "#", string + (b - 1), error, error_len, (ftnlen)1, e -
1180 (b - 1), error_len);
1181 s_copy(pictur, " ", pictur_len, (ftnlen)1);
1182 return 0;
1183 }
1184
1185 /* Look for unresolved markers */
1186
1187 if (zznote_("[", &b, &e, (ftnlen)1)) {
1188 } else if (zznote_("]", &b, &e, (ftnlen)1)) {
1189 } else if (zznote_("O", &b, &e, (ftnlen)1)) {
1190 } else if (zznote_("o", &b, &e, (ftnlen)1)) {
1191 } else if (zznote_("z", &b, &e, (ftnlen)1)) {
1192 }
1193 if (b > 0) {
1194 *succes = FALSE_;
1195 *ntvec = 0;
1196 s_copy(type__, " ", type_len, (ftnlen)1);
1197 s_copy(error, string, error_len, string_len);
1198 i__1 = e + 1;
1199 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1200 zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len);
1201 prefix_("The substring \"#\" could not be resolved in the input stri"
1202 "ng: ' ", &c__0, error, (ftnlen)63, error_len);
1203 suffix_("'", &c__0, error, (ftnlen)1, error_len);
1204 repmc_(error, "#", string + (b - 1), error, error_len, (ftnlen)1, e -
1205 (b - 1), error_len);
1206 s_copy(pictur, " ", pictur_len, (ftnlen)1);
1207 return 0;
1208 }
1209 if (zzist_("m", (ftnlen)1) && zzist_("d", (ftnlen)1)) {
1210 *succes = FALSE_;
1211 *ntvec = 0;
1212 s_copy(type__, " ", type_len, (ftnlen)1);
1213 s_copy(error, string, error_len, string_len);
1214 resolv = zznote_("m", &b1, &e1, (ftnlen)1);
1215 resolv = zznote_("d", &b2, &e2, (ftnlen)1);
1216 b = max(b1,b2);
1217 e = max(e1,e2);
1218 i__1 = e + 1;
1219 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1220 zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len);
1221 b = min(b1,b2);
1222 e = min(e1,e2);
1223 i__1 = e + 1;
1224 zzinssub_(error, ">", &i__1, error, error_len, (ftnlen)1, error_len);
1225 zzinssub_(error, "<", &b, error, error_len, (ftnlen)1, error_len);
1226 prefix_("Both a month \"#\" and day of year delimiter \"#\" appear i"
1227 "n the input string: ' ", &c__0, error, (ftnlen)77, error_len);
1228 suffix_("'", &c__0, error, (ftnlen)1, error_len);
1229 repmc_(error, "#", string + (b1 - 1), error, error_len, (ftnlen)1, e1
1230 - (b1 - 1), error_len);
1231 repmc_(error, "#", string + (b2 - 1), error, error_len, (ftnlen)1, e2
1232 - (b2 - 1), error_len);
1233 s_copy(pictur, " ", pictur_len, (ftnlen)1);
1234 return 0;
1235 }
1236
1237 /* Make the remaining obvious substitutions for hours, */
1238 /* minutes, and seconds */
1239
1240 if (zzrept_("i:i:i:n", "D*H*M*S", &r2l, (ftnlen)7, (ftnlen)7)) {
1241 } else if (zzrept_("i:i:i:i", "D*H*M*S", &r2l, (ftnlen)7, (ftnlen)7)) {
1242 } else if (zzrept_("i:i:n", "H*M*S", &r2l, (ftnlen)5, (ftnlen)5)) {
1243 } else if (zzrept_("i:i:i", "H*M*S", &r2l, (ftnlen)5, (ftnlen)5)) {
1244 } else if (zzrept_("i:n", "H*M", &r2l, (ftnlen)3, (ftnlen)3)) {
1245 } else if (zzrept_("i:i", "H*M", &r2l, (ftnlen)3, (ftnlen)3)) {
1246 }
1247 resolv = zzremt_(":", (ftnlen)1);
1248
1249 /* Handle the obvious substitutions of an integer next to */
1250 /* a Month. */
1251
1252 if (zzsubt_("<miiH", "mDY", &l2r, (ftnlen)5, (ftnlen)3)) {
1253 } else if (zzsubt_("<mi", "mD", &l2r, (ftnlen)3, (ftnlen)2)) {
1254 } else if (zzsubt_("Siim>", "SYDm", &l2r, (ftnlen)5, (ftnlen)4)) {
1255 } else if (zzsubt_("im>", "Dm", &l2r, (ftnlen)3, (ftnlen)2)) {
1256 } else if (zzsubt_("miY>", "mDY", &l2r, (ftnlen)4, (ftnlen)3)) {
1257 } else if (zzsubt_("Ymi", "YmD", &l2r, (ftnlen)3, (ftnlen)3)) {
1258 } else if (zzsubt_("Smi", "SmD", &l2r, (ftnlen)3, (ftnlen)3)) {
1259 } else if (zzsubt_("Mmi", "MmD", &l2r, (ftnlen)3, (ftnlen)3)) {
1260 } else if (zzsubt_("imY", "DmY", &l2r, (ftnlen)3, (ftnlen)3)) {
1261 } else if (zzsubt_("imH", "DmH", &l2r, (ftnlen)3, (ftnlen)3)) {
1262 } else if (zzrept_("Yid", "Yy*", &l2r, (ftnlen)3, (ftnlen)3)) {
1263 } else if (zzrept_("iYd", "yY*", &l2r, (ftnlen)3, (ftnlen)3)) {
1264 } else if (zzrept_("Ydi", "Y*y", &l2r, (ftnlen)3, (ftnlen)3)) {
1265 }
1266
1267 /* That's it we let ZZUNPCK handle the problem of diagnosing */
1268 /* or decoding the current representation. */
1269
1270 *succes = zzunpck_(string, yabbrv, tvec, ntvec, type__, pictur, error,
1271 string_len, type_len, pictur_len, error_len);
1272 if (s_cmp(pictur, " ", pictur_len, (ftnlen)1) != 0) {
1273 if (i_indx(pictur, ".#", pictur_len, (ftnlen)2) != 0) {
1274 suffix_("::RND", &c__1, pictur, (ftnlen)5, pictur_len);
1275 }
1276 if (s_cmp(modify + (modify_len << 1), " ", modify_len, (ftnlen)1) !=
1277 0) {
1278 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1279 suffix_(modify + (modify_len << 1), &c__0, pictur, modify_len,
1280 pictur_len);
1281 }
1282 if (s_cmp(modify + (modify_len << 2), " ", modify_len, (ftnlen)1) !=
1283 0) {
1284 suffix_("::", &c__1, pictur, (ftnlen)2, pictur_len);
1285 suffix_(modify + (modify_len << 2), &c__0, pictur, modify_len,
1286 pictur_len);
1287 }
1288 }
1289 return 0;
1290 } /* tpartv_ */
1291
1292