Home

Context Navigation

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

Last change on this file since 4080 was 4075, checked in by gronemeier, 5 years ago
add program to convert the new binary output into netcdf (binary_to_netcdf.f90)
Property svn:keywords set to `Id`
File size: 36.3 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 4075 2019-07-08 11:57:28Z 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
	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
	84	CHARACTER(LEN=200) :: temp_string !< dummy string
	85
	86	CHARACTER(LEN=:), ALLOCATABLE :: filename_prefix !< prefix of names of files to be read
	87
	88	CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_to_netcdf' !< name of routine
	89	CHARACTER(LEN=*), PARAMETER :: config_file_name = 'BINARY_TO_NETCDF_CONFIG' !< name of configuration file
	90
	91	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list !< list of netcdf file names
	92
	93	INTEGER(iwp) :: charlen !< length of characters (strings) in binary file
	94	INTEGER(iwp) :: dom_global_id !< global ID within a single file defined by DOM
	95	INTEGER(iwp) :: file_index !< loop index to loop over files
	96	INTEGER(iwp) :: nc_file_id !< ID of netcdf output file
	97	INTEGER(iwp) :: nfiles !< number of output files defined in config file
	98	INTEGER :: return_value !< return value
	99	INTEGER :: your_return_value !< returned value of called routine
	100
	101	INTEGER(KIND=1) :: dummy_int8 !< dummy variable used for reading
	102	INTEGER(KIND=2) :: dummy_int16 !< dummy variable used for reading
	103	INTEGER(KIND=4) :: dummy_int32 !< dummy variable used for reading
	104	INTEGER(iwp) :: dummy_intwp !< dummy variable used for reading
	105
	106	INTEGER, PARAMETER :: bin_file_unit = 2 !< Fortran unit of binary file
	107	INTEGER, PARAMETER :: config_file_unit = 1 !< Fortran unit of configuration file
	108
	109	INTEGER, DIMENSION(:), ALLOCATABLE :: dim_id_netcdf !< mapped dimension id within NetCDF file:
	110	!> dimension_list(i)%id and dim_id_netcdf(dimension_list(i)%id)
	111	!> reference the same dimension
	112	INTEGER, DIMENSION(:), ALLOCATABLE :: var_id_netcdf !< mapped variable id within NetCDF file:
	113	!> variable_list(i)%id and var_id_netcdf(variable_list(i)%id)
	114	!> reference the same variable
	115
	116	LOGICAL :: print_debug_output = .FALSE. !< if true, print debug output to STDOUT
	117
	118	REAL(KIND=4) :: dummy_real32 !< dummy variable used for reading
	119	REAL(KIND=8) :: dummy_real64 !< dummy variable used for reading
	120
	121	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list !< list containing all attributes of a file
	122	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list !< list containing all dimensions of a file
	123	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list !< list containing all variables of a file
	124
	125
	126	return_value = 0
	127
	128	CALL internal_message( 'info', routine_name // ': Start converting binary files...' )
	129
	130	CALL read_config( your_return_value )
	131
	132	IF ( your_return_value == 0 ) THEN
	133	DO file_index = 1, nfiles
	134
	135	CALL internal_message( 'info', routine_name // &
	136	': create file ' // TRIM( filename_list(file_index) ) )
	137
	138	CALL read_binary_header( TRIM( filename_list(file_index) ), your_return_value )
	139
	140	IF ( your_return_value == 0 ) THEN
	141	CALL define_netcdf_files( TRIM( filename_list(file_index) ), your_return_value )
	142	ELSE
	143	return_value = your_return_value
	144	ENDIF
	145
	146	IF ( your_return_value == 0 ) THEN
	147	CALL convert_data_to_netcdf( TRIM( filename_list(file_index) ), your_return_value )
	148	ELSE
	149	return_value = your_return_value
	150	ENDIF
	151
	152	ENDDO
	153	ELSE
	154	return_value = your_return_value
	155	ENDIF
	156
	157	IF ( return_value == 0 ) THEN
	158	CALL internal_message( 'info', routine_name // ': Execution finished' )
	159	ELSE
	160	CALL internal_message( 'error', routine_name // ': Error during execution! Check results!' )
	161	STOP 1
	162	ENDIF
	163
	164	CONTAINS
	165
	166
	167	!--------------------------------------------------------------------------------------------------!
	168	! Description:
	169	! ------------
	170	!> Read configuration file.
	171	!--------------------------------------------------------------------------------------------------!
	172	SUBROUTINE read_config( return_value )
	173
	174	CHARACTER(LEN=:), ALLOCATABLE :: read_string !< string read from file
	175	CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_config' !< name of routine
	176
	177	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list_tmp !< temporary list of file names
	178
	179	INTEGER(iwp) :: filename_prefix_length !< length of string containing the filname prefix
	180	INTEGER :: io_stat !< status of Fortran I/O operations
	181	INTEGER, INTENT(OUT) :: return_value !< return value of routine
	182
	183
	184	return_value = 0
	185
	186	OPEN( config_file_unit, FILE=config_file_name, FORM='unformatted', &
	187	STATUS='OLD', IOSTAT=io_stat )
	188
	189	IF ( io_stat /= 0 ) THEN
	190	return_value = 1
	191	CALL internal_message( 'error', &
	192	routine_name // ': error while opening configuration file "' // &
	193	TRIM( config_file_name ) // '"' )
	194	ENDIF
	195
	196	IF ( return_value == 0 ) THEN
	197
	198	READ( config_file_unit ) filename_prefix_length
	199
	200	ALLOCATE( CHARACTER(filename_prefix_length)::filename_prefix )
	201
	202	READ( config_file_unit ) filename_prefix
	203
	204	READ( config_file_unit ) charlen
	205
	206	READ( config_file_unit ) dom_global_id
	207
	208	!-- Read the list of output file names
	209	ALLOCATE( CHARACTER(LEN=charlen) :: read_string )
	210	nfiles = 0
	211	DO WHILE ( io_stat == 0 )
	212
	213	READ( config_file_unit, IOSTAT=io_stat ) read_string
	214
	215	IF ( io_stat == 0 ) THEN
	216
	217	IF ( TRIM( read_string ) == '* end config file *' ) THEN
	218	EXIT
	219	ELSE
	220
	221	!-- Extend the list of file names if necessary
	222	IF ( .NOT. ALLOCATED( filename_list ) ) THEN
	223	nfiles = 1
	224	ALLOCATE( filename_list(nfiles) )
	225	ELSE
	226	ALLOCATE( filename_list_tmp(nfiles) )
	227	filename_list_tmp = filename_list
	228	DEALLOCATE( filename_list )
	229	nfiles = nfiles + 1
	230	ALLOCATE( filename_list(nfiles) )
	231	filename_list(:nfiles-1) = filename_list_tmp
	232	DEALLOCATE( filename_list_tmp )
	233	ENDIF
	234
	235	filename_list(nfiles) = TRIM( read_string )
	236
	237	ENDIF
	238
	239	ELSEIF ( io_stat > 0 ) THEN
	240	return_value = 1
	241	CALL internal_message( 'error', routine_name // &
	242	': error while reading file names from config' )
	243	EXIT
	244	ENDIF
	245
	246	ENDDO
	247
	248	CLOSE( config_file_unit )
	249
	250	ENDIF
	251
	252	END SUBROUTINE read_config
	253
	254	!--------------------------------------------------------------------------------------------------!
	255	! Description:
	256	! ------------
	257	!> Read header information from binary files.
	258	!--------------------------------------------------------------------------------------------------!
	259	SUBROUTINE read_binary_header( bin_filename_body, return_value )
	260
	261	CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read
	262	CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read
	263	CHARACTER(LEN=charlen ) :: read_string !< string read from file
	264
	265	CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_binary_header' !< name of routine
	266
	267	INTEGER :: i !< loop index
	268	INTEGER :: io_stat !< status of Fortran I/O operations
	269	INTEGER :: n_attributes !< number of attributes in file
	270	INTEGER :: n_dimensions !< number of dimensions in file
	271	INTEGER :: n_variables !< number of variables in file
	272	INTEGER(iwp) :: var_ndim !< number of dimensions of a variable
	273	INTEGER, INTENT(OUT) :: return_value !< return value
	274
	275	TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attribute_list_tmp !< temporary attribute list
	276	TYPE(dimension_type), DIMENSION(:), ALLOCATABLE :: dimension_list_tmp !< temporary dimension list
	277	TYPE(variable_type), DIMENSION(:), ALLOCATABLE :: variable_list_tmp !< temporary variable list
	278
	279
	280	return_value = 0
	281
	282	!-- Open binary file of PE0
	283	bin_filename = TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_000000'
	284
	285	CALL internal_message( 'debug', routine_name // ': read file ' // TRIM( bin_filename ) )
	286
	287	OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD', IOSTAT=io_stat )
	288
	289	!-- Skip redundant information
	290	IF ( io_stat == 0 ) THEN
	291
	292	READ( bin_file_unit ) dummy_intwp
	293	READ( bin_file_unit ) dummy_intwp
	294	READ( bin_file_unit ) read_string
	295
	296	ELSE
	297
	298	return_value = 1
	299	CALL internal_message( 'error', routine_name // &
	300	': could not open file ' // TRIM( bin_filename ) )
	301
	302	ENDIF
	303
	304	!-- Read dimension, variable and attribute information
	305	DO WHILE ( io_stat == 0 ) ! iterate over file header
	306
	307	READ( bin_file_unit ) read_string
	308
	309	CALL internal_message( 'debug', routine_name // ': read_string=' // TRIM( read_string ) )
	310
	311	SELECT CASE ( TRIM( read_string ) )
	312
	313	CASE ( 'dimension' )
	314
	315	!-- Increase dimension list by 1 element
	316	IF ( .NOT. ALLOCATED( dimension_list ) ) THEN
	317	ALLOCATE( dimension_list(1) )
	318	n_dimensions = 1
	319	ELSE
	320	ALLOCATE( dimension_list_tmp(n_dimensions) )
	321	dimension_list_tmp = dimension_list
	322	DEALLOCATE( dimension_list )
	323	n_dimensions = n_dimensions + 1
	324	ALLOCATE( dimension_list(n_dimensions) )
	325	dimension_list(1:n_dimensions-1) = dimension_list_tmp
	326	DEALLOCATE( dimension_list_tmp )
	327	ENDIF
	328
	329	!-- Read dimension
	330	READ( bin_file_unit ) read_string
	331	dimension_list(n_dimensions)%name = read_string
	332	READ( bin_file_unit ) dimension_list(n_dimensions)%id
	333	READ( bin_file_unit ) read_string
	334	dimension_list(n_dimensions)%data_type = read_string
	335	READ( bin_file_unit ) dimension_list(n_dimensions)%length
	336
	337	CASE ( 'variable' )
	338
	339	!-- Increase variable list by 1 element
	340	IF ( .NOT. ALLOCATED( variable_list ) ) THEN
	341	ALLOCATE( variable_list(1) )
	342	n_variables = 1
	343	ELSE
	344	ALLOCATE( variable_list_tmp(n_variables) )
	345	variable_list_tmp = variable_list
	346	DEALLOCATE( variable_list )
	347	n_variables = n_variables + 1
	348	ALLOCATE( variable_list(n_variables) )
	349	variable_list(1:n_variables-1) = variable_list_tmp
	350	DEALLOCATE( variable_list_tmp )
	351	ENDIF
	352
	353	!-- Read variable
	354	READ( bin_file_unit ) read_string
	355	variable_list(n_variables)%name = read_string
	356	READ( bin_file_unit ) variable_list(n_variables)%id
	357	READ( bin_file_unit ) read_string
	358	variable_list(n_variables)%data_type = read_string
	359	READ( bin_file_unit ) var_ndim
	360	ALLOCATE( variable_list(n_variables)%dimension_ids(1:var_ndim) )
	361	READ( bin_file_unit ) ( variable_list(n_variables)%dimension_ids(i), i = 1, var_ndim )
	362
	363	CASE ( 'attribute' )
	364
	365	!-- Increase attribute list by 1 element
	366	IF ( .NOT. ALLOCATED( attribute_list ) ) THEN
	367	ALLOCATE( attribute_list(1) )
	368	n_attributes = 1
	369	ELSE
	370	ALLOCATE( attribute_list_tmp(n_attributes) )
	371	attribute_list_tmp = attribute_list
	372	DEALLOCATE( attribute_list )
	373	n_attributes = n_attributes + 1
	374	ALLOCATE( attribute_list(n_attributes) )
	375	attribute_list(1:n_attributes-1) = attribute_list_tmp
	376	DEALLOCATE( attribute_list_tmp )
	377	ENDIF
	378
	379	!-- Read attribute
	380	READ( bin_file_unit ) attribute_list(n_attributes)%var_id
	381	READ( bin_file_unit ) read_string
	382	attribute_list(n_attributes)%name = read_string
	383	READ( bin_file_unit ) read_string
	384	attribute_list(n_attributes)%data_type = read_string
	385
	386	SELECT CASE( attribute_list(n_attributes)%data_type )
	387
	388	CASE ( 'char' )
	389	READ( bin_file_unit ) read_string
	390	attribute_list(n_attributes)%value_char = read_string
	391
	392	CASE ( 'int16' )
	393	READ( bin_file_unit ) attribute_list(n_attributes)%value_int16
	394
	395	CASE ( 'int32' )
	396	READ( bin_file_unit ) attribute_list(n_attributes)%value_int32
	397
	398	CASE ( 'real32' )
	399	READ( bin_file_unit ) attribute_list(n_attributes)%value_real32
	400
	401	CASE ( 'real64' )
	402	READ( bin_file_unit ) attribute_list(n_attributes)%value_real64
	403
	404	CASE DEFAULT
	405	return_value = 1
	406	CALL internal_message( 'error', routine_name // ': data type "' // &
	407	TRIM( attribute_list(n_attributes)%data_type ) // &
	408	'" of attribute "' // &
	409	TRIM( attribute_list(n_attributes)%name ) // &
	410	'" is not supported' )
	411
	412	END SELECT
	413
	414	CASE ( '* end file header *' )
	415	EXIT
	416
	417	CASE DEFAULT
	418	return_value = 1
	419	CALL internal_message( 'error', routine_name // &
	420	': unknown header information: ' // TRIM( read_string ) )
	421
	422	END SELECT
	423
	424	IF ( return_value /= 0 ) EXIT
	425
	426	ENDDO ! iterate over file header
	427
	428	END SUBROUTINE read_binary_header
	429
	430	!--------------------------------------------------------------------------------------------------!
	431	! Description:
	432	! ------------
	433	!> Define all netcdf files.
	434	!--------------------------------------------------------------------------------------------------!
	435	SUBROUTINE define_netcdf_files( nc_filename, return_value )
	436
	437	CHARACTER(LEN=*), INTENT(IN) :: nc_filename !< name of netcdf file
	438
	439	CHARACTER(LEN=*), PARAMETER :: routine_name = 'define_netcdf_files' !< routine name
	440
	441	INTEGER :: i !< loop index
	442	INTEGER :: j !< loop index
	443	INTEGER :: nc_data_type !< netcdf data type of output variable
	444	INTEGER :: nc_dim_length !< length of dimension in netcdf file
	445	INTEGER :: nc_stat !< return value of Netcdf calls
	446	INTEGER, INTENT(OUT) :: return_value !< return value
	447
	448	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: var_dim_id !< list of dimension ids of a variable
	449
	450
	451	return_value = 0
	452
	453	!-- Create Netcdf-file
	454	nc_stat = NF90_CREATE( TRIM( nc_filename ), IOR( NF90_CLOBBER, NF90_NETCDF4 ), nc_file_id )
	455
	456	IF ( nc_stat /= NF90_NOERR ) THEN
	457	return_value = 1
	458	CALL internal_message( 'error', routine_name // &
	459	': NF90_CREATE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	460	ELSE
	461
	462	!-- Define dimensions in NetCDF file
	463	ALLOCATE( dim_id_netcdf(1:MAXVAL(dimension_list(:)%id)) )
	464
	465	DO i = 1, SIZE( dimension_list )
	466
	467	IF ( dimension_list(i)%length < 0 ) THEN
	468	nc_dim_length = NF90_UNLIMITED
	469	ELSE
	470	nc_dim_length = dimension_list(i)%length
	471	ENDIF
	472
	473	nc_stat = NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dim_length, &
	474	dim_id_netcdf(dimension_list(i)%id) )
	475
	476	IF ( nc_stat /= NF90_NOERR ) THEN
	477	return_value = 1
	478	CALL internal_message( 'error', routine_name // &
	479	': dimension "' // TRIM( dimension_list(i)%name ) // &
	480	'": NF90_DEF_DIM error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	481	EXIT
	482	ENDIF
	483
	484	ENDDO
	485
	486	ENDIF
	487
	488	IF ( return_value == 0 ) THEN
	489
	490	!-- Create vector to map variable IDs from binary file to those within netcdf file
	491	ALLOCATE( var_id_netcdf(MIN( MINVAL(attribute_list(:)%var_id), &
	492	MINVAL(variable_list(:)%id) ) : &
	493	MAX( MAXVAL(attribute_list(:)%var_id), &
	494	MAXVAL(variable_list(:)%id) ) ) )
	495
	496	!-- Map global id from binary file to that of the netcdf file
	497	var_id_netcdf(dom_global_id) = NF90_GLOBAL
	498
	499	!-- Define variables in NetCDF file
	500	DO i = 1, SIZE( variable_list )
	501
	502	SELECT CASE ( TRIM( variable_list(i)%data_type ) )
	503
	504	CASE ( 'char' )
	505	nc_data_type = NF90_CHAR
	506
	507	CASE ( 'int8' )
	508	nc_data_type = NF90_BYTE
	509
	510	CASE ( 'int16' )
	511	nc_data_type = NF90_SHORT
	512
	513	CASE ( 'int32' )
	514	nc_data_type = NF90_INT
	515
	516	CASE ( 'real32' )
	517	nc_data_type = NF90_FLOAT
	518
	519	CASE ( 'real64' )
	520	nc_data_type = NF90_DOUBLE
	521
	522	CASE DEFAULT
	523	return_value = 1
	524	CALL internal_message( 'error', routine_name // &
	525	': data type "' // TRIM( variable_list(i)%data_type ) // &
	526	'" of variable "' // TRIM( variable_list(i)%name ) // &
	527	'" is not supported' )
	528
	529	END SELECT
	530
	531	IF ( return_value == 0 ) THEN
	532
	533	ALLOCATE( var_dim_id(1:SIZE( variable_list(i)%dimension_ids )) )
	534
	535	DO j = 1, SIZE( variable_list(i)%dimension_ids )
	536
	537	var_dim_id(j) = dim_id_netcdf(variable_list(i)%dimension_ids(j))
	538
	539	ENDDO
	540
	541	nc_stat = NF90_DEF_VAR( nc_file_id, variable_list(i)%name, nc_data_type, &
	542	var_dim_id, var_id_netcdf(variable_list(i)%id) )
	543	IF ( nc_stat /= NF90_NOERR ) THEN
	544	return_value = 1
	545	CALL internal_message( 'error', routine_name // &
	546	': variable "' // TRIM( variable_list(i)%name ) // &
	547	'": NF90_DEF_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	548	ENDIF
	549
	550	DEALLOCATE( var_dim_id )
	551
	552	ENDIF
	553
	554	IF ( return_value /= 0 ) EXIT
	555
	556	ENDDO
	557
	558	ENDIF
	559
	560	IF ( return_value == 0 ) THEN
	561
	562	!-- Define attributes in netcdf
	563	DO i = 1, SIZE( attribute_list )
	564
	565	SELECT CASE ( TRIM( attribute_list(i)%data_type ) )
	566
	567	CASE ( 'char' )
	568	nc_stat = NF90_PUT_ATT( nc_file_id, &
	569	var_id_netcdf(attribute_list(i)%var_id), &
	570	TRIM(attribute_list(i)%name), &
	571	TRIM(attribute_list(i)%value_char) )
	572
	573	CASE ( 'int8' )
	574	nc_stat = NF90_PUT_ATT( nc_file_id, &
	575	var_id_netcdf(attribute_list(i)%var_id), &
	576	TRIM(attribute_list(i)%name), &
	577	attribute_list(i)%value_int8 )
	578
	579	CASE ( 'int16' )
	580	nc_stat = NF90_PUT_ATT( nc_file_id, &
	581	var_id_netcdf(attribute_list(i)%var_id), &
	582	TRIM(attribute_list(i)%name), &
	583	attribute_list(i)%value_int16 )
	584
	585	CASE ( 'int32' )
	586	nc_stat = NF90_PUT_ATT( nc_file_id, &
	587	var_id_netcdf(attribute_list(i)%var_id), &
	588	TRIM(attribute_list(i)%name), &
	589	attribute_list(i)%value_int32 )
	590
	591	CASE ( 'real32' )
	592	nc_stat = NF90_PUT_ATT( nc_file_id, &
	593	var_id_netcdf(attribute_list(i)%var_id), &
	594	TRIM(attribute_list(i)%name), &
	595	attribute_list(i)%value_real32 )
	596
	597	CASE ( 'real64' )
	598	nc_stat = NF90_PUT_ATT( nc_file_id, &
	599	var_id_netcdf(attribute_list(i)%var_id), &
	600	TRIM(attribute_list(i)%name), &
	601	attribute_list(i)%value_real64 )
	602
	603	CASE DEFAULT
	604	return_value = 1
	605	CALL internal_message( 'error', routine_name // &
	606	': data type "' // TRIM( attribute_list(i)%data_type ) // &
	607	'" of attribute "' // TRIM( attribute_list(i)%name ) // &
	608	'" is not supported' )
	609	EXIT
	610
	611	END SELECT
	612
	613	IF ( nc_stat /= NF90_NOERR ) THEN
	614	return_value = 1
	615	CALL internal_message( 'error', routine_name // &
	616	': attribute "' // TRIM( attribute_list(i)%name ) // &
	617	'": NF90_PUT_ATT error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	618	EXIT
	619	ENDIF
	620
	621	ENDDO ! loop over attributes
	622
	623	ENDIF
	624
	625	IF ( ALLOCATED( attribute_list ) ) DEALLOCATE( attribute_list )
	626	IF ( ALLOCATED( dimension_list ) ) DEALLOCATE( dimension_list )
	627
	628	nc_stat = NF90_ENDDEF( nc_file_id )
	629	IF ( nc_stat /= NF90_NOERR ) THEN
	630	return_value = 1
	631	CALL internal_message( 'error', routine_name // &
	632	': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	633	ENDIF
	634
	635	END SUBROUTINE define_netcdf_files
	636
	637	!--------------------------------------------------------------------------------------------------!
	638	! Description:
	639	! ------------
	640	!> Read variable data from binary and write them into netcdf files.
	641	!--------------------------------------------------------------------------------------------------!
	642	SUBROUTINE convert_data_to_netcdf( bin_filename_body, return_value )
	643
	644	CHARACTER(LEN=2*charlen) :: bin_filename !< name of binary file which to read
	645	CHARACTER(LEN=* ), INTENT(IN) :: bin_filename_body !< body of binary filename which to read
	646	CHARACTER(LEN=charlen ) :: read_string !< string read from file
	647	CHARACTER(LEN=charlen ) :: variable_name !< name of variable to be read
	648
	649	CHARACTER(LEN=*), PARAMETER :: routine_name = 'convert_data_to_netcdf' !< routine name
	650
	651	INTEGER :: data_count !< count of data values of a variable over all dimensions
	652	INTEGER :: i !< loop file_index
	653	INTEGER :: io_stat !< status of Fortran I/O operations
	654	INTEGER :: pe_id !< loop index for loop over PE files
	655	INTEGER :: n_dim !< number of dimensions of a variable
	656	INTEGER :: nc_stat !< return value of Netcdf calls
	657	INTEGER, INTENT(OUT) :: return_value !< return value
	658	INTEGER(iwp) :: var_id !< variable id read from binary file
	659
	660	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: start_positions !< start position of data per dimension
	661	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: data_count_per_dimension !< data count of variable per dimension
	662	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_start !< lower bounds of variable
	663	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_end !< upper bounds of variable
	664	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_origin !< lower bounds of dimensions in output file
	665
	666	INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< variable values
	667	INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< variable values
	668	INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< variable values
	669	INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< variable values
	670
	671	LOGICAL :: file_exists !< true if file exists
	672
	673	REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< variable values
	674	REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< variable values
	675	REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< variable values
	676
	677
	678	return_value = 0
	679
	680	!-- Open binary files of every possible PE
	681	DO pe_id = 0, 999999
	682
	683	WRITE( bin_filename, '(A, I6.6)' ) &
	684	TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', pe_id
	685
	686	INQUIRE( FILE=bin_filename, EXIST=file_exists )
	687
	688	!-- Read file if it exists
	689	IF ( file_exists ) THEN
	690
	691	!-- Open file and skip header (file of PE0 is already opened)
	692	IF ( pe_id /= 0 ) THEN
	693
	694	OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD' )
	695
	696	CALL internal_message( 'debug', routine_name // &
	697	': read binary file ' // TRIM( bin_filename ) )
	698
	699	read_string = ''
	700	DO WHILE ( TRIM( read_string ) /= '* end file header *' )
	701
	702	READ( bin_file_unit ) read_string
	703
	704	SELECT CASE ( TRIM( read_string ) )
	705
	706	CASE ( 'char' )
	707	READ( bin_file_unit ) read_string
	708
	709	CASE ( 'int8' )
	710	READ( bin_file_unit ) dummy_int8
	711
	712	CASE ( 'int16' )
	713	READ( bin_file_unit ) dummy_int16
	714
	715	CASE ( 'int32' )
	716	READ( bin_file_unit ) dummy_int32
	717
	718	CASE ( 'real32' )
	719	READ( bin_file_unit ) dummy_real32
	720
	721	CASE ( 'real64' )
	722	READ( bin_file_unit ) dummy_real64
	723
	724	END SELECT
	725
	726	ENDDO
	727
	728	ENDIF
	729
	730	!-- Read variable data
	731	io_stat = 0
	732	DO WHILE ( io_stat == 0 .AND. return_value == 0 )
	733
	734	READ( bin_file_unit, IOSTAT=io_stat ) var_id
	735	IF ( io_stat < 0 ) EXIT ! End-of-file
	736
	737	DO i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 )
	738	IF ( var_id == variable_list(i)%id ) THEN
	739	n_dim = SIZE( variable_list(i)%dimension_ids )
	740	variable_name = variable_list(i)%name
	741
	742	CALL internal_message( 'debug', routine_name // ': read variable "' // &
	743	TRIM( variable_name ) // '"' )
	744	WRITE( temp_string, * ) n_dim
	745	CALL internal_message( 'debug', routine_name // &
	746	': n_dim = ' // TRIM( temp_string ) )
	747
	748	EXIT
	749	ENDIF
	750	ENDDO
	751
	752	ALLOCATE( bounds_start(1:n_dim) )
	753	ALLOCATE( bounds_end(1:n_dim) )
	754	ALLOCATE( bounds_origin(1:n_dim) )
	755	ALLOCATE( start_positions(1:n_dim) )
	756	ALLOCATE( data_count_per_dimension(1:n_dim) )
	757
	758	READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dim )
	759	READ( bin_file_unit ) ( bounds_end(i), i = 1, n_dim )
	760	READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dim )
	761
	762	WRITE( temp_string, * ) bounds_start
	763	CALL internal_message( 'debug', routine_name // &
	764	': bounds_start = ' // TRIM( temp_string ) )
	765	WRITE( temp_string, * ) bounds_end
	766	CALL internal_message( 'debug', routine_name // &
	767	': bounds_end = ' // TRIM( temp_string ) )
	768	WRITE( temp_string, * ) bounds_origin
	769	CALL internal_message( 'debug', routine_name // &
	770	': bounds_origin = ' // TRIM( temp_string ) )
	771
	772	data_count = 1
	773
	774	DO i = 1, n_dim
	775	data_count = data_count * ( bounds_end(i) - bounds_start(i) + 1 )
	776	start_positions(i) = bounds_start(i) - bounds_origin(i) + 1
	777	data_count_per_dimension(i) = bounds_end(i) - bounds_start(i) + 1
	778	ENDDO
	779
	780	read_string = ''
	781	READ( bin_file_unit ) read_string ! read data type of following values
	782
	783	SELECT CASE ( TRIM( read_string ) )
	784
	785	CASE ( 'int8' )
	786	ALLOCATE( values_int8(1:data_count) )
	787
	788	READ( bin_file_unit ) ( values_int8(i), i = 1, data_count )
	789
	790	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int8, &
	791	start = start_positions, count = data_count_per_dimension )
	792
	793	DEALLOCATE( values_int8 )
	794
	795	CASE ( 'int16' )
	796	ALLOCATE( values_int16(1:data_count) )
	797
	798	READ( bin_file_unit ) ( values_int16(i), i = 1, data_count )
	799
	800	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int16, &
	801	start = start_positions, count = data_count_per_dimension )
	802
	803	DEALLOCATE( values_int16 )
	804
	805	CASE ( 'int32' )
	806	ALLOCATE( values_int32(1:data_count) )
	807
	808	READ( bin_file_unit ) ( values_int32(i), i = 1, data_count )
	809
	810	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int32, &
	811	start = start_positions, count = data_count_per_dimension )
	812
	813	DEALLOCATE( values_int32 )
	814
	815	CASE ( 'intwp' )
	816	ALLOCATE( values_intwp(1:data_count) )
	817
	818	READ( bin_file_unit ) ( values_intwp(i), i = 1, data_count )
	819
	820	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_intwp, &
	821	start = start_positions, count = data_count_per_dimension )
	822
	823	DEALLOCATE( values_intwp )
	824
	825	CASE ( 'real32' )
	826	ALLOCATE( values_real32(1:data_count) )
	827
	828	READ( bin_file_unit ) ( values_real32(i), i = 1, data_count )
	829
	830	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real32, &
	831	start = start_positions, count = data_count_per_dimension )
	832
	833	DEALLOCATE( values_real32 )
	834
	835	CASE ( 'real64' )
	836	ALLOCATE( values_real64(1:data_count) )
	837
	838	READ( bin_file_unit ) ( values_real64(i), i = 1, data_count )
	839
	840	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real64, &
	841	start = start_positions, count = data_count_per_dimension )
	842
	843	DEALLOCATE( values_real64 )
	844
	845	CASE ( 'realwp' )
	846	ALLOCATE( values_realwp(1:data_count) )
	847
	848	READ( bin_file_unit ) ( values_realwp(i), i = 1, data_count )
	849
	850	nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_realwp, &
	851	start = start_positions, count = data_count_per_dimension )
	852
	853	DEALLOCATE( values_realwp )
	854
	855	END SELECT
	856
	857	IF ( nc_stat /= NF90_NOERR ) THEN
	858	return_value = 1
	859	CALL internal_message( 'error', routine_name // &
	860	': variable "' // TRIM( variable_name ) // &
	861	'": NF90_PUT_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	862	ENDIF
	863
	864	!-- Deallocate fields for next variable
	865	DEALLOCATE( start_positions )
	866	DEALLOCATE( data_count_per_dimension )
	867	DEALLOCATE( bounds_start )
	868	DEALLOCATE( bounds_end )
	869	DEALLOCATE( bounds_origin )
	870
	871	ENDDO ! end loop over variables in a file
	872
	873	CLOSE( bin_file_unit )
	874
	875	ELSE
	876
	877	EXIT
	878
	879	ENDIF ! if file exists
	880
	881	ENDDO ! end loop over all PE
	882
	883	nc_stat = NF90_CLOSE( nc_file_id )
	884
	885	IF ( nc_stat /= NF90_NOERR ) THEN
	886	return_value = 1
	887	CALL internal_message( 'error', routine_name // &
	888	': NF90_CLOSE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
	889	ENDIF
	890
	891	!-- Deallocate fields for next file
	892	IF ( ALLOCATED( variable_list ) ) DEALLOCATE( variable_list )
	893	IF ( ALLOCATED( dim_id_netcdf ) ) DEALLOCATE( dim_id_netcdf )
	894	IF ( ALLOCATED( var_id_netcdf ) ) DEALLOCATE( var_id_netcdf )
	895
	896	END SUBROUTINE convert_data_to_netcdf
	897
	898	!--------------------------------------------------------------------------------------------------!
	899	! Description:
	900	! ------------
	901	!> Message routine for internal use.
	902	!--------------------------------------------------------------------------------------------------!
	903	SUBROUTINE internal_message( level, string )
	904
	905	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
	906	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
	907
	908	IF ( TRIM( level ) == 'error' ) THEN
	909	WRITE( *, '(A,A)' ) ' ## ERROR ', string
	910	FLUSH(6)
	911	ELSEIF ( TRIM( level ) == 'debug' .AND. print_debug_output ) THEN
	912	WRITE( *, '(A,A)' ) ' ++ DEBUG ', string
	913	FLUSH(6)
	914	ELSEIF ( TRIM( level ) == 'info' ) THEN
	915	WRITE( *, '(A,A)' ) ' -- INFO ', string
	916	FLUSH(6)
	917	ENDIF
	918
	919	END SUBROUTINE internal_message
	920
	921	END PROGRAM binary_to_netcdf

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |