!> @file binary_to_netcdf.f90 !--------------------------------------------------------------------------------------------------! ! This file is part of the PALM model system. ! ! PALM is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 2019-2019 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------------------------! ! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: binary_to_netcdf.f90 4107 2019-07-22 08:51:35Z monakurppa $ ! Initial revision ! ! ! Authors: ! -------- !> @author Viola Weniger !> @author Tobias Gronemeier !> @author Helge Knoop ! !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> This program reads binary output files written by DOM (the data-output module of PALM) and !> converts the data into NetCDF files. !> !> @todo Change style of printed messages to terminal in accordance to PALM termial output. !--------------------------------------------------------------------------------------------------! PROGRAM binary_to_netcdf USE NETCDF IMPLICIT NONE !-- Set kinds to be used as defaults INTEGER, PARAMETER :: wp = 8 !< default real kind INTEGER, PARAMETER :: iwp = 4 !< default integer kind INTEGER, PARAMETER :: charlen_internal = 1000 !< length of strings within this program TYPE attribute_type CHARACTER(LEN=charlen_internal) :: data_type !< data type of attribute value CHARACTER(LEN=charlen_internal) :: name !< name of attribute CHARACTER(LEN=charlen_internal) :: value_char !< character value INTEGER(iwp) :: var_id !< id of variable to which the attribute belongs to INTEGER(KIND=1) :: value_int8 !< 8bit integer value INTEGER(KIND=2) :: value_int16 !< 16bit integer value INTEGER(KIND=4) :: value_int32 !< 32bit integer value REAL(KIND=4) :: value_real32 !< 32bit real value REAL(KIND=8) :: value_real64 !< 64bit real value END TYPE attribute_type TYPE dimension_type CHARACTER(LEN=charlen_internal) :: data_type !< data type of dimension CHARACTER(LEN=charlen_internal) :: name !< dimension name INTEGER(iwp) :: id !< dimension id within file INTEGER(iwp) :: length !< length of dimension END TYPE dimension_type TYPE variable_type CHARACTER(LEN=charlen_internal) :: data_type !< data type of variable CHARACTER(LEN=charlen_internal) :: name !< variable name INTEGER(iwp) :: id !< variable id within file INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids used by variable END TYPE variable_type CHARACTER(LEN=charlen_internal) :: temp_string !< dummy string CHARACTER(LEN=:), ALLOCATABLE :: filename_prefix !< prefix of names of files to be read CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: group_names !< names of output groups CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list !< list of netcdf file names CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_to_netcdf' !< name of routine CHARACTER(LEN=*), PARAMETER :: config_file_name_base = 'BINARY_TO_NETCDF_CONFIG' !< name of config file CHARACTER(LEN=*), PARAMETER :: & config_file_list_name = 'BINARY_CONFIG_LIST' !< file containing list of binary config files of each output group INTEGER(iwp) :: charlen !< length of characters (strings) in binary file INTEGER(iwp) :: dom_global_id !< global ID within a single file defined by DOM INTEGER :: dom_master_rank !< master MPI rank in DOM (rank which wrote additional information in DOM) INTEGER :: dom_nrank !< number of MPI ranks used by DOM INTEGER(iwp) :: file_index !< loop index to loop over files INTEGER :: group !< loop index to loop over groups INTEGER(iwp) :: nc_file_id !< ID of netcdf output file INTEGER(iwp) :: nfiles !< number of output files defined in config file INTEGER :: ngroup !< number of output-file groups INTEGER :: return_value !< return value INTEGER :: your_return_value !< returned value of called routine INTEGER(KIND=1) :: dummy_int8 !< dummy variable used for reading INTEGER(KIND=2) :: dummy_int16 !< dummy variable used for reading INTEGER(KIND=4) :: dummy_int32 !< dummy variable used for reading INTEGER(iwp) :: dummy_intwp !< dummy variable used for reading INTEGER, PARAMETER :: bin_file_unit = 12 !< Fortran unit of binary file INTEGER, PARAMETER :: config_file_unit = 11 !< Fortran unit of configuration file INTEGER, PARAMETER :: config_file_list_unit = 10 !< Fortran unit of file containing config-file list INTEGER, DIMENSION(:), ALLOCATABLE :: dim_id_netcdf !< mapped dimension id within NetCDF file: !> dimension_list(i)%id and dim_id_netcdf(dimension_list(i)%id) !> reference the same dimension INTEGER, DIMENSION(:), ALLOCATABLE :: var_id_netcdf !< mapped variable id within NetCDF file: !> variable_list(i)%id and var_id_netcdf(variable_list(i)%id) !> reference the same variable LOGICAL :: print_debug_output = .FALSE. !< if true, print debug output to STDOUT REAL(KIND=4) :: dummy_real32 !< dummy variable used for reading REAL(KIND=8) :: dummy_real64 !< dummy variable used for reading TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list !< list containing all attributes of a file TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list !< list containing all dimensions of a file TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list !< list containing all variables of a file return_value = 0 CALL internal_message( 'info', 'Start ' // routine_name // ' ...' ) CALL get_group_names( return_value ) IF ( return_value == 0 ) THEN !-- Go through each group of output files (all marked by same file suffix) DO group = 1, ngroup CALL internal_message( 'info', 'Start converting ' // TRIM( group_names(group) ) // & ' binary files:' ) CALL read_config( TRIM( group_names(group) ), your_return_value ) IF ( your_return_value == 0 ) THEN DO file_index = 1, nfiles CALL internal_message( 'info', 'Create file ' // TRIM( filename_list(file_index) ) ) CALL read_binary_header( TRIM( filename_list(file_index) ), your_return_value ) IF ( your_return_value == 0 ) THEN CALL define_netcdf_files( TRIM( filename_list(file_index) ), your_return_value ) ELSE return_value = your_return_value ENDIF IF ( your_return_value == 0 ) THEN CALL convert_data_to_netcdf( TRIM( filename_list(file_index) ), your_return_value ) ELSE return_value = your_return_value ENDIF ENDDO ELSE return_value = your_return_value ENDIF IF ( ALLOCATED( filename_list ) ) DEALLOCATE( filename_list ) IF ( ALLOCATED( filename_prefix ) ) DEALLOCATE( filename_prefix ) ENDDO ENDIF IF ( return_value == 0 ) THEN CALL internal_message( 'info', 'Execution finished' ) ELSE CALL internal_message( 'error', routine_name // ': Error during execution! Check results!' ) STOP 1 ENDIF CONTAINS !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Check if any configuration file is present in the current directory and get the list of all !> these files and extract the output-group names. !--------------------------------------------------------------------------------------------------! SUBROUTINE get_group_names( return_value ) CHARACTER(LEN=charlen_internal) :: file_name !< file name read from list CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_group_names' !< name of routine INTEGER :: i !< loop index INTEGER :: io_stat !< status of Fortran I/O operations INTEGER, INTENT(OUT) :: return_value !< return value CALL internal_message( 'info', 'Check if anything to convert...' ) !-- Search for configuration files and save the list of file names in a separate file CALL EXECUTE_COMMAND_LINE( & COMMAND='find . -type f -name "' // config_file_name_base // '*" | ' // & 'sed -r "s/^\.\/(' // config_file_name_base // ')?(.+)$/\1\2/" > ' // & config_file_list_name, & WAIT=.TRUE., & EXITSTAT=return_value ) !-- Read the config-file-name list and extract the group names from the file names IF ( return_value /= 0 ) THEN CALL internal_message( 'error', routine_name // & ': error while searching for configuration files: ' // & 'System returned non-zero exit status. ' // & 'Please report this error to the developers!' ) ELSE OPEN( config_file_list_unit, FILE=config_file_list_name, FORM='formatted', & STATUS='OLD', IOSTAT=io_stat ) !-- Count the configuration files ngroup = 0 DO WHILE ( io_stat == 0 ) READ( config_file_list_unit, '(A)', IOSTAT=io_stat ) file_name IF ( io_stat == 0 ) ngroup = ngroup + 1 ENDDO REWIND( config_file_list_unit ) IF ( ngroup /= 0 ) THEN ALLOCATE( group_names(ngroup) ) !-- Extract the group names DO i = 1, ngroup READ( config_file_list_unit, '(A)', IOSTAT=io_stat ) file_name IF ( INDEX( TRIM( file_name ), config_file_name_base ) == 1 ) THEN IF ( TRIM( file_name ) == TRIM( config_file_name_base ) ) THEN group_names(i) = '' ELSE group_names(i) = file_name(LEN_TRIM( config_file_name_base )+1:) ENDIF ELSE return_value = 1 CALL internal_message( 'error', routine_name // & ': error while getting list of binary config files: ' // & 'Unexpected text found in file list. ' // & 'Please report this error to the developers!' ) EXIT ENDIF ENDDO ELSE CALL internal_message( 'info', 'No configuration files found. ' // & 'No binary files to convert to NetCDF.' ) ENDIF CLOSE( config_file_list_unit ) ENDIF END SUBROUTINE get_group_names !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read configuration file. !--------------------------------------------------------------------------------------------------! SUBROUTINE read_config( group_name, return_value ) CHARACTER(LEN=:), ALLOCATABLE :: read_string !< string read from file CHARACTER(LEN=*), INTENT(IN) :: group_name !< group name CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_config' !< name of routine CHARACTER(LEN=charlen_internal) :: config_file_name !< config file name with additional suffix CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list_tmp !< temporary list of file names INTEGER(iwp) :: filename_prefix_length !< length of string containing the filname prefix INTEGER :: io_stat !< status of Fortran I/O operations INTEGER, INTENT(OUT) :: return_value !< return value of routine return_value = 0 config_file_name = config_file_name_base // group_name OPEN( config_file_unit, FILE=config_file_name, FORM='unformatted', & STATUS='OLD', IOSTAT=io_stat ) IF ( io_stat /= 0 ) THEN return_value = 1 CALL internal_message( 'error', & routine_name // ': error while opening configuration file "' // & TRIM( config_file_name ) // '"' ) ENDIF IF ( return_value == 0 ) THEN READ( config_file_unit ) dom_nrank IF ( dom_nrank > 1000000 ) THEN dom_nrank = 1000000 CALL internal_message( 'info', routine_name // & ': number of MPI ranks used in PALM is greater than the maximum ' // & 'amount I can handle. I will only consider the first 1000000 output files.' ) ENDIF READ( config_file_unit ) dom_master_rank READ( config_file_unit ) filename_prefix_length ALLOCATE( CHARACTER(filename_prefix_length)::filename_prefix ) READ( config_file_unit ) filename_prefix READ( config_file_unit ) charlen READ( config_file_unit ) dom_global_id !-- Read the list of output file names ALLOCATE( CHARACTER(LEN=charlen) :: read_string ) nfiles = 0 DO WHILE ( io_stat == 0 ) READ( config_file_unit, IOSTAT=io_stat ) read_string IF ( io_stat == 0 ) THEN IF ( TRIM( read_string ) == '*** end config file ***' ) THEN EXIT ELSE !-- Extend the list of file names if necessary IF ( .NOT. ALLOCATED( filename_list ) ) THEN nfiles = 1 ALLOCATE( filename_list(nfiles) ) ELSE ALLOCATE( filename_list_tmp(nfiles) ) filename_list_tmp = filename_list DEALLOCATE( filename_list ) nfiles = nfiles + 1 ALLOCATE( filename_list(nfiles) ) filename_list(:nfiles-1) = filename_list_tmp DEALLOCATE( filename_list_tmp ) ENDIF filename_list(nfiles) = TRIM( read_string ) // group_name ENDIF ELSEIF ( io_stat > 0 ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': error while reading file names from config' ) EXIT ENDIF ENDDO CLOSE( config_file_unit ) ENDIF END SUBROUTINE read_config !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read header information from binary files. !--------------------------------------------------------------------------------------------------! SUBROUTINE read_binary_header( bin_filename_body, return_value ) CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read CHARACTER(LEN=charlen ) :: read_string !< string read from file CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_binary_header' !< name of routine INTEGER :: i !< loop index INTEGER :: io_stat !< status of Fortran I/O operations INTEGER :: n_attributes !< number of attributes in file INTEGER :: n_dimensions !< number of dimensions in file INTEGER :: n_variables !< number of variables in file INTEGER(iwp) :: var_ndim !< number of dimensions of a variable INTEGER, INTENT(OUT) :: return_value !< return value TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list_tmp !< temporary attribute list TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list_tmp !< temporary dimension list TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list_tmp !< temporary variable list return_value = 0 !-- Open binary file written by dom_master_rank WRITE( bin_filename , '(A,I6.6)' ) & TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', dom_master_rank CALL internal_message( 'debug', routine_name // ': read file ' // TRIM( bin_filename ) ) OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD', IOSTAT=io_stat ) !-- Skip redundant information IF ( io_stat == 0 ) THEN READ( bin_file_unit ) dummy_intwp READ( bin_file_unit ) dummy_intwp READ( bin_file_unit ) read_string ELSE return_value = 1 CALL internal_message( 'error', routine_name // & ': could not open file ' // TRIM( bin_filename ) ) ENDIF !-- Read dimension, variable and attribute information DO WHILE ( io_stat == 0 ) ! iterate over file header READ( bin_file_unit ) read_string CALL internal_message( 'debug', routine_name // ': read_string=' // TRIM( read_string ) ) SELECT CASE ( TRIM( read_string ) ) CASE ( 'dimension' ) !-- Increase dimension list by 1 element IF ( .NOT. ALLOCATED( dimension_list ) ) THEN ALLOCATE( dimension_list(1) ) n_dimensions = 1 ELSE ALLOCATE( dimension_list_tmp(n_dimensions) ) dimension_list_tmp = dimension_list DEALLOCATE( dimension_list ) n_dimensions = n_dimensions + 1 ALLOCATE( dimension_list(n_dimensions) ) dimension_list(1:n_dimensions-1) = dimension_list_tmp DEALLOCATE( dimension_list_tmp ) ENDIF !-- Read dimension READ( bin_file_unit ) read_string dimension_list(n_dimensions)%name = read_string READ( bin_file_unit ) dimension_list(n_dimensions)%id READ( bin_file_unit ) read_string dimension_list(n_dimensions)%data_type = read_string READ( bin_file_unit ) dimension_list(n_dimensions)%length CASE ( 'variable' ) !-- Increase variable list by 1 element IF ( .NOT. ALLOCATED( variable_list ) ) THEN ALLOCATE( variable_list(1) ) n_variables = 1 ELSE ALLOCATE( variable_list_tmp(n_variables) ) variable_list_tmp = variable_list DEALLOCATE( variable_list ) n_variables = n_variables + 1 ALLOCATE( variable_list(n_variables) ) variable_list(1:n_variables-1) = variable_list_tmp DEALLOCATE( variable_list_tmp ) ENDIF !-- Read variable READ( bin_file_unit ) read_string variable_list(n_variables)%name = read_string READ( bin_file_unit ) variable_list(n_variables)%id READ( bin_file_unit ) read_string variable_list(n_variables)%data_type = read_string READ( bin_file_unit ) var_ndim ALLOCATE( variable_list(n_variables)%dimension_ids(1:var_ndim) ) READ( bin_file_unit ) ( variable_list(n_variables)%dimension_ids(i), i = 1, var_ndim ) CASE ( 'attribute' ) !-- Increase attribute list by 1 element IF ( .NOT. ALLOCATED( attribute_list ) ) THEN ALLOCATE( attribute_list(1) ) n_attributes = 1 ELSE ALLOCATE( attribute_list_tmp(n_attributes) ) attribute_list_tmp = attribute_list DEALLOCATE( attribute_list ) n_attributes = n_attributes + 1 ALLOCATE( attribute_list(n_attributes) ) attribute_list(1:n_attributes-1) = attribute_list_tmp DEALLOCATE( attribute_list_tmp ) ENDIF !-- Read attribute READ( bin_file_unit ) attribute_list(n_attributes)%var_id READ( bin_file_unit ) read_string attribute_list(n_attributes)%name = read_string READ( bin_file_unit ) read_string attribute_list(n_attributes)%data_type = read_string SELECT CASE( attribute_list(n_attributes)%data_type ) CASE ( 'char' ) READ( bin_file_unit ) read_string attribute_list(n_attributes)%value_char = read_string CASE ( 'int16' ) READ( bin_file_unit ) attribute_list(n_attributes)%value_int16 CASE ( 'int32' ) READ( bin_file_unit ) attribute_list(n_attributes)%value_int32 CASE ( 'real32' ) READ( bin_file_unit ) attribute_list(n_attributes)%value_real32 CASE ( 'real64' ) READ( bin_file_unit ) attribute_list(n_attributes)%value_real64 CASE DEFAULT return_value = 1 CALL internal_message( 'error', routine_name // ': data type "' // & TRIM( attribute_list(n_attributes)%data_type ) // & '" of attribute "' // & TRIM( attribute_list(n_attributes)%name ) // & '" is not supported' ) END SELECT CASE ( '*** end file header ***' ) EXIT CASE DEFAULT return_value = 1 CALL internal_message( 'error', routine_name // & ': unknown header information: ' // TRIM( read_string ) ) END SELECT IF ( return_value /= 0 ) EXIT ENDDO ! iterate over file header CLOSE( bin_file_unit ) END SUBROUTINE read_binary_header !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Define all netcdf files. !--------------------------------------------------------------------------------------------------! SUBROUTINE define_netcdf_files( nc_filename, return_value ) CHARACTER(LEN=*), INTENT(IN) :: nc_filename !< name of netcdf file CHARACTER(LEN=*), PARAMETER :: routine_name = 'define_netcdf_files' !< routine name INTEGER :: i !< loop index INTEGER :: j !< loop index INTEGER :: nc_data_type !< netcdf data type of output variable INTEGER :: nc_dim_length !< length of dimension in netcdf file INTEGER :: nc_stat !< return value of Netcdf calls INTEGER, INTENT(OUT) :: return_value !< return value INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: var_dim_id !< list of dimension ids of a variable return_value = 0 !-- Create Netcdf-file nc_stat = NF90_CREATE( TRIM( nc_filename ), IOR( NF90_CLOBBER, NF90_NETCDF4 ), nc_file_id ) IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': NF90_CREATE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) ELSE !-- Define dimensions in NetCDF file ALLOCATE( dim_id_netcdf(1:MAXVAL(dimension_list(:)%id)) ) DO i = 1, SIZE( dimension_list ) IF ( dimension_list(i)%length < 0 ) THEN nc_dim_length = NF90_UNLIMITED ELSE nc_dim_length = dimension_list(i)%length ENDIF nc_stat = NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dim_length, & dim_id_netcdf(dimension_list(i)%id) ) IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': dimension "' // TRIM( dimension_list(i)%name ) // & '": NF90_DEF_DIM error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) EXIT ENDIF ENDDO ENDIF IF ( return_value == 0 ) THEN !-- Create vector to map variable IDs from binary file to those within netcdf file ALLOCATE( var_id_netcdf(MIN( MINVAL(attribute_list(:)%var_id), & MINVAL(variable_list(:)%id) ) : & MAX( MAXVAL(attribute_list(:)%var_id), & MAXVAL(variable_list(:)%id) ) ) ) !-- Map global id from binary file to that of the netcdf file var_id_netcdf(dom_global_id) = NF90_GLOBAL !-- Define variables in NetCDF file DO i = 1, SIZE( variable_list ) SELECT CASE ( TRIM( variable_list(i)%data_type ) ) CASE ( 'char' ) nc_data_type = NF90_CHAR CASE ( 'int8' ) nc_data_type = NF90_BYTE CASE ( 'int16' ) nc_data_type = NF90_SHORT CASE ( 'int32' ) nc_data_type = NF90_INT CASE ( 'real32' ) nc_data_type = NF90_FLOAT CASE ( 'real64' ) nc_data_type = NF90_DOUBLE CASE DEFAULT return_value = 1 CALL internal_message( 'error', routine_name // & ': data type "' // TRIM( variable_list(i)%data_type ) // & '" of variable "' // TRIM( variable_list(i)%name ) // & '" is not supported' ) END SELECT IF ( return_value == 0 ) THEN ALLOCATE( var_dim_id(1:SIZE( variable_list(i)%dimension_ids )) ) DO j = 1, SIZE( variable_list(i)%dimension_ids ) var_dim_id(j) = dim_id_netcdf(variable_list(i)%dimension_ids(j)) ENDDO nc_stat = NF90_DEF_VAR( nc_file_id, variable_list(i)%name, nc_data_type, & var_dim_id, var_id_netcdf(variable_list(i)%id) ) IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': variable "' // TRIM( variable_list(i)%name ) // & '": NF90_DEF_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) ENDIF DEALLOCATE( var_dim_id ) ENDIF IF ( return_value /= 0 ) EXIT ENDDO ENDIF IF ( return_value == 0 ) THEN !-- Define attributes in netcdf DO i = 1, SIZE( attribute_list ) SELECT CASE ( TRIM( attribute_list(i)%data_type ) ) CASE ( 'char' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & TRIM(attribute_list(i)%value_char) ) CASE ( 'int8' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & attribute_list(i)%value_int8 ) CASE ( 'int16' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & attribute_list(i)%value_int16 ) CASE ( 'int32' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & attribute_list(i)%value_int32 ) CASE ( 'real32' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & attribute_list(i)%value_real32 ) CASE ( 'real64' ) nc_stat = NF90_PUT_ATT( nc_file_id, & var_id_netcdf(attribute_list(i)%var_id), & TRIM(attribute_list(i)%name), & attribute_list(i)%value_real64 ) CASE DEFAULT return_value = 1 CALL internal_message( 'error', routine_name // & ': data type "' // TRIM( attribute_list(i)%data_type ) // & '" of attribute "' // TRIM( attribute_list(i)%name ) // & '" is not supported' ) EXIT END SELECT IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': attribute "' // TRIM( attribute_list(i)%name ) // & '": NF90_PUT_ATT error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) EXIT ENDIF ENDDO ! loop over attributes ENDIF IF ( ALLOCATED( attribute_list ) ) DEALLOCATE( attribute_list ) IF ( ALLOCATED( dimension_list ) ) DEALLOCATE( dimension_list ) nc_stat = NF90_ENDDEF( nc_file_id ) IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) ENDIF END SUBROUTINE define_netcdf_files !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read variable data from binary and write them into netcdf files. !--------------------------------------------------------------------------------------------------! SUBROUTINE convert_data_to_netcdf( bin_filename_body, return_value ) CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read CHARACTER(LEN=charlen ) :: read_string !< string read from file CHARACTER(LEN=charlen ) :: variable_name !< name of variable to be read CHARACTER(LEN=*), PARAMETER :: routine_name = 'convert_data_to_netcdf' !< routine name INTEGER :: data_count !< count of data values of a variable over all dimensions INTEGER :: i !< loop file_index INTEGER :: io_stat !< status of Fortran I/O operations INTEGER :: pe_id !< loop index for loop over PE files INTEGER :: n_dim !< number of dimensions of a variable INTEGER :: nc_stat !< return value of Netcdf calls INTEGER, INTENT(OUT) :: return_value !< return value INTEGER(iwp) :: var_id !< variable id read from binary file INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_positions !< start position of data per dimension INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: data_count_per_dimension !< data count of variable per dimension INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_start !< lower bounds of variable INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_end !< upper bounds of variable INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_origin !< lower bounds of dimensions in output file INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< variable values INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< variable values INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< variable values INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< variable values LOGICAL :: file_exists !< true if file exists REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< variable values REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< variable values REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< variable values return_value = 0 !-- Open binary files of every possible PE DO pe_id = 0, dom_nrank - 1 WRITE( bin_filename, '(A, I6.6)' ) & TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', pe_id INQUIRE( FILE=bin_filename, EXIST=file_exists ) !-- Read file if it exists IF ( file_exists ) THEN OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD' ) CALL internal_message( 'debug', routine_name // & ': read binary file ' // TRIM( bin_filename ) ) read_string = '' DO WHILE ( TRIM( read_string ) /= '*** end file header ***' ) READ( bin_file_unit ) read_string SELECT CASE ( TRIM( read_string ) ) CASE ( 'char' ) READ( bin_file_unit ) read_string CASE ( 'int8' ) READ( bin_file_unit ) dummy_int8 CASE ( 'int16' ) READ( bin_file_unit ) dummy_int16 CASE ( 'int32' ) READ( bin_file_unit ) dummy_int32 CASE ( 'real32' ) READ( bin_file_unit ) dummy_real32 CASE ( 'real64' ) READ( bin_file_unit ) dummy_real64 END SELECT ENDDO !-- Read variable data io_stat = 0 DO WHILE ( io_stat == 0 .AND. return_value == 0 ) READ( bin_file_unit, IOSTAT=io_stat ) var_id IF ( io_stat < 0 ) EXIT ! End-of-file DO i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 ) IF ( var_id == variable_list(i)%id ) THEN n_dim = SIZE( variable_list(i)%dimension_ids ) variable_name = variable_list(i)%name CALL internal_message( 'debug', routine_name // ': read variable "' // & TRIM( variable_name ) // '"' ) WRITE( temp_string, * ) n_dim CALL internal_message( 'debug', routine_name // & ': n_dim = ' // TRIM( temp_string ) ) EXIT ENDIF ENDDO ALLOCATE( bounds_start(1:n_dim) ) ALLOCATE( bounds_end(1:n_dim) ) ALLOCATE( bounds_origin(1:n_dim) ) ALLOCATE( start_positions(1:n_dim) ) ALLOCATE( data_count_per_dimension(1:n_dim) ) READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dim ) READ( bin_file_unit ) ( bounds_end(i), i = 1, n_dim ) READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dim ) WRITE( temp_string, * ) bounds_start CALL internal_message( 'debug', routine_name // & ': bounds_start = ' // TRIM( temp_string ) ) WRITE( temp_string, * ) bounds_end CALL internal_message( 'debug', routine_name // & ': bounds_end = ' // TRIM( temp_string ) ) WRITE( temp_string, * ) bounds_origin CALL internal_message( 'debug', routine_name // & ': bounds_origin = ' // TRIM( temp_string ) ) data_count = 1 DO i = 1, n_dim data_count = data_count * ( bounds_end(i) - bounds_start(i) + 1 ) start_positions(i) = bounds_start(i) - bounds_origin(i) + 1 data_count_per_dimension(i) = bounds_end(i) - bounds_start(i) + 1 ENDDO read_string = '' READ( bin_file_unit ) read_string ! read data type of following values SELECT CASE ( TRIM( read_string ) ) CASE ( 'int8' ) ALLOCATE( values_int8(1:data_count) ) READ( bin_file_unit ) ( values_int8(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int8, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_int8 ) CASE ( 'int16' ) ALLOCATE( values_int16(1:data_count) ) READ( bin_file_unit ) ( values_int16(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int16, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_int16 ) CASE ( 'int32' ) ALLOCATE( values_int32(1:data_count) ) READ( bin_file_unit ) ( values_int32(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int32, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_int32 ) CASE ( 'intwp' ) ALLOCATE( values_intwp(1:data_count) ) READ( bin_file_unit ) ( values_intwp(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_intwp, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_intwp ) CASE ( 'real32' ) ALLOCATE( values_real32(1:data_count) ) READ( bin_file_unit ) ( values_real32(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real32, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_real32 ) CASE ( 'real64' ) ALLOCATE( values_real64(1:data_count) ) READ( bin_file_unit ) ( values_real64(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real64, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_real64 ) CASE ( 'realwp' ) ALLOCATE( values_realwp(1:data_count) ) READ( bin_file_unit ) ( values_realwp(i), i = 1, data_count ) nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_realwp, & start = start_positions, count = data_count_per_dimension ) DEALLOCATE( values_realwp ) END SELECT IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': variable "' // TRIM( variable_name ) // & '": NF90_PUT_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) ENDIF !-- Deallocate fields for next variable DEALLOCATE( start_positions ) DEALLOCATE( data_count_per_dimension ) DEALLOCATE( bounds_start ) DEALLOCATE( bounds_end ) DEALLOCATE( bounds_origin ) ENDDO ! end loop over variables in a file CLOSE( bin_file_unit ) ENDIF ! if file exists ENDDO ! end loop over all PE nc_stat = NF90_CLOSE( nc_file_id ) IF ( nc_stat /= NF90_NOERR ) THEN return_value = 1 CALL internal_message( 'error', routine_name // & ': NF90_CLOSE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) ) ENDIF !-- Deallocate fields for next file IF ( ALLOCATED( variable_list ) ) DEALLOCATE( variable_list ) IF ( ALLOCATED( dim_id_netcdf ) ) DEALLOCATE( dim_id_netcdf ) IF ( ALLOCATED( var_id_netcdf ) ) DEALLOCATE( var_id_netcdf ) END SUBROUTINE convert_data_to_netcdf !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Message routine for internal use. !--------------------------------------------------------------------------------------------------! SUBROUTINE internal_message( level, string ) CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level CHARACTER(LEN=*), INTENT(IN) :: string !< message string IF ( TRIM( level ) == 'error' ) THEN WRITE( *, '(A,A)' ) ' ## ERROR ', string FLUSH(6) ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN WRITE( *, '(A,A)' ) ' ++ DEBUG ', string FLUSH(6) ELSEIF ( TRIM( level ) == 'info' ) THEN WRITE( *, '(A,A)' ) ' -- INFO ', string FLUSH(6) ENDIF END SUBROUTINE internal_message END PROGRAM binary_to_netcdf