UPP  V11.0.0
 All Data Structures Files Functions Pages
blockIO.c
1 /*module documentation block */
2 /* . . . */
3 /* module: obsmod */
4 /* prgmmr: middlecoff org: gsd/esrl date: 2006-04-27 */
5 /* */
6 /* abstract: This module contains contains routines used to open, */
7 /* read from, and close data files in a manner similar */
8 /* to fortran direct access (DA) reads */
9 /* */
10 /* The Fortran standard does not */
11 /* - specify what the status return code should be for a DA */
12 /* when read past the EOF */
13 /* - provide a way to detect end-of-file for a DA file */
14 /* - apply the concept end-of-file to direct-access files */
15 /* */
16 /* Consequently, the standard does not specify what the contents */
17 /* of the buffer will be for locations past the EOF. */
18 /* */
19 /* The routines in this file provide a more portable way to */
20 /* read a file in a "direct access" like manner. */
21 /* */
22 /* program history log: */
23 /* 2006-04-27 middlecoff */
24 /* */
25 /* */
26 /* Subroutines Included: */
27 /* sub openfileread - ope */
28 /* sub closfile */
29 /* sub getbytes - */
30 /* */
31 /* Variable Definitions: */
32 /* */
33 /* */
34 /* */
35 /*end documentation block */
36 
37 
38 #include <stdlib.h>
39 #include <stdio.h>
40 
41 #define MAXLUN 1000
42 static int lunTableInit=0;
43 static FILE *lunTable[MAXLUN];
44 static int lunUsed[MAXLUN];
45 
46 void initLunTable ()
47  {
48  int i;
49  if (lunTableInit == 0)
50  {
51  for (i=0; i < MAXLUN; i++)
52  lunUsed[i] = 0;
53  lunTableInit = 1;
54  }
55  }
56 
57 void
58 #if defined(funder)
59  openfileread_
60 #elif defined(f2under)
61  openfileread__
62 #elif defined(fcaps)
63  OPENFILEREAD
64 #else
65  openfileread
66 #endif
67  (FortranInt *lun, FortranInt *istat, FortranByte *fname)
68  /* Assume the name is null terminated in the Fortran code */
69  {
70  int cLun;
71  initLunTable();
72  cLun = (int) *lun;
73  /* Check lun range */
74  if ((cLun < 0) || (cLun >= MAXLUN))
75  {
76  *istat = -1;
77  return;
78  }
79 
80  /* Close if open */
81  if (lunUsed[cLun] != 0)
82  fclose (lunTable[cLun]);
83 
84  /* Open the file */
85  lunTable[cLun] = fopen (fname, "r");
86  if (lunTable[cLun] == NULL)
87  {
88  *istat = -1;
89  return;
90  }
91  lunUsed[cLun] = 1;
92  *istat = 0;
93  return;
94  }
95 
96 
97 /* This routine emulates IBM Fortran direct access read */
98 void
99 #if defined(funder)
100  getbytes_
101 #elif defined(f2under)
102  getbytes__
103 #elif defined(fcaps)
104  GETBYTES
105 #else
106  getbytes
107 #endif
108  (FortranInt *lun, void *buff, FortranLlong *recno, FortranLlong *recl, FortranInt *istat)
109  {
110  int cLun;
111  size_t cRecl;
112  size_t xfer;
113  char *cbuff;
114  int i;
115  long offset;
116  initLunTable();
117  cRecl = (size_t) *recl;
118  cLun = (int) *lun;
119  cbuff = (char *) buff;
120  /* Check lun range */
121  if ((cLun < 0) || (cLun >= MAXLUN))
122  {
123  *istat = -1;
124  return;
125  }
126 
127  /* Is it open? */
128  if (lunUsed[cLun] == 0)
129  {
130  *istat = -2;
131  return;
132  }
133 
134  /* move to the right record */
135  offset = ((long) *recno-1)*cRecl;
136  if(fseek(lunTable[cLun], offset, 0) !=0)
137  {*istat = -3;return; }
138 
139  /* Get the data */
140  xfer = fread (buff, (size_t) 1, cRecl, lunTable[cLun]);
141  if (xfer < cRecl)
142  {
143  *istat = 1;
144  /* Short read, pad with zeros */
145  for (i=xfer; i < cRecl; i++)
146  cbuff[i] = '\0';
147  }
148  else
149  *istat = 0;
150 
151  return;
152  }
153 
154 
155 void
156 #if defined(funder)
157  closefile_
158 #elif defined(f2under)
159  closefile__
160 #elif defined(fcaps)
161  CLOSEFILE
162 #else
163  closefile
164 #endif
165  (FortranInt *lun, FortranInt *istat)
166  {
167  int cLun;
168 
169  initLunTable();
170 
171  cLun = (int) *lun;
172  /* Check lun range */
173  if ((cLun < 0) || (cLun >= MAXLUN))
174  {
175  *istat = -1;
176  return;
177  }
178 
179  /* Is it open? */
180  if (lunUsed[cLun] == 0)
181  {
182  *istat = -1;
183  return;
184  }
185 
186  /* Close the file */
187  fclose (lunTable[cLun]);
188  lunUsed[cLun] = 0;
189 
190  *istat = 0;
191  return;
192 
193 }