1 /* wrline.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__9 = 9;
12 static integer c__3 = 3;
13 static integer c__0 = 0;
14 static integer c__2 = 2;
15
16 /* $Procedure WRLINE ( Write Output Line to a Device ) */
wrline_0_(int n__,char * device,char * line,ftnlen device_len,ftnlen line_len)17 /* Subroutine */ int wrline_0_(int n__, char *device, char *line, ftnlen
18 device_len, ftnlen line_len)
19 {
20 /* System generated locals */
21 integer i__1;
22 cilist ci__1;
23 olist o__1;
24 cllist cl__1;
25 inlist ioin__1;
26
27 /* Builtin functions */
28 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
29 integer *, char *, ftnlen), e_wsfe(void), f_inqu(inlist *),
30 s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
31 e_wsle(void), f_open(olist *);
32 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
33 integer f_clos(cllist *);
34
35 /* Local variables */
36 integer unit;
37 extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
38 extern integer ltrim_(char *, ftnlen);
39 char error[240];
40 extern integer rtrim_(char *, ftnlen);
41 extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
42 logical opened;
43 extern /* Subroutine */ int fndlun_(integer *);
44 char tmpnam[255];
45 integer iostat;
46 extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
47 ftnlen);
48 logical exists;
49 char errstr[11];
50 extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
51
52 /* Fortran I/O blocks */
53 static cilist io___6 = { 0, 6, 0, 0, 0 };
54 static cilist io___7 = { 0, 6, 0, 0, 0 };
55 static cilist io___8 = { 0, 6, 0, 0, 0 };
56 static cilist io___9 = { 0, 6, 0, 0, 0 };
57 static cilist io___10 = { 0, 6, 0, 0, 0 };
58 static cilist io___11 = { 0, 6, 0, 0, 0 };
59 static cilist io___12 = { 0, 6, 0, 0, 0 };
60 static cilist io___15 = { 0, 6, 0, 0, 0 };
61 static cilist io___16 = { 0, 6, 0, 0, 0 };
62 static cilist io___17 = { 0, 6, 0, 0, 0 };
63 static cilist io___18 = { 0, 6, 0, 0, 0 };
64
65
66 /* $ Abstract */
67
68 /* Write a character string to an output device. */
69
70 /* $ Disclaimer */
71
72 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
73 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
74 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
75 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
76 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
77 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
78 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
79 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
80 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
81 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
82
83 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
84 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
85 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
86 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
87 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
88 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
89
90 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
91 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
92 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
93 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
94
95 /* $ Required_Reading */
96
97 /* None. */
98
99 /* $ Keywords */
100
101 /* TEXT */
102 /* FILES */
103 /* ERROR */
104
105 /* $ Declarations */
106 /* $ Brief_I/O */
107
108 /* VARIABLE I/O DESCRIPTION */
109 /* -------- --- -------------------------------------------------- */
110 /* DEVICE I A string specifying an output device. */
111 /* LINE I A line of text to be output. */
112 /* FILEN P Maximum length of a file name. */
113
114 /* $ Detailed_Input */
115
116 /* LINE is a line of text to be written to the output */
117 /* device specified by DEVICE. */
118
119 /* DEVICE is the output device to which the line of text */
120 /* will be written. */
121
122 /* Possible values and meanings of DEVICE are: */
123
124 /* a device name This may be the name of a */
125 /* file, or any other name that */
126 /* is valid in a FORTRAN OPEN */
127 /* statement. For example, on a */
128 /* VAX, a logical name may be */
129 /* used. */
130
131 /* The device name must not */
132 /* be any of the reserved strings */
133 /* below. */
134
135
136 /* 'SCREEN' The output will go to the */
137 /* terminal screen. */
138
139
140 /* 'NULL' The data will not be output. */
141
142
143 /* 'SCREEN' and 'NULL' can be written in mixed */
144 /* case. For example, the following call will work: */
145
146 /* CALL WRLINE ( 'screEn', LINE ) */
147
148 /* $ Detailed_Output */
149
150 /* None. */
151
152 /* $ Parameters */
153
154 /* FILEN is the maximum length of a file name. */
155
156 /* $ Exceptions */
157
158 /* This routine is a special case as far as error handling */
159 /* is concerned because it is called to output error */
160 /* messages resulting from errors detected by other routines. */
161 /* In such a case, calling SIGERR would constitute recursion. */
162 /* Therefore, this routine prints error messages rather */
163 /* than signalling errors via SIGERR and setting the long */
164 /* error message via SETMSG. */
165
166 /* The following exceptional cases are treated as errors: */
167
168 /* 1) SPICE(NOFREELOGICALUNIT) -- No logical unit number */
169 /* is available to refer to the device. */
170
171 /* 2) SPICE(FILEOPENFAILED) -- General file open error. */
172
173 /* 3) SPICE(FILEWRITEFAILED) -- General file write error. */
174
175 /* 4) SPICE(INQUIREFAILED) -- INQUIRE statement failed. */
176
177 /* 5) Leading blanks in (non-blank) file names are not */
178 /* significant. The file names */
179
180 /* 'MYFILE.DAT' */
181 /* ' MYFILE.DAT' */
182
183 /* are considered to name the same file. */
184
185 /* 6) If different names that indicate the same file are supplied */
186 /* to this routine on different calls, all output associated */
187 /* with these calls WILL be written to the file. For example, */
188 /* on a system where logical filenames are supported, if */
189 /* ALIAS is a logical name pointing to MYFILE, then the calls */
190
191 /* CALL WRLINE ( 'MYFILE', 'This is the first line' ) */
192 /* CALL WRLINE ( 'ALIAS', 'This is the second line' ) */
193
194 /* will place the lines of text */
195
196 /* 'This is the first line' */
197 /* 'This is the second line' */
198
199 /* in MYFILE. See $Restrictions for more information on use */
200 /* of logical names on VAX systems. */
201
202 /* $ Files */
203
204 /* 1) If DEVICE specifies a device other than 'SCREEN' or 'NULL', */
205 /* that device is opened (if it's not already open) as a NEW, */
206 /* SEQUENTIAL, FORMATTED file. The logical unit used is */
207 /* determined at run time. */
208
209 /* $ Particulars */
210
211 /* If the output device is a file that is not open, the file will */
212 /* be opened (if possible) as a NEW, sequential, formatted file, */
213 /* and the line of text will be written to the file. If the file */
214 /* is already opened as a sequential, formatted file, the line of */
215 /* text will be written to the file. */
216
217 /* Use the entry point CLLINE to close files opened by WRLINE. */
218
219 /* $ Examples */
220
221 /* 1) Write a message to the screen: */
222
223 /* CALL WRLINE ( 'SCREEN', 'Here''s a message.' ) */
224
225 /* The text */
226
227 /* Here's a message. */
228
229 /* will be written to the screen. */
230
231
232 /* 2) Write out all of the elements of a character string array */
233 /* to a file. */
234
235 /* CHARACTER*(80) STRING ( ASIZE ) */
236 /* . */
237 /* . */
238 /* . */
239 /* DO I = 1, ASIZE */
240 /* CALL WRLINE ( FILE, STRING(I) ) */
241 /* END DO */
242
243
244 /* 3) Set DEVICE to NULL to suppress output: */
245
246 /* C */
247 /* C Ask the user whether verbose program output is */
248 /* C desired. Set the output device accordingly. */
249 /* C */
250 /* WRITE (*,*) 'Do you want to see test results ' // */
251 /* . 'on the screen?' */
252 /* READ (*,FMT='(A)') VERBOS */
253
254 /* CALL LJUST ( VERBOS, VERBOS ) */
255 /* CALL UCASE ( VERBOS, VERBOS ) */
256
257 /* IF ( VERBOS(1:1) .EQ. 'Y' ) THEN */
258 /* DEVICE = 'SCREEN' */
259 /* ELSE */
260 /* DEVICE = 'NULL' */
261 /* ENDIF */
262 /* . */
263 /* . */
264 /* . */
265 /* C */
266 /* C Output test results. */
267 /* C */
268 /* CALL WRLINE ( DEVICE, STRING ) */
269 /* . */
270 /* . */
271 /* . */
272
273 /* $ Restrictions */
274
275 /* 1) File names must not exceed FILEN characters. */
276
277 /* 2) On VAX systems, caution should be exercised when using */
278 /* multiple logical names to point to the same file. Logical */
279 /* name translation supporting execution of the Fortran */
280 /* INQUIRE statement does not appear to work reliably in all */
281 /* cases, which may lead this routine to believe that different */
282 /* logical names indicate different files. The specific problem */
283 /* that has been observed is that logical names that include */
284 /* disk specifications are not always recognized as pointing */
285 /* to the file they actually name. */
286
287 /* $ Literature_References */
288
289 /* None. */
290
291 /* $ Author_and_Institution */
292
293 /* N.J. Bachman (JPL) */
294 /* H.A. Neilan (JPL) */
295
296 /* $ Version */
297
298 /* - SPICELIB Version 4.25.0, 10-MAR-2014 (BVS) */
299
300 /* Updated for SUN-SOLARIS-64BIT-INTEL. */
301
302 /* - SPICELIB Version 4.24.0, 10-MAR-2014 (BVS) */
303
304 /* Updated for PC-LINUX-64BIT-IFORT. */
305
306 /* - SPICELIB Version 4.23.0, 10-MAR-2014 (BVS) */
307
308 /* Updated for PC-CYGWIN-GFORTRAN. */
309
310 /* - SPICELIB Version 4.22.0, 10-MAR-2014 (BVS) */
311
312 /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
313
314 /* - SPICELIB Version 4.21.0, 10-MAR-2014 (BVS) */
315
316 /* Updated for PC-CYGWIN-64BIT-GCC_C. */
317
318 /* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */
319
320 /* Updated for SUN-SOLARIS-INTEL. */
321
322 /* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */
323
324 /* Updated for SUN-SOLARIS-INTEL-CC_C. */
325
326 /* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */
327
328 /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
329
330 /* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */
331
332 /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
333
334 /* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */
335
336 /* Updated for PC-WINDOWS-64BIT-IFORT. */
337
338 /* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */
339
340 /* Updated for PC-LINUX-64BIT-GFORTRAN. */
341
342 /* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */
343
344 /* Updated for PC-64BIT-MS_C. */
345
346 /* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */
347
348 /* Updated for MAC-OSX-64BIT-INTEL_C. */
349
350 /* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */
351
352 /* Updated for MAC-OSX-64BIT-IFORT. */
353
354 /* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */
355
356 /* Updated for MAC-OSX-64BIT-GFORTRAN. */
357
358 /* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */
359
360 /* Updated for PC-LINUX-GFORTRAN. */
361
362 /* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */
363
364 /* Updated for MAC-OSX-GFORTRAN. */
365
366 /* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */
367
368 /* Updated for PC-LINUX-IFORT. */
369
370 /* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */
371
372 /* Updated for PC-LINUX-64BIT-GCC_C. */
373
374 /* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */
375
376 /* Updated for MAC-OSX-INTEL_C. */
377
378 /* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */
379
380 /* Updated for MAC-OSX-IFORT. */
381
382 /* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */
383
384 /* Updated for PC-WINDOWS-IFORT. */
385
386 /* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */
387
388 /* Updated for SUN-SOLARIS-64BIT-GCC_C. */
389
390 /* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */
391
392 /* Updated for PC-CYGWIN_C. */
393
394 /* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */
395
396 /* Updated for PC-CYGWIN. */
397
398 /* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */
399
400 /* Added MAC-OSX environments. */
401
402 /* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */
403
404 /* The environment lines were expanded so that the supported */
405 /* environments are now explicitely given. New */
406 /* environments are WIN-NT */
407
408 /* - SPICELIB Version 4.0.3, 16-SEP-1999 (NJB) */
409
410 /* CSPICE environments were added. Some typos were corrected. */
411
412 /* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */
413
414 /* The environment lines were expanded so that the supported */
415 /* environments are now explicitly given. New */
416 /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
417
418 /* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */
419
420 /* The environment lines were expanded so that the supported */
421 /* environments are now explicitly given. Previously, */
422 /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
423 /* by the environment label SUN. */
424
425 /* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */
426
427 /* References to the PC-LINUX environment were added. The */
428 /* write format for the case where the output device is the */
429 /* screen has been made system-dependent; list-directed output */
430 /* format is now used for systems that require a leading carriage */
431 /* control character; other systems use character format. The */
432 /* write format for the case where the output device is a file */
433 /* has been changed from list-directed to character. */
434
435
436 /* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
437
438 /* Module was updated to include the value for FILEN */
439 /* and the appropriate OPEN statement for the Silicon */
440 /* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
441 /* value of 256 for Unix platforms was changed to 255. */
442
443 /* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
444
445 /* Module was updated to include the value of FILEN for the */
446 /* Hewlett Packard UX 9000/750 environment. */
447
448 /* The code was also reformatted so that a utility program can */
449 /* create the source file for a specific environment given a */
450 /* master source file. */
451
452 /* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
453
454 /* Comment section for permuted index source lines was added */
455 /* following the header. */
456
457 /* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
458
459 /* This routine now can write to files that have been opened */
460 /* by other routines. */
461
462 /* The limit imposed by this routine on the number of files it */
463 /* can open has been removed. */
464
465 /* The output file is now opened as a normal text file on */
466 /* VAX systems. */
467
468 /* Improper treatment of the case where DEVICE is blank was */
469 /* remedied. */
470
471 /* Unneeded variable declarations and references were removed. */
472
473 /* Initialization of SAVED variables was added. */
474
475 /* All occurrences of "PRINT *" have been replaced by */
476 /* "WRITE (*,*)". */
477
478 /* Calls to UCASE and LJUST replace in-line code that performed */
479 /* these operations. */
480
481 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
482
483 /* -& */
484 /* $ Index_Entries */
485
486 /* write output line to a device */
487
488 /* -& */
489 /* $ Revisions */
490
491 /* - SPICELIB Version 4.0.0, 07-APR-1998 (NJB) */
492
493 /* References to the PC-LINUX environment were added. */
494
495 /* The write format for the case where the output device is the */
496 /* screen has been made system-dependent; list-directed output */
497 /* format is now used for systems that require a leading carriage */
498 /* control character; other systems use character format. The */
499 /* write format for the case where the output device is a file */
500 /* has been changed from list-directed to character. */
501
502 /* - SPICELIB Version 3.0.0, 11-NOV-1993 (HAN) */
503
504 /* Module was updated to include the value for FILEN */
505 /* and the appropriate OPEN statement for the Silicon */
506 /* Graphics, DEC Alpha-OSF/1, and NeXT platforms. The previous */
507 /* value of 256 for Unix platforms was changed to 255. */
508
509 /* - SPICELIB Version 2.1.0, 13-OCT-1992 (HAN) */
510
511 /* Module was updated to include the value of FILEN for the */
512 /* Hewlett Packard UX 9000/750 environment. */
513
514 /* The code was also reformatted so that a utility program can */
515 /* create the source file for a specific environment given a */
516 /* master source file. */
517
518 /* - SPICELIB Version 2.0.0, 25-MAR-1991 (NJB) */
519
520 /* 1) This routine now can write to files that have been opened */
521 /* by other routines. WRLINE uses an INQUIRE statement to */
522 /* determine whether the file indicated by DEVICE is open, */
523 /* and if it is, WRLINE does not attempt to open it. This */
524 /* allows use of WRLINE to feed error output into a log file */
525 /* opened by another routine. */
526
527 /* The header has been updated accordingly. */
528
529 /* This fix also fixes a bug wherein this routine would treat */
530 /* different character strings naming the same file as though */
531 /* they indicated different files. */
532
533 /* 2) The limit imposed by this routine on the number of files it */
534 /* can open has been removed. The file database used in */
535 /* previous versions of this routine is no longer used. */
536
537 /* 3) On VAX systems, this routine now opens the output file */
538 /* (when required to do so) as a normal text file. */
539
540 /* 4) Improper treatment of the case where DEVICE is blank was */
541 /* remedied. Any value of DEVICE that is not equal to */
542 /* 'SCREEN' or 'NULL' after being left-justified and */
543 /* converted to upper case is considered to be a file name. */
544
545 /* 5) Unneeded variable declarations and references were removed. */
546 /* The arrays called STATUS and FILES are not needed. */
547
548 /* 6) All instances if "PRINT *" have been replaced by */
549 /* "WRITE (*,*)" because Language Systems Fortran on the */
550 /* Macintosh interprets "PRINT *" in a non-standard manner. */
551
552 /* 7) Use of the EXIST specifier was added to the INQUIRE */
553 /* statement used to determine whether the file named by */
554 /* DEVICE is open. This is a work-around for a rather */
555 /* peculiar behavior of at least one version of Sun Fortran: */
556 /* files that don't exist may be considered to be open, as */
557 /* indicated by the OPENED specifier of the INQUIRE statement. */
558
559 /* 8) One other thing: now that LJUST and UCASE are error-free, */
560 /* WRLINE uses them; this simplifies the code. */
561
562
563 /* - Beta Version 1.2.0, 27-FEB-1989 (NJB) */
564
565 /* Call to GETLUN replaced by call to FNDLUN, which is error-free. */
566 /* Call to IOERR replaced with in-line code to construct long */
567 /* error message indicating file open failure. Arrangement of */
568 /* declarations changed. Keywords added. FILEN declaration */
569 /* moved to "declarations" section. Parameters section added. */
570
571 /* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */
572
573 /* Upper bound of written substring changed to prevent use of */
574 /* invalid substring bound. Specifically, LASTNB ( LINE ) was */
575 /* replaced by MAX ( 1, LASTNB (LINE) ). This upper bound */
576 /* now used in the PRINT statement as well. */
577
578 /* -& */
579
580 /* SPICELIB functions */
581
582
583 /* Local variables */
584
585
586 /* Executable Code: */
587
588 switch(n__) {
589 case 1: goto L_clline;
590 }
591
592 ljust_(device, tmpnam, device_len, (ftnlen)255);
593 ucase_(tmpnam, tmpnam, (ftnlen)255, (ftnlen)255);
594
595 /* TMPNAM is now left justified and is in upper case. */
596
597 if (s_cmp(tmpnam, "NULL", (ftnlen)255, (ftnlen)4) == 0) {
598 return 0;
599 } else if (s_cmp(tmpnam, "SCREEN", (ftnlen)255, (ftnlen)6) == 0) {
600 ci__1.cierr = 1;
601 ci__1.ciunit = 6;
602 ci__1.cifmt = "(A)";
603 iostat = s_wsfe(&ci__1);
604 if (iostat != 0) {
605 goto L100001;
606 }
607 iostat = do_fio(&c__1, line, rtrim_(line, line_len));
608 if (iostat != 0) {
609 goto L100001;
610 }
611 iostat = e_wsfe();
612 L100001:
613 return 0;
614 }
615
616 /* Find out whether we'll need to open the file. */
617
618 /* We use the EXIST inquiry specifier because files that don't exist */
619 /* may be (possibly due to a Sun compiler bug) deemed to be OPEN by */
620 /* Sun Fortran. */
621
622 i__1 = ltrim_(device, device_len) - 1;
623 ioin__1.inerr = 1;
624 ioin__1.infilen = device_len - i__1;
625 ioin__1.infile = device + i__1;
626 ioin__1.inex = &exists;
627 ioin__1.inopen = &opened;
628 ioin__1.innum = &unit;
629 ioin__1.innamed = 0;
630 ioin__1.inname = 0;
631 ioin__1.inacc = 0;
632 ioin__1.inseq = 0;
633 ioin__1.indir = 0;
634 ioin__1.infmt = 0;
635 ioin__1.inform = 0;
636 ioin__1.inunf = 0;
637 ioin__1.inrecl = 0;
638 ioin__1.innrec = 0;
639 ioin__1.inblank = 0;
640 iostat = f_inqu(&ioin__1);
641 if (iostat != 0) {
642
643 /* This is weird. How can an INQUIRE statement fail, */
644 /* if the syntax is correct? But just in case... */
645
646 s_wsle(&io___6);
647 do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
648 e_wsle();
649 s_wsle(&io___7);
650 do_lio(&c__9, &c__1, "WRLINE: File = ", (ftnlen)15);
651 do_lio(&c__9, &c__1, device, device_len);
652 do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
653 do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
654 e_wsle();
655 return 0;
656 }
657 if (! (opened && exists)) {
658
659 /* We will need a free logical unit. There is always the chance */
660 /* that no units are available. */
661
662 fndlun_(&unit);
663 if (unit < 1) {
664 s_wsle(&io___8);
665 do_lio(&c__9, &c__1, "SPICE(NOFREELOGICALUNIT)", (ftnlen)24);
666 e_wsle();
667 s_wsle(&io___9);
668 do_lio(&c__9, &c__1, " ", (ftnlen)1);
669 e_wsle();
670 s_wsle(&io___10);
671 do_lio(&c__9, &c__1, "WRLINE: Maximum number of logical units th"
672 "at can be allocated by SPICELIB has already been reached",
673 (ftnlen)98);
674 e_wsle();
675 return 0;
676 }
677
678 /* Okay, we have a unit. Open the file, and hope nothing */
679 /* goes awry. (On the VAX, the qualifier */
680
681 /* CARRIAGECONTROL = 'LIST' */
682
683 /* may be inserted into the OPEN statement.) */
684
685 i__1 = ltrim_(device, device_len) - 1;
686 o__1.oerr = 1;
687 o__1.ounit = unit;
688 o__1.ofnmlen = device_len - i__1;
689 o__1.ofnm = device + i__1;
690 o__1.orl = 0;
691 o__1.osta = "NEW";
692 o__1.oacc = 0;
693 o__1.ofm = 0;
694 o__1.oblnk = 0;
695 iostat = f_open(&o__1);
696 if (iostat != 0) {
697 s_wsle(&io___11);
698 do_lio(&c__9, &c__1, "SPICE(FILEOPENFAILED)", (ftnlen)21);
699 e_wsle();
700 s_wsle(&io___12);
701 do_lio(&c__9, &c__1, " ", (ftnlen)1);
702 e_wsle();
703 s_copy(error, "WRLINE: An error occurred while attempting to open"
704 , (ftnlen)240, (ftnlen)50);
705 suffix_(device, &c__1, error, device_len, (ftnlen)240);
706 suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
707 suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)
708 32, (ftnlen)240);
709 suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
710 intstr_(&iostat, errstr, (ftnlen)11);
711 suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
712 suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
713 s_wsle(&io___15);
714 do_lio(&c__9, &c__1, error, (ftnlen)240);
715 e_wsle();
716 return 0;
717 }
718
719 /* Whew! We're ready to write to this file. */
720
721 }
722
723 /* At this point, either we opened the file, or it was already */
724 /* opened by somebody else. */
725
726 /* This is the easy part. Write the next line to the file. */
727
728 ci__1.cierr = 1;
729 ci__1.ciunit = unit;
730 ci__1.cifmt = "(A)";
731 iostat = s_wsfe(&ci__1);
732 if (iostat != 0) {
733 goto L100002;
734 }
735 iostat = do_fio(&c__1, line, rtrim_(line, line_len));
736 if (iostat != 0) {
737 goto L100002;
738 }
739 iostat = e_wsfe();
740 L100002:
741
742 /* Well, what happened? Any non-zero value for IOSTAT indicates */
743 /* an error. */
744
745 if (iostat != 0) {
746 s_copy(error, "WRLINE: An error occurred while attempting to WRITE t"
747 "o ", (ftnlen)240, (ftnlen)55);
748 suffix_(device, &c__1, error, device_len, (ftnlen)240);
749 suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
750 suffix_("The value of IOSTAT returned was", &c__2, error, (ftnlen)32,
751 (ftnlen)240);
752 suffix_(":", &c__0, error, (ftnlen)1, (ftnlen)240);
753 intstr_(&iostat, errstr, (ftnlen)11);
754 suffix_(errstr, &c__1, error, (ftnlen)11, (ftnlen)240);
755 suffix_(".", &c__0, error, (ftnlen)1, (ftnlen)240);
756 s_wsle(&io___16);
757 do_lio(&c__9, &c__1, error, (ftnlen)240);
758 e_wsle();
759 return 0;
760 }
761 return 0;
762 /* $Procedure CLLINE ( Close a device ) */
763
764 L_clline:
765 /* $ Abstract */
766
767 /* Close a device. */
768
769 /* $ Disclaimer */
770
771 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
772 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
773 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
774 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
775 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
776 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
777 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
778 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
779 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
780 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
781
782 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
783 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
784 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
785 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
786 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
787 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
788
789 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
790 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
791 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
792 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
793
794 /* $ Required_Reading */
795
796 /* None. */
797
798 /* $ Keywords */
799
800 /* TEXT, FILES, ERROR */
801
802 /* $ Declarations */
803
804 /* CHARACTER*(*) DEVICE */
805
806 /* $ Brief_I/O */
807
808 /* VARIABLE I/O DESCRIPTION */
809 /* -------- --- -------------------------------------------------- */
810 /* DEVICE I Device to be closed. */
811
812 /* $ Detailed_Input */
813
814 /* DEVICE is the name of a device which is currently */
815 /* opened for reading or writing. */
816
817 /* $ Detailed_Output */
818
819 /* None. */
820
821 /* $ Parameters */
822
823 /* None. */
824
825 /* $ Exceptions */
826
827 /* This routine is called by SPICELIB error handling routines, so */
828 /* it cannot use the normal SPICELIB error signalling mechanism. */
829 /* Instead, it writes error messages to the screen if necessary. */
830
831 /* 1) If the device indicated by DEVICE was not opened by WRLINE, */
832 /* this routine closes it anyway. */
833
834 /* 2) If the INQUIRE performed by this routine fails, an error */
835 /* diagnosis is printed to the screen. */
836
837 /* $ Files */
838
839 /* This routin */
840
841 /* $ Particulars */
842
843 /* CLLINE closes a device that is currently open. */
844
845 /* $ Examples */
846
847 /* 1) Write two lines to the file, SPUD.DAT (VAX file name */
848 /* syntax), and then close the file. */
849
850 /* CALL WRLINE ( 'SPUD.DAT', ' This is line 1 ' ) */
851 /* CALL WRLINE ( 'SPUD.DAT', ' This is line 2 ' ) */
852 /* CALL CLLINE ( 'SPUD.DAT' ) */
853
854 /* $ Restrictions */
855
856 /* None. */
857
858 /* $ Literature_References */
859
860 /* None. */
861
862 /* $ Author_and_Institution */
863
864 /* N.J. Bachman (JPL) */
865
866 /* $ Version */
867
868 /* - SPICELIB Version 4.0.5, 17-JUL-2002 (BVS) */
869
870 /* Added MAC-OSX environments. */
871
872 /* - SPICELIB Version 4.0.4, 08-OCT-1999 (WLT) */
873
874 /* The environment lines were expanded so that the supported */
875 /* environments are now explicitely given. New */
876 /* environments are WIN-NT */
877
878 /* - SPICELIB Version 4.0.2, 28-JUL-1999 (WLT) */
879
880 /* The environment lines were expanded so that the supported */
881 /* environments are now explicitly given. New */
882 /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
883
884 /* - SPICELIB Version 4.0.1, 18-MAR-1999 (WLT) */
885
886 /* The environment lines were expanded so that the supported */
887 /* environments are now explicitly given. Previously, */
888 /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
889 /* by the environment label SUN. */
890
891 /* - SPICELIB Version 2.0.1, 10-MAR-1992 (WLT) */
892
893 /* Comment section for permuted index source lines was added */
894 /* following the header. */
895
896 /* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
897
898 /* All occurrences of "PRINT *" have been replaced by */
899 /* "WRITE (*,*)". */
900
901 /* Also, this routine now closes the device named by DEVICE */
902 /* whether or not the device was opened by WRLINE. */
903
904 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */
905
906 /* -& */
907 /* $ Index_Entries */
908
909 /* None. */
910
911 /* -& */
912 /* $ Revisions */
913
914 /* - SPICELIB Version 2.0.0, 26-MAR-1991 (NJB) */
915
916 /* All instances if "PRINT *" have been replaced by "WRITE (*,*)" */
917 /* because Language Systems Fortran on the Macintosh interprets */
918 /* "PRINT *" in a non-standard manner. */
919
920 /* This routine no longer has to maintain the file database, since */
921 /* WRLINE does not use it any more. */
922
923 /* Also, this routine now closes the device named by DEVICE, */
924 /* whether or not the device was opened by WRLINE. */
925
926 /* - Beta Version 1.0.1, 08-NOV-1988 (NJB) */
927
928 /* Keywords added. */
929 /* -& */
930
931 /* Find the unit connected to DEVICE. */
932
933 i__1 = ltrim_(device, device_len) - 1;
934 ioin__1.inerr = 1;
935 ioin__1.infilen = device_len - i__1;
936 ioin__1.infile = device + i__1;
937 ioin__1.inex = 0;
938 ioin__1.inopen = 0;
939 ioin__1.innum = &unit;
940 ioin__1.innamed = 0;
941 ioin__1.inname = 0;
942 ioin__1.inacc = 0;
943 ioin__1.inseq = 0;
944 ioin__1.indir = 0;
945 ioin__1.infmt = 0;
946 ioin__1.inform = 0;
947 ioin__1.inunf = 0;
948 ioin__1.inrecl = 0;
949 ioin__1.innrec = 0;
950 ioin__1.inblank = 0;
951 iostat = f_inqu(&ioin__1);
952 if (iostat != 0) {
953
954 /* This is weird. How can an INQUIRE statement fail, */
955 /* if the syntax is correct? But just in case... */
956
957 s_wsle(&io___17);
958 do_lio(&c__9, &c__1, "SPICE(INQUIREFAILED)", (ftnlen)20);
959 e_wsle();
960 s_wsle(&io___18);
961 do_lio(&c__9, &c__1, "CLLINE: File = ", (ftnlen)16);
962 do_lio(&c__9, &c__1, device, device_len);
963 do_lio(&c__9, &c__1, "IOSTAT = ", (ftnlen)9);
964 do_lio(&c__3, &c__1, (char *)&iostat, (ftnlen)sizeof(integer));
965 e_wsle();
966 return 0;
967 }
968 cl__1.cerr = 0;
969 cl__1.cunit = unit;
970 cl__1.csta = 0;
971 f_clos(&cl__1);
972 return 0;
973 } /* wrline_ */
974
wrline_(char * device,char * line,ftnlen device_len,ftnlen line_len)975 /* Subroutine */ int wrline_(char *device, char *line, ftnlen device_len,
976 ftnlen line_len)
977 {
978 return wrline_0_(0, device, line, device_len, line_len);
979 }
980
clline_(char * device,ftnlen device_len)981 /* Subroutine */ int clline_(char *device, ftnlen device_len)
982 {
983 return wrline_0_(1, device, (char *)0, device_len, (ftnint)0);
984 }
985
986