1 /*
2 ccp4_diskio_f.c FORTRAN API for file i/o.
3 Copyright (C) 2002 CCLRC, Charles Ballard and Martyn Winn
4
5 This library is free software: you can redistribute it and/or
6 modify it under the terms of the GNU Lesser General Public License
7 version 3, modified in accordance with the provisions of the
8 license to address the requirements of UK law.
9
10 You should have received a copy of the modified GNU Lesser General
11 Public License along with this library. If not, copies may be
12 downloaded from http://www.ccp4.ac.uk/ccp4license.php
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU Lesser General Public License for more details.
18 */
19
20 /** @page diskio_f_page Fortran API for low level input/output.
21 *
22 * @section diskio_f_file_list File list
23
24 <ul>
25 <li>ccp4_diskio_f.c
26 </ul>
27
28 * @section diskio_f_overview Overview
29
30 This library consists of a set of wrappers to C functions which
31 perform random access input/output (I/O) on various data items, including
32 bytes, to stream-mode files.
33
34 */
35
36 /** @file ccp4_diskio_f.c
37 * FORTRAN API for file i/o.
38 * Charles Ballard and Martyn Winn
39 */
40
41 /* FORTRAN API for library.c
42 *
43 * revisions:
44 * (4/5/01) C.Ballard
45 * respond to first steps to make library.c
46 * more "C" like.
47 * (21/8/01) C.Ballard
48 * error catching from library.c
49 *
50 *
51 * Portability and Code
52 *
53 * System dependent names are handled in the FORTRAN_SUBR,
54 * FORTRAN_FUN, FORTRAN_CALL macros defined in the header file.
55 * fpstr is a typedef which masks the intricacies of FORTRAN string
56 * passing.
57 */
58
59 #include <string.h>
60 #include "ccp4_utils.h"
61 #include "ccp4_errno.h"
62 #include "ccp4_fortran.h"
63 #include "ccp4_file_err.h"
64 /* rcsid[] = "$Id$" */
65
66
67 /**
68 * _ioChannels:
69 * structure to hold files
70 */
71 typedef struct _CCP4IObj CCP4IObj;
72
73 enum FILE_KLASS {NONE,CCP4_FILE,CCP4_MAP};
74
75 struct _CCP4IObj {
76 enum FILE_KLASS klass;
77 CCP4File *iobj;
78 };
79
80 static CCP4IObj *_ioChannels[MAXFILES];
81
_get_channel()82 int _get_channel()
83 {
84 int i;
85 for ( i = 1; i < MAXFILES ; i++)
86 if (!_ioChannels[i]) return i;
87 return -1;
88 }
89
_iobj_init()90 CCP4IObj *_iobj_init()
91 {
92 return (CCP4IObj *) malloc(sizeof(CCP4IObj));
93 }
94
95 static int file_attribute[] = { /* DISKIO file modes */
96 O_RDWR | O_TRUNC, /* 'UNKNOWN' open as 'OLD'/'NEW' check existence */
97 O_TMP | O_RDWR | O_TRUNC, /* 'SCRATCH' open as 'OLD' and delete on closing */
98 O_RDWR, /* 'OLD' file MUST exist or program halts */
99 O_RDWR | O_TRUNC, /* 'NEW' create (overwrite) new file */
100 O_RDONLY /* 'READONLY' self explanatory */
101 };
102
103 FORTRAN_SUBR ( QOPEN, qopen,
104 (int *iunit, fpstr lognam, fpstr atbuta, int lognam_len, int atbuta_len),
105 (int *iunit, fpstr lognam, fpstr atbuta),
106 (int *iunit, fpstr lognam, int lognam_len, fpstr atbuta, int atbuta_len))
107 {
108 char *atbut2, *temp_lognam, *fname;
109 int istat;
110
111 atbut2 = ccp4_FtoCString(FTN_STR(atbuta), FTN_LEN(atbuta));
112
113 switch (atbut2[0]) {
114 case 'U':
115 case 'u':
116 istat = 0;
117 break;
118 case 'S':
119 case 's':
120 istat = 1;
121 break;
122 case 'O':
123 case 'o':
124 istat = 2;
125 break;
126 case 'N':
127 case 'n':
128 istat = 3;
129 #ifndef _MSC_VER
130 if (strcasecmp(getenv("CCP4_OPEN"),"UNKNOWN"))
131 #else
132 if (_stricmp(getenv("CCP4_OPEN"),"UNKNOWN"))
133 #endif
134 istat = 0;
135 break;
136 case 'R':
137 case 'r':
138 istat = 4;
139 break;
140 default:
141 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_BadMode),
142 "QOPEN", NULL);
143 }
144 if (atbut2) free(atbut2);
145
146 if ((*iunit = _get_channel()) == -1)
147 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_MaxFile),
148 "COPEN1", NULL);
149
150 _ioChannels[*iunit] = _iobj_init();
151
152 temp_lognam = ccp4_FtoCString(FTN_STR(lognam), FTN_LEN(lognam));
153 if (!(fname = getenv(temp_lognam)))
154 fname = temp_lognam;
155
156 if (!(_ioChannels[*iunit]->iobj = ccp4_file_open (fname,
157 file_attribute[istat]) ) ) {
158 printf(" Can't open file %s\n",fname);
159 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_CantOpenFile),
160 "COPEN2", NULL);
161 }
162
163 _ioChannels[*iunit]->klass = CCP4_FILE;
164
165 if(temp_lognam) free(temp_lognam);
166 }
167
168 FORTRAN_SUBR ( QQOPEN, qqopen,
169 (int *iunit, fpstr lognam, const int *istat, int lognam_len),
170 (int *iunit, fpstr lognam, const int *istat),
171 (int *iunit, fpstr lognam, int lognam_len, const int *istat))
172 {
173 char *fname, *temp_lognam;
174 int jstat;
175 temp_lognam = ccp4_FtoCString(FTN_STR(lognam), FTN_LEN(lognam));
176
177 if (*istat < 1 || *istat > 5)
178 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_BadMode),
179 "QQOPEN (mode)", NULL);
180
181 jstat = *istat;
182
183 if (jstat == 4)
184 #ifndef _MSC_VER
185 if (strcasecmp(getenv("CCP4_OPEN"),"UNKNOWN"))
186 #else
187 if (_stricmp(getenv("CCP4_OPEN"),"UNKNOWN"))
188 #endif
189 jstat = 1;
190
191 if (!(fname = getenv(temp_lognam)))
192 fname = temp_lognam;
193
194 if ((*iunit = _get_channel()) == -1)
195 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_MaxFile),
196 "QQOPEN", NULL);
197
198 _ioChannels[*iunit] = _iobj_init();
199
200 if (!(_ioChannels[*iunit]->iobj = ccp4_file_open (fname,
201 file_attribute[jstat-1]) ) )
202 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_MaxFile),
203 "QQOPEN", NULL);
204
205 _ioChannels[*iunit]->klass = CCP4_FILE;
206
207 if(temp_lognam) free(temp_lognam);
208 }
209
210 /**
211 * Opens filename on io stream iunit. istat corresponds to the open mode.
212 * @param iunit iochannel number
213 * @param filename fortran character array giving filename
214 * @param istat file mode
215 */
216 FORTRAN_SUBR ( COPEN, copen,
217 (int *iunit, fpstr filename, int *istat, int filename_len),
218 (int *iunit, fpstr filename, int *istat),
219 (int *iunit, fpstr filename, int filename_len, int *istat))
220 {
221 char *tempfile;
222
223 tempfile = ccp4_FtoCString(FTN_STR(filename), FTN_LEN(filename));
224
225 if ((*iunit = _get_channel()) == -1)
226 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_MaxFile),
227 "COPEN", NULL);
228
229 _ioChannels[*iunit] = _iobj_init();
230
231 if (!(_ioChannels[*iunit]->iobj = ccp4_file_open (tempfile,
232 file_attribute[*istat-1]) ) )
233 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_MaxFile),
234 "COPEN", NULL);
235
236 _ioChannels[*iunit]->klass = CCP4_FILE;
237
238 free(tempfile);
239 }
240
241 /**
242 * qrarch:
243 * @iunit: iochannel
244 * @ipos: position in file
245 * @ireslt: return value
246 *
247 * For binary files with a well-determined structure in terms of
248 * [[float]]s and [[int]]s we may want to set up the connected stream to
249 * do transparent reading of files written on a machine with a different
250 * architecture. This is currently the case for map files and
251 * MTZ files and this routine is called from mtzlib and maplib.
252 *
253 * qrarch reads the machine stamp at word ipos
254 * for the diskio file on stream iunit and sets up the appropriate
255 * bit-twiddling for subsequent qreads on that stream. The
256 * information read from the file is returned in \meta{ireslt} in the
257 * form fileFT+16fileIT. If the stamp is zero
258 * (as it would be for files written with a previous version of the
259 * library) we assume the file is in native format and needs no
260 * conversion in qread; in this case ireslt will be zero and
261 * the caller can issue a warning. Iconvert and Fconvert are
262 * used by qread to determine the type of conversion (if any) to be
263 * applied to integers and reals.
264 *
265 * Fudge:fudge Ian Tickle reports old VAX files which have a machine
266 * stamp which is byte-flipped from the correct VAX value,although it should
267 * always have been zero as far as I can see. To accommodate this, set the
268 * logical NATIVEMTZ and the machine stamp won't be read for any
269 * input files for which qrarch is called.
270 *
271 * Extra feature: logical/environment variable CONVERT_FROM may be set
272 * to one of BEIEEE, LEIEEE, VAX or CONVEXNATIVE to avoid
273 * reading the machine stamp and assume the file is from the stipulated
274 * archictecture for all input MTZ and map files for which qrarch is
275 * called.
276 *
277 * N.B.: leaves the stream positioned just after the machine stamp.
278 *
279 */
280 FORTRAN_SUBR ( QRARCH, qrarch,
281 (int *iunit, int *ipos, int *ireslt),
282 (int *iunit, int *ipos, int *ireslt),
283 (int *iunit, int *ipos, int *ireslt))
284 {
285 if (ccp4_file_setstamp(_ioChannels[*iunit]->iobj, *ipos))
286 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_BadMode),
287 "QRARCH", NULL);
288 if ((*ireslt = ccp4_file_rarch (_ioChannels[*iunit]->iobj)) == -1)
289 ccp4_signal(CCP4_ERRLEVEL(4), "QRARCH", NULL);
290 }
291
292 /**
293 * qwarch
294 * @iunit: io channel
295 * @ipos: position
296 *
297 * This is the complement of qrarch, writing the native machine
298 * architecture information machine stamp to diskio stream
299 * iunit at word ipos. Currently called from mtzlib and maplib.
300 *
301 * The machine stamp in mtstring is four nibbles in order, indicating
302 * complex and real format (must both be the same), integer format and
303 * character format (currently irrelevant). The last two bytes of
304 * mtstring are currently unused and always zero.
305 *
306 * N.B.: leaves the stream positioned just after the machine stamp.
307 *
308 */
309 FORTRAN_SUBR ( QWARCH, qwarch,
310 (int *iunit, int *ipos),
311 (int *iunit, int *ipos),
312 (int *iunit, int *ipos))
313 {
314 if (ccp4_file_setstamp(_ioChannels[*iunit]->iobj, *ipos))
315 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_BadMode),
316 "QWARCH", NULL);
317 if (ccp4_file_warch (_ioChannels[*iunit]->iobj) == -1)
318 ccp4_signal(CCP4_ERRLEVEL(4), "QWARCH", NULL);
319 }
320
321 /**
322 * qclose:
323 * @iunit: io channel
324 *
325 * Closes the file open on diskio stream iunit
326 */
327 FORTRAN_SUBR ( QCLOSE, qclose,
328 (int *iunit),
329 (int *iunit),
330 (int *iunit))
331 {
332 if (ccp4_file_close (_ioChannels[*iunit]->iobj))
333 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_CloseFail),
334 "QCLOSE", NULL);
335 free(_ioChannels[*iunit]);
336 _ioChannels[*iunit]=NULL;
337 }
338
339 /**
340 * qmode:
341 * @iunit: io channel
342 * @mode: access mode
343 * @size: item size
344 *
345 * Changes the diskio access mode for stream @iunit to
346 * @mode. The resulting size in bytes of items for transfer is
347 * returned as @size
348 *
349 */
350 FORTRAN_SUBR ( QMODE, qmode,
351 (int *iunit, int *mode, int *size),
352 (int *iunit, int *mode, int *size),
353 (int *iunit, int *mode, int *size))
354 {
355 if ( (*size = ccp4_file_itemsize(_ioChannels[*iunit]->iobj)) == -1 ||
356 ccp4_file_setmode(_ioChannels[*iunit]->iobj,*mode) == -1)
357 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_BadMode),
358 "QMODE", NULL);
359 }
360
361 /**
362 * qread:
363 * @iunit: io channel
364 * @buffer:
365 * @nitems: number of items
366 * @result: return value
367 *
368 * Reads @nitems in the current mode qmode() from diskio
369 * stream @iunit previously opened by qopen() and
370 * returns @result which is %0 on success or %-1 at EOF.
371 * It aborts on an i/o error.
372 * Numbers written in a foreign format will be translated if necessary if
373 * the stream is connected to an MTZ or map file.
374 *
375 */
376 FORTRAN_SUBR ( QREAD, qread,
377 (int *iunit, uint8 *buffer, int *nitems, int *result),
378 (int *iunit, uint8 *buffer, int *nitems, int *result),
379 (int *iunit, uint8 *buffer, int *nitems, int *result))
380 {
381 *result = 0;
382 if ( ccp4_file_read (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems){
383 if ( ccp4_file_feof(_ioChannels[*iunit]->iobj) )
384 *result = -1;
385 else
386 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
387 "QREAD", NULL);
388 }
389 }
390
391 /**
392 * qreadi:
393 * @iunit: io channel
394 * @buffer:
395 * @result:
396 *
397 * Fills INT buffer in int mode from diskio stream
398 * @iunit previously opened by qopen() and returns
399 * @result} which %0 on success or %-1 on EOF.
400 * It aborts on an i/o failure.
401 * Call it with a character substring if necessary to control the number
402 * of bytes read.
403 *
404 */
405 FORTRAN_SUBR ( QREADI, qreadi,
406 (int *iunit, uint8* buffer, int *nitems, int *result),
407 (int *iunit, uint8* buffer, int *nitems, int *result),
408 (int *iunit, uint8* buffer, int *nitems, int *result))
409 {
410 *result = 0;
411 if ( ccp4_file_readint (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems) {
412 if ( ccp4_file_feof(_ioChannels[*iunit]->iobj) )
413 *result = -1;
414 else
415 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
416 "QREADI", NULL);
417 }
418 }
419
420 /**
421 * qreadi2:
422 * @iunit: io channel
423 * @buffer:
424 * @result:
425 *
426 * Fills INT*2 buffer in int mode from diskio stream
427 * @iunit previously opened by qopen() and returns
428 * @result} which %0 on success or %-1 on EOF.
429 * It aborts on an i/o failure.
430 * Call it with a character substring if necessary to control the number
431 * of bytes read.
432 *
433 */
434 FORTRAN_SUBR ( QREADI2, qreadi2,
435 (int *iunit, uint8* buffer, int *nitems, int *result),
436 (int *iunit, uint8* buffer, int *nitems, int *result),
437 (int *iunit, uint8* buffer, int *nitems, int *result))
438 {
439 *result = 0;
440 if ( ccp4_file_readshort (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems) {
441 if ( ccp4_file_feof(_ioChannels[*iunit]->iobj) )
442 *result = -1;
443 else
444 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
445 "QREADI2", NULL);
446 }
447 }
448
449 /**
450 * qreadr:
451 * @iunit:
452 * @buffer:
453 * @result:
454 *
455 * Fills REAL] buffer in int mode from diskio stream
456 * @iunit previously opened by qopen() and returns
457 * @result which 0 on success or -1 on EOF.
458 * It aborts on an i/o failure.
459 * Call it with a character substring if necessary to control the number
460 * of bytes read.
461 *
462 */
463 FORTRAN_SUBR ( QREADR, qreadr,
464 (int *iunit, uint8* buffer, int *nitems, int *result),
465 (int *iunit, uint8* buffer, int *nitems, int *result),
466 (int *iunit, uint8* buffer, int *nitems, int *result))
467 {
468 *result = 0;
469 if ( ccp4_file_readfloat (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems) {
470 if ( ccp4_file_feof(_ioChannels[*iunit]->iobj) )
471 *result = -1;
472 else
473 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
474 "QREADR", NULL);
475 }
476 }
477
478 /**
479 * qreadq:
480 * @iunit:
481 * @buffer:
482 * i@result:
483 *
484 * Fills COMPLEX buffer in int mode from diskio stream
485 * @iunit previously opened by qopen() and returns
486 * @result which 0 on success or -1 on EOF.
487 * It aborts on an i/o failure.
488 * Call it with a character substring if necessary to control the number
489 * of bytes read.
490 *
491 */
492 FORTRAN_SUBR ( QREADQ, qreadq,
493 (int *iunit, uint8* buffer, int *nitems, int *result),
494 (int *iunit, uint8* buffer, int *nitems, int *result),
495 (int *iunit, uint8* buffer, int *nitems, int *result))
496 {
497 *result = 0;
498 if ( ccp4_file_readcomp (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems) {
499 if ( ccp4_file_feof(_ioChannels[*iunit]->iobj) )
500 *result = -1;
501 else
502 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
503 "QREADQ", NULL);
504 }
505 }
506
507 /**
508 * qreadc::
509 * @iunit:
510 * @buffer:
511 * @result:
512 *
513 * Fills CHARACTER buffer in byte mode from diskio stream
514 * @iunit previously opened by qopen() and returns
515 * @result which is 0 on success or -1 on EOF.
516 * It aborts on an i/o failure.
517 * Call it with a character substring if necessary to control the number
518 * of bytes read.
519 *
520 */
521 FORTRAN_SUBR ( QREADC, qreadc,
522 (int *iunit, fpstr buffer, int *result, int buffer_len),
523 (int *iunit, fpstr buffer, int *result),
524 (int *iunit, fpstr buffer, int buffer_len, int *result))
525 {
526 int n;
527
528 n = FTN_LEN(buffer);
529
530 if (ccp4_file_readchar (_ioChannels[*iunit]->iobj, (uint8 *) FTN_STR(buffer), (size_t) n) != n)
531 ccp4_signal(CCP4_ERRLEVEL(4) | CCP4_ERRNO(CIO_ReadFail),
532 "QREADC", NULL);
533 *result = 0;
534 }
535
536 /**
537 * qwrite:
538 * @iunit:
539 * @buffer:
540 * @meta:
541 *
542 * This write @nitems items from @buffer to qopen()
543 * stream \meta{iunit} using the current mode.
544 *
545 */
546 FORTRAN_SUBR ( QWRITE, qwrite,
547 (int *iunit, uint8 * buffer, int *nitems),
548 (int *iunit, uint8 * buffer, int *nitems),
549 (int *iunit, uint8 * buffer, int *nitems))
550 {
551 if ( ccp4_file_write (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems)
552 ccp4_signal(CCP4_ERRLEVEL(4), "QWRITE", NULL);
553 }
554
555 /**
556 * qwriti:
557 * @iunit:
558 * @buffer:
559 * @nitems:
560 *
561 * This write @nitems items from @buffer to qopen()
562 * stream @iunit using the INT32 mode.
563 *
564 */
565 FORTRAN_SUBR ( QWRITI, qwriti,
566 (int *iunit, uint8 * buffer, int *nitems),
567 (int *iunit, uint8 * buffer, int *nitems),
568 (int *iunit, uint8 * buffer, int *nitems))
569 {
570 if ( ccp4_file_writeint (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems)
571 ccp4_signal(CCP4_ERRLEVEL(4), "QWRITI", NULL);
572 }
573
574 /**
575 * qwritr:
576 * @iunit:
577 * @buffer:
578 * @nitems:
579 *
580 * This write @nitems items from @buffer to qopen()
581 * stream @iunit using the FLOAT32 mode.
582 *
583 */
584 FORTRAN_SUBR ( QWRITR, qwritr,
585 (int *iunit, uint8 * buffer, int *nitems),
586 (int *iunit, uint8 * buffer, int *nitems),
587 (int *iunit, uint8 * buffer, int *nitems))
588 {
589 if ( ccp4_file_writefloat (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems)
590 ccp4_signal(CCP4_ERRLEVEL(4), "QWRITR", NULL);
591 }
592
593 /**
594 * qwrite:
595 * @iunit:
596 * @buffer:
597 * @nitems:
598 *
599 * This write @nitems items from @buffer to qopen()
600 * stream @iunit using the COMP64 mode.
601 *
602 */
603 FORTRAN_SUBR ( QWRITQ, qwritq,
604 (int *iunit, uint8 * buffer, int *nitems),
605 (int *iunit, uint8 * buffer, int *nitems),
606 (int *iunit, uint8 * buffer, int *nitems))
607 {
608 if ( ccp4_file_writecomp (_ioChannels[*iunit]->iobj, buffer, *nitems) != *nitems)
609 ccp4_signal(CCP4_ERRLEVEL(4), "QWRITQ", NULL);
610 }
611
612 /* \subsection{{\tt subroutine qwritc (\meta{iunit}, \meta{buffer})}} */
613 /* */
614 /* Writes [[CHARACTER*(*)]] \meta{buffer} to [[qopen]]ed */
615 /* stream \meta{iunit} in byte mode. */
616 /* */
617 /* <diskio routines>= */
618 FORTRAN_SUBR ( QWRITC, qwritc,
619 (int *iunit, fpstr buffer, int buffer_len),
620 (int *iunit, fpstr buffer),
621 (int *iunit, fpstr buffer, int buffer_len))
622 {
623 int n;
624
625 n = FTN_LEN(buffer);
626
627 if (ccp4_file_writechar (_ioChannels[*iunit]->iobj, (uint8 *) FTN_STR(buffer),
628 (size_t) n) != n)
629 ccp4_signal(CCP4_ERRLEVEL(4), "WWRITC", NULL);
630 }
631
632 /**
633 * qseek:
634 * @iunit:
635 * @irec:
636 * @iel:
637 * @lrecl:
638 *
639 * Seeks to element @iel in record @irec in diskio stream
640 * @iunit whose record length is @lrecl.
641 *
642 */
643 FORTRAN_SUBR ( QSEEK, qseek,
644 (int *iunit, int *irec, int *iel, int *lrecl),
645 (int *iunit, int *irec, int *iel, int *lrecl),
646 (int *iunit, int *irec, int *iel, int *lrecl))
647 {
648 /*switch from FORTRAN offset to C offset */
649 if (ccp4_file_seek (_ioChannels[*iunit]->iobj, (*irec-1)*(*lrecl)+(*iel-1),SEEK_SET) )
650 ccp4_signal(CCP4_ERRLEVEL(4), "QSEEK", NULL);
651 }
652
653 /**
654 * qback:
655 * @iunit:
656 * @lrecl:
657 *
658 * Backspaces one record, of length @lrecl on diskio stream @iunit.
659 *
660 */
661 FORTRAN_SUBR ( QBACK, qback,
662 (int *iunit, int *lrecl),
663 (int *iunit, int *lrecl),
664 (int *iunit, int *lrecl))
665 {
666 if (ccp4_file_seek (_ioChannels[*iunit]->iobj, -(*lrecl), SEEK_CUR) )
667 ccp4_signal(CCP4_ERRLEVEL(4), "QBACK", NULL);
668 }
669
670 /**
671 * qskip:
672 * @iunit:
673 * @lrecl:
674 *
675 * Skip forward 1 record of length @lrecl on diskio stream @iunit.
676 *
677 */
678 FORTRAN_SUBR ( QSKIP, qskip,
679 (int *iunit, int *lrecl),
680 (int *iunit, int *lrecl),
681 (int *iunit, int *lrecl))
682 {
683 if (ccp4_file_seek (_ioChannels[*iunit]->iobj, *lrecl, SEEK_CUR) )
684 ccp4_signal(CCP4_ERRLEVEL(4), "QSKIP", NULL);
685 }
686
687 /**
688 * qqinq:
689 * @istrm:
690 * @filnam:
691 * @length:
692 *
693 * Returns the name @filnam and @length of the file (if any)
694 * open on diskio stream @istrm.
695 *
696 */
697 FORTRAN_SUBR ( QQINQ, qqinq,
698 (int *istrm, fpstr logname, fpstr filename, int *length,
699 int logname_len, int filename_len),
700 (int *istrm, fpstr logname, fpstr filename, int *length),
701 (int *istrm, fpstr logname, int logname_len, fpstr filename,
702 int filename_len, int *length))
703 {
704 char *log_name = NULL, *file_name;
705
706 if ( *istrm < 1 || *istrm >= MAXFILES || !_ioChannels[*istrm]->iobj) {
707 *length = -1;
708 if (!(log_name = ccp4_FtoCString(FTN_STR(logname),
709 FTN_LEN(logname))))
710 log_name = strdup("diskio.dft");
711 if (!(file_name = getenv(log_name)))
712 file_name = log_name;
713 for ( *istrm = 1; *istrm != MAXFILES; (*istrm)++)
714 if (!strcmp(file_name,_ioChannels[*istrm]->iobj->name)) break;
715 }
716 if (*istrm != MAXFILES) {
717 *length = ccp4_file_length(_ioChannels[*istrm]->iobj);
718 strncpy(FTN_STR(filename), _ioChannels[*istrm]->iobj->name,
719 MIN(strlen(_ioChannels[*istrm]->iobj->name),
720 FTN_LEN(filename))); }
721
722 if ( *length == -1)
723 ccp4_signal(CCP4_ERRLEVEL(3) | CCP4_ERRNO(CIO_SeekFail),
724 "QINQ", NULL);
725 if (log_name != NULL) free(log_name);
726 }
727
728 /**
729 * qlocate:
730 * @iunit:
731 * @locate:
732 *
733 * Returns the current position \meta{locate} in the diskio stream @iunit.
734 *
735 */
736 FORTRAN_SUBR ( QLOCATE, qlocate,
737 (int *iunit, int *locate),
738 (int *iunit, int *locate),
739 (int *iunit, int *locate))
740 {
741 if ( (*locate = (int) ccp4_file_tell (_ioChannels[*iunit]->iobj) )
742 == -1)
743 ccp4_signal(CCP4_ERRLEVEL(3) | CCP4_ERRNO(CIO_SeekFail),
744 "QLOCATE", NULL);
745 }
746
747