1 /* dafrcr.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 logical c_false = FALSE_;
11 static integer c__1 = 1;
12 
13 /* $Procedure DAFRCR ( DAF, read character record ) */
dafrcr_(integer * handle,integer * recno,char * crec,ftnlen crec_len)14 /* Subroutine */ int dafrcr_(integer *handle, integer *recno, char *crec,
15 	ftnlen crec_len)
16 {
17     /* System generated locals */
18     integer i__1;
19 
20     /* Builtin functions */
21     integer i_len(char *, ftnlen), s_rdue(cilist *), do_uio(integer *, char *,
22 	     ftnlen), e_rdue(void);
23 
24     /* Local variables */
25     integer unit;
26     extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *,
27 	    integer *, ftnlen), chkin_(char *, ftnlen);
28     extern logical failed_(void);
29     extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen), sigerr_(
30 	    char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
31     integer iostat;
32     extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
33     extern logical return_(void);
34 
35     /* Fortran I/O blocks */
36     static cilist io___3 = { 1, 0, 1, 0, 0 };
37 
38 
39 /* $ Abstract */
40 
41 /*     Read the contents of a character record from a DAF. */
42 
43 /* $ Disclaimer */
44 
45 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
46 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
47 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
48 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
49 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
50 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
51 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
52 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
53 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
54 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
55 
56 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
57 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
58 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
59 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
60 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
61 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
62 
63 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
64 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
65 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
66 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
67 
68 /* $ Required_Reading */
69 
70 /*     DAF */
71 
72 /* $ Keywords */
73 
74 /*     FILES */
75 
76 /* $ Declarations */
77 /* $ Brief_I/O */
78 
79 /*     Variable  I/O  Description */
80 /*     --------  ---  -------------------------------------------------- */
81 /*     HANDLE     I   Handle of DAF. */
82 /*     RECNO      I   Record number of character record. */
83 /*     CREC       O   Character record. */
84 
85 /* $ Detailed_Input */
86 
87 /*     HANDLE      is the handle associated with a DAF. */
88 
89 /*     RECNO       is the record number of a character record within */
90 /*                 the file. */
91 
92 /* $ Detailed_Output */
93 
94 /*     CREC        contains the first 1000 characters of the specified */
95 /*                 record from the specified file. */
96 
97 /* $ Parameters */
98 
99 /*      None. */
100 
101 /* $ Files */
102 
103 /*     None. */
104 
105 /* $ Exceptions */
106 
107 /*     1) If the declared length of CREC is not 1000 characters, */
108 /*        the error SPICE(DAFBADRECLEN) is signalled. */
109 
110 /*     2) If the specified record cannot (for some reason) be read, */
111 /*        the error SPICE(DAFCRNOTFOUND) is signalled. */
112 
113 /* $ Particulars */
114 
115 /*     Unlike double precision records, character records are */
116 /*     not buffered. Also, while failing to find a specific double */
117 /*     precision record is indicated through the calling sequence, */
118 /*     failing to find a character record results in an error. */
119 
120 /* $ Examples */
121 
122 /*     In the following example, matching summary and name records are */
123 /*     read from a DAF: */
124 
125 /*        CALL DAFGDR ( HANDLE, NEXT,   DREC, FOUND ) */
126 /*        CALL DAFRCR ( HANDLE, NEXT+1, CREC        ) */
127 
128 /*     Note that a character record always immediately follows a summary */
129 /*     record. */
130 
131 /* $ Restrictions */
132 
133 /*     1) This routine is only used to read records on environments */
134 /*        whose characters are a single byte in size.  Updates */
135 /*        to this routine and routines in its call tree may be */
136 /*        required to properly handle other cases. */
137 
138 /* $ Literature_References */
139 
140 /*     NAIF Document 167.0, "Double Precision Array Files (DAF) */
141 /*     Specification and User's Guide" */
142 
143 /* $ Author_and_Institution */
144 
145 /*     I.M. Underwood  (JPL) */
146 
147 /* $ Version */
148 
149 /* -    SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */
150 
151 /*        Updated this routine to make proper use of the new */
152 /*        handle manager functionality installed underneath */
153 /*        DAF. */
154 
155 /* -    SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
156 
157 /*        Comment section for permuted index source lines was added */
158 /*        following the header. */
159 
160 /* -    SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
161 
162 /*        Literature references added to the header. */
163 
164 /* -    SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
165 
166 /* -& */
167 /* $ Index_Entries */
168 
169 /*     read daf character record */
170 
171 /* -& */
172 /* $ Revisions */
173 
174 /* -    SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */
175 
176 /*        This routine now makes use of the handle manager */
177 /*        code.  A call to DAFSIH was inserted just after */
178 /*        the standard SPICE error handling code at the */
179 /*        head of the module.  This was done to insure that */
180 /*        the caller is referring to a legitmately loaded */
181 /*        DAF.  The penalty for performing this check is */
182 /*        a binary search on the number of loaded files, */
183 /*        which should be small compared to the actual READ */
184 /*        performed below. */
185 
186 /*        The call to DAFHLU has been replaced with ZZDDHHLU, */
187 /*        since calls to DAFHLU locks handles to their logical */
188 /*        units. */
189 
190 /* -& */
191 
192 /*     SPICELIB functions */
193 
194 
195 /*     Local variables */
196 
197 
198 /*     Standard SPICE error handling. */
199 
200     if (return_()) {
201 	return 0;
202     } else {
203 	chkin_("DAFRCR", (ftnlen)6);
204     }
205 
206 /*     Check to be sure that HANDLE is attached to a file that is open */
207 /*     with read access.  If the call fails, check out and return. */
208 
209     dafsih_(handle, "READ", (ftnlen)4);
210     if (failed_()) {
211 	chkout_("DAFRCR", (ftnlen)6);
212 	return 0;
213     }
214 
215 /*     Now make certain that the string to receive the contents of */
216 /*     the character record is the appropriate length. */
217 
218     if (i_len(crec, crec_len) != 1000) {
219 	setmsg_("Expected length of character record is 1000. Passed string "
220 		"has length #", (ftnlen)71);
221 	i__1 = i_len(crec, crec_len);
222 	errint_("#", &i__1, (ftnlen)1);
223 	sigerr_("SPICE(DAFBADCRECLEN)", (ftnlen)20);
224     } else {
225 
226 /*        Retrieve a logical unit for this handle.  This has the */
227 /*        side-effect of locking this UNIT to HANDLE. */
228 
229 	zzddhhlu_(handle, "DAF", &c_false, &unit, (ftnlen)3);
230 	if (failed_()) {
231 	    chkout_("DAFRCR", (ftnlen)6);
232 	    return 0;
233 	}
234 	io___3.ciunit = unit;
235 	io___3.cirec = *recno;
236 	iostat = s_rdue(&io___3);
237 	if (iostat != 0) {
238 	    goto L100001;
239 	}
240 	iostat = do_uio(&c__1, crec, crec_len);
241 	if (iostat != 0) {
242 	    goto L100001;
243 	}
244 	iostat = e_rdue();
245 L100001:
246 	if (iostat != 0) {
247 	    setmsg_("Could not read record #. IOSTAT was #.", (ftnlen)38);
248 	    errint_("#", recno, (ftnlen)1);
249 	    errint_("#", &iostat, (ftnlen)1);
250 	    sigerr_("SPICE(DAFCRNOTFOUND)", (ftnlen)20);
251 	}
252     }
253     chkout_("DAFRCR", (ftnlen)6);
254     return 0;
255 } /* dafrcr_ */
256 
257