1 /* tpictr.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      TPICTR ( Create a Time Format Picture ) */
tpictr_(char * sample,char * pictur,logical * ok,char * error,ftnlen sample_len,ftnlen pictur_len,ftnlen error_len)9 /* Subroutine */ int tpictr_(char *sample, char *pictur, logical *ok, char *
10 	error, ftnlen sample_len, ftnlen pictur_len, ftnlen error_len)
11 {
12     /* Builtin functions */
13     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
14     integer s_cmp(char *, char *, ftnlen, ftnlen);
15 
16     /* Local variables */
17     doublereal tvec[10];
18     logical mods;
19     char type__[5];
20     integer ntvec;
21     logical succes, yabbrv;
22     char modify[8*5];
23     extern /* Subroutine */ int tpartv_(char *, doublereal *, integer *, char
24 	    *, char *, logical *, logical *, logical *, char *, char *,
25 	    ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
26 
27 /* $ Abstract */
28 
29 /*     Given a sample time string, create a time format picture */
30 /*     suitable for use by the routine TIMOUT. */
31 
32 /* $ Disclaimer */
33 
34 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
35 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
36 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
37 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
38 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
39 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
40 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
41 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
42 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
43 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
44 
45 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
46 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
47 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
48 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
49 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
50 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
51 
52 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
53 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
54 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
55 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
56 
57 /* $ Required_Reading */
58 
59 /*      None. */
60 
61 /* $ Keywords */
62 
63 /*      TIME */
64 
65 /* $ Declarations */
66 /* $ Brief_I/O */
67 
68 /*     VARIABLE  I/O  DESCRIPTION */
69 /*     --------  ---  -------------------------------------------------- */
70 /*     SAMPLE     I   is a sample date time string */
71 /*     PICTUR     O   is a format picture that describes SAMPLE */
72 /*     OK         O   indicates success or failure to parse SAMPLE */
73 /*     ERROR      O   a diagnostic returned if SAMPLE cannot be parsed */
74 
75 /* $ Detailed_Input */
76 
77 /*     SAMPLE     is a representative time string that to use */
78 /*                as a model to format time strings. */
79 
80 /* $ Detailed_Output */
81 
82 /*     PICTUR     is a format picture suitable for use with the SPICE */
83 /*                routine TIMOUT.  This picture when used to format */
84 /*                the appropriate  epoch via TIMOUT will yield the same */
85 /*                time components in the same order as the components */
86 /*                in SAMPLE. */
87 
88 /*                Picture should be declared to be at least 80 characters */
89 /*                in length.  If Picture is not sufficiently large */
90 /*                to contain the format picture, the picture will */
91 /*                be truncated on the right. */
92 
93 /*     OK         is a logical flag.  If all of the components of SAMPLE */
94 /*                are recognizable, OK will be returned with the value */
95 /*                TRUE.  If some part of PICTUR cannot be parsed, */
96 /*                OK will be returned with the value FALSE. */
97 
98 /*     ERROR      is a diagnostic message  that indicates what part of */
99 /*                SAMPLE was not recognizable.  If SAMPLE can be */
100 /*                successfully parsed, OK will be TRUE and ERROR will */
101 /*                be returned as a blank string.  If ERROR does not */
102 /*                have sufficient room (up to 400 characters) to */
103 /*                contain the full message, the message will be truncated */
104 /*                on the right. */
105 
106 /* $ Parameters */
107 
108 /*     None. */
109 
110 /* $ Files */
111 
112 /*     None. */
113 
114 /* $ Exceptions */
115 
116 /*     Error free. */
117 
118 /*     1) All problems with the inputs are diagnosed via OK and ERROR. */
119 
120 /*     2) If a format picture can not be created from the sample */
121 /*        time string, PICTUR is returned as a blank string. */
122 
123 /* $ Particulars */
124 
125 /*     Although the routine TIMOUT provides SPICE users with a great */
126 /*     deal of flexibility in formatting time strings, users must */
127 /*     master the means by which a time picture is constructed */
128 /*     suitable for use by TIMOUT. */
129 
130 /*     This routine allows SPICE users to supply a sample time string */
131 /*     from which a corresponding time format picture can be created, */
132 /*     freeing users from the task of mastering the intricacies of */
133 /*     the routine TIMOUT. */
134 
135 /*     Note that TIMOUT can produce many time strings whose patterns */
136 /*     can not be discerned by this routine.  When such outputs are */
137 /*     called for, the user must consult TIMOUT and construct the */
138 /*     appropriate format picture "by hand".  However, these exceptional */
139 /*     formats are not widely used and are not generally recognizable */
140 /*     to an uninitiated reader. */
141 
142 /* $ Examples */
143 
144 /*     Suppose you need to print epochs corresponding to some */
145 /*     events and you wish the epochs to have the same arrangement */
146 /*     of components as in the string '10:23 P.M. PDT January 3, 1993' */
147 
148 /*     The following subroutine call will construct the appropriate */
149 /*     format picture for use with TIMOUT. */
150 
151 /*     CALL TPICTR ( '10:23 P.M. PDT January 3, 1993', PICTUR, OK, ERROR) */
152 
153 /*     The resulting picture is: */
154 
155 /*        'AP:MN AMPM PDT Month DD, YYYY ::UTC-7' */
156 
157 /*     This picture can be used with TIMOUT to format a sequence */
158 /*     of epochs, ET(1),...,ET(N) (given as ephemeris seconds past J2000) */
159 /*     as shown in the loop below: */
160 
161 /*        DO I = 1, N */
162 /*           CALL TIMOUT ( ET(I), PICTUR, STRING ) */
163 /*           WRITE (*,*) 'Epoch: ', I, ' --- ', STRING */
164 /*        END DO */
165 
166 /* $ Restrictions */
167 
168 /*     None. */
169 
170 /* $ Author_and_Institution */
171 
172 /*     W.L. Taber      (JPL) */
173 
174 /* $ Literature_References */
175 
176 /*     None. */
177 
178 /* $ Version */
179 
180 /* -    SPICELIB Version 1.0.1, 16-MAR-1999 (WLT) */
181 
182 /*        Corrected a minor spelling error in the header comments. */
183 
184 /* -    SPICELIB Version 1.0.0, 10-AUG-1996 (WLT) */
185 
186 
187 /* -& */
188 /* $ Index_Entries */
189 
190 /*     Use a sample time string to produce a time format picture */
191 
192 /* -& */
193 
194 /*     This routine is really just a front for one aspect of */
195 /*     the routine TPARTV. */
196 
197     s_copy(error, " ", error_len, (ftnlen)1);
198     tpartv_(sample, tvec, &ntvec, type__, modify, &mods, &yabbrv, &succes,
199 	    pictur, error, sample_len, (ftnlen)5, (ftnlen)8, pictur_len,
200 	    error_len);
201     if (s_cmp(pictur, " ", pictur_len, (ftnlen)1) == 0) {
202 	*ok = FALSE_;
203     } else {
204 	*ok = TRUE_;
205 	s_copy(error, " ", error_len, (ftnlen)1);
206     }
207     return 0;
208 } /* tpictr_ */
209 
210