Ignore:
Timestamp:
Nov 13, 2018 4:09:31 PM (6 years ago)
Author:
suehring
Message:

Implement interface for posix conform C-systemcalls in order to replace non-standard FORTRAN functions ftell and fseek

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/surface_output_processing/surface_output_to_vtk.f90

    r3496 r3523  
    2525! -----------------
    2626! $Id$
     27! Implement interface for posix conform C-systemcalls in order to replace
     28! non-standard FORTRAN functions ftell and fseek.
     29!
     30! 3496 2018-11-06 15:59:50Z suehring
    2731! Use subroutine call for fseek instead of function call. gfortran has some
    2832! problems with this.
     
    3438! --------
    3539! @author Matthias Suehring and Klaus Ketelsen
     40!
     41!------------------------------------------------------------------------------!
     42! Description:
     43! ------------
     44!> Interface to posix systemcalls. The module allows to call the following
     45!> C system calls from FORTRAN: ftell, lseek.
     46!------------------------------------------------------------------------------!
     47 MODULE posix_interface
     48 
     49    INTERFACE
     50       INTEGER (C_SIZE_T) FUNCTION C_LSEEK (fd, offset, whence)                &
     51                                   BIND(C, NAME='lseek')
     52         
     53          USE ISO_C_BINDING
     54         
     55          IMPLICIT NONE
     56         
     57          INTEGER(KIND=C_INT),    VALUE ::  fd
     58          INTEGER(KIND=C_SIZE_T), VALUE ::  offset
     59          INTEGER(KIND=C_INT),    VALUE ::  whence
     60         
     61       END FUNCTION C_LSEEK
     62       
     63    END INTERFACE
     64   
     65    INTERFACE
     66       INTEGER (C_SIZE_T) FUNCTION C_FTELL ( fd )                              &
     67                                   BIND(C, NAME='ftell')
     68         
     69          USE ISO_C_BINDING
     70         
     71          IMPLICIT NONE
     72         
     73          INTEGER(KIND=C_INT),    VALUE ::  fd
     74
     75       END FUNCTION C_FTELL
     76       
     77    END INTERFACE
     78   
     79    PUBLIC posix_lseek, posix_ftell
     80   
     81    CONTAINS
     82!
     83!------------------------------------------------------------------------------!
     84! Description:
     85! ------------
     86!> Interface for the C-routine lseek.
     87!------------------------------------------------------------------------------!
     88    SUBROUTINE posix_lseek( fid, offset )
     89   
     90       USE ISO_C_BINDING
     91   
     92       IMPLICIT NONE
     93
     94       INTEGER,INTENT(IN)                     ::  fid    !< file unit
     95       INTEGER(KIND=C_SIZE_T),INTENT(IN)      ::  offset !< file offset from the beginning
     96
     97       INTEGER(KIND=C_INT)                    ::  my_fid !< file unit
     98       INTEGER(KIND=C_SIZE_T)                 ::  retval !< return value
     99       INTEGER(KIND=C_INT)                    ::  whence !< mode, here start from the beginning
     100
     101       my_fid = fid
     102       whence = 0
     103
     104       retval = C_LSEEK( fid, offset, whence )
     105       
     106    END SUBROUTINE posix_lseek
     107!
     108!------------------------------------------------------------------------------!
     109! Description:
     110! ------------
     111!> Interface for the C-routine ftell.
     112!------------------------------------------------------------------------------!
     113    SUBROUTINE posix_ftell( fid, filepos )
     114   
     115       USE ISO_C_BINDING
     116   
     117       IMPLICIT NONE
     118
     119       INTEGER,INTENT(IN)      ::  fid                     !< file unit
     120       INTEGER(KIND=C_SIZE_T), INTENT(INOUT)   ::  filepos !< file position
     121
     122       filepos = C_FTELL( fid )
     123       
     124    END SUBROUTINE posix_ftell
     125
     126 END MODULE posix_interface
    36127!
    37128!------------------------------------------------------------------------------!
     
    45136!------------------------------------------------------------------------------!
    46137 PROGRAM surface_output_to_vtk
     138 
     139    USE, INTRINSIC ::  ISO_C_BINDING
     140 
     141    USE posix_interface,                                                       &
     142        ONLY:  posix_ftell, posix_lseek
    47143
    48144    IMPLICIT NONE
    49145   
    50     CHARACTER(LEN=4)   ::  char_time            !< string indicating simulated time
    51     CHARACTER(LEN=4)   ::  file_suffix = '.bin' !< string which contain the suffix indicating surface data
    52    
    53     CHARACTER(LEN=10)  ::  char_dum             !< dummy string
    54    
    55     CHARACTER(LEN=30)  ::  myid_char            !< combined string indicating binary file
    56    
    57     CHARACTER(LEN=100) ::  path                 !< path to the binary data
    58     CHARACTER(LEN=100) ::  run                  !< name of the run
    59     CHARACTER(LEN=100) ::  variable_name        !< name of the processed output variable   
    60    
    61     INTEGER(4)   ::  ftell                      !< intrinsic function, get current position in file
    62 !     INTEGER(4)   ::  fseek                      !< intrinsic function, go to given position in file
    63     INTEGER(4)   ::  ndum                       !< return parameter of intrinsic function fseek
    64    
    65     INTEGER, PARAMETER ::  iwp = 4              !< integer precision
    66     INTEGER, PARAMETER ::  wp  = 8              !< float precision
    67    
    68     INTEGER(iwp) ::  cycle_number               !< cycle number
    69     INTEGER(iwp) ::  f                          !< running index over all binary files
    70     INTEGER(iwp) ::  file_id_in = 18            !< file unit for input binaray file   
    71     INTEGER(iwp) ::  file_id_out = 20           !< file unit for output VTK file       
    72     INTEGER(iwp) ::  file_id_out_header = 19    !< file unit for temporary header file
    73     INTEGER(iwp) ::  length                     !< length of string on file
    74     INTEGER(iwp) ::  n                          !< running index over all points and polygons
    75     INTEGER(iwp) ::  npoints_total              !< total number of points
    76     INTEGER(iwp) ::  ns_total                   !< total number of polygons
    77     INTEGER(iwp) ::  num_pe                     !< number of processors of the run
    78    
    79     INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  filepos !< current fileposition in binary file
     146    CHARACTER(LEN=4)   ::  char_time              !< string indicating simulated time
     147    CHARACTER(LEN=4)   ::  file_suffix = '.bin'   !< string which contain the suffix indicating surface data
     148   
     149    CHARACTER(LEN=10)  ::  char_dum               !< dummy string
     150   
     151    CHARACTER(LEN=30)  ::  myid_char              !< combined string indicating binary file
     152   
     153    CHARACTER(LEN=100) ::  path                   !< path to the binary data
     154    CHARACTER(LEN=100) ::  run                    !< name of the run
     155    CHARACTER(LEN=100) ::  variable_name          !< name of the processed output variable   
     156       
     157    INTEGER, PARAMETER ::  iwp = 4                !< integer precision
     158    INTEGER, PARAMETER ::  wp  = 8                !< float precision
     159    INTEGER, PARAMETER ::  OFFSET_KIND = C_SIZE_T !< unsigned integer for the C-interface
     160   
     161    INTEGER(iwp) ::  cycle_number                 !< cycle number
     162    INTEGER(iwp) ::  f                            !< running index over all binary files
     163    INTEGER(iwp) ::  file_id_in = 18              !< file unit for input binaray file   
     164    INTEGER(iwp) ::  file_id_out = 20             !< file unit for output VTK file       
     165    INTEGER(iwp) ::  file_id_out_header = 19      !< file unit for temporary header file
     166    INTEGER(iwp) ::  length                       !< length of string on file
     167    INTEGER(iwp) ::  n                            !< running index over all points and polygons
     168    INTEGER(iwp) ::  npoints_total                !< total number of points
     169    INTEGER(iwp) ::  ns_total                     !< total number of polygons
     170    INTEGER(iwp) ::  num_pe                       !< number of processors of the run
     171   
     172    INTEGER(OFFSET_KIND),DIMENSION(:), ALLOCATABLE ::  filepos !< current fileposition in binary file
     173   
    80174    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  npoints !< number of points/vertices in a binaray file
    81175    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  ns      !< number of surface elements in a binaray file
     
    148242!
    149243!--    Obtain current file position. Will be stored for next file opening.
    150        filepos(f) = ftell( file_id_in )
    151 !        CALL FTELL( file_id_in, filepos(f) )
     244       CALL posix_ftell( file_id_in, filepos(f) )
    152245!
    153246!--    Write header information. Only one time required.
     
    183276!
    184277!--    Move to last postion.
    185 !        ndum = fseek( file_id_in, filepos(f), 0 )
    186        CALL FSEEK( file_id_in, filepos(f), 0, ndum )
     278       CALL posix_lseek( file_id_in, filepos(f) )
    187279!
    188280!--    Allocate array for polygon data
     
    194286!--    Obtain current file position after reading the local polygon data.
    195287!--    Will be used for next file opening.
    196        filepos(f) = ftell( file_id_in )
    197 !        CALL FTELL( file_id_in, filepos(f) )
     288       CALL posix_ftell( file_id_in, filepos(f) )
    198289!
    199290!--    Write further header information. Only one time required.
     
    254345!--       Move to last postion.
    255346!           ndum = fseek( file_id_in, filepos(f), 0 )
    256           CALL FSEEK( file_id_in, filepos(f), 0, ndum )
     347          CALL posix_lseek( file_id_in, filepos(f) )
     348!           CALL FSEEK( file_id_in, filepos(f), 0, ndum )
    257349!
    258350!--       Read string length and string indicating the output time step.
     
    317409!
    318410!--       Remember file position in binary file and close it.
    319           filepos(f) = ftell( file_id_in )
    320 !           CALL FTELL( file_id_in, filepos(f) )
     411          CALL posix_ftell( file_id_in, filepos(f) )
    321412       
    322413          CLOSE ( file_id_in )
Note: See TracChangeset for help on using the changeset viewer.