1 /* writla.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 WRITLA ( Write array of lines to a logical unit ) */
writla_(integer * numlin,char * array,integer * unit,ftnlen array_len)9 /* Subroutine */ int writla_(integer *numlin, char *array, integer *unit,
10 ftnlen array_len)
11 {
12 /* System generated locals */
13 integer i__1;
14
15 /* Local variables */
16 integer i__;
17 extern /* Subroutine */ int chkin_(char *, ftnlen);
18 extern logical failed_(void);
19 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
20 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
21 ftnlen);
22 extern logical return_(void);
23 extern /* Subroutine */ int writln_(char *, integer *, ftnlen);
24
25 /* $ Abstract */
26
27 /* This routine will write an array of text lines to a Fortran */
28 /* logical unit. */
29
30 /* $ Disclaimer */
31
32 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
33 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
34 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
35 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
36 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
37 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
38 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
39 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
40 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
41 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
42
43 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
44 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
45 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
46 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
47 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
48 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
49
50 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
51 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
52 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
53 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
54
55 /* $ Required_Reading */
56
57 /* None. */
58
59 /* $ Keywords */
60
61 /* UTILITY */
62
63 /* $ Declarations */
64 /* $ Brief_I/O */
65
66 /* Variable I/O Description */
67 /* -------- --- -------------------------------------------------- */
68 /* NUMLIN I Number of lines to be written to the file. */
69 /* ARRAY I Array containing the lines to be written. */
70 /* UNIT I Fortran unit number to use for output. */
71
72 /* $ Detailed_Input */
73
74
75 /* NUMLIN The number of text lines in ARRAY which are to be */
76 /* written to UNIT. NUMLIN > 0. */
77
78 /* ARRAY The array which contains the text lines to be written to */
79 /* UNIT. */
80
81 /* The contents of this variable are not modified. */
82
83 /* UNIT The Fortran unit number for the output. This may */
84 /* be either the unit number for the terminal, or the */
85 /* unit number of a previously opened text file. */
86
87 /* $ Detailed_Output */
88
89 /* None. */
90
91 /* $ Parameters */
92
93 /* None. */
94
95 /* $ Exceptions */
96
97 /* 1) If the number of lines, NUMLIN, is not positive, the error */
98 /* SPICE(INVALIDARGUMENT) will be signalled. */
99
100 /* 2) If an error occurs while attempting to write to the text */
101 /* file attached to UNIT, a routine called by this routine will */
102 /* detect and signal the error. */
103
104 /* $ Files */
105
106 /* See the description of UNIT above. */
107
108 /* $ Particulars */
109
110 /* This routine writes an array of character strings to a specified */
111 /* Fortran logical unit, writing each array element as a line of */
112 /* output. */
113
114 /* $ Examples */
115
116 /* The following example demonstrates the use of this routine, */
117 /* displaying a short poem on the standard output device, typically a */
118 /* terminal screen. */
119
120 /* PROGRAM EXAMPL */
121 /* C */
122 /* C Example program for WRITLA. */
123 /* C */
124 /* CHARACTER*(80) LINES(4) */
125
126 /* LINES(1) = 'Mary had a little lamb' */
127 /* LINES(2) = 'Whose fleece was white as snow' */
128 /* LINES(3) = 'And everywhere that mary went' */
129 /* LINES(4) = 'The lamb was sure to go' */
130
131 /* CALL WRITLA ( 4, LINES, 6 ) */
132
133 /* END */
134
135 /* $ Restrictions */
136
137 /* None. */
138
139 /* $ Literature_References */
140
141 /* None. */
142
143 /* $ Author_and_Institution */
144
145 /* K.R. Gehringer (JPL) */
146
147 /* $ Version */
148
149 /* - SPICELIB 1.0.0, 20-DEC-1995 (KRG) */
150
151 /* The routine graduated */
152
153 /* - Beta Version 2.0.0, 13-OCT-1994 (KRG) */
154
155 /* This routine now participates fully with the SPICELIB error */
156 /* handler, checking in on entry and checking out on exit. The */
157 /* overhead associated with the error handler should not be */
158 /* significant relative to the operation of this routine. */
159
160 /* - Beta Version 1.0.0, 18-DEC-1992 (KRG) */
161
162 /* -& */
163 /* $ Index_Entries */
164
165 /* write an array of text lines to a logical unit */
166
167 /* -& */
168
169 /* SPICELIB functions */
170
171
172 /* Local variables */
173
174
175 /* Standard SPICE error handling. */
176
177 if (return_()) {
178 return 0;
179 } else {
180 chkin_("WRITLA", (ftnlen)6);
181 }
182
183 /* Check to see if the maximum number of lines is positive. */
184
185 if (*numlin <= 0) {
186 setmsg_("The number of lines to be written was not positive. It was "
187 "#.", (ftnlen)61);
188 errint_("#", numlin, (ftnlen)1);
189 sigerr_("SPICE(INVALIDARGUMENT)", (ftnlen)22);
190 chkout_("WRITLA", (ftnlen)6);
191 return 0;
192 }
193
194 /* Begin writing the lines to UNIT. Stop when an error occurs, or */
195 /* when we have finished writing all of the lines. */
196
197 i__1 = *numlin;
198 for (i__ = 1; i__ <= i__1; ++i__) {
199 writln_(array + (i__ - 1) * array_len, unit, array_len);
200 if (failed_()) {
201
202 /* If the write failed, an appropriate error message has */
203 /* already been set, so we simply need to return. */
204
205 chkout_("WRITLA", (ftnlen)6);
206 return 0;
207 }
208 }
209 chkout_("WRITLA", (ftnlen)6);
210 return 0;
211 } /* writla_ */
212
213