Home

Context Navigation

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

Last change on this file since 4628 was 4628, checked in by raasch, 4 years ago
extensions required for MPI-I/O of particle data to restart files
Property svn:keywords set to `Id`
File size: 18.5 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 4628 2020-07-29 07:23:03Z raasch $
26	! extensions required for MPI-I/O of particle data to restart files
27	!
28	! 4495 2020-04-13 20:11:20Z raasch
29	! Initial version (K. Ketelsen)
30	!
31	!
32	!
33	! Description:
34	! ------------
35	!> Interface to some POSIX system calls, mainly used for read/write of restart files
36	!> in non-parallel mode in MPI-IO compatible format.
37	!--------------------------------------------------------------------------------------------------!
38	MODULE posix_interface
39
40	USE ISO_C_BINDING
41
42	USE kinds
43
44	IMPLICIT NONE
45
46	PRIVATE
47
48	SAVE
49
50	!
51	!-- Definitions copied from C include file fcntl.h
52	INTEGER, PARAMETER :: O_RDONLY = 0
53	INTEGER, PARAMETER :: O_WRONLY = 1
54	INTEGER, PARAMETER :: O_RDWR = 2
55	INTEGER, PARAMETER :: O_CREAT = 64 !> 0100 octal
56	INTEGER, PARAMETER :: SEEK_SET = 0
57
58
59	!
60	!-- Interfaces for POSIX calls
61	INTERFACE
62	INTEGER(C_INT) FUNCTION C_OPEN( pathname, flags, mode ) BIND( C, NAME = 'open' )
63	USE ISO_C_BINDING
64	IMPLICIT NONE
65	CHARACTER(KIND=C_CHAR), DIMENSION(128) :: pathname
66	INTEGER(KIND=C_INT), VALUE :: flags
67	INTEGER(KIND=C_INT), VALUE :: mode
68	END FUNCTION C_OPEN
69	END INTERFACE
70
71	INTERFACE
72	INTEGER(C_SIZE_T) FUNCTION C_LSEEK( fd, offset, whence ) BIND( C, NAME = 'lseek' )
73	USE ISO_C_BINDING
74	IMPLICIT NONE
75	INTEGER(KIND=C_INT), VALUE :: fd
76	INTEGER(KIND=C_SIZE_T), VALUE :: offset
77	INTEGER(KIND=C_INT), VALUE :: whence
78	END FUNCTION C_LSEEK
79	END INTERFACE
80
81	!
82	!-- The read system call uses values of type off_t. There is no Fortran C_OFF_T, therefore C_SIZE_T
83	!-- has been used here, assuming both are 8 byte integers.
84	INTERFACE
85	INTEGER(C_SIZE_T) FUNCTION C_READ( fd, buf, nr_byte ) BIND(C, NAME = 'read' )
86	USE ISO_C_BINDING
87	IMPLICIT NONE
88	INTEGER(KIND=C_INT), VALUE :: fd
89	TYPE(C_PTR), VALUE :: buf
90	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte
91	END FUNCTION C_READ
92	END INTERFACE
93
94	INTERFACE
95	INTEGER(C_SIZE_T) FUNCTION C_WRITE( fd, buf, nr_byte ) BIND( C, NAME = 'write' )
96	USE ISO_C_BINDING
97	IMPLICIT NONE
98	INTEGER(KIND=C_INT), VALUE :: fd
99	TYPE(C_PTR), VALUE :: buf
100	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte
101	END FUNCTION C_WRITE
102	END INTERFACE
103
104	INTERFACE
105	INTEGER(C_INT) FUNCTION C_CLOSE( fd ) BIND( C, NAME = 'close' )
106	USE ISO_C_BINDING
107	IMPLICIT NONE
108	INTEGER(KIND=C_INT), VALUE :: fd
109	END FUNCTION C_CLOSE
110	END INTERFACE
111
112	!
113	!-- PALM interfaces
114	INTERFACE posix_close
115	MODULE PROCEDURE posix_close
116	END INTERFACE posix_close
117
118	INTERFACE posix_lseek
119	MODULE PROCEDURE posix_lseek
120	END INTERFACE posix_lseek
121
122	INTERFACE posix_open
123	MODULE PROCEDURE posix_open
124	END INTERFACE posix_open
125
126	INTERFACE posix_read
127	MODULE PROCEDURE posix_read
128	MODULE PROCEDURE posix_read_char_array
129	MODULE PROCEDURE posix_read_int_1d
130	MODULE PROCEDURE posix_read_int_2d
131	MODULE PROCEDURE posix_read_i4_3d
132	MODULE PROCEDURE posix_read_i8_3d
133	MODULE PROCEDURE posix_read_offset_1d
134	MODULE PROCEDURE posix_read_real_1d
135	MODULE PROCEDURE posix_read_real_2d
136	MODULE PROCEDURE posix_read_real_3d
137	END INTERFACE posix_read
138
139	INTERFACE posix_write
140	MODULE PROCEDURE posix_write
141	MODULE PROCEDURE posix_write_char_array
142	MODULE PROCEDURE posix_write_int_1d
143	MODULE PROCEDURE posix_write_int_2d
144	MODULE PROCEDURE posix_write_i4_3d
145	MODULE PROCEDURE posix_write_i8_3d
146	MODULE PROCEDURE posix_write_offset_1d
147	MODULE PROCEDURE posix_write_real_1d
148	MODULE PROCEDURE posix_write_real_2d
149	MODULE PROCEDURE posix_write_real_3d
150	END INTERFACE posix_write
151
152	PUBLIC posix_close, posix_lseek, posix_open, posix_read, posix_write
153
154	CONTAINS
155
156	INTEGER FUNCTION posix_open( file_name, rd_flag )
157
158	IMPLICIT NONE
159
160	CHARACTER(LEN=*), INTENT(IN) :: file_name
161	CHARACTER(LEN=1), DIMENSION(:), POINTER :: f_string
162	CHARACTER(LEN=128), TARGET :: lo_file_name
163
164	INTEGER(C_INT) :: fd
165	INTEGER(C_INT) :: flags
166	INTEGER(C_INT) :: name_len
167	INTEGER(C_INT) :: mode
168	INTEGER, DIMENSION(1) :: bufshape
169
170	LOGICAL, INTENT(IN) :: rd_flag
171
172	TYPE(C_PTR) :: ptr
173
174
175	!
176	!-- Note: There might be better solutions to convert FORTRAN string to C string but this works on
177	!-- different FORTRAN compiler
178	name_len = LEN( TRIM( file_name ) ) + 1
179	lo_file_name = TRIM( file_name ) // CHAR(0)
180	ptr = C_LOC( lo_file_name(1:1) )
181	bufshape(1) = name_len
182	CALL C_F_POINTER( ptr, f_string, bufshape )
183
184	mode = 420 ! Mode 644
185
186	IF ( rd_flag ) THEN
187	flags = O_RDONLY
188	fd = C_OPEN (f_string, flags, mode) ! Open for reading
189	ELSE
190	flags = O_WRONLY + O_CREAT
191	fd = C_OPEN (f_string, flags, mode) ! Open for writing
192	ENDIF
193
194	posix_open = fd
195
196	END FUNCTION posix_open
197
198
199
200	SUBROUTINE posix_lseek( fid, offset )
201
202	IMPLICIT NONE
203
204	INTEGER, INTENT(IN) :: fid
205	INTEGER(KIND=C_INT) :: my_fid
206	INTEGER(KIND=C_SIZE_T), INTENT(IN) :: offset
207	INTEGER(KIND=C_SIZE_T) :: retval
208	INTEGER(KIND=C_INT) :: whence
209
210
211	my_fid = fid
212	whence = SEEK_SET
213
214	retval = C_LSEEK( my_fid, offset, whence )
215
216	END SUBROUTINE posix_lseek
217
218
219
220	SUBROUTINE posix_read_int_1d( fid, data, nw )
221
222	IMPLICIT NONE
223
224	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) :: data
225	INTEGER, INTENT(IN) :: fid
226	INTEGER :: nr_byte
227	INTEGER, INTENT(IN) :: nw
228
229	TYPE(C_PTR) :: buf
230
231
232	nr_byte = nw*iwp
233	buf = C_LOC( data )
234
235	CALL posix_read( fid, buf, nr_byte )
236
237	END SUBROUTINE posix_read_int_1d
238
239
240
241	SUBROUTINE posix_read_int_2d( fid, data, nw )
242
243	IMPLICIT NONE
244
245	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) :: data
246	INTEGER, INTENT(IN) :: fid
247	INTEGER :: nr_byte
248	INTEGER, INTENT(IN) :: nw
249
250	TYPE(C_PTR) :: buf
251
252
253	nr_byte = nw * iwp
254	buf = C_LOC( data )
255
256	CALL posix_read( fid, buf, nr_byte )
257
258	END SUBROUTINE posix_read_int_2d
259
260
261
262	SUBROUTINE posix_read_i4_3d( fid, data, nw )
263
264	IMPLICIT NONE
265
266	INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
267	INTEGER, INTENT(IN) :: fid !<
268	INTEGER :: nr_byte !<
269	INTEGER, INTENT(IN) :: nw !<
270
271	TYPE(C_PTR) :: buf !<
272
273
274	nr_byte = nw * isp
275	buf = C_LOC( data )
276
277	CALL posix_read( fid, buf, nr_byte )
278
279	END SUBROUTINE posix_read_i4_3d
280
281
282
283	SUBROUTINE posix_read_i8_3d( fid, data, nw )
284
285	IMPLICIT NONE
286
287	INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
288	INTEGER, INTENT(IN) :: fid !<
289	INTEGER :: nr_byte !<
290	INTEGER, INTENT(IN) :: nw !<
291
292	TYPE(C_PTR) :: buf !<
293
294
295	nr_byte = nw * idp
296	buf = C_LOC( data )
297
298	CALL posix_read( fid, buf, nr_byte )
299
300	END SUBROUTINE posix_read_i8_3d
301
302
303
304	SUBROUTINE posix_read_offset_1d( fid, data, nw )
305
306	IMPLICIT NONE
307
308	INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) :: data
309	INTEGER, INTENT(IN) :: fid
310	INTEGER :: nr_byte
311	INTEGER, INTENT(IN) :: nw
312	TYPE(C_PTR) :: buf
313
314
315	nr_byte = nw * C_SIZE_T
316	buf = C_LOC( data )
317
318	CALL posix_read( fid, buf, nr_byte )
319
320	END SUBROUTINE posix_read_offset_1d
321
322
323
324	SUBROUTINE posix_read_real_1d( fid, data, nw )
325
326	IMPLICIT NONE
327
328	INTEGER, INTENT(IN) :: fid
329	INTEGER :: nr_byte
330	INTEGER, INTENT(IN) :: nw
331
332	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data
333
334	TYPE(C_PTR) :: buf
335
336
337	nr_byte = nw * wp
338	buf = C_LOC( data )
339
340	CALL posix_read( fid, buf, nr_byte )
341
342	END SUBROUTINE posix_read_real_1d
343
344
345
346	SUBROUTINE posix_read_real_2d( fid, data, nw )
347
348	IMPLICIT NONE
349
350	INTEGER, INTENT(IN) :: fid
351	INTEGER :: nr_byte
352	INTEGER, INTENT(IN) :: nw
353
354	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data
355
356	TYPE(C_PTR) :: buf
357
358
359	nr_byte = nw * wp
360	buf = C_LOC( data )
361
362	CALL posix_read( fid, buf, nr_byte )
363
364	END SUBROUTINE posix_read_real_2d
365
366
367
368	SUBROUTINE posix_read_real_3d( fid, data, nw )
369
370	IMPLICIT NONE
371
372	INTEGER, INTENT(IN) :: fid
373	INTEGER :: nr_byte
374	INTEGER, INTENT(IN) :: nw
375
376	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data
377
378	TYPE(C_PTR) :: buf
379
380
381	nr_byte = nw * wp
382	buf = C_LOC( data )
383
384	CALL posix_read( fid, buf, nr_byte )
385
386	END SUBROUTINE posix_read_real_3d
387
388
389
390	SUBROUTINE posix_read( fid, buf, nb )
391
392	IMPLICIT NONE
393
394	INTEGER, INTENT(IN) :: fid
395	INTEGER(KIND=C_INT) :: my_fid
396	INTEGER , INTENT(IN) :: nb
397	INTEGER(KIND=C_SIZE_T) :: nr_byte
398	INTEGER(KIND=C_SIZE_T) :: retval
399
400	TYPE(C_PTR) :: buf
401
402
403	my_fid = fid
404	nr_byte = nb
405
406	retval = C_READ( my_fid, buf, nr_byte )
407
408	!
409	!-- The posix standard says that is not guaranteed that all bytes are read in one read system call.
410	!-- If retval is not equal to nr_byte, another system call has to be issued.
411	!-- However, in all Unix distributions it is commonly accepted, that all bytes are read in one call
412	!-- during during disk-IO. Therefore, here is only an error query and no reading in a while loop.
413	IF ( retval /= nr_byte ) THEN
414	WRITE(6,*) 'Number of bytes read does not match the number of requested bytes'
415	CALL abort
416	ENDIF
417
418	END SUBROUTINE posix_read
419
420
421
422	SUBROUTINE posix_read_char_array( fid, data )
423
424	IMPLICIT NONE
425
426	CHARACTER(LEN=*), DIMENSION(:) :: data
427	CHARACTER(LEN=LEN(data)), TARGET :: data_buf
428
429	INTEGER, INTENT(IN) :: fid
430	INTEGER :: i
431	INTEGER(KIND=C_INT) :: my_fid
432	INTEGER(KIND=C_SIZE_T) :: name_len
433	INTEGER(KIND=C_SIZE_T) :: retval
434
435	TYPE(C_PTR) :: ptr
436
437
438	my_fid = fid
439
440	DO i = 1, SIZE( data )
441	data_buf = data(i)
442	name_len = LEN(data(i))
443	ptr = C_LOC( data_buf(1:1) )
444	retval = C_READ( my_fid, ptr, name_len )
445	data(i) = data_buf
446	ENDDO
447
448	END SUBROUTINE posix_read_char_array
449
450
451
452	SUBROUTINE posix_write_int_1d( fid, data, nw )
453
454	IMPLICIT NONE
455
456	INTEGER, INTENT(IN) :: fid
457	INTEGER(KIND=C_INT) :: my_fid
458	INTEGER(KIND=C_SIZE_T) :: nr_byte
459	INTEGER , INTENT(IN) :: nw
460	INTEGER(KIND=C_SIZE_T) :: retval
461
462	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) :: data
463
464	TYPE(C_PTR) :: buf
465
466
467	my_fid = fid
468	nr_byte = nw * iwp
469	buf = C_LOC( data )
470
471	retval = C_WRITE( my_fid, buf, nr_byte )
472
473	END SUBROUTINE posix_write_int_1d
474
475
476
477	SUBROUTINE posix_write_int_2d( fid, data, nw )
478
479	IMPLICIT NONE
480
481	INTEGER, INTENT(IN) :: fid
482	INTEGER :: nr_byte
483	INTEGER, INTENT(IN) :: nw
484
485	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) :: data
486
487	TYPE(C_PTR) :: buf
488
489
490	nr_byte = nw * iwp
491	buf = C_LOC( data )
492
493	CALL posix_write( fid, buf, nr_byte )
494
495	END SUBROUTINE posix_write_int_2d
496
497
498
499	SUBROUTINE posix_write_i4_3d( fid, data, nw )
500
501	IMPLICIT NONE
502
503	INTEGER, INTENT(IN) :: fid !<
504	INTEGER :: nr_byte !<
505	INTEGER, INTENT(IN) :: nw !<
506
507	INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
508
509	TYPE(C_PTR) :: buf !<
510
511
512	nr_byte = nw * isp
513	buf = C_LOC( data )
514
515	CALL posix_write( fid, buf, nr_byte )
516
517	END SUBROUTINE posix_write_i4_3d
518
519
520
521	SUBROUTINE posix_write_i8_3d( fid, data, nw )
522
523	IMPLICIT NONE
524
525	INTEGER, INTENT(IN) :: fid !<
526	INTEGER :: nr_byte !<
527	INTEGER, INTENT(IN) :: nw !<
528
529	INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
530
531	TYPE(C_PTR) :: buf !<
532
533
534	nr_byte = nw * idp
535	buf = C_LOC( data )
536
537	CALL posix_write( fid, buf, nr_byte )
538
539	END SUBROUTINE posix_write_i8_3d
540
541
542
543	SUBROUTINE posix_write_offset_1d( fid, data, nw )
544
545	IMPLICIT NONE
546
547	INTEGER, INTENT(IN) :: fid
548	INTEGER :: nr_byte
549	INTEGER, INTENT(IN) :: nw
550
551	INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) :: data
552
553	TYPE(C_PTR) :: buf
554
555
556	nr_byte = nw * STORAGE_SIZE( data(1) ) / 8
557	buf = C_LOC( data )
558
559	CALL posix_write(fid, buf, nr_byte )
560
561	END SUBROUTINE posix_write_offset_1d
562
563
564
565	SUBROUTINE posix_write_real_1d( fid, data, nw )
566
567	IMPLICIT NONE
568
569	INTEGER, INTENT(IN) :: fid
570	INTEGER :: nr_byte
571	INTEGER, INTENT(IN) :: nw
572
573	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data
574
575	TYPE(C_PTR) :: buf
576
577
578	nr_byte = nw * wp
579	buf = C_LOC( data )
580
581	CALL posix_write( fid, buf, nr_byte )
582
583	END SUBROUTINE posix_write_real_1d
584
585
586
587	SUBROUTINE posix_write_real_2d( fid, data, nw )
588
589	IMPLICIT NONE
590
591	INTEGER, INTENT(IN) :: fid
592	INTEGER :: nr_byte
593	INTEGER, INTENT(IN) :: nw
594
595	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data
596
597	TYPE(C_PTR) :: buf
598
599
600	nr_byte = nw * wp
601	buf = C_LOC( data )
602
603	CALL posix_write( fid, buf, nr_byte )
604
605	END SUBROUTINE posix_write_real_2d
606
607
608
609	SUBROUTINE posix_write_real_3d( fid, data, nw )
610
611	IMPLICIT NONE
612
613	INTEGER, INTENT(IN) :: fid
614	INTEGER :: nr_byte
615	INTEGER, INTENT(IN) :: nw
616
617	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data
618
619	TYPE(C_PTR) :: buf
620
621
622	nr_byte = nw * wp
623	buf = C_LOC( data )
624
625	CALL posix_write( fid, buf, nr_byte )
626
627	END SUBROUTINE posix_write_real_3d
628
629
630
631	SUBROUTINE posix_write( fid, buf, nb )
632
633	IMPLICIT NONE
634
635	INTEGER, INTENT(IN) :: fid
636	INTEGER(KIND=C_INT) :: my_fid
637	INTEGER , INTENT(IN) :: nb
638	INTEGER(KIND=C_SIZE_T) :: nr_byte
639	INTEGER(KIND=C_SIZE_T) :: retval
640
641	TYPE(C_PTR) :: buf
642
643
644	my_fid = fid
645	nr_byte = nb
646
647	retval = C_WRITE( my_fid, buf, nr_byte )
648
649	IF ( retval /= nr_byte ) THEN
650	WRITE(6,*) 'Number of bytes to write does not match the number of requested bytes'
651	CALL abort
652	ENDIF
653
654	END SUBROUTINE posix_write
655
656
657
658	SUBROUTINE posix_write_char_array( fid, data )
659
660	IMPLICIT NONE
661
662	CHARACTER(LEN=*), DIMENSION(:) :: data
663
664	CHARACTER(LEN=LEN(data)+1), TARGET :: data_buf
665
666	INTEGER, INTENT(IN) :: fid
667	INTEGER :: i
668	INTEGER(KIND=C_INT) :: my_fid
669	INTEGER(KIND=C_SIZE_T) :: name_len
670	INTEGER(KIND=C_SIZE_T) :: retval
671
672	TYPE(C_PTR) :: ptr
673
674
675	my_fid = fid
676
677	DO i = 1, SIZE( data )
678	data_buf = data(i) // CHAR( 0 )
679	name_len = LEN( data(i) )
680	ptr = C_LOC( data_buf(1:1) )
681	retval = C_WRITE( my_fid, ptr, name_len )
682	ENDDO
683
684	END SUBROUTINE posix_write_char_array
685
686
687
688	SUBROUTINE posix_close( fid )
689
690	IMPLICIT NONE
691
692	INTEGER, INTENT(IN) :: fid
693	INTEGER(KIND=C_INT) :: my_fid
694	INTEGER(KIND=C_INT) :: retval
695
696
697	my_fid = fid
698
699	retval = C_CLOSE( my_fid )
700
701	END SUBROUTINE posix_close
702
703
704	END MODULE posix_interface

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |