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

Last change on this file since 4775 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
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 4652 2020-08-27 08:51:55Z raasch $
27! Routine fortran_sleep moved from old module posix_calls_from_fortran to here
28!
29! 4649 2020-08-25 12:11:17Z raasch
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!
36! 4495 2020-04-13 20:11:20Z raasch
37! Initial version (K. Ketelsen)
38!
39!
40!--------------------------------------------------------------------------------------------------!
41! Description:
42! ------------
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.
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
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  !<
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
73          CHARACTER(KIND=C_CHAR), DIMENSION(128) ::  pathname  !<
74          INTEGER(KIND=C_INT), VALUE             ::  flags     !<
75          INTEGER(KIND=C_INT), VALUE             ::  mode      !<
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
83         INTEGER(KIND=C_INT), VALUE    ::  fd      !<
84         INTEGER(KIND=C_SIZE_T), VALUE ::  offset  !<
85         INTEGER(KIND=C_INT), VALUE    ::  whence  !<
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
96          INTEGER(KIND=C_INT), VALUE    ::  fd       !<
97          INTEGER(KIND=C_SIZE_T), VALUE ::  nr_byte  !<
98          TYPE(C_PTR), VALUE            ::  buf      !<
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
106          INTEGER(KIND=C_INT), VALUE    ::  fd       !<
107          INTEGER(KIND=C_SIZE_T), VALUE ::  nr_byte  !<
108          TYPE(C_PTR), VALUE            ::  buf      !<
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
116          INTEGER(KIND=C_INT), VALUE ::  fd  !<
117       END FUNCTION C_CLOSE
118    END INTERFACE
119
120!
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!
131!-- PALM interfaces
132    INTERFACE fortran_sleep
133       MODULE PROCEDURE fortran_sleep
134    END INTERFACE fortran_sleep
135
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
153       MODULE PROCEDURE posix_read_i4_3d
154       MODULE PROCEDURE posix_read_i8_3d
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
166       MODULE PROCEDURE posix_write_i4_3d
167       MODULE PROCEDURE posix_write_i8_3d
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
174    PUBLIC fortran_sleep,                                                                          &
175           posix_close,                                                                            &
176           posix_lseek,                                                                            &
177           posix_open,                                                                             &
178           posix_read,                                                                             &
179           posix_write
180
181 CONTAINS
182
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
202 INTEGER FUNCTION posix_open( file_name, rd_flag )
203
204    IMPLICIT NONE
205
206    CHARACTER(LEN=*), INTENT(IN)            ::  file_name     !<
207    CHARACTER(LEN=1), DIMENSION(:), POINTER ::  f_string      !<
208    CHARACTER(LEN=128), TARGET              ::  lo_file_name  !<
209
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      !<
215
216    LOGICAL, INTENT(IN)                     ::  rd_flag       !<
217
218    TYPE(C_PTR)                             ::  ptr           !<
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
225    lo_file_name = TRIM( file_name ) // CHAR( 0 )
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
233       flags = o_rdonly
234       fd    = C_OPEN( f_string, flags, mode )  ! Open for reading
235    ELSE
236       flags = o_wronly + o_creat
237       fd    = C_OPEN( f_string, flags, mode )  ! Open for writing
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
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  !<
255
256
257    my_fid = fid
258    whence = seek_set
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
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      !<
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
286 SUBROUTINE posix_read_int_2d( fid, data, nw )
287
288    IMPLICIT NONE
289
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      !<
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
306 SUBROUTINE posix_read_i4_3d( fid, data, nw )
307
308    IMPLICIT NONE
309
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      !<
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
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      !<
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
346 SUBROUTINE posix_read_offset_1d( fid, data, nw )
347
348    IMPLICIT NONE
349
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      !<
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
370    INTEGER                                         ::  nr_byte  !<
371    INTEGER, INTENT(IN)                             ::  fid      !<
372    INTEGER, INTENT(IN)                             ::  nw       !<
373
374    REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
375
376    TYPE(C_PTR)                                     ::  buf      !<
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
392    INTEGER                                              ::  nr_byte  !<
393    INTEGER, INTENT(IN)                                  ::  fid      !<
394    INTEGER, INTENT(IN)                                  ::  nw       !<
395
396    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) ::  data     !<
397
398    TYPE(C_PTR)                                          ::  buf      !<
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
414    INTEGER                                                ::  nr_byte  !<
415    INTEGER, INTENT(IN)                                    ::  fid      !<
416    INTEGER, INTENT(IN)                                    ::  nw       !<
417
418    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) ::  data     !<
419
420    TYPE(C_PTR)                                            ::  buf      !<
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
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   !<
441
442    TYPE(C_PTR)            ::  buf      !<
443
444
445    my_fid  = fid
446    nr_byte = nb
447
448    retval = C_READ( my_fid, buf, nr_byte )
449
450!
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.
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
456        WRITE( 6, * ) 'Number of bytes read does not match the number of requested bytes'
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
468    CHARACTER(LEN=*), DIMENSION(:)   ::  data      !<
469    CHARACTER(LEN=LEN(data)), TARGET ::  data_buf  !<
470
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    !<
476
477    TYPE(C_PTR)                      ::  ptr       !<
478
479
480    my_fid  = fid
481
482    DO  i = 1, SIZE( data )
483       data_buf = data(i)
484       name_len = LEN( data(i) )
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
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   !<
503
504    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
505
506    TYPE(C_PTR)                                         ::  buf      !<
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
523    INTEGER                                               ::  nr_byte  !<
524    INTEGER, INTENT(IN)                                   ::  fid      !<
525    INTEGER, INTENT(IN)                                   ::  nw       !<
526
527    INTEGER(KIND=iwp), INTENT(IN), TARGET, DIMENSION(:,:) ::  data     !<
528
529    TYPE(C_PTR)                                           :: buf       !<
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
541 SUBROUTINE posix_write_i4_3d( fid, data, nw )
542
543    IMPLICIT NONE
544
545    INTEGER                                                 ::  nr_byte  !<
546    INTEGER, INTENT(IN)                                     ::  fid      !<
547    INTEGER, INTENT(IN)                                     ::  nw       !<
548
549    INTEGER(KIND=isp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
550
551    TYPE(C_PTR)                                             ::  buf      !<
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
567    INTEGER                                                 ::  nr_byte  !<
568    INTEGER, INTENT(IN)                                     ::  fid      !<
569    INTEGER, INTENT(IN)                                     ::  nw       !<
570
571    INTEGER(KIND=idp), INTENT(IN), TARGET, DIMENSION(:,:,:) ::  data     !<
572
573    TYPE(C_PTR)                                             ::  buf      !<
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
585 SUBROUTINE posix_write_offset_1d( fid, data, nw )
586
587    IMPLICIT NONE
588
589    INTEGER                                                  ::  nr_byte  !<
590    INTEGER, INTENT(IN)                                      ::  fid      !<
591    INTEGER, INTENT(IN)                                      ::  nw       !<
592
593    INTEGER(KIND=C_SIZE_T), INTENT(IN), TARGET, DIMENSION(:) ::  data     !<
594
595    TYPE(C_PTR)                                              ::  buf      !<
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
611    INTEGER                                         ::  nr_byte   !<
612    INTEGER, INTENT(IN)                             ::  fid       !<
613    INTEGER, INTENT(IN)                             ::  nw        !<
614
615    REAL(KIND=wp), INTENT(IN), TARGET, DIMENSION(:) ::  data      !<
616
617    TYPE(C_PTR)                                     ::  buf       !<
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
633    INTEGER                                              ::  nr_byte  !<
634    INTEGER, INTENT(IN)                                  ::  fid      !<
635    INTEGER, INTENT(IN)                                  ::  nw       !<
636
637    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:) ::  data     !<
638
639    TYPE(C_PTR)                                          ::  buf      !<
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
655    INTEGER                                                ::  nr_byte  !<
656    INTEGER, INTENT(IN)                                    ::  fid      !<
657    INTEGER, INTENT(IN)                                    ::  nw       !<
658
659    REAL(KIND=wp), INTENT(INOUT), TARGET, DIMENSION(:,:,:) ::  data     !<
660
661    TYPE(C_PTR)                                            ::  buf      !<
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
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   !<
682
683    TYPE(C_PTR)            ::  buf      !<
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
692       WRITE( 6, * ) 'Number of bytes to write does not match the number of requested bytes'
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
704    CHARACTER(LEN=*), DIMENSION(:)     ::  data      !<
705    CHARACTER(LEN=LEN(data)+1), TARGET ::  data_buf  !<
706
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    !<
712
713    TYPE(C_PTR)                        ::  ptr       !<
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
733    INTEGER, INTENT(IN) ::  fid     !<
734    INTEGER(KIND=C_INT) ::  my_fid  !<
735    INTEGER(KIND=C_INT) ::  retval  !<
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.