Home

Context Navigation

source: palm/trunk/UTIL/binary_to_netcdf.f90 @ 4129

Last change on this file since 4129 was 4123, checked in by gronemeier, 5 years ago
bugfix: do not assue that output arrays start with index 0
Property svn:keywords set to `Id`
File size: 41.1 KB

Rev	Line
[4075]	1	!> @file binary_to_netcdf.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
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
	9	!
	10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	!
	14	! You should have received a copy of the GNU General Public License along with
	15	! PALM. If not, see <http://www.gnu.org/licenses/>.
	16	!
	17	! Copyright 2019-2019 Leibniz Universitaet Hannover
	18	!--------------------------------------------------------------------------------------------------!
	19	!
	20	! Current revisions:
	21	! ------------------
	22	!
	23	!
	24	! Former revisions:
	25	! -----------------
	26	! $Id: binary_to_netcdf.f90 4123 2019-07-26 13:45:03Z gronemeier $
	27	! Initial revision
	28	!
	29	!
	30	! Authors:
	31	! --------
	32	!> @author Viola Weniger
	33	!> @author Tobias Gronemeier
	34	!> @author Helge Knoop
	35	!
	36	!--------------------------------------------------------------------------------------------------!
	37	! Description:
	38	! ------------
	39	!> This program reads binary output files written by DOM (the data-output module of PALM) and
	40	!> converts the data into NetCDF files.
	41	!>
	42	!> @todo Change style of printed messages to terminal in accordance to PALM termial output.
	43	!--------------------------------------------------------------------------------------------------!
	44	PROGRAM binary_to_netcdf
	45
	46	USE NETCDF
	47
	48	IMPLICIT NONE
	49
	50	!-- Set kinds to be used as defaults
	51	INTEGER, PARAMETER :: wp = 8 !< default real kind
	52	INTEGER, PARAMETER :: iwp = 4 !< default integer kind
	53
	54	INTEGER, PARAMETER :: charlen_internal = 1000 !< length of strings within this program
	55
	56
	57	TYPE attribute_type
	58	CHARACTER(LEN=charlen_internal) :: data_type !< data type of attribute value
	59	CHARACTER(LEN=charlen_internal) :: name !< name of attribute
	60	CHARACTER(LEN=charlen_internal) :: value_char !< character value
	61	INTEGER(iwp) :: var_id !< id of variable to which the attribute belongs to
	62	INTEGER(KIND=1) :: value_int8 !< 8bit integer value
	63	INTEGER(KIND=2) :: value_int16 !< 16bit integer value
	64	INTEGER(KIND=4) :: value_int32 !< 32bit integer value
	65	REAL(KIND=4) :: value_real32 !< 32bit real value
	66	REAL(KIND=8) :: value_real64 !< 64bit real value
	67	END TYPE attribute_type
	68
	69	TYPE dimension_type
	70	CHARACTER(LEN=charlen_internal) :: data_type !< data type of dimension
	71	CHARACTER(LEN=charlen_internal) :: name !< dimension name
	72	INTEGER(iwp) :: id !< dimension id within file
	73	INTEGER(iwp) :: length !< length of dimension
	74	END TYPE dimension_type
	75
	76	TYPE variable_type
	77	CHARACTER(LEN=charlen_internal) :: data_type !< data type of variable
	78	CHARACTER(LEN=charlen_internal) :: name !< variable name
	79	INTEGER(iwp) :: id !< variable id within file
	80	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids used by variable
	81	END TYPE variable_type
	82
	83
[4107]	84	CHARACTER(LEN=charlen_internal) :: temp_string !< dummy string
	85	CHARACTER(LEN=:), ALLOCATABLE :: filename_prefix !< prefix of names of files to be read
	86	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: group_names !< names of output groups
	87	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list !< list of netcdf file names
[4075]	88
[4107]	89	CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_to_netcdf' !< name of routine
	90	CHARACTER(LEN=*), PARAMETER :: config_file_name_base = 'BINARY_TO_NETCDF_CONFIG' !< name of config file
	91	CHARACTER(LEN=*), PARAMETER :: &
	92	config_file_list_name = 'BINARY_CONFIG_LIST' !< file containing list of binary config files of each output group
[4075]	93
	94	INTEGER(iwp) :: charlen !< length of characters (strings) in binary file
	95	INTEGER(iwp) :: dom_global_id !< global ID within a single file defined by DOM
[4107]	96	INTEGER :: dom_master_rank !< master MPI rank in DOM (rank which wrote additional information in DOM)
	97	INTEGER :: dom_nrank !< number of MPI ranks used by DOM
[4075]	98	INTEGER(iwp) :: file_index !< loop index to loop over files
[4107]	99	INTEGER :: group !< loop index to loop over groups
[4075]	100	INTEGER(iwp) :: nc_file_id !< ID of netcdf output file
	101	INTEGER(iwp) :: nfiles !< number of output files defined in config file
[4107]	102	INTEGER :: ngroup !< number of output-file groups
[4075]	103	INTEGER :: return_value !< return value
	104	INTEGER :: your_return_value !< returned value of called routine
	105
	106	INTEGER(KIND=1) :: dummy_int8 !< dummy variable used for reading
	107	INTEGER(KIND=2) :: dummy_int16 !< dummy variable used for reading
	108	INTEGER(KIND=4) :: dummy_int32 !< dummy variable used for reading
	109	INTEGER(iwp) :: dummy_intwp !< dummy variable used for reading
	110
[4107]	111	INTEGER, PARAMETER :: bin_file_unit = 12 !< Fortran unit of binary file
	112	INTEGER, PARAMETER :: config_file_unit = 11 !< Fortran unit of configuration file
	113	INTEGER, PARAMETER :: config_file_list_unit = 10 !< Fortran unit of file containing config-file list
[4075]	114
	115	INTEGER, DIMENSION(:), ALLOCATABLE :: dim_id_netcdf !< mapped dimension id within NetCDF file:
	116	!> dimension_list(i)%id and dim_id_netcdf(dimension_list(i)%id)
	117	!> reference the same dimension
	118	INTEGER, DIMENSION(:), ALLOCATABLE :: var_id_netcdf !< mapped variable id within NetCDF file:
	119	!> variable_list(i)%id and var_id_netcdf(variable_list(i)%id)
	120	!> reference the same variable
	121
	122	LOGICAL :: print_debug_output = .FALSE. !< if true, print debug output to STDOUT
	123
	124	REAL(KIND=4) :: dummy_real32 !< dummy variable used for reading
	125	REAL(KIND=8) :: dummy_real64 !< dummy variable used for reading
	126
	127	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list !< list containing all attributes of a file
	128	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list !< list containing all dimensions of a file
	129	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list !< list containing all variables of a file
	130
	131
	132	return_value = 0
	133
[4107]	134	CALL internal_message( 'info', 'Start ' // routine_name // ' ...' )
[4075]	135
[4107]	136	CALL get_group_names( return_value )
[4075]	137
[4107]	138	IF ( return_value == 0 ) THEN
[4075]	139
[4107]	140	!-- Go through each group of output files (all marked by same file suffix)
	141	DO group = 1, ngroup
[4075]	142
[4107]	143	CALL internal_message( 'info', 'Start converting ' // TRIM( group_names(group) ) // &
	144	' binary files:' )
[4075]	145
[4107]	146	CALL read_config( TRIM( group_names(group) ), your_return_value )
	147
[4075]	148	IF ( your_return_value == 0 ) THEN
[4107]	149	DO file_index = 1, nfiles
[4075]	150
[4107]	151	CALL internal_message( 'info', 'Create file ' // TRIM( filename_list(file_index) ) )
	152
	153	CALL read_binary_header( TRIM( filename_list(file_index) ), your_return_value )
	154
	155	IF ( your_return_value == 0 ) THEN
	156	CALL define_netcdf_files( TRIM( filename_list(file_index) ), your_return_value )
	157	ELSE
	158	return_value = your_return_value
	159	ENDIF
	160
	161	IF ( your_return_value == 0 ) THEN
	162	CALL convert_data_to_netcdf( TRIM( filename_list(file_index) ), your_return_value )
	163	ELSE
	164	return_value = your_return_value
	165	ENDIF
	166
	167	ENDDO
[4075]	168	ELSE
	169	return_value = your_return_value
	170	ENDIF
	171
[4107]	172	IF ( ALLOCATED( filename_list ) ) DEALLOCATE( filename_list )
	173	IF ( ALLOCATED( filename_prefix ) ) DEALLOCATE( filename_prefix )
	174
[4075]	175	ENDDO
[4107]	176
[4075]	177	ENDIF
	178
	179	IF ( return_value == 0 ) THEN
[4107]	180	CALL internal_message( 'info', 'Execution finished' )
[4075]	181	ELSE
	182	CALL internal_message( 'error', routine_name // ': Error during execution! Check results!' )
	183	STOP 1
	184	ENDIF
	185
	186	CONTAINS
	187
	188
	189	!--------------------------------------------------------------------------------------------------!
	190	! Description:
	191	! ------------
[4107]	192	!> Check if any configuration file is present in the current directory and get the list of all
	193	!> these files and extract the output-group names.
	194	!--------------------------------------------------------------------------------------------------!
	195	SUBROUTINE get_group_names( return_value )
	196
	197	CHARACTER(LEN=charlen_internal) :: file_name !< file name read from list
	198
	199	CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_group_names' !< name of routine
	200
	201	INTEGER :: i !< loop index
	202	INTEGER :: io_stat !< status of Fortran I/O operations
	203	INTEGER, INTENT(OUT) :: return_value !< return value
	204
	205
	206	CALL internal_message( 'info', 'Check if anything to convert...' )
	207
	208	!-- Search for configuration files and save the list of file names in a separate file
	209	CALL EXECUTE_COMMAND_LINE( &
	210	COMMAND='find . -type f -name "' // config_file_name_base // '*" \| ' // &
	211	'sed -r "s/^\.\/(' // config_file_name_base // ')?(.+)$/\1\2/" > ' // &
	212	config_file_list_name, &
	213	WAIT=.TRUE., &
	214	EXITSTAT=return_value )
	215
	216	!-- Read the config-file-name list and extract the group names from the file names
	217	IF ( return_value /= 0 ) THEN
	218
	219	CALL internal_message( 'error', routine_name // &
	220	': error while searching for configuration files: ' // &
	221	'System returned non-zero exit status. ' // &
	222	'Please report this error to the developers!' )
	223
	224	ELSE
	225
	226	OPEN( config_file_list_unit, FILE=config_file_list_name, FORM='formatted', &
	227	STATUS='OLD', IOSTAT=io_stat )
	228
	229	!-- Count the configuration files
	230	ngroup = 0
	231	DO WHILE ( io_stat == 0 )
	232	READ( config_file_list_unit, '(A)', IOSTAT=io_stat ) file_name
	233	IF ( io_stat == 0 ) ngroup = ngroup + 1
	234	ENDDO
	235	REWIND( config_file_list_unit )
	236
	237	IF ( ngroup /= 0 ) THEN
	238
	239	ALLOCATE( group_names(ngroup) )
	240
	241	!-- Extract the group names
	242	DO i = 1, ngroup
	243	READ( config_file_list_unit, '(A)', IOSTAT=io_stat ) file_name
	244	IF ( INDEX( TRIM( file_name ), config_file_name_base ) == 1 ) THEN
	245	IF ( TRIM( file_name ) == TRIM( config_file_name_base ) ) THEN
	246	group_names(i) = ''
	247	ELSE
	248	group_names(i) = file_name(LEN_TRIM( config_file_name_base )+1:)
	249	ENDIF
	250	ELSE
	251	return_value = 1
	252	CALL internal_message( 'error', routine_name // &
	253	': error while getting list of binary config files: ' // &
	254	'Unexpected text found in file list. ' // &
	255	'Please report this error to the developers!' )
	256	EXIT
	257	ENDIF
	258	ENDDO
	259
	260	ELSE
	261	CALL internal_message( 'info', 'No configuration files found. ' // &
	262	'No binary files to convert to NetCDF.' )
	263	ENDIF
	264
	265	CLOSE( config_file_list_unit )
	266
	267	ENDIF
	268
	269	END SUBROUTINE get_group_names
	270
	271	!--------------------------------------------------------------------------------------------------!
	272	! Description:
	273	! ------------
[4075]	274	!> Read configuration file.
	275	!--------------------------------------------------------------------------------------------------!
[4107]	276	SUBROUTINE read_config( group_name, return_value )
[4075]	277
	278	CHARACTER(LEN=:), ALLOCATABLE :: read_string !< string read from file
[4107]	279	CHARACTER(LEN=*), INTENT(IN) :: group_name !< group name
[4075]	280	CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_config' !< name of routine
	281
[4107]	282	CHARACTER(LEN=charlen_internal) :: config_file_name !< config file name with additional suffix
	283
[4075]	284	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list_tmp !< temporary list of file names
	285
	286	INTEGER(iwp) :: filename_prefix_length !< length of string containing the filname prefix
	287	INTEGER :: io_stat !< status of Fortran I/O operations
	288	INTEGER, INTENT(OUT) :: return_value !< return value of routine
	289
	290
	291	return_value = 0
	292
[4107]	293	config_file_name = config_file_name_base // group_name
	294
[4075]	295	OPEN( config_file_unit, FILE=config_file_name, FORM='unformatted', &
	296	STATUS='OLD', IOSTAT=io_stat )
	297
	298	IF ( io_stat /= 0 ) THEN
	299	return_value = 1
	300	CALL internal_message( 'error', &
	301	routine_name // ': error while opening configuration file "' // &
	302	TRIM( config_file_name ) // '"' )
	303	ENDIF
	304
	305	IF ( return_value == 0 ) THEN
	306
[4107]	307	READ( config_file_unit ) dom_nrank
	308
	309	IF ( dom_nrank > 1000000 ) THEN
	310	dom_nrank = 1000000
	311	CALL internal_message( 'info', routine_name // &
	312	': number of MPI ranks used in PALM is greater than the maximum ' // &
	313	'amount I can handle. I will only consider the first 1000000 output files.' )
	314	ENDIF
	315
	316	READ( config_file_unit ) dom_master_rank
[4075]	317	READ( config_file_unit ) filename_prefix_length
	318
	319	ALLOCATE( CHARACTER(filename_prefix_length)::filename_prefix )
	320
	321	READ( config_file_unit ) filename_prefix
	322	READ( config_file_unit ) charlen
	323	READ( config_file_unit ) dom_global_id
	324
	325	!-- Read the list of output file names
	326	ALLOCATE( CHARACTER(LEN=charlen) :: read_string )
	327	nfiles = 0
	328	DO WHILE ( io_stat == 0 )
	329
	330	READ( config_file_unit, IOSTAT=io_stat ) read_string
	331
	332	IF ( io_stat == 0 ) THEN
	333
	334	IF ( TRIM( read_string ) == '* end config file *' ) THEN
	335	EXIT
	336	ELSE
	337
	338	!-- Extend the list of file names if necessary
	339	IF ( .NOT. ALLOCATED( filename_list ) ) THEN
	340	nfiles = 1
	341	ALLOCATE( filename_list(nfiles) )
	342	ELSE
	343	ALLOCATE( filename_list_tmp(nfiles) )
	344	filename_list_tmp = filename_list
	345	DEALLOCATE( filename_list )
	346	nfiles = nfiles + 1
	347	ALLOCATE( filename_list(nfiles) )
	348	filename_list(:nfiles-1) = filename_list_tmp
	349	DEALLOCATE( filename_list_tmp )
	350	ENDIF
	351
[4107]	352	filename_list(nfiles) = TRIM( read_string ) // group_name
[4075]	353
	354	ENDIF
	355
	356	ELSEIF ( io_stat > 0 ) THEN
	357	return_value = 1
	358	CALL internal_message( 'error', routine_name // &
	359	': error while reading file names from config' )
	360	EXIT
	361	ENDIF
	362
	363	ENDDO
	364
	365	CLOSE( config_file_unit )
	366
	367	ENDIF
	368
	369	END SUBROUTINE read_config
	370
	371	!--------------------------------------------------------------------------------------------------!
	372	! Description:
	373	! ------------
	374	!> Read header information from binary files.
	375	!--------------------------------------------------------------------------------------------------!
	376	SUBROUTINE read_binary_header( bin_filename_body, return_value )
	377
	378	CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read
	379	CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read
	380	CHARACTER(LEN=charlen ) :: read_string !< string read from file
	381
	382	CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_binary_header' !< name of routine
	383
	384	INTEGER :: i !< loop index
	385	INTEGER :: io_stat !< status of Fortran I/O operations
	386	INTEGER :: n_attributes !< number of attributes in file
	387	INTEGER :: n_dimensions !< number of dimensions in file
	388	INTEGER :: n_variables !< number of variables in file
	389	INTEGER(iwp) :: var_ndim !< number of dimensions of a variable
	390	INTEGER, INTENT(OUT) :: return_value !< return value
	391
	392	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list_tmp !< temporary attribute list
	393	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list_tmp !< temporary dimension list
	394	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list_tmp !< temporary variable list
	395
	396
	397	return_value = 0
	398
[4107]	399	!-- Open binary file written by dom_master_rank
	400	WRITE( bin_filename , '(A,I6.6)' ) &
	401	TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', dom_master_rank
[4075]	402
	403	CALL internal_message( 'debug', routine_name // ': read file ' // TRIM( bin_filename ) )
	404
	405	OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD', IOSTAT=io_stat )
	406
	407	!-- Skip redundant information
	408	IF ( io_stat == 0 ) THEN
	409
	410	READ( bin_file_unit ) dummy_intwp
	411	READ( bin_file_unit ) dummy_intwp
	412	READ( bin_file_unit ) read_string
	413
	414	ELSE
	415
	416	return_value = 1
	417	CALL internal_message( 'error', routine_name // &
	418	': could not open file ' // TRIM( bin_filename ) )
	419
	420	ENDIF
	421
	422	!-- Read dimension, variable and attribute information
	423	DO WHILE ( io_stat == 0 ) ! iterate over file header
	424
	425	READ( bin_file_unit ) read_string
	426
	427	CALL internal_message( 'debug', routine_name // ': read_string=' // TRIM( read_string ) )
	428
	429	SELECT CASE ( TRIM( read_string ) )
	430
	431	CASE ( 'dimension' )
	432
	433	!-- Increase dimension list by 1 element
	434	IF ( .NOT. ALLOCATED( dimension_list ) ) THEN
	435	ALLOCATE( dimension_list(1) )
	436	n_dimensions = 1
	437	ELSE
	438	ALLOCATE( dimension_list_tmp(n_dimensions) )
	439	dimension_list_tmp = dimension_list
	440	DEALLOCATE( dimension_list )
	441	n_dimensions = n_dimensions + 1
	442	ALLOCATE( dimension_list(n_dimensions) )
	443	dimension_list(1:n_dimensions-1) = dimension_list_tmp
	444	DEALLOCATE( dimension_list_tmp )
	445	ENDIF
	446
	447	!-- Read dimension
	448	READ( bin_file_unit ) read_string
	449	dimension_list(n_dimensions)%name = read_string
	450	READ( bin_file_unit ) dimension_list(n_dimensions)%id
	451	READ( bin_file_unit ) read_string
	452	dimension_list(n_dimensions)%data_type = read_string
	453	READ( bin_file_unit ) dimension_list(n_dimensions)%length
	454
	455	CASE ( 'variable' )
	456
	457	!-- Increase variable list by 1 element
	458	IF ( .NOT. ALLOCATED( variable_list ) ) THEN
	459	ALLOCATE( variable_list(1) )
	460	n_variables = 1
	461	ELSE
	462	ALLOCATE( variable_list_tmp(n_variables) )
	463	variable_list_tmp = variable_list
	464	DEALLOCATE( variable_list )
	465	n_variables = n_variables + 1
	466	ALLOCATE( variable_list(n_variables) )
	467	variable_list(1:n_variables-1) = variable_list_tmp
	468	DEALLOCATE( variable_list_tmp )
	469	ENDIF
	470
	471	!-- Read variable
	472	READ( bin_file_unit ) read_string
	473	variable_list(n_variables)%name = read_string
	474	READ( bin_file_unit ) variable_list(n_variables)%id
	475	READ( bin_file_unit ) read_string
	476	variable_list(n_variables)%data_type = read_string
	477	READ( bin_file_unit ) var_ndim
	478	ALLOCATE( variable_list(n_variables)%dimension_ids(1:var_ndim) )
	479	READ( bin_file_unit ) ( variable_list(n_variables)%dimension_ids(i), i = 1, var_ndim )
	480
	481	CASE ( 'attribute' )
	482
	483	!-- Increase attribute list by 1 element
	484	IF ( .NOT. ALLOCATED( attribute_list ) ) THEN
	485	ALLOCATE( attribute_list(1) )
	486	n_attributes = 1
	487	ELSE
	488	ALLOCATE( attribute_list_tmp(n_attributes) )
	489	attribute_list_tmp = attribute_list
	490	DEALLOCATE( attribute_list )
	491	n_attributes = n_attributes + 1
	492	ALLOCATE( attribute_list(n_attributes) )
	493	attribute_list(1:n_attributes-1) = attribute_list_tmp
	494	DEALLOCATE( attribute_list_tmp )
	495	ENDIF
	496
	497	!-- Read attribute
	498	READ( bin_file_unit ) attribute_list(n_attributes)%var_id
	499	READ( bin_file_unit ) read_string
	500	attribute_list(n_attributes)%name = read_string
	501	READ( bin_file_unit ) read_string
	502	attribute_list(n_attributes)%data_type = read_string
	503
	504	SELECT CASE( attribute_list(n_attributes)%data_type )
	505
	506	CASE ( 'char' )
	507	READ( bin_file_unit ) read_string
	508	attribute_list(n_attributes)%value_char = read_string
	509
	510	CASE ( 'int16' )
	511	READ( bin_file_unit ) attribute_list(n_attributes)%value_int16
	512
	513	CASE ( 'int32' )
	514	READ( bin_file_unit ) attribute_list(n_attributes)%value_int32
	515
	516	CASE ( 'real32' )
	517	READ( bin_file_unit ) attribute_list(n_attributes)%value_real32
	518
	519	CASE ( 'real64' )
	520	READ( bin_file_unit ) attribute_list(n_attributes)%value_real64
	521
	522	CASE DEFAULT
	523	return_value = 1
	524	CALL internal_message( 'error', routine_name // ': data type "' // &
	525	TRIM( attribute_list(n_attributes)%data_type ) // &
	526	'" of attribute "' // &
	527	TRIM( attribute_list(n_attributes)%name ) // &
	528	'" is not supported' )
	529
	530	END SELECT
	531
	532	CASE ( '* end file header *' )
	533	EXIT
	534
	535	CASE DEFAULT
	536	return_value = 1
	537	CALL internal_message( 'error', routine_name // &
	538	': unknown header information: ' // TRIM( read_string ) )
	539
	540	END SELECT
	541
	542	IF ( return_value /= 0 ) EXIT
	543
	544	ENDDO ! iterate over file header
	545
[4107]	546	CLOSE( bin_file_unit )
	547
[4075]	548	END SUBROUTINE read_binary_header
	549
	550	!--------------------------------------------------------------------------------------------------!
	551	! Description:
	552	! ------------
	553	!> Define all netcdf files.
	554	!--------------------------------------------------------------------------------------------------!
	555	SUBROUTINE define_netcdf_files( nc_filename, return_value )
	556
	557	CHARACTER(LEN=*), INTENT(IN) :: nc_filename !< name of netcdf file
	558
	559	CHARACTER(LEN=*), PARAMETER :: routine_name = 'define_netcdf_files' !< routine name
	560
	561	INTEGER :: i !< loop index
	562	INTEGER :: j !< loop index
	563	INTEGER :: nc_data_type !< netcdf data type of output variable
	564	INTEGER :: nc_dim_length !< length of dimension in netcdf file
	565	INTEGER :: nc_stat !< return value of Netcdf calls
	566	INTEGER, INTENT(OUT) :: return_value !< return value
	567
	568	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: var_dim_id !< list of dimension ids of a variable
	569
	570
	571	return_value = 0
	572
	573	!-- Create Netcdf-file
	574	nc_stat = NF90_CREATE( TRIM( nc_filename ), IOR( NF90_CLOBBER, NF90_NETCDF4 ), nc_file_id )
	575
	576	IF ( nc_stat /= NF90_NOERR ) THEN
	577	return_value = 1
	578	CALL internal_message( 'error', routine_name // &
	579	': NF90_CREATE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	580	ELSE
	581
	582	!-- Define dimensions in NetCDF file
	583	ALLOCATE( dim_id_netcdf(1:MAXVAL(dimension_list(:)%id)) )
	584
	585	DO i = 1, SIZE( dimension_list )
	586
	587	IF ( dimension_list(i)%length < 0 ) THEN
	588	nc_dim_length = NF90_UNLIMITED
	589	ELSE
	590	nc_dim_length = dimension_list(i)%length
	591	ENDIF
	592
	593	nc_stat = NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dim_length, &
	594	dim_id_netcdf(dimension_list(i)%id) )
	595
	596	IF ( nc_stat /= NF90_NOERR ) THEN
	597	return_value = 1
	598	CALL internal_message( 'error', routine_name // &
	599	': dimension "' // TRIM( dimension_list(i)%name ) // &
	600	'": NF90_DEF_DIM error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	601	EXIT
	602	ENDIF
	603
	604	ENDDO
	605
	606	ENDIF
	607
	608	IF ( return_value == 0 ) THEN
	609
	610	!-- Create vector to map variable IDs from binary file to those within netcdf file
	611	ALLOCATE( var_id_netcdf(MIN( MINVAL(attribute_list(:)%var_id), &
	612	MINVAL(variable_list(:)%id) ) : &
	613	MAX( MAXVAL(attribute_list(:)%var_id), &
	614	MAXVAL(variable_list(:)%id) ) ) )
	615
	616	!-- Map global id from binary file to that of the netcdf file
	617	var_id_netcdf(dom_global_id) = NF90_GLOBAL
	618
	619	!-- Define variables in NetCDF file
	620	DO i = 1, SIZE( variable_list )
	621
	622	SELECT CASE ( TRIM( variable_list(i)%data_type ) )
	623
	624	CASE ( 'char' )
	625	nc_data_type = NF90_CHAR
	626
	627	CASE ( 'int8' )
	628	nc_data_type = NF90_BYTE
	629
	630	CASE ( 'int16' )
	631	nc_data_type = NF90_SHORT
	632
	633	CASE ( 'int32' )
	634	nc_data_type = NF90_INT
	635
	636	CASE ( 'real32' )
	637	nc_data_type = NF90_FLOAT
	638
	639	CASE ( 'real64' )
	640	nc_data_type = NF90_DOUBLE
	641
	642	CASE DEFAULT
	643	return_value = 1
	644	CALL internal_message( 'error', routine_name // &
	645	': data type "' // TRIM( variable_list(i)%data_type ) // &
	646	'" of variable "' // TRIM( variable_list(i)%name ) // &
	647	'" is not supported' )
	648
	649	END SELECT
	650
	651	IF ( return_value == 0 ) THEN
	652
	653	ALLOCATE( var_dim_id(1:SIZE( variable_list(i)%dimension_ids )) )
	654
	655	DO j = 1, SIZE( variable_list(i)%dimension_ids )
	656
	657	var_dim_id(j) = dim_id_netcdf(variable_list(i)%dimension_ids(j))
	658
	659	ENDDO
	660
	661	nc_stat = NF90_DEF_VAR( nc_file_id, variable_list(i)%name, nc_data_type, &
	662	var_dim_id, var_id_netcdf(variable_list(i)%id) )
	663	IF ( nc_stat /= NF90_NOERR ) THEN
	664	return_value = 1
	665	CALL internal_message( 'error', routine_name // &
	666	': variable "' // TRIM( variable_list(i)%name ) // &
	667	'": NF90_DEF_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	668	ENDIF
	669
	670	DEALLOCATE( var_dim_id )
	671
	672	ENDIF
	673
	674	IF ( return_value /= 0 ) EXIT
	675
	676	ENDDO
	677
	678	ENDIF
	679
	680	IF ( return_value == 0 ) THEN
	681
	682	!-- Define attributes in netcdf
	683	DO i = 1, SIZE( attribute_list )
	684
	685	SELECT CASE ( TRIM( attribute_list(i)%data_type ) )
	686
	687	CASE ( 'char' )
	688	nc_stat = NF90_PUT_ATT( nc_file_id, &
	689	var_id_netcdf(attribute_list(i)%var_id), &
	690	TRIM(attribute_list(i)%name), &
	691	TRIM(attribute_list(i)%value_char) )
	692
	693	CASE ( 'int8' )
	694	nc_stat = NF90_PUT_ATT( nc_file_id, &
	695	var_id_netcdf(attribute_list(i)%var_id), &
	696	TRIM(attribute_list(i)%name), &
	697	attribute_list(i)%value_int8 )
	698
	699	CASE ( 'int16' )
	700	nc_stat = NF90_PUT_ATT( nc_file_id, &
	701	var_id_netcdf(attribute_list(i)%var_id), &
	702	TRIM(attribute_list(i)%name), &
	703	attribute_list(i)%value_int16 )
	704
	705	CASE ( 'int32' )
	706	nc_stat = NF90_PUT_ATT( nc_file_id, &
	707	var_id_netcdf(attribute_list(i)%var_id), &
	708	TRIM(attribute_list(i)%name), &
	709	attribute_list(i)%value_int32 )
	710
	711	CASE ( 'real32' )
	712	nc_stat = NF90_PUT_ATT( nc_file_id, &
	713	var_id_netcdf(attribute_list(i)%var_id), &
	714	TRIM(attribute_list(i)%name), &
	715	attribute_list(i)%value_real32 )
	716
	717	CASE ( 'real64' )
	718	nc_stat = NF90_PUT_ATT( nc_file_id, &
	719	var_id_netcdf(attribute_list(i)%var_id), &
	720	TRIM(attribute_list(i)%name), &
	721	attribute_list(i)%value_real64 )
	722
	723	CASE DEFAULT
	724	return_value = 1
	725	CALL internal_message( 'error', routine_name // &
	726	': data type "' // TRIM( attribute_list(i)%data_type ) // &
	727	'" of attribute "' // TRIM( attribute_list(i)%name ) // &
	728	'" is not supported' )
	729	EXIT
	730
	731	END SELECT
	732
	733	IF ( nc_stat /= NF90_NOERR ) THEN
	734	return_value = 1
	735	CALL internal_message( 'error', routine_name // &
	736	': attribute "' // TRIM( attribute_list(i)%name ) // &
	737	'": NF90_PUT_ATT error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	738	EXIT
	739	ENDIF
	740
	741	ENDDO ! loop over attributes
	742
	743	ENDIF
	744
	745	IF ( ALLOCATED( attribute_list ) ) DEALLOCATE( attribute_list )
	746	IF ( ALLOCATED( dimension_list ) ) DEALLOCATE( dimension_list )
	747
	748	nc_stat = NF90_ENDDEF( nc_file_id )
	749	IF ( nc_stat /= NF90_NOERR ) THEN
	750	return_value = 1
	751	CALL internal_message( 'error', routine_name // &
	752	': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	753	ENDIF
	754
	755	END SUBROUTINE define_netcdf_files
	756
	757	!--------------------------------------------------------------------------------------------------!
	758	! Description:
	759	! ------------
	760	!> Read variable data from binary and write them into netcdf files.
	761	!--------------------------------------------------------------------------------------------------!
	762	SUBROUTINE convert_data_to_netcdf( bin_filename_body, return_value )
	763
	764	CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read
	765	CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read
	766	CHARACTER(LEN=charlen ) :: read_string !< string read from file
	767	CHARACTER(LEN=charlen ) :: variable_name !< name of variable to be read
	768
	769	CHARACTER(LEN=*), PARAMETER :: routine_name = 'convert_data_to_netcdf' !< routine name
	770
	771	INTEGER :: data_count !< count of data values of a variable over all dimensions
	772	INTEGER :: i !< loop file_index
	773	INTEGER :: io_stat !< status of Fortran I/O operations
	774	INTEGER :: pe_id !< loop index for loop over PE files
	775	INTEGER :: n_dim !< number of dimensions of a variable
	776	INTEGER :: nc_stat !< return value of Netcdf calls
	777	INTEGER, INTENT(OUT) :: return_value !< return value
	778	INTEGER(iwp) :: var_id !< variable id read from binary file
	779
	780	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_positions !< start position of data per dimension
	781	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: data_count_per_dimension !< data count of variable per dimension
	782	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_start !< lower bounds of variable
	783	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_origin !< lower bounds of dimensions in output file
	784
	785	INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< variable values
	786	INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< variable values
	787	INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< variable values
	788	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< variable values
	789
	790	LOGICAL :: file_exists !< true if file exists
	791
	792	REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< variable values
	793	REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< variable values
	794	REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< variable values
	795
	796
	797	return_value = 0
	798
	799	!-- Open binary files of every possible PE
[4107]	800	DO pe_id = 0, dom_nrank - 1
[4075]	801
	802	WRITE( bin_filename, '(A, I6.6)' ) &
	803	TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', pe_id
	804
	805	INQUIRE( FILE=bin_filename, EXIST=file_exists )
	806
	807	!-- Read file if it exists
	808	IF ( file_exists ) THEN
	809
[4107]	810	OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD' )
[4075]	811
[4107]	812	CALL internal_message( 'debug', routine_name // &
	813	': read binary file ' // TRIM( bin_filename ) )
[4075]	814
[4107]	815	read_string = ''
	816	DO WHILE ( TRIM( read_string ) /= '* end file header *' )
[4075]	817
[4107]	818	READ( bin_file_unit ) read_string
[4075]	819
[4107]	820	SELECT CASE ( TRIM( read_string ) )
[4075]	821
[4107]	822	CASE ( 'char' )
	823	READ( bin_file_unit ) read_string
[4075]	824
[4107]	825	CASE ( 'int8' )
	826	READ( bin_file_unit ) dummy_int8
[4075]	827
[4107]	828	CASE ( 'int16' )
	829	READ( bin_file_unit ) dummy_int16
[4075]	830
[4107]	831	CASE ( 'int32' )
	832	READ( bin_file_unit ) dummy_int32
[4075]	833
[4107]	834	CASE ( 'real32' )
	835	READ( bin_file_unit ) dummy_real32
[4075]	836
[4107]	837	CASE ( 'real64' )
	838	READ( bin_file_unit ) dummy_real64
[4075]	839
[4107]	840	END SELECT
[4075]	841
[4107]	842	ENDDO
[4075]	843
	844	!-- Read variable data
	845	io_stat = 0
	846	DO WHILE ( io_stat == 0 .AND. return_value == 0 )
	847
	848	READ( bin_file_unit, IOSTAT=io_stat ) var_id
	849	IF ( io_stat < 0 ) EXIT ! End-of-file
	850
	851	DO i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 )
	852	IF ( var_id == variable_list(i)%id ) THEN
	853	n_dim = SIZE( variable_list(i)%dimension_ids )
	854	variable_name = variable_list(i)%name
	855
	856	CALL internal_message( 'debug', routine_name // ': read variable "' // &
	857	TRIM( variable_name ) // '"' )
	858	WRITE( temp_string, * ) n_dim
	859	CALL internal_message( 'debug', routine_name // &
	860	': n_dim = ' // TRIM( temp_string ) )
	861
	862	EXIT
	863	ENDIF
	864	ENDDO
	865
	866	ALLOCATE( bounds_start(1:n_dim) )
	867	ALLOCATE( bounds_origin(1:n_dim) )
	868	ALLOCATE( start_positions(1:n_dim) )
	869	ALLOCATE( data_count_per_dimension(1:n_dim) )
	870
	871	READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dim )
[4123]	872	READ( bin_file_unit ) ( data_count_per_dimension(i), i = 1, n_dim )
[4075]	873	READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dim )
	874
	875	WRITE( temp_string, * ) bounds_start
	876	CALL internal_message( 'debug', routine_name // &
	877	': bounds_start = ' // TRIM( temp_string ) )
[4123]	878	WRITE( temp_string, * ) data_count_per_dimension
[4075]	879	CALL internal_message( 'debug', routine_name // &
[4123]	880	': data_count_per_dimension = ' // TRIM( temp_string ) )
[4075]	881	WRITE( temp_string, * ) bounds_origin
	882	CALL internal_message( 'debug', routine_name // &
	883	': bounds_origin = ' // TRIM( temp_string ) )
	884
	885	data_count = 1
	886
	887	DO i = 1, n_dim
[4123]	888	data_count = data_count * data_count_per_dimension(i)
[4075]	889	start_positions(i) = bounds_start(i) - bounds_origin(i) + 1
	890	ENDDO
	891
	892	read_string = ''
	893	READ( bin_file_unit ) read_string ! read data type of following values
	894
	895	SELECT CASE ( TRIM( read_string ) )
	896
	897	CASE ( 'int8' )
	898	ALLOCATE( values_int8(1:data_count) )
	899
	900	READ( bin_file_unit ) ( values_int8(i), i = 1, data_count )
	901
	902	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int8, &
	903	start = start_positions, count = data_count_per_dimension )
	904
	905	DEALLOCATE( values_int8 )
	906
	907	CASE ( 'int16' )
	908	ALLOCATE( values_int16(1:data_count) )
	909
	910	READ( bin_file_unit ) ( values_int16(i), i = 1, data_count )
	911
	912	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int16, &
	913	start = start_positions, count = data_count_per_dimension )
	914
	915	DEALLOCATE( values_int16 )
	916
	917	CASE ( 'int32' )
	918	ALLOCATE( values_int32(1:data_count) )
	919
	920	READ( bin_file_unit ) ( values_int32(i), i = 1, data_count )
	921
	922	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int32, &
	923	start = start_positions, count = data_count_per_dimension )
	924
	925	DEALLOCATE( values_int32 )
	926
	927	CASE ( 'intwp' )
	928	ALLOCATE( values_intwp(1:data_count) )
	929
	930	READ( bin_file_unit ) ( values_intwp(i), i = 1, data_count )
	931
	932	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_intwp, &
	933	start = start_positions, count = data_count_per_dimension )
	934
	935	DEALLOCATE( values_intwp )
	936
	937	CASE ( 'real32' )
	938	ALLOCATE( values_real32(1:data_count) )
	939
	940	READ( bin_file_unit ) ( values_real32(i), i = 1, data_count )
	941
	942	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real32, &
	943	start = start_positions, count = data_count_per_dimension )
	944
	945	DEALLOCATE( values_real32 )
	946
	947	CASE ( 'real64' )
	948	ALLOCATE( values_real64(1:data_count) )
	949
	950	READ( bin_file_unit ) ( values_real64(i), i = 1, data_count )
	951
	952	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real64, &
	953	start = start_positions, count = data_count_per_dimension )
	954
	955	DEALLOCATE( values_real64 )
	956
	957	CASE ( 'realwp' )
	958	ALLOCATE( values_realwp(1:data_count) )
	959
	960	READ( bin_file_unit ) ( values_realwp(i), i = 1, data_count )
	961
	962	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_realwp, &
	963	start = start_positions, count = data_count_per_dimension )
	964
	965	DEALLOCATE( values_realwp )
	966
	967	END SELECT
	968
	969	IF ( nc_stat /= NF90_NOERR ) THEN
	970	return_value = 1
	971	CALL internal_message( 'error', routine_name // &
	972	': variable "' // TRIM( variable_name ) // &
	973	'": NF90_PUT_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	974	ENDIF
	975
	976	!-- Deallocate fields for next variable
	977	DEALLOCATE( start_positions )
	978	DEALLOCATE( data_count_per_dimension )
	979	DEALLOCATE( bounds_start )
	980	DEALLOCATE( bounds_origin )
	981
	982	ENDDO ! end loop over variables in a file
	983
	984	CLOSE( bin_file_unit )
	985
	986	ENDIF ! if file exists
	987
	988	ENDDO ! end loop over all PE
	989
	990	nc_stat = NF90_CLOSE( nc_file_id )
	991
	992	IF ( nc_stat /= NF90_NOERR ) THEN
	993	return_value = 1
	994	CALL internal_message( 'error', routine_name // &
	995	': NF90_CLOSE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	996	ENDIF
	997
	998	!-- Deallocate fields for next file
	999	IF ( ALLOCATED( variable_list ) ) DEALLOCATE( variable_list )
	1000	IF ( ALLOCATED( dim_id_netcdf ) ) DEALLOCATE( dim_id_netcdf )
	1001	IF ( ALLOCATED( var_id_netcdf ) ) DEALLOCATE( var_id_netcdf )
	1002
	1003	END SUBROUTINE convert_data_to_netcdf
	1004
	1005	!--------------------------------------------------------------------------------------------------!
	1006	! Description:
	1007	! ------------
	1008	!> Message routine for internal use.
	1009	!--------------------------------------------------------------------------------------------------!
	1010	SUBROUTINE internal_message( level, string )
	1011
	1012	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
	1013	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
	1014
	1015	IF ( TRIM( level ) == 'error' ) THEN
	1016	WRITE( *, '(A,A)' ) ' ## ERROR ', string
	1017	FLUSH(6)
	1018	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
	1019	WRITE( *, '(A,A)' ) ' ++ DEBUG ', string
	1020	FLUSH(6)
	1021	ELSEIF ( TRIM( level ) == 'info' ) THEN
	1022	WRITE( *, '(A,A)' ) ' -- INFO ', string
	1023	FLUSH(6)
	1024	ENDIF
	1025
	1026	END SUBROUTINE internal_message
	1027
	1028	END PROGRAM binary_to_netcdf

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |