- Timestamp:
- Nov 13, 2018 4:09:31 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/surface_output_processing/surface_output_to_vtk.f90
r3496 r3523 25 25 ! ----------------- 26 26 ! $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 27 31 ! Use subroutine call for fseek instead of function call. gfortran has some 28 32 ! problems with this. … … 34 38 ! -------- 35 39 ! @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 36 127 ! 37 128 !------------------------------------------------------------------------------! … … 45 136 !------------------------------------------------------------------------------! 46 137 PROGRAM surface_output_to_vtk 138 139 USE, INTRINSIC :: ISO_C_BINDING 140 141 USE posix_interface, & 142 ONLY: posix_ftell, posix_lseek 47 143 48 144 IMPLICIT NONE 49 145 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 80 174 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: npoints !< number of points/vertices in a binaray file 81 175 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ns !< number of surface elements in a binaray file … … 148 242 ! 149 243 !-- 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) ) 152 245 ! 153 246 !-- Write header information. Only one time required. … … 183 276 ! 184 277 !-- 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) ) 187 279 ! 188 280 !-- Allocate array for polygon data … … 194 286 !-- Obtain current file position after reading the local polygon data. 195 287 !-- 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) ) 198 289 ! 199 290 !-- Write further header information. Only one time required. … … 254 345 !-- Move to last postion. 255 346 ! 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 ) 257 349 ! 258 350 !-- Read string length and string indicating the output time step. … … 317 409 ! 318 410 !-- 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) ) 321 412 322 413 CLOSE ( file_id_in )
Note: See TracChangeset
for help on using the changeset viewer.
