UPP (develop)
Loading...
Searching...
No Matches
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
42static int lunTableInit=0;
43static FILE *lunTable[MAXLUN];
44static int lunUsed[MAXLUN];
45
46void 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
57void
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 */
98void
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
155void
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}
real, dimension(:), allocatable buff
Used in the many variables' gather; note that scattering has been replaced with subdomain reads when ...
Definition CTLBLK.f:183