Ignore:
Timestamp:
Nov 6, 2018 3:59:50 PM (3 years ago)
Author:
suehring
Message:

Use subroutine call for intrinsic routine fseek instead of function call. gfortran has some problems with the function interface.

File:
1 edited

Legend:

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

    r3494 r3496  
    2525! -----------------
    2626! $Id$
     27! Use subroutine call for fseek instead of function call. gfortran has some
     28! problems with this.
     29!
     30! 3494 2018-11-06 14:51:27Z suehring
    2731! Initial version
    28 !
    29 ! 3241 2018-09-12 15:02:00Z raasch
    30 !
    3132!
    3233! Authors:
     
    4344!> Output is distinguished between instantaneous and time-averaged data.
    4445!------------------------------------------------------------------------------!
    45  PROGRAM surface_output_merge
     46 PROGRAM surface_output_to_vtk
    4647
    4748    IMPLICIT NONE
     
    5960   
    6061    INTEGER(4)   ::  ftell                      !< intrinsic function, get current position in file
    61     INTEGER(4)   ::  fseek                      !< intrinsic function, go to given position in file
     62!     INTEGER(4)   ::  fseek                      !< intrinsic function, go to given position in file
    6263    INTEGER(4)   ::  ndum                       !< return parameter of intrinsic function fseek
    6364   
     
    6768    INTEGER(iwp) ::  cycle_number               !< cycle number
    6869    INTEGER(iwp) ::  f                          !< running index over all binary files
    69     INTEGER(iwp) ::  file_id_in = 110           !< file unit for input binaray file   
     70    INTEGER(iwp) ::  file_id_in = 18            !< file unit for input binaray file   
    7071    INTEGER(iwp) ::  file_id_out = 20           !< file unit for output VTK file       
    7172    INTEGER(iwp) ::  file_id_out_header = 19    !< file unit for temporary header file
     
    8990    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  points         !< point / vertex data
    9091    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  polygons       !< polygon data
     92   
     93    logical :: flag
    9194
    9295!
    9396!-- Read namelist.
    94     CALL surface_output_merge_parin
     97    CALL surface_output_parin
    9598!
    9699!-- Allocate array which contains the file position in each output file,
     
    124127!
    125128!--    Create filename of the treated binary file.
    126        CALL surface_output_merge_create_file_string
     129       CALL surface_output_create_file_string
    127130!
    128131!--    Open file with surface output for processor f.
    129        OPEN ( file_id_in + f, FILE = TRIM( path ) // TRIM( run ) //            &
    130               TRIM( myid_char ), FORM='UNFORMATTED' )
     132       OPEN ( file_id_in, FILE = TRIM( path ) // TRIM( run ) //                &
     133              TRIM( myid_char ), FORM = 'UNFORMATTED' )
    131134!
    132135!--    Read number of vertices / points and surface elements
    133        READ ( file_id_in + f )  npoints(f)
    134        READ ( file_id_in + f )  npoints_total
    135        READ ( file_id_in + f )  ns(f)
    136        READ ( file_id_in + f )  ns_total
     136       READ ( file_id_in )  npoints(f)
     137       READ ( file_id_in )  npoints_total
     138       READ ( file_id_in )  ns(f)
     139       READ ( file_id_in )  ns_total
    137140
    138141!
     
    142145!
    143146!--    Read polygon data and store them in a temporary file.
    144        READ ( file_id_in + f )  points
     147       READ ( file_id_in )  points
    145148!
    146149!--    Obtain current file position. Will be stored for next file opening.
    147        filepos(f) = ftell( file_id_in + f )
     150       filepos(f) = ftell( file_id_in )
     151!        CALL FTELL( file_id_in, filepos(f) )
    148152!
    149153!--    Write header information. Only one time required.
     
    165169       DEALLOCATE( points )
    166170       
    167        CLOSE ( file_id_in + f )
     171       CLOSE ( file_id_in )
    168172    ENDDO
    169173!
     
    172176!
    173177!--    Create filename of the treated binary file .   
    174        CALL surface_output_merge_create_file_string
     178       CALL surface_output_create_file_string
    175179!
    176180!--    Open file with surface output for processor f.
    177        OPEN ( file_id_in + f, FILE = TRIM( path ) // TRIM( run ) //            &
    178               TRIM( myid_char ), FORM='UNFORMATTED' )
     181       OPEN ( file_id_in, FILE = TRIM( path ) // TRIM( run ) //                &
     182              TRIM( myid_char ), FORM = 'UNFORMATTED' )
    179183!
    180184!--    Move to last postion.
    181        ndum = fseek( file_id_in + f, filepos(f), 0 )
     185!        ndum = fseek( file_id_in, filepos(f), 0 )
     186       CALL FSEEK( file_id_in, filepos(f), 0, ndum )
    182187!
    183188!--    Allocate array for polygon data
     
    185190!
    186191!--    Read polygon data and store them in a temporary file.
    187        READ ( file_id_in + f )  polygons
     192       READ ( file_id_in )  polygons
    188193!
    189194!--    Obtain current file position after reading the local polygon data.
    190195!--    Will be used for next file opening.
    191        filepos(f) = ftell( file_id_in + f )
     196       filepos(f) = ftell( file_id_in )
     197!        CALL FTELL( file_id_in, filepos(f) )
    192198!
    193199!--    Write further header information. Only one time required.
     
    200206!--    surface element.
    201207       DO n = 1, ns(f)
    202           WRITE ( file_id_out_header, '(8I10)' )  INT (polygons(1:5,n) )
     208          WRITE ( file_id_out_header, '(8I10)' )  INT( polygons(1:5,n) )
    203209       ENDDO
    204210!
     
    206212       DEALLOCATE( polygons )
    207213       
    208        CLOSE ( file_id_in + f )
     214       CLOSE ( file_id_in )
    209215       
    210216    ENDDO
    211217   
    212218    f = 0
    213     CALL surface_output_merge_create_file_string
     219    CALL surface_output_create_file_string
    214220!
    215221!-- Write further header information. Only once required.
     
    240246!
    241247!--       Create filename of the treated binary file.           
    242           CALL surface_output_merge_create_file_string
     248          CALL surface_output_create_file_string
    243249!
    244250!--       Open binary file with surface output for processor f.
    245           OPEN ( file_id_in + f, FILE = TRIM( path ) // TRIM( run ) //         &
    246                  TRIM( myid_char ), FORM='UNFORMATTED' )
     251          OPEN ( file_id_in, FILE = TRIM( path ) // TRIM( run ) //         &
     252                 TRIM( myid_char ), FORM = 'UNFORMATTED' )
    247253!
    248254!--       Move to last postion.
    249           ndum = fseek( file_id_in + f, filepos(f), 0 )
     255!           ndum = fseek( file_id_in, filepos(f), 0 )
     256          CALL FSEEK( file_id_in, filepos(f), 0, ndum )
    250257!
    251258!--       Read string length and string indicating the output time step.
    252           READ ( file_id_in + f ) length
    253           READ ( file_id_in + f ) char_time(1:length)
     259          READ ( file_id_in ) length
     260          READ ( file_id_in ) char_time(1:length)
    254261!
    255262!--       If string for the output time indicates the end-of-file, set the eof
     
    257264          IF ( char_time(1:length) == 'END' )  THEN
    258265             eof(f) = .TRUE.
    259              CLOSE ( file_id_in + f )
     266             CLOSE ( file_id_in )
    260267             CYCLE
    261268          ENDIF
    262269!
    263270!--       Read output time, and variable name.
    264           READ ( file_id_in + f ) simulated_time
    265           READ ( file_id_in + f ) length
    266           READ ( file_id_in + f ) variable_name(1:length)
     271          READ ( file_id_in ) simulated_time
     272          READ ( file_id_in ) length
     273          READ ( file_id_in ) variable_name(1:length)
    267274!
    268275!--       For first loop index, open the target output file. First create the
     
    296303             OPEN ( file_id_out, FILE = TRIM( path ) // TRIM( char_dum ) //    &
    297304                    's_' // TRIM( variable_name ) // '.vtk', FORM='FORMATTED', &
    298                     POSITION='APPEND' )           
     305                    POSITION = 'APPEND' )           
    299306          ENDIF
    300307!
     
    302309          ALLOCATE( var(1:ns(f)) )
    303310       
    304           READ( file_id_in + f ) var
     311          READ( file_id_in ) var
    305312!
    306313!--       Write variable data into output VTK file.
     
    310317!
    311318!--       Remember file position in binary file and close it.
    312           filepos(f) = ftell( file_id_in + f )
    313        
    314           CLOSE ( file_id_in + f )
     319          filepos(f) = ftell( file_id_in )
     320!           CALL FTELL( file_id_in, filepos(f) )
     321       
     322          CLOSE ( file_id_in )
    315323!
    316324!--       Deallocate temporary array for variable data.
     
    338346!> This subroutine read the namelist file.
    339347!------------------------------------------------------------------------------!
    340     SUBROUTINE surface_output_merge_parin
     348    SUBROUTINE surface_output_parin
    341349       
    342350       IMPLICIT NONE
     
    358366       CLOSE( file_id_parin )
    359367       
    360     END SUBROUTINE surface_output_merge_parin
     368    END SUBROUTINE surface_output_parin
    361369     
    362370!------------------------------------------------------------------------------!
     
    365373!> This subroutine creates the filename string of the treated binary file.
    366374!------------------------------------------------------------------------------!
    367     SUBROUTINE surface_output_merge_create_file_string
     375    SUBROUTINE surface_output_create_file_string
    368376       
    369377       IMPLICIT NONE
     
    417425       ENDIF
    418426       
    419     END SUBROUTINE surface_output_merge_create_file_string
    420    
    421  END PROGRAM surface_output_merge
    422 
    423 
    424 
     427    END SUBROUTINE surface_output_create_file_string
     428   
     429 END PROGRAM surface_output_to_vtk
     430
     431
     432
Note: See TracChangeset for help on using the changeset viewer.