1 /*
2
3 !
4 ! Dalton, a molecular electronic structure program
5 ! Copyright (C) by the authors of Dalton.
6 !
7 ! This program is free software; you can redistribute it and/or
8 ! modify it under the terms of the GNU Lesser General Public
9 ! License version 2.1 as published by the Free Software Foundation.
10 !
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ! Lesser General Public License for more details.
15 !
16 ! If a copy of the GNU LGPL v2.1 was not distributed with this
17 ! code, you can obtain one at https://www.gnu.org/licenses/old-licenses/lgpl-2.1.en.html.
18 !
19
20 !
21 */
22 /*
23 This version of CC was generated from version used 1998/99 on
24 jensen by a merge with the version used on Linux PCs
25 Christof Haettig, April 1999
26
27 fixed for 64 bit mode on IBM AIX with VAR_INT64 and SYS_AIX set
28 Christof Haettig, Mar 19 2003
29
30 General interfacing with fortran code compiled with non-default
31 integer size done by Pawel Salek, Feb 2008.
32 */
33
34 /* Simulate the cray 64 bit word addressable I/O routines and
35 allow for large buffering in core.
36
37
38 CALL WOPEN(UNIT, NAME, LENNAM, BLOCKS, STATS, IERR)
39 ---- ------
40
41 CALL WCLOSE(UNIT, IERR)
42
43 CALL GETWA(UNIT, RESULT, ADDR, COUNT, IERR)
44
45 CALL PUTWA(UNIT, SOURCE, ADDR, COUNT, IERR)
46
47 Currently the I/O is syncronous and unbuffered */
48 #define _DEFAULT_SOURCE 1
49 #define _LARGEFILE64_SOURCE
50 #include <stdio.h>
51 #include <stdlib.h>
52 #include <string.h>
53 #include <sys/time.h>
54 #include <sys/types.h>
55 #include <sys/file.h>
56 #include <fcntl.h>
57 #include <unistd.h>
58
59 #define max_file 99
60
61 /* define here the integer type, which has the same lengths
62 as the integers used under fortran */
63 #if defined (VAR_INT64)
64 #include <stdint.h>
65 typedef int64_t INTEGER;
66 #else
67 typedef int INTEGER;
68 #endif
69
70 /* Mark Fortran-callable API with FSYM */
71 #include "FSYMdef.h"
72
73 /* For propertiary machines, which have no lseek64() because their
74 developers though that 64-bit lseek should be good enough for
75 everybody, map the symbols to the old API that makes so guarantees
76 about file pointer size - and hope it works.
77
78 This problem has been reported for many other programs, for eg. OS
79 X and HP/UX. Web searching engines are your friends.
80 */
81 //#if defined (HAVE_NO_LSEEK64)
82 #define lseek64 lseek
83 #define off64_t off_t
84 //#endif
85
86 /* Disable old cruft. */
87 #if defined(OLD_CRUFT)
88 #if defined (SYS_FUJITSU)
89 #ifdef __uxp__
90 #define L_XTND SEEK_END
91 #define lseek64 lseek
92 #define _LLTYPES
93 #endif
94
95 #endif /* OLD_CRUFT */
96
97 #endif
98
99 static int first_call = 1; /* need to do stuff on the first call */
100
101 static struct w_file {
102 int fds; /* file descriptor */
103 off64_t length; /* file length in bytes */
104 off64_t position; /* current file position in bytes a la lseek */
105 char *path; /* file name */
106 INTEGER stats; /* boolean flag to collect statistics */
107 double words_write; /* total no. of words written */
108 double words_read; /* total no. of words read */
109 double time_write; /* total wall time writing */
110 double time_read; /* total wall time reading */
111 INTEGER n_read; /* no. of read requests */
112 INTEGER n_write; /* no. of write reqeusts */
113 INTEGER seek_read; /* no. of seeks on read */
114 INTEGER seek_write; /* no. of seeks on write */
115 } file_array[max_file];
116
117 /** returns ai with the wall clock time in seconds as a double. The
118 actual accuracy is OS-dependent. */
119 void
FSYM(walltm)120 FSYM(walltm)(double *ai)
121 {
122 struct timeval tp;
123
124 (void) gettimeofday(&tp,NULL);
125 *ai = (double) tp.tv_sec + ((double) tp.tv_usec) * 1.0e-6;
126 }
127
128
129 static INTEGER
isUnitValidAndOpen(INTEGER unit)130 isUnitValidAndOpen(INTEGER unit)
131 {
132 if ( (unit < 0) || (unit >= max_file) )
133 return -1;
134
135 if ( file_array[unit].fds == -1 )
136 return -1;
137
138 return 0;
139 }
140
141 static INTEGER
isAddressValid(INTEGER addr)142 isAddressValid(INTEGER addr)
143 {
144 return (addr <= 0) ? -4 : 0;
145 }
146
147 static INTEGER
isCountValid(INTEGER count)148 isCountValid(INTEGER count)
149 {
150 return (count < 0) ? -4 : 0;
151 }
152
153 static void
InitFileStats(struct w_file * file)154 InitFileStats(struct w_file* file)
155 {
156 file->stats = 1;
157 file->words_write = 0.0e0;
158 file->words_read = 0.0e0;
159 file->time_read = 0.0e0;
160 file->time_write = 0.0e0;
161 file->n_read = 0;
162 file->n_write = 0;
163 file->seek_read = 0;
164 file->seek_write = 0;
165 }
166
167 static void
PrintFileStats(INTEGER unit,const struct w_file * file)168 PrintFileStats(INTEGER unit, const struct w_file *file)
169 {
170 double ave_read=0.0e0, ave_write=0.0e0;
171 double rate_read=0.0e0, rate_write=0.0e0;
172
173 if (file->n_read) {
174 ave_read = file->words_read / (double) file->n_read;
175 if (file->time_read > 0.0e0)
176 rate_read = file->words_read / (1000000.0e0 * file->time_read);
177 }
178
179 if (file->n_write) {
180 ave_write = file->words_write / (double) file->n_write;
181 if (file->time_write > 0.0e0)
182 rate_write = file->words_write / (1000000.0e0 * file->time_write);
183 }
184
185 fflush(stdout);
186 fprintf(stderr,"CRAYIO: Statistics for unit %d, file '%s', length=%lu bytes.\n",
187 unit, file->path, (unsigned long)file->length);
188 fprintf(stderr,
189 "CRAYIO: oper : #req. : #seek : #words :"
190 " #w/#req : time(s) : MW/s \n"
191 "CRAYIO: read : %7d : %7d : %9d : %7d : %7.1f : %6.3f\n",
192 file->n_read, file->seek_read, (int) file->words_read,
193 (int) ave_read, file->time_read, rate_read);
194 fprintf(stderr,"CRAYIO:write : %7d : %7d : %9d : %7d : %7.1f : %6.3f\n",
195 file->n_write, file->seek_write, (int) file->words_write,
196 (int) ave_write, file->time_write, rate_write);
197 }
198
199 static void
InitFileData(struct w_file * file)200 InitFileData(struct w_file *file)
201 {
202 file->fds = -1;
203 file->length = (off64_t) -1;
204 file->path = NULL;
205 file->position = (off64_t) -1;
206 }
207
208 static void
FirstCall()209 FirstCall()
210 /* Initialization on first call to anything */
211 {
212 INTEGER i;
213
214 for (i=0; i<max_file; i++) {
215
216 InitFileData(&file_array[i]);
217 InitFileStats(&file_array[i]);
218 }
219
220 first_call = 0;
221 }
222
223 void
FSYM(wclose)224 FSYM(wclose)(const INTEGER *unit, INTEGER *ierr)
225 {
226 struct w_file *file;
227
228 if (first_call)
229 FirstCall();
230
231 if ( (*ierr = isUnitValidAndOpen(*unit)) )
232 return;
233
234 file = file_array + *unit;
235
236 *ierr = close(file->fds);
237
238 if (file->stats)
239 PrintFileStats(*unit, file);
240
241 InitFileData(file);
242
243 InitFileStats(file);
244 }
245
246 /* ARGSUSED */
FSYM(wopen)247 void FSYM(wopen)(const INTEGER *unit, const char *name, const INTEGER *lennam,
248 const INTEGER* blocks, const INTEGER *stats, INTEGER *ierr)
249 {
250 struct w_file *file;
251
252 *ierr = (INTEGER) 0;
253
254 if (first_call)
255 FirstCall();
256
257 if ( (*unit < 0) || (*unit >= max_file) ) {
258 *ierr = -1;
259 fprintf(stderr,
260 "WOPEN fatal error: unit %d \n"
261 "WOPEN fatal error: MAX_FILE %d \n",
262 *unit, max_file);
263 return;
264 }
265
266 file = file_array + *unit;
267
268 file->stats = *stats;
269
270 if (*lennam > 0) {
271 file->path = malloc((size_t) (*lennam + 1));
272 (void) strncpy(file->path,name,(INTEGER) *lennam);
273 /* file->path[*lennam] = NULL; */
274 file->path[*lennam] = 0;
275 }
276 else {
277 file->path = malloc((size_t) 8);
278 (void) sprintf(file->path,"fort.%.2d",*unit);
279 }
280 if (( file->fds = open(file->path, (O_RDWR|O_CREAT), 0660))
281 == -1) {
282 *ierr = -6;
283 return;
284 }
285
286 file->length = lseek64(file->fds, (off64_t) 0, SEEK_END);
287 file->position = lseek64(file->fds, (off64_t) 0, SEEK_SET);
288
289 }
290
291 void
FSYM(getwa)292 FSYM(getwa)(const INTEGER *unit, double *result, const INTEGER *addr,
293 const INTEGER *count, INTEGER *ierr)
294 {
295 size_t nbytes, con2;
296 off64_t where, con1;
297 double start=0, end;
298 struct w_file *file;
299
300 if (first_call)
301 FirstCall();
302
303 if ( (*ierr = isUnitValidAndOpen(*unit)) )
304 return;
305
306 if ( (*ierr = isAddressValid(*addr)) )
307 return;
308
309 if ( (*ierr = isCountValid(*count)) )
310 return;
311
312 file = file_array + *unit;
313
314 con1 = *addr;
315 con2 = *count;
316
317 nbytes = con2 * 8;
318 where = (con1 - (off64_t) 1) * (off64_t) 8;
319
320 if ( (where+nbytes) > file->length ) {
321 *ierr = -5;
322 fflush(stdout);
323 fprintf(stderr,
324 "GETWA: where %lu \n"
325 "GETWA: nbytes %lu \n"
326 "GETWA: file->length %lu \n",
327 (unsigned long)where, (unsigned long)nbytes,
328 (unsigned long)file->length);
329 PrintFileStats(*unit, file);
330 return;
331 }
332
333 if (file->stats)
334 walltm_(&start);
335
336 if (where != file->position) {
337 file->seek_read++;
338 if ( (file->position = lseek64(file->fds, where, SEEK_SET)) == (off64_t) -1) {
339 *ierr = -4;
340 return;
341 }
342 }
343
344 if ( read(file->fds, result, nbytes) != nbytes) {
345 *ierr = -6;
346 return;
347 }
348
349 file->position += nbytes;
350
351 if (file->stats) {
352 walltm_(&end);
353 file->n_read++;
354 file->words_read += (double) *count;
355 file->time_read += end - start;
356 }
357
358 *ierr = 0;
359 }
360
361 void
FSYM(putwa)362 FSYM(putwa)(const INTEGER *unit, const double *source, const INTEGER *addr,
363 const INTEGER *count, INTEGER *ierr)
364 {
365 size_t nbytes,con2;
366 off64_t where, con1;
367 double start=0, end;
368 struct w_file *file;
369
370 if (first_call)
371 FirstCall();
372
373 if ( (*ierr = isUnitValidAndOpen(*unit)) )
374 return;
375
376 if ( (*ierr = isAddressValid(*addr)) )
377 return;
378
379 if ( (*ierr = isCountValid(*count)) )
380 return;
381
382 file = file_array + *unit;
383
384 con1 = *addr;
385 con2 = *count;
386
387 nbytes = con2 * 8;
388 where = (con1 - (off64_t) 1) * (off64_t) 8;
389
390 if (file->stats)
391 walltm_(&start);
392
393 if (where != file->position) {
394 file->seek_write++;
395 if ( (file->position = lseek64(file->fds, where, SEEK_SET)) == (off64_t) -1) {
396 *ierr = -4;
397 return;
398 }
399 }
400
401 if ( (*ierr=write(file->fds, source, nbytes)) != nbytes) {
402 printf("\n write returned %d \n",*ierr);
403 *ierr = -6;
404 return;
405 }
406
407 where += nbytes;
408 file->position += nbytes;
409 if (file->length < where)
410 file->length = where;
411
412
413 if (file->stats) {
414 walltm_(&end);
415 file->n_write++;
416 file->words_write += (double) *count;
417 file->time_write += end - start;
418 }
419
420 *ierr = 0;
421 }
422