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

Last change on this file since 4598 was 4495, checked in by raasch, 12 months ago

restart data handling with MPI-IO added, first part

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