Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |