Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |