Home

Context Navigation

source: palm/trunk/SOURCE/posix_interface_mod.f90 @ 4586

Last change on this file since 4586 was 4495, checked in by raasch, 5 years ago
restart data handling with MPI-IO added, first part
Property svn:keywords set to `Id`
File size: 15.9 KB

Line
1	!> @file posix_interface_mod.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6	! Public License as published by the Free Software Foundation, either version 3 of the License, or
7	! (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10	! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11	! Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with PALM. If not, see
14	! <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2020 Leibniz Universitaet Hannover
17	! -------------------------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! -----------------
21	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: posix_interface_mod.f90 4495 2020-04-13 20:11:20Z gronemeier $
26	! Initial version (K. Ketelsen)
27	!
28	!
29	!
30	! Description:
31	! ------------
32	!> Interface to some POSIX system calls, mainly used for read/write of restart files
33	!> in non-parallel mode in MPI-IO compatible format.
34	!--------------------------------------------------------------------------------------------------!
35	MODULE posix_interface
36
37	USE ISO_C_BINDING
38
39	USE kinds
40
41	IMPLICIT NONE
42
43	PRIVATE
44
45	SAVE
46
47	!
48	!-- Definitions copied from C include file fcntl.h
49	INTEGER, PARAMETER :: O_RDONLY = 0
50	INTEGER, PARAMETER :: O_WRONLY = 1
51	INTEGER, PARAMETER :: O_RDWR = 2
52	INTEGER, PARAMETER :: O_CREAT = 64 !> 0100 octal
53	INTEGER, PARAMETER :: SEEK_SET = 0
54
55
56	!
57	!-- Interfaces for POSIX calls
58	INTERFACE
59	INTEGER(C_INT) FUNCTION C_OPEN( pathname, flags, mode ) BIND( C, NAME = 'open' )
60	USE ISO_C_BINDING
61	IMPLICIT NONE
62	CHARACTER(KIND=C_CHAR), DIMENSION(128) :: pathname
63	INTEGER(KIND=C_INT), VALUE :: flags
64	INTEGER(KIND=C_INT), VALUE :: mode
65	END FUNCTION C_OPEN
66	END INTERFACE
67
68	INTERFACE
69	INTEGER(C_SIZE_T) FUNCTION C_LSEEK( fd, offset, whence ) BIND( C, NAME = 'lseek' )
70	USE ISO_C_BINDING
71	IMPLICIT NONE
72	INTEGER(KIND=C_INT), VALUE :: fd
73	INTEGER(KIND=C_SIZE_T), VALUE :: offset
74	INTEGER(KIND=C_INT), VALUE :: whence
75	END FUNCTION C_LSEEK
76	END INTERFACE
77
78	!
79	!-- The read system call uses values of type off_t. There is no Fortran C_OFF_T, therefore C_SIZE_T
80	!-- has been used here, assuming both are 8 byte integers.
81	INTERFACE
82	INTEGER(C_SIZE_T) FUNCTION C_READ( fd, buf, nr_byte ) BIND(C, NAME = 'read' )
83	USE ISO_C_BINDING
84	IMPLICIT NONE
85	INTEGER(KIND=C_INT), VALUE :: fd
86	TYPE(C_PTR), VALUE :: buf
87	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte
88	END FUNCTION C_READ
89	END INTERFACE
90
91	INTERFACE
92	INTEGER(C_SIZE_T) FUNCTION C_WRITE( fd, buf, nr_byte ) BIND( C, NAME = 'write' )
93	USE ISO_C_BINDING
94	IMPLICIT NONE
95	INTEGER(KIND=C_INT), VALUE :: fd
96	TYPE(C_PTR), VALUE :: buf
97	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte
98	END FUNCTION C_WRITE
99	END INTERFACE
100
101	INTERFACE
102	INTEGER(C_INT) FUNCTION C_CLOSE( fd ) BIND( C, NAME = 'close' )
103	USE ISO_C_BINDING
104	IMPLICIT NONE
105	INTEGER(KIND=C_INT), VALUE :: fd
106	END FUNCTION C_CLOSE
107	END INTERFACE
108
109	!
110	!-- PALM interfaces
111	INTERFACE posix_close
112	MODULE PROCEDURE posix_close
113	END INTERFACE posix_close
114
115	INTERFACE posix_lseek
116	MODULE PROCEDURE posix_lseek
117	END INTERFACE posix_lseek
118
119	INTERFACE posix_open
120	MODULE PROCEDURE posix_open
121	END INTERFACE posix_open
122
123	INTERFACE posix_read
124	MODULE PROCEDURE posix_read
125	MODULE PROCEDURE posix_read_char_array
126	MODULE PROCEDURE posix_read_int_1d
127	MODULE PROCEDURE posix_read_int_2d
128	MODULE PROCEDURE posix_read_offset_1d
129	MODULE PROCEDURE posix_read_real_1d
130	MODULE PROCEDURE posix_read_real_2d
131	MODULE PROCEDURE posix_read_real_3d
132	END INTERFACE posix_read
133
134	INTERFACE posix_write
135	MODULE PROCEDURE posix_write
136	MODULE PROCEDURE posix_write_char_array
137	MODULE PROCEDURE posix_write_int_1d
138	MODULE PROCEDURE posix_write_int_2d
139	MODULE PROCEDURE posix_write_offset_1d
140	MODULE PROCEDURE posix_write_real_1d
141	MODULE PROCEDURE posix_write_real_2d
142	MODULE PROCEDURE posix_write_real_3d
143	END INTERFACE posix_write
144
145	PUBLIC posix_close, posix_lseek, posix_open, posix_read, posix_write
146
147	CONTAINS
148
149	INTEGER FUNCTION posix_open( file_name, rd_flag )
150
151	IMPLICIT NONE
152
153	CHARACTER(LEN=*), INTENT(IN) :: file_name
154	CHARACTER(LEN=1), DIMENSION(:), POINTER :: f_string
155	CHARACTER(LEN=128), TARGET :: lo_file_name
156
157	INTEGER(C_INT) :: fd
158	INTEGER(C_INT) :: flags
159	INTEGER(C_INT) :: name_len
160	INTEGER(C_INT) :: mode
161	INTEGER, DIMENSION(1) :: bufshape
162
163	LOGICAL, INTENT(IN) :: rd_flag
164
165	TYPE(C_PTR) :: ptr
166
167
168	!
169	!-- Note: There might be better solutions to convert FORTRAN string to C string but this works on
170	!-- different FORTRAN compiler
171	name_len = LEN( TRIM( file_name ) ) + 1
172	lo_file_name = TRIM( file_name ) // CHAR(0)
173	ptr = C_LOC( lo_file_name(1:1) )
174	bufshape(1) = name_len
175	CALL C_F_POINTER( ptr, f_string, bufshape )
176
177	mode = 420 ! Mode 644
178
179	IF ( rd_flag ) THEN
180	flags = O_RDONLY
181	fd = C_OPEN (f_string, flags, mode) ! Open for reading
182	ELSE
183	flags = O_WRONLY + O_CREAT
184	fd = C_OPEN (f_string, flags, mode) ! Open for writing
185	ENDIF
186
187	posix_open = fd
188
189	END FUNCTION posix_open
190
191
192
193	SUBROUTINE posix_lseek( fid, offset )
194
195	IMPLICIT NONE
196
197	INTEGER, INTENT(IN) :: fid
198	INTEGER(KIND=C_INT) :: my_fid
199	INTEGER(KIND=C_SIZE_T), INTENT(IN) :: offset
200	INTEGER(KIND=C_SIZE_T) :: retval
201	INTEGER(KIND=C_INT) :: whence
202
203
204	my_fid = fid
205	whence = SEEK_SET
206
207	retval = C_LSEEK( my_fid, offset, whence )
208
209	END SUBROUTINE posix_lseek
210
211
212
213	SUBROUTINE posix_read_int_1d( fid, data, nw )
214
215	IMPLICIT NONE
216
217	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) :: data
218	INTEGER, INTENT(IN) :: fid
219	INTEGER :: nr_byte
220	INTEGER, INTENT(IN) :: nw
221
222	TYPE(C_PTR) :: buf
223
224
225	nr_byte = nw*iwp
226	buf = C_LOC( data )
227
228	CALL posix_read( fid, buf, nr_byte )
229
230	END SUBROUTINE posix_read_int_1d
231
232
233
234	SUBROUTINE posix_read_int_2d (fid, data, nw)
235
236	IMPLICIT NONE
237
238	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) :: data
239	INTEGER, INTENT(IN) :: fid
240	INTEGER :: nr_byte
241	INTEGER, INTENT(IN) :: nw
242
243	TYPE(C_PTR) :: buf
244
245
246	nr_byte = nw * iwp
247	buf = C_LOC( data )
248
249	CALL posix_read( fid, buf, nr_byte )
250
251	END SUBROUTINE posix_read_int_2d
252
253
254
255	SUBROUTINE posix_read_offset_1d( fid, data, nw )
256
257	IMPLICIT NONE
258
259	INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) :: data
260	INTEGER, INTENT(IN) :: fid
261	INTEGER :: nr_byte
262	INTEGER, INTENT(IN) :: nw
263	TYPE(C_PTR) :: buf
264
265
266	nr_byte = nw * C_SIZE_T
267	buf = C_LOC( data )
268
269	CALL posix_read( fid, buf, nr_byte )
270
271	END SUBROUTINE posix_read_offset_1d
272
273
274
275	SUBROUTINE posix_read_real_1d( fid, data, nw )
276
277	IMPLICIT NONE
278
279	INTEGER, INTENT(IN) :: fid
280	INTEGER :: nr_byte
281	INTEGER, INTENT(IN) :: nw
282
283	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data
284
285	TYPE(C_PTR) :: buf
286
287
288	nr_byte = nw * wp
289	buf = C_LOC( data )
290
291	CALL posix_read( fid, buf, nr_byte )
292
293	END SUBROUTINE posix_read_real_1d
294
295
296
297	SUBROUTINE posix_read_real_2d( fid, data, nw )
298
299	IMPLICIT NONE
300
301	INTEGER, INTENT(IN) :: fid
302	INTEGER :: nr_byte
303	INTEGER, INTENT(IN) :: nw
304
305	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data
306
307	TYPE(C_PTR) :: buf
308
309
310	nr_byte = nw * wp
311	buf = C_LOC( data )
312
313	CALL posix_read( fid, buf, nr_byte )
314
315	END SUBROUTINE posix_read_real_2d
316
317
318
319	SUBROUTINE posix_read_real_3d( fid, data, nw )
320
321	IMPLICIT NONE
322
323	INTEGER, INTENT(IN) :: fid
324	INTEGER :: nr_byte
325	INTEGER, INTENT(IN) :: nw
326
327	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data
328
329	TYPE(C_PTR) :: buf
330
331
332	nr_byte = nw * wp
333	buf = C_LOC( data )
334
335	CALL posix_read( fid, buf, nr_byte )
336
337	END SUBROUTINE posix_read_real_3d
338
339
340
341	SUBROUTINE posix_read( fid, buf, nb )
342
343	IMPLICIT NONE
344
345	INTEGER, INTENT(IN) :: fid
346	INTEGER(KIND=C_INT) :: my_fid
347	INTEGER , INTENT(IN) :: nb
348	INTEGER(KIND=C_SIZE_T) :: nr_byte
349	INTEGER(KIND=C_SIZE_T) :: retval
350
351	TYPE(C_PTR) :: buf
352
353
354	my_fid = fid
355	nr_byte = nb
356
357	retval = C_READ( my_fid, buf, nr_byte )
358
359	!
360	!-- The posix standard says that is not guaranteed that all bytes are read in one read system call.
361	!-- If retval is not equal to nr_byte, another system call has to be issued.
362	!-- However, in all Unix distributions it is commonly accepted, that all bytes are read in one call
363	!-- during during disk-IO. Therefore, here is only an error query and no reading in a while loop.
364	IF ( retval /= nr_byte ) THEN
365	WRITE(6,*) 'Number of bytes read does not match the number of requested bytes'
366	CALL abort
367	ENDIF
368
369	END SUBROUTINE posix_read
370
371
372
373	SUBROUTINE posix_read_char_array( fid, data )
374
375	IMPLICIT NONE
376
377	CHARACTER(LEN=*), DIMENSION(:) :: data
378	CHARACTER(LEN=LEN(data)), TARGET :: data_buf
379
380	INTEGER, INTENT(IN) :: fid
381	INTEGER :: i
382	INTEGER(KIND=C_INT) :: my_fid
383	INTEGER(KIND=C_SIZE_T) :: name_len
384	INTEGER(KIND=C_SIZE_T) :: retval
385
386	TYPE(C_PTR) :: ptr
387
388
389	my_fid = fid
390
391	DO i = 1, SIZE( data )
392	data_buf = data(i)
393	name_len = LEN(data(i))
394	ptr = C_LOC( data_buf(1:1) )
395	retval = C_READ( my_fid, ptr, name_len )
396	data(i) = data_buf
397	ENDDO
398
399	END SUBROUTINE posix_read_char_array
400
401
402
403	SUBROUTINE posix_write_int_1d( fid, data, nw )
404
405	IMPLICIT NONE
406
407	INTEGER, INTENT(IN) :: fid
408	INTEGER(KIND=C_INT) :: my_fid
409	INTEGER(KIND=C_SIZE_T) :: nr_byte
410	INTEGER , INTENT(IN) :: nw
411	INTEGER(KIND=C_SIZE_T) :: retval
412
413	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) :: data
414
415	TYPE(C_PTR) :: buf
416
417
418	my_fid = fid
419	nr_byte = nw * iwp
420	buf = C_LOC( data )
421
422	retval = C_WRITE( my_fid, buf, nr_byte )
423
424	END SUBROUTINE posix_write_int_1d
425
426
427
428	SUBROUTINE posix_write_int_2d( fid, data, nw )
429
430	IMPLICIT NONE
431
432	INTEGER, INTENT(IN) :: fid
433	INTEGER :: nr_byte
434	INTEGER, INTENT(IN) :: nw
435
436	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) :: data
437
438	TYPE(C_PTR) :: buf
439
440
441	nr_byte = nw * iwp
442	buf = C_LOC( data )
443
444	CALL posix_write( fid, buf, nr_byte )
445
446	END SUBROUTINE posix_write_int_2d
447
448
449
450	SUBROUTINE posix_write_offset_1d( fid, data, nw )
451
452	IMPLICIT NONE
453
454	INTEGER, INTENT(IN) :: fid
455	INTEGER :: nr_byte
456	INTEGER, INTENT(IN) :: nw
457
458	INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) :: data
459
460	TYPE(C_PTR) :: buf
461
462
463	nr_byte = nw * STORAGE_SIZE( data(1) ) / 8
464	buf = C_LOC( data )
465
466	CALL posix_write(fid, buf, nr_byte )
467
468	END SUBROUTINE posix_write_offset_1d
469
470
471
472	SUBROUTINE posix_write_real_1d( fid, data, nw )
473
474	IMPLICIT NONE
475
476	INTEGER, INTENT(IN) :: fid
477	INTEGER :: nr_byte
478	INTEGER, INTENT(IN) :: nw
479
480	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data
481
482	TYPE(C_PTR) :: buf
483
484
485	nr_byte = nw * wp
486	buf = C_LOC( data )
487
488	CALL posix_write( fid, buf, nr_byte )
489
490	END SUBROUTINE posix_write_real_1d
491
492
493
494	SUBROUTINE posix_write_real_2d( fid, data, nw )
495
496	IMPLICIT NONE
497
498	INTEGER, INTENT(IN) :: fid
499	INTEGER :: nr_byte
500	INTEGER, INTENT(IN) :: nw
501
502	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data
503
504	TYPE(C_PTR) :: buf
505
506
507	nr_byte = nw * wp
508	buf = C_LOC( data )
509
510	CALL posix_write( fid, buf, nr_byte )
511
512	END SUBROUTINE posix_write_real_2d
513
514
515
516	SUBROUTINE posix_write_real_3d( fid, data, nw )
517
518	IMPLICIT NONE
519
520	INTEGER, INTENT(IN) :: fid
521	INTEGER :: nr_byte
522	INTEGER, INTENT(IN) :: nw
523
524	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data
525
526	TYPE(C_PTR) :: buf
527
528
529	nr_byte = nw * wp
530	buf = C_LOC( data )
531
532	CALL posix_write( fid, buf, nr_byte )
533
534	END SUBROUTINE posix_write_real_3d
535
536
537
538	SUBROUTINE posix_write( fid, buf, nb )
539
540	IMPLICIT NONE
541
542	INTEGER, INTENT(IN) :: fid
543	INTEGER(KIND=C_INT) :: my_fid
544	INTEGER , INTENT(IN) :: nb
545	INTEGER(KIND=C_SIZE_T) :: nr_byte
546	INTEGER(KIND=C_SIZE_T) :: retval
547
548	TYPE(C_PTR) :: buf
549
550
551	my_fid = fid
552	nr_byte = nb
553
554	retval = C_WRITE( my_fid, buf, nr_byte )
555
556	IF ( retval /= nr_byte ) THEN
557	WRITE(6,*) 'Number of bytes to write does not match the number of requested bytes'
558	CALL abort
559	ENDIF
560
561	END SUBROUTINE posix_write
562
563
564
565	SUBROUTINE posix_write_char_array( fid, data )
566
567	IMPLICIT NONE
568
569	CHARACTER(LEN=*), DIMENSION(:) :: data
570
571	CHARACTER(LEN=LEN(data)+1), TARGET :: data_buf
572
573	INTEGER, INTENT(IN) :: fid
574	INTEGER :: i
575	INTEGER(KIND=C_INT) :: my_fid
576	INTEGER(KIND=C_SIZE_T) :: name_len
577	INTEGER(KIND=C_SIZE_T) :: retval
578
579	TYPE(C_PTR) :: ptr
580
581
582	my_fid = fid
583
584	DO i = 1, SIZE( data )
585	data_buf = data(i) // CHAR( 0 )
586	name_len = LEN( data(i) )
587	ptr = C_LOC( data_buf(1:1) )
588	retval = C_WRITE( my_fid, ptr, name_len )
589	ENDDO
590
591	END SUBROUTINE posix_write_char_array
592
593
594
595	SUBROUTINE posix_close( fid )
596
597	IMPLICIT NONE
598
599	INTEGER, INTENT(IN) :: fid
600	INTEGER(KIND=C_INT) :: my_fid
601	INTEGER(KIND=C_INT) :: retval
602
603
604	my_fid = fid
605
606	retval = C_CLOSE( my_fid )
607
608	END SUBROUTINE posix_close
609
610
611	END MODULE posix_interface

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |