1 /**
2 * Copyright 1981-2016 ECMWF.
3 *
4 * This software is licensed under the terms of the Apache Licence
5 * Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
6 *
7 * In applying this licence, ECMWF does not waive the privileges and immunities
8 * granted to it by virtue of its status as an intergovernmental organisation
9 * nor does it submit to any jurisdiction.
10 */
11
12 /*
13 newpbio.c
14 */
15 #include "bufrgrib.h"
16 #include "fort2c.h"
17 #include "common/fortint.h"
18
19 #include <sys/types.h>
20 #include <sys/stat.h>
21 #include <fcntl.h>
22
23 #ifndef CRAY
24 #ifdef FORTRAN_NO_UNDERSCORE
25 #define PBOPEN3 pbopen3
26 #define PBREAD3 pbread3
27 #define PBWRITE3 pbwrite3
28 #define PBSEEK3 pbseek3
29 #define PBCLOSE3 pbclose3
30 #else
31 #define PBOPEN3 pbopen3_
32 #define PBREAD3 pbread3_
33 #define PBWRITE3 pbwrite3_
34 #define PBSEEK3 pbseek3_
35 #define PBCLOSE3 pbclose3_
36 #endif
37 #endif
38
39 #define NAMEBUFFLEN 256
40 #define MODEBUFFLEN 10
41
42 /*************************************************************************
43 * FUNCTION: pbopen - Open file (from FORTRAN)
44 **************************************************************************
45 */
46 void PBOPEN(FILE ** unit, _fcd name, _fcd mode, fortint * iret,
47 if defined hpR64 || defined hpiaR64
48 long l1, long l2
49 #else
50 fortint l1, fortint l2
51 #endif
52 )
53 /*
54 * Purpose: Opens file, return UNIX FILE pointer.
55 *
56 * Function returns: iret: -1 = Could not open file.
57 * -2 = Invalid file name.
58 * -3 = Invalid open mode specified
59 * 0 = OK.
60 *
61 * Note: l1 and l2 are the lengths of the character strings in
62 * name and mode on SGI.
63 */
64 {
65 char *fname;
66 char *modes;
67 char *p;
68 char flags[4];
69
70 #if (!defined CRAY) && (!defined VAX)
71 char namebuff[NAMEBUFFLEN], modebuff[MODEBUFFLEN];
72
73 /* Put the character strings into buffers and ensure that there is a
74 null terminator (for SGI case when FORTRAN CHARACTER variable is full
75 right to end with characters */
76 strncpy( namebuff, name, NAMEBUFFLEN - 1);
77 strncpy( modebuff, mode, MODEBUFFLEN - 1);
78 namebuff[l1] = '\0';
79 modebuff[l2] = '\0';
80 #endif
81
82 strcpy(flags,"");
83
84 *unit = NULL;
85 *iret = 0;
86
87 /* convert fortran to c string : file name */
88
89 #if (!defined CRAY) && (!defined VAX)
90 if(!(fname = fcd2char(namebuff)))
91 #else
92 if(!(fname = fcd2char(name)))
93 #endif
94 {
95 *iret = -2;
96 return;
97 }
98
99 /* strip trailing blanks */
100
101 p = fname + strlen(fname) - 1 ;
102 while(*p == ' ')
103 {
104 *p = 0;
105 p--;
106 }
107
108 /* convert fortran to c string : open modes */
109
110 #if (!defined CRAY) && (!defined VAX)
111 if(!(modes = fcd2char(modebuff)))
112 #else
113 if(!(modes = fcd2char(mode)))
114 #endif
115 {
116 free(fname);
117 *iret = -2;
118 return;
119 }
120
121
122 /* build open flags from "modes" */
123
124 p = modes;
125 while(*p && ( strlen(flags) < 3 ) )
126 {
127 switch(*p)
128 {
129 case '+': strcat(flags, "+");
130 break;
131
132 case 'a':
133 case 'A': strcat(flags, "a");
134 break;
135
136 case 'c':
137 case 'C':
138 case 'w':
139 case 'W': strcat(flags, "w");
140 break;
141
142 case 'r':
143 case 'R': strcat(flags, "r");
144 break;
145
146 default: *iret = -3;
147 return;
148
149 }
150 p++;
151 }
152
153 /* if read/write change flags */
154
155 if ( !strcmp(flags,"wr") || !strcmp(flags, "rw") )
156 strcpy(flags, "r+w" );
157
158 *unit = fopen(fname, flags );
159
160 if(*unit == NULL)
161 {
162 perror(fname);
163 perror("pbopen");
164 *iret = -1;
165 }
166
167
168 free(fname);
169 free(modes);
170
171 }
172
173 /*************************************************************************
174 * FUNCTION: pbseek - Seek (from FORTRAN)
175 **************************************************************************
176 */
PBSEEK(FILE ** unit,fortint * offset,fortint * whence,fortint * iret)177 void PBSEEK(FILE ** unit, fortint * offset, fortint * whence, fortint * iret)
178 /*
179 *
180 * Purpose: Seeks to specified location in file.
181 *
182 * Function returns: status : -2 = error in handling file,
183 * -1 = end-of-file
184 * otherwise, = byte offset from start of file.
185 *
186 * whence = 0, from start of file
187 * = 1, from current position
188 * = 2, from end of file.
189 */
190 {
191 int my_offset = (int) *offset;
192 int my_whence = (int) *whence;
193 int my_iret;
194
195 if ( my_whence == 2) my_offset = - abs(my_offset);
196 /* must use negative offset if working
197 from end-of-file */
198
199 my_iret = fseek(*unit, my_offset, my_whence);
200
201 if(my_iret != 0)
202 {
203 if ( ! feof(*unit) )
204 {
205 my_iret = -2; /* error in file-handling */
206 perror("pbseek");
207 }
208 else
209 my_iret = -1; /* end-of-file */
210
211 clearerr(*unit);
212 *iret = (fortint) my_iret;
213 return;
214 }
215
216 my_iret = ftell(*unit); /* byte offset from start of file */
217 *iret = (fortint) my_iret;
218 return;
219
220 }
221
222
223 /*************************************************************************
224 * FUNCTION: pbread - Read (from FORTRAN)
225 **************************************************************************
226 */
PBREAD(FILE ** unit,char * buffer,fortint * nbytes,fortint * iret)227 void PBREAD(FILE ** unit, char * buffer, fortint * nbytes, fortint * iret)
228 /*
229 *
230 * Purpose: Reads a block of bytes from a file.
231 *
232 * Function returns: status : -2 = error in reading file,
233 * -1 = end-of-file,
234 * otherwise, = number of bytes read.
235 */
236 {
237 int my_nbytes = (int) *nbytes;
238 int my_iret;
239
240 if ( (my_iret = fread(buffer, 1, my_nbytes, *unit) ) != my_nbytes)
241 {
242 /* Read problem */
243 if ( ! feof(*unit) )
244 {
245 my_iret = -2; /* error in file-handling */
246 perror("pbread");
247 clearerr(*unit);
248 }
249 else
250 {
251 my_iret = -1; /* end-of-file */
252 clearerr(*unit);
253 }
254 }
255 *iret = my_iret;
256 return;
257
258 }
259
260
261 /*************************************************************************
262 * FUNCTION: pbread2 - Read (from FORTRAN)
263 **************************************************************************
264 */
PBREAD2(FILE ** unit,char * buffer,fortint * nbytes,fortint * iret)265 void PBREAD2(FILE ** unit, char * buffer, fortint * nbytes, fortint * iret)
266 /*
267 *
268 * Purpose: Reads a block of bytes from a file.
269 *
270 * Function returns: status : -2 = error in reading file,
271 * otherwise, = number of bytes read.
272 */
273 {
274 int my_nbytes = (int) *nbytes;
275 int my_iret;
276
277 if ( (my_iret = fread(buffer, 1, my_nbytes, *unit) ) != my_nbytes)
278 {
279 /* Read problem */
280 if ( ! feof(*unit) )
281 {
282 my_iret = -2; /* error in file-handling */
283 perror("pbread");
284 clearerr(*unit);
285 }
286 }
287 *iret = my_iret;
288 return;
289
290 }
291
292 /*************************************************************************
293 * FUNCTION: pbwrite - Write (from FORTRAN)
294 **************************************************************************
295 */
PBWRITE(FILE ** unit,char * buffer,fortint * nbytes,fortint * iret)296 void PBWRITE( FILE ** unit, char * buffer, fortint * nbytes, fortint *iret)
297 /*
298 * Purpose: Writes a block of bytes to a file.
299 *
300 * Function returns: status : -1 = Could not write to file.
301 * >=0 = Number of bytes written.
302 */
303 {
304 int my_nbytes = (int) *nbytes;
305 int my_iret;
306
307 if ( (my_iret = fwrite(buffer, 1, my_nbytes, *unit) ) != my_nbytes)
308 {
309 /* Problem with write */
310 perror("pbwrite");
311 my_iret = -1;
312 }
313 *iret = my_iret;
314 return;
315
316 }
317
318
319
320 /*************************************************************************
321 * FUNCTION: pbclose - close (from FORTRAN)
322 **************************************************************************
323 */
PBCLOSE(FILE ** unit,fortint * iret)324 void PBCLOSE( FILE ** unit, fortint * iret)
325 /*
326 *
327 * Purpose: Closes file.
328 *
329 * Function returns: status : non-0 = error in handling file.
330 * 0 = OK.
331 */
332 {
333 int my_iret;
334
335 my_iret = fclose(*unit);
336
337 if(my_iret != 0) perror("pbclose");
338 *iret = my_iret;
339 return;
340
341 }
342
343
344 /*************************************************************************
345 * FUNCTION: pbflush - flush (from FORTRAN)
346 **************************************************************************
347 */
PBFLUSH(FILE ** unit)348 void PBFLUSH( FILE ** unit)
349 /*
350 *
351 * Purpose: Flushes file.
352 *
353 */
354 {
355
356 fflush(*unit);
357 }
358
359
PBREAD3(fortint * unit,char * buffer,fortint * nbytes,fortint * iret)360 void PBREAD3(fortint *unit, char * buffer, fortint * nbytes, fortint * iret)
361 /*
362 *
363 * Purpose: Reads a block of bytes from a file.
364 *
365 * Function returns: status : -2 = error in reading file,
366 * -1 = end-of-file,
367 * otherwise, = number of bytes read.
368 */
369 {
370
371 *iret = read(*unit, buffer, *nbytes);
372
373 /* Read problem */
374 if (*iret == -1)
375 {
376 *iret = -2; /* error in file-handling */
377 perror("pbread3");
378 return;
379 }
380 else if (*iret != *nbytes)
381 {
382 *iret = -1;
383 printf("EOF; pbread3; bytes requested %d; read in: %d\n",
384 *nbytes,*iret);
385 return;
386 }
387
388 }
389
oct_bin3(int onum)390 static oct_bin3(int onum)
391 {
392 char tmp[20];
393 int rc;
394
395 sprintf(tmp,"%d",onum);
396 sscanf(tmp,"%o",&rc);
397 return rc;
398 }
PBOPEN3(fortint * unit,_fcd name,_fcd mode,fortint * iret,fortint l1,fortint l2)399 void PBOPEN3(fortint *unit, _fcd name, _fcd mode, fortint * iret,
400 fortint l1, fortint l2)
401 /*
402 * Purpose: Opens file, return UNIX FILE pointer.
403 *
404 * Function returns: iret: -1 = Could not open file.
405 * -2 = Invalid file name.
406 * -3 = Invalid open mode specified
407 * 0 = OK.
408 *
409 * Note: l1 and l2 are the lengths of the character strings in
410 * name and mode on SGI.
411 */
412 {
413 char *fname;
414 char *modes;
415 char *p;
416 int oflag;
417 int dmas;
418 int filemode;
419
420 #if (!defined CRAY) && (!defined VAX)
421 char namebuff[NAMEBUFFLEN], modebuff[MODEBUFFLEN];
422
423 /* Put the character strings into buffers and ensure that there is a
424 null terminator (for SGI case when FORTRAN CHARACTER variable is full
425 right to end with characters */
426 strncpy( namebuff, name, NAMEBUFFLEN - 1);
427 strncpy( modebuff, mode, MODEBUFFLEN - 1);
428 namebuff[l1] = '\0';
429 modebuff[l2] = '\0';
430 #endif
431
432
433 *unit = 0;
434 *iret = 0;
435
436 /* convert fortran to c string : file name */
437
438 #if (!defined CRAY) && (!defined VAX)
439 if(!(fname = fcd2char(namebuff)))
440 #else
441 if(!(fname = fcd2char(name)))
442 #endif
443 {
444 *iret = -2;
445 return;
446 }
447
448 /* strip trailing blanks */
449
450 p = fname + strlen(fname) - 1 ;
451 while(*p == ' ')
452 {
453 *p = 0;
454 p--;
455 }
456
457 /* convert fortran to c string : open modes */
458
459 #if (!defined CRAY) && (!defined VAX)
460 if(!(modes = fcd2char(modebuff)))
461 #else
462 if(!(modes = fcd2char(mode)))
463 #endif
464 {
465 free(fname);
466 *iret = -3;
467 return;
468 }
469
470 /* build open flags from "modes" */
471
472 p = modes;
473 while(*p)
474 {
475 switch(*p)
476 {
477 case '+': break;
478
479 case 'a':
480 case 'A': oflag = 0x100 | 2 | 0x08;
481 filemode = 766;
482 break;
483
484 case 'c':
485 case 'C':
486 case 'w':
487 case 'W': oflag = 0x100 | 1;
488 filemode = 766;
489 break;
490
491 case 'r':
492 case 'R': oflag = 0;
493 filemode = 444;
494 break;
495
496 default: *iret = -3;
497 return;
498
499 }
500 p++;
501 }
502
503
504 dmas = umask(000);
505 *unit = open(fname, oflag, oct_bin3(filemode));
506 umask(dmas);
507
508 if(*unit == -1)
509 {
510 perror(fname);
511 perror("pbopen3");
512 *iret = -2;
513 }
514
515
516 free(fname);
517 free(modes);
518
519 }
520
521
PBCLOSE3(fortint * unit,fortint * iret)522 void PBCLOSE3( fortint * unit, fortint * iret)
523 /*
524 *
525 * Purpose: Closes file.
526 *
527 * Function returns: status : non-0 = error in handling file.
528 * 0 = OK.
529 */
530 {
531 *iret = close(*unit);
532
533 if(*iret != 0) perror("pbclose3");
534
535 }
536
PBSEEK3(fortint * unit,fortint * offset,fortint * whence,fortint * iret)537 void PBSEEK3(fortint * unit, fortint * offset, fortint * whence, fortint * iret)
538 /*
539 *
540 * Purpose: Seeks to specified location in file.
541 *
542 * Function returns: status : -2 = error in handling file,
543 * -1 = end-of-file
544 * otherwise, = byte offset from start of file.
545 *
546 * whence = 0, from start of file
547 * = 1, from current position
548 * = 2, from end of file.
549 */
550 {
551 fortint my_offset = *offset;
552 int my_whence;
553
554 if ( *whence == 2)
555 {
556 my_offset = - abs(my_offset);
557 my_whence = 2;
558 }
559 else if (*whence == 0)
560 {
561 my_whence = 0;
562 }
563 else
564 {
565 my_whence = 1;
566 }
567
568 /* must use negative offset if working
569 from end-of-file */
570
571 if ((*iret=lseek(*unit, my_offset, my_whence)) < 0)
572 {
573 perror("pbseek3;");
574 *iret = -1; /* end-of-file */
575 }
576
577 }
578
PBWRITE3(fortint * unit,char * buffer,fortint * nbytes,fortint * iret)579 void PBWRITE3( fortint * unit, char * buffer, fortint * nbytes, fortint *iret)
580 /*
581 * Purpose: Writes a block of bytes to a file.
582 *
583 * Function returns: status : -1 = Could not write to file.
584 * >=0 = Number of bytes written.
585 */
586 {
587 if ((*iret = write(*unit, buffer, *nbytes)) != *nbytes)
588 {
589 perror("pbwrite3: ");
590 *iret = -1;
591 }
592
593 }
594
595