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

Rev	Line
[4495]	1	!> @file posix_interface_mod.f90
[4649]	2	!--------------------------------------------------------------------------------------------------!
[4495]	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
[4649]	17	!--------------------------------------------------------------------------------------------------!
[4495]	18	!
[4649]	19	!
[4495]	20	! Current revisions:
	21	! -----------------
[4628]	22	!
	23	!
[4495]	24	! Former revisions:
	25	! -----------------
	26	! $Id: posix_interface_mod.f90 4649 2020-08-25 12:11:17Z raasch $
[4649]	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	!
[4628]	33	! 4495 2020-04-13 20:11:20Z raasch
[4495]	34	! Initial version (K. Ketelsen)
	35	!
	36	!
[4649]	37	!--------------------------------------------------------------------------------------------------!
[4495]	38	! Description:
	39	! ------------
[4649]	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.
[4495]	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
[4649]	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 !<
[4495]	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
[4649]	70	CHARACTER(KIND=C_CHAR), DIMENSION(128) :: pathname !<
	71	INTEGER(KIND=C_INT), VALUE :: flags !<
	72	INTEGER(KIND=C_INT), VALUE :: mode !<
[4495]	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
[4649]	80	INTEGER(KIND=C_INT), VALUE :: fd !<
	81	INTEGER(KIND=C_SIZE_T), VALUE :: offset !<
	82	INTEGER(KIND=C_INT), VALUE :: whence !<
[4495]	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
[4649]	93	INTEGER(KIND=C_INT), VALUE :: fd !<
	94	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte !<
	95	TYPE(C_PTR), VALUE :: buf !<
[4495]	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
[4649]	103	INTEGER(KIND=C_INT), VALUE :: fd !<
	104	INTEGER(KIND=C_SIZE_T), VALUE :: nr_byte !<
	105	TYPE(C_PTR), VALUE :: buf !<
[4495]	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
[4649]	113	INTEGER(KIND=C_INT), VALUE :: fd !<
[4495]	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
[4628]	136	MODULE PROCEDURE posix_read_i4_3d
	137	MODULE PROCEDURE posix_read_i8_3d
[4495]	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
[4628]	149	MODULE PROCEDURE posix_write_i4_3d
	150	MODULE PROCEDURE posix_write_i8_3d
[4495]	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
[4649]	157	PUBLIC posix_close, &
	158	posix_lseek, &
	159	posix_open, &
	160	posix_read, &
	161	posix_write
[4495]	162
	163	CONTAINS
	164
	165	INTEGER FUNCTION posix_open( file_name, rd_flag )
	166
	167	IMPLICIT NONE
	168
[4649]	169	CHARACTER(LEN=*), INTENT(IN) :: file_name !<
	170	CHARACTER(LEN=1), DIMENSION(:), POINTER :: f_string !<
	171	CHARACTER(LEN=128), TARGET :: lo_file_name !<
[4495]	172
[4649]	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 !<
[4495]	178
[4649]	179	LOGICAL, INTENT(IN) :: rd_flag !<
[4495]	180
[4649]	181	TYPE(C_PTR) :: ptr !<
[4495]	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
[4649]	188	lo_file_name = TRIM( file_name ) // CHAR( 0 )
[4495]	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
[4649]	196	flags = o_rdonly
	197	fd = C_OPEN( f_string, flags, mode ) ! Open for reading
[4495]	198	ELSE
[4649]	199	flags = o_wronly + o_creat
	200	fd = C_OPEN( f_string, flags, mode ) ! Open for writing
[4495]	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
[4649]	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 !<
[4495]	218
	219
	220	my_fid = fid
[4649]	221	whence = seek_set
[4495]	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
[4649]	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 !<
[4495]	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
[4628]	249	SUBROUTINE posix_read_int_2d( fid, data, nw )
[4495]	250
	251	IMPLICIT NONE
	252
[4649]	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 !<
[4495]	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
[4628]	269	SUBROUTINE posix_read_i4_3d( fid, data, nw )
	270
	271	IMPLICIT NONE
	272
[4649]	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 !<
[4628]	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
[4649]	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 !<
[4628]	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
[4495]	309	SUBROUTINE posix_read_offset_1d( fid, data, nw )
	310
	311	IMPLICIT NONE
	312
[4649]	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 !<
[4495]	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
[4649]	333	INTEGER :: nr_byte !<
	334	INTEGER, INTENT(IN) :: fid !<
	335	INTEGER, INTENT(IN) :: nw !<
[4495]	336
[4649]	337	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data !<
[4495]	338
[4649]	339	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	355	INTEGER :: nr_byte !<
	356	INTEGER, INTENT(IN) :: fid !<
	357	INTEGER, INTENT(IN) :: nw !<
[4495]	358
[4649]	359	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data !<
[4495]	360
[4649]	361	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	377	INTEGER :: nr_byte !<
	378	INTEGER, INTENT(IN) :: fid !<
	379	INTEGER, INTENT(IN) :: nw !<
[4495]	380
[4649]	381	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data !<
[4495]	382
[4649]	383	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	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 !<
[4495]	404
[4649]	405	TYPE(C_PTR) :: buf !<
[4495]	406
	407
	408	my_fid = fid
	409	nr_byte = nb
	410
	411	retval = C_READ( my_fid, buf, nr_byte )
	412
	413	!
[4649]	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.
[4495]	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
[4649]	419	WRITE( 6, * ) 'Number of bytes read does not match the number of requested bytes'
[4495]	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
[4649]	431	CHARACTER(LEN=*), DIMENSION(:) :: data !<
	432	CHARACTER(LEN=LEN(data)), TARGET :: data_buf !<
[4495]	433
[4649]	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 !<
[4495]	439
[4649]	440	TYPE(C_PTR) :: ptr !<
[4495]	441
	442
	443	my_fid = fid
	444
	445	DO i = 1, SIZE( data )
	446	data_buf = data(i)
[4649]	447	name_len = LEN( data(i) )
[4495]	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
[4649]	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 !<
[4495]	466
[4649]	467	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) :: data !<
[4495]	468
[4649]	469	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	486	INTEGER :: nr_byte !<
	487	INTEGER, INTENT(IN) :: fid !<
	488	INTEGER, INTENT(IN) :: nw !<
[4495]	489
[4649]	490	INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) :: data !<
[4495]	491
[4649]	492	TYPE(C_PTR) :: buf !<
[4495]	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
[4628]	504	SUBROUTINE posix_write_i4_3d( fid, data, nw )
	505
	506	IMPLICIT NONE
	507
[4649]	508	INTEGER :: nr_byte !<
	509	INTEGER, INTENT(IN) :: fid !<
	510	INTEGER, INTENT(IN) :: nw !<
[4628]	511
[4649]	512	INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
[4628]	513
[4649]	514	TYPE(C_PTR) :: buf !<
[4628]	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
[4649]	530	INTEGER :: nr_byte !<
	531	INTEGER, INTENT(IN) :: fid !<
	532	INTEGER, INTENT(IN) :: nw !<
[4628]	533
[4649]	534	INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) :: data !<
[4628]	535
[4649]	536	TYPE(C_PTR) :: buf !<
[4628]	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
[4495]	548	SUBROUTINE posix_write_offset_1d( fid, data, nw )
	549
	550	IMPLICIT NONE
	551
[4649]	552	INTEGER :: nr_byte !<
	553	INTEGER, INTENT(IN) :: fid !<
	554	INTEGER, INTENT(IN) :: nw !<
[4495]	555
[4649]	556	INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) :: data !<
[4495]	557
[4649]	558	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	574	INTEGER :: nr_byte !<
	575	INTEGER, INTENT(IN) :: fid !<
	576	INTEGER, INTENT(IN) :: nw !<
[4495]	577
[4649]	578	REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) :: data !<
[4495]	579
[4649]	580	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	596	INTEGER :: nr_byte !<
	597	INTEGER, INTENT(IN) :: fid !<
	598	INTEGER, INTENT(IN) :: nw !<
[4495]	599
[4649]	600	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) :: data !<
[4495]	601
[4649]	602	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	618	INTEGER :: nr_byte !<
	619	INTEGER, INTENT(IN) :: fid !<
	620	INTEGER, INTENT(IN) :: nw !<
[4495]	621
[4649]	622	REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) :: data !<
[4495]	623
[4649]	624	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	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 !<
[4495]	645
[4649]	646	TYPE(C_PTR) :: buf !<
[4495]	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
[4649]	655	WRITE( 6, * ) 'Number of bytes to write does not match the number of requested bytes'
[4495]	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
[4649]	667	CHARACTER(LEN=*), DIMENSION(:) :: data !<
	668	CHARACTER(LEN=LEN(data)+1), TARGET :: data_buf !<
[4495]	669
[4649]	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 !<
[4495]	675
[4649]	676	TYPE(C_PTR) :: ptr !<
[4495]	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
[4649]	696	INTEGER, INTENT(IN) :: fid !<
	697	INTEGER(KIND=C_INT) :: my_fid !<
	698	INTEGER(KIND=C_INT) :: retval !<
[4495]	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 |