Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |