source: trunk/WRF.COMMON/WRFV3/external/io_grib2/bacio-1.3/bacio.v1.3.c @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 16.7 KB
Line 
1/* Fortran-callable routines to read and write characther (bacio) and */
2/*   numeric (banio) data byte addressably                            */
3/* Robert Grumbine  16 March 1998 */
4/*  v1.1: Put diagnostic output under control of define VERBOSE or QUIET */
5/*        Add option of non-seeking read/write                           */
6/*        Return code for fewer data read/written than requested */
7/*  v1.2: Add cray compatibility  20 April 1998                  */
8
9#include <stdio.h>
10#include <sys/types.h>
11#include <sys/stat.h>
12#include <fcntl.h>
13#include <unistd.h>
14#ifdef MACOS
15#include <sys/malloc.h>
16#else
17#include <malloc.h>
18#endif
19#include <ctype.h>
20#include <string.h>
21
22/* Include the C library file for definition/control */
23/* Things that might be changed for new systems are there. */
24/* This source file should not (need to) be edited, merely recompiled */
25#include "clib.h"
26
27
28/* Return Codes:  */
29/*  0    All was well                                   */
30/* -1    Tried to open read only _and_ write only       */
31/* -2    Tried to read and write in the same call       */
32/* -3    Internal failure in name processing            */
33/* -4    Failure in opening file                        */
34/* -5    Tried to read on a write-only file             */ 
35/* -6    Failed in read to find the 'start' location    */
36/* -7    Tried to write to a read only file             */
37/* -8    Failed in write to find the 'start' location   */
38/* -9    Error in close                                 */
39/* -10   Read or wrote fewer data than requested        */
40
41/* Note: In your Fortran code, call bacio, not bacio_.  */
42/*int bacio_(int * mode, int * start, int * size, int * no, int * nactual,   */ 
43/*          int * fdes, const char *fname, char *data, int  namelen,         */ 
44/*          int  datanamelen)                                                */
45/* Arguments: */
46/* Mode is the integer specifying operations to be performed                 */
47/*    see the clib.inc file for the values.  Mode is obtained                */
48/*    by adding together the values corresponding to the operations          */
49/*    The best method is to include the clib.inc file and refer to the       */
50/*    names for the operations rather than rely on hard-coded values         */
51/* Start is the byte number to start your operation from.  0 is the first    */
52/*    byte in the file, not 1.                                               */
53/* Newpos is the position in the file after a read or write has been         */
54/*    performed.  You'll need this if you're doing 'seeking' read/write      */
55/* Size is the size of the objects you are trying to read.  Rely on the      */
56/*    values in the locale.inc file.  Types are CHARACTER, INTEGER, REAL,    */
57/*    COMPLEX.  Specify the correct value by using SIZEOF_type, where type   */
58/*    is one of these.  (After having included the locale.inc file)          */
59/* no is the number of things to read or write (characters, integers,        */
60/*                                                              whatever)    */
61/* nactual is the number of things actually read or written.  Check that     */
62/*    you got what you wanted.                                               */
63/* fdes is an integer 'file descriptor'.  This is not a Fortran Unit Number  */
64/*    You can use it, however, to refer to files you've previously opened.   */
65/* fname is the name of the file.  This only needs to be defined when you    */
66/*    are opening a file.  It must be (on the Fortran side) declared as      */
67/*    CHARACTER*N, where N is a length greater than or equal to the length   */
68/*    of the file name.  CHARACTER*1 fname[80] (for example) will fail.      */
69/* data is the name of the entity (variable, vector, array) that you want    */
70/*    to write data out from or read it in to.  The fact that C is declaring */
71/*    it to be a char * does not affect your fortran.                        */
72/* namelen - Do NOT specify this.  It is created automagically by the        */
73/*    Fortran compiler                                                       */
74/* datanamelen - Ditto                                                       */ 
75
76
77int BACIO
78(int * mode, int * start, int *newpos, int * size, int * no, 
79 int * nactual, int * fdes, const char *fname, char *datary, 
80 int  namelen, int  datanamelen) 
81{
82  int i, j, jret, seekret;
83  char *realname, *tempchar;
84  int tcharval;
85  size_t count;
86
87/* Initialization(s) */
88  *nactual = 0;
89
90/* Check for illegal combinations of options */
91  if (( BAOPEN_RONLY & *mode) &&
92     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
93     #ifdef VERBOSE
94       printf("illegal -- trying to open both read only and write only\n");
95     #endif
96     return -1;
97  }
98  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
99     #ifdef VERBOSE
100       printf("illegal -- trying to both read and write in the same call\n");
101     #endif
102     return -2;
103  }
104
105/* This section handles Fortran to C translation of strings so as to */
106/*   be able to open the files Fortran is expecting to be opened.    */
107  #ifdef CRAY90
108    namelen = _fcdlen(fcd_fname);
109    fname   = _fcdtocp(fcd_fname);
110  #endif
111
112  realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
113  if (realname == NULL) { 
114    #ifdef VERBOSE
115      printf("failed to mallocate realname %d = namelen\n", namelen);
116      fflush(stdout);
117    #endif
118    return -3;
119  }
120
121  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
122       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
123       (BAOPEN_RW & *mode) ) {
124    #ifdef VERBOSE
125      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
126      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
127    #endif
128    tempchar = (char *) malloc(sizeof(char) * 1 ) ;
129    i = 0;
130    j = 0;
131    *tempchar = fname[i];
132    tcharval = *tempchar;
133    while (i == j && i < namelen ) {
134       fflush(stdout); 
135       if ( isgraph(tcharval) ) {
136         realname[j] = fname[i];
137         j += 1;
138       }
139       i += 1;
140       *tempchar = fname[i];
141       tcharval = *tempchar;
142    }
143    #ifdef VERBOSE
144      printf("i,j = %d %d\n",i,j); fflush(stdout);
145    #endif
146    realname[j] = '\0';
147    free(tempchar);
148  } 
149   
150/* Open files with correct read/write and file permission. */
151  if (BAOPEN_RONLY & *mode) {
152    #ifdef VERBOSE
153      printf("open read only %s\n", realname);
154    #endif
155     *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
156  }
157  else if (BAOPEN_WONLY & *mode ) {
158    #ifdef VERBOSE
159      printf("open write only %s\n", realname);
160    #endif
161     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
162  }
163  else if (BAOPEN_WONLY_TRUNC & *mode ) {
164    #ifdef VERBOSE
165      printf("open write only with truncation %s\n", realname);
166    #endif
167     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
168  }
169  else if (BAOPEN_WONLY_APPEND & *mode ) {
170    #ifdef VERBOSE
171      printf("open write only with append %s\n", realname);
172    #endif
173     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
174  }
175  else if (BAOPEN_RW & *mode) {
176    #ifdef VERBOSE
177      printf("open read-write %s\n", realname);
178    #endif
179     *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
180  }
181  else {
182    #ifdef VERBOSE
183      printf("no openings\n");
184    #endif
185  }
186  if (*fdes < 0) {
187    #ifdef VERBOSE
188      printf("error in file descriptor! *fdes %d\n", *fdes);
189    #endif
190    return -4;
191  }
192  else {
193    #ifdef VERBOSE
194      printf("file descriptor = %d\n",*fdes );
195    #endif
196  }
197
198
199/* Read data as requested */
200  if (BAREAD & *mode &&
201   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
202    #ifdef VERBOSE
203      printf("Error, trying to read while in write only mode!\n");
204    #endif
205    return -5;
206  }
207  else if (BAREAD & *mode ) {
208  /* Read in some data */
209    if (! (*mode & NOSEEK) ) {
210      seekret = lseek(*fdes, *start, SEEK_SET);
211      if (seekret == -1) {
212        #ifdef VERBOSE
213          printf("error in seeking to %d\n",*start);
214        #endif
215        return -6;
216      }
217      #ifdef VERBOSE
218      else {
219         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
220      }
221      #endif
222    }
223    #ifdef CRAY90
224      datary = _fcdtocp(fcd_datary);
225    #endif
226    if (datary == NULL) {
227      printf("Massive catastrophe -- datary pointer is NULL\n");
228      return -666;
229    }
230    #ifdef VERBOSE
231      printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
232    #endif
233    count = (size_t) *no;
234    jret = read(*fdes, (void *) datary, count);
235    if (jret != *no) {
236      #ifdef VERBOSE
237        printf("did not read in the requested number of bytes\n");
238        printf("read in %d bytes instead of %d \n",jret, *no);
239      #endif
240    } 
241    else {
242    #ifdef VERBOSE
243      printf("read in %d bytes requested \n", *no);
244    #endif
245    }
246    *nactual = jret;
247    *newpos = *start + jret;
248  }
249/* Done with reading */
250 
251/* See if we should be writing */
252  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
253    #ifdef VERBOSE
254      printf("Trying to write on a read only file \n");
255    #endif
256     return -7;
257  }
258  else if ( BAWRITE & *mode ) {
259    if (! (*mode & NOSEEK) ) {
260      seekret = lseek(*fdes, *start, SEEK_SET);
261      if (seekret == -1) {
262      #ifdef VERBOSE
263        printf("error in seeking to %d\n",*start);
264      #endif
265        return -8;
266      }
267    }
268    #ifdef CRAY90
269      datary = _fcdtocp(fcd_datary);
270    #endif
271    if (datary == NULL) {
272      printf("Massive catastrophe -- datary pointer is NULL\n");
273      return -666;
274    }
275    #ifdef VERBOSE
276      printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
277    #endif
278    count = (size_t) *no;
279    jret = write(*fdes, (void *) datary, count);
280    if (jret != *no) {
281    #ifdef VERBOSE
282      printf("did not write out the requested number of bytes\n");
283      printf("wrote %d bytes instead\n", jret);
284    #endif
285      *nactual = jret;
286      *newpos = *start + jret;
287    }
288    else {
289    #ifdef VERBOSE
290       printf("wrote %d bytes \n", jret);
291    #endif
292       *nactual = jret;
293       *newpos = *start + jret;
294    }
295  }
296/* Done with writing */
297   
298
299/* Close file if requested */
300  if (BACLOSE & *mode ) {
301    jret = close(*fdes);
302    if (jret != 0) { 
303    #ifdef VERBOSE
304      printf("close failed! jret = %d\n",jret);
305    #endif
306      return -9;
307    }
308  }
309/* Done closing */
310
311  free(realname);
312
313/* Check that if we were reading or writing, that we actually got what */
314/*  we expected, else return a -10.  Return 0 (success) if we're here  */
315/*  and weren't reading or writing */
316  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
317    return -10;
318  }
319  else {
320    return 0;
321  }
322} 
323int BANIO
324(int * mode, int * start, int *newpos, int * size, int * no, 
325 int * nactual, int * fdes, const char *fname, char *datary, 
326 int  namelen ) 
327{
328  int i, j, jret, seekret;
329  char *realname, *tempchar;
330  int tcharval;
331
332/* Initialization(s) */
333  *nactual = 0;
334
335/* Check for illegal combinations of options */
336  if (( BAOPEN_RONLY & *mode) &&
337     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
338     #ifdef VERBOSE
339       printf("illegal -- trying to open both read only and write only\n");
340     #endif
341     return -1;
342  }
343  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
344     #ifdef VERBOSE
345       printf("illegal -- trying to both read and write in the same call\n");
346     #endif
347     return -2;
348  }
349
350/* This section handles Fortran to C translation of strings so as to */
351/*   be able to open the files Fortran is expecting to be opened.    */
352  #ifdef CRAY90
353    namelen = _fcdlen(fcd_fname);
354    fname   = _fcdtocp(fcd_fname);
355  #endif
356  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
357       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
358       (BAOPEN_RW & *mode) ) {
359    #ifdef VERBOSE
360      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
361      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
362    #endif
363    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
364    if (realname == NULL) { 
365      #ifdef VERBOSE
366        printf("failed to mallocate realname %d = namelen\n", namelen);
367        fflush(stdout);
368      #endif
369      return -3;
370    }
371    tempchar = (char *) malloc(sizeof(char) * 1 ) ;
372    i = 0;
373    j = 0;
374    *tempchar = fname[i];
375    tcharval = *tempchar;
376    while (i == j && i < namelen ) {
377       fflush(stdout); 
378       if ( isgraph(tcharval) ) {
379         realname[j] = fname[i];
380         j += 1;
381       }
382       i += 1;
383       *tempchar = fname[i];
384       tcharval = *tempchar;
385    }
386    #ifdef VERBOSE
387      printf("i,j = %d %d\n",i,j); fflush(stdout);
388    #endif
389    realname[j] = '\0';
390  } 
391   
392/* Open files with correct read/write and file permission. */
393  if (BAOPEN_RONLY & *mode) {
394    #ifdef VERBOSE
395      printf("open read only %s\n", realname);
396    #endif
397     *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
398  }
399  else if (BAOPEN_WONLY & *mode ) {
400    #ifdef VERBOSE
401      printf("open write only %s\n", realname);
402    #endif
403     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
404  }
405  else if (BAOPEN_WONLY_TRUNC & *mode ) {
406    #ifdef VERBOSE
407      printf("open write only with truncation %s\n", realname);
408    #endif
409     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
410  }
411  else if (BAOPEN_WONLY_APPEND & *mode ) {
412    #ifdef VERBOSE
413      printf("open write only with append %s\n", realname);
414    #endif
415     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
416  }
417  else if (BAOPEN_RW & *mode) {
418    #ifdef VERBOSE
419      printf("open read-write %s\n", realname);
420    #endif
421     *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
422  }
423  else {
424    #ifdef VERBOSE
425      printf("no openings\n");
426    #endif
427  }
428  if (*fdes < 0) {
429    #ifdef VERBOSE
430      printf("error in file descriptor! *fdes %d\n", *fdes);
431    #endif
432    return -4;
433  }
434  else {
435    #ifdef VERBOSE
436      printf("file descriptor = %d\n",*fdes );
437    #endif
438  }
439
440
441/* Read data as requested */
442  if (BAREAD & *mode &&
443   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
444    #ifdef VERBOSE
445      printf("Error, trying to read while in write only mode!\n");
446    #endif
447    return -5;
448  }
449  else if (BAREAD & *mode ) {
450  /* Read in some data */
451    if (! (*mode & NOSEEK) ) {
452      seekret = lseek(*fdes, *start, SEEK_SET);
453      if (seekret == -1) {
454        #ifdef VERBOSE
455          printf("error in seeking to %d\n",*start);
456        #endif
457        return -6;
458      }
459      #ifdef VERBOSE
460      else {
461         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
462      }
463      #endif
464    }
465    jret = read(*fdes, datary, *no*(*size) );
466    if (jret != *no*(*size) ) {
467      #ifdef VERBOSE
468        printf("did not read in the requested number of items\n");
469        printf("read in %d items of %d \n",jret/(*size), *no);
470      #endif
471      *nactual = jret/(*size);
472      *newpos = *start + jret;
473    } 
474    #ifdef VERBOSE
475      printf("read in %d items \n", jret/(*size));
476    #endif
477    *nactual = jret/(*size);
478    *newpos = *start + jret;
479  }
480/* Done with reading */
481 
482/* See if we should be writing */
483  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
484    #ifdef VERBOSE
485      printf("Trying to write on a read only file \n");
486    #endif
487     return -7;
488  }
489  else if ( BAWRITE & *mode ) {
490    if (! (*mode & NOSEEK) ) {
491      seekret = lseek(*fdes, *start, SEEK_SET);
492      if (seekret == -1) {
493      #ifdef VERBOSE
494        printf("error in seeking to %d\n",*start);
495      #endif
496        return -8;
497      }
498      #ifdef VERBOSE
499      else {
500        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
501      }
502      #endif
503    }
504    jret = write(*fdes, datary, *no*(*size));
505    if (jret != *no*(*size)) {
506    #ifdef VERBOSE
507      printf("did not write out the requested number of items\n");
508      printf("wrote %d items instead\n", jret/(*size) );
509    #endif
510      *nactual = jret/(*size) ;
511      *newpos = *start + jret;
512    }
513    else {
514    #ifdef VERBOSE
515       printf("wrote %d items \n", jret/(*size) );
516    #endif
517       *nactual = jret/(*size) ;
518       *newpos = *start + jret;
519    }
520  }
521/* Done with writing */
522   
523
524/* Close file if requested */
525  if (BACLOSE & *mode ) {
526    jret = close(*fdes);
527    if (jret != 0) { 
528    #ifdef VERBOSE
529      printf("close failed! jret = %d\n",jret);
530    #endif
531      return -9;
532    }
533  }
534/* Done closing */
535
536/* Check that if we were reading or writing, that we actually got what */
537/*  we expected, else return a -10.  Return 0 (success) if we're here  */
538/*  and weren't reading or writing */
539  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
540    return -10;
541  }
542  else {
543    return 0;
544  }
545} 
Note: See TracBrowser for help on using the repository browser.