Home

Context Navigation

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

Last change on this file since 4554 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

Line
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-2020 Leibniz Universitaet Hannover
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 eckhard $
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 :: iwp = 4 !< default integer kind for output-variable values
52	INTEGER, PARAMETER :: wp = 8 !< default real kind for output-variable values
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 :: variable_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 :: id !< dimension id within file
73	INTEGER :: 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 :: id !< variable id within file
80	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids used by variable
81	END TYPE variable_type
82
83
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
88
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
93
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
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 :: dummy_int !< dummy variable used for reading
110
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
114
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)
117	!> reference the same dimension
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)
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
134	CALL internal_message( 'info', 'Start ' // routine_name // ' ...' )
135
136	CALL get_group_names( return_value )
137
138	IF ( return_value == 0 ) THEN
139
140	!-- Go through each group of output files (all marked by same file suffix)
141	DO group = 1, ngroups
142
143	CALL internal_message( 'info', 'Start converting ' // TRIM( group_names(group) ) // &
144	' binary files:' )
145
146	CALL read_config( TRIM( group_names(group) ), your_return_value )
147
148	IF ( your_return_value == 0 ) THEN
149	DO file_index = 1, nfiles
150
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) ), &
163	your_return_value )
164	ELSE
165	return_value = your_return_value
166	ENDIF
167
168	ENDDO
169	ELSE
170	return_value = your_return_value
171	ENDIF
172
173	IF ( ALLOCATED( filename_list ) ) DEALLOCATE( filename_list )
174	IF ( ALLOCATED( filename_prefix ) ) DEALLOCATE( filename_prefix )
175
176	ENDDO
177
178	ENDIF
179
180	IF ( return_value == 0 ) THEN
181	CALL internal_message( 'info', 'Execution finished' )
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	! ------------
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
231	ngroups = 0
232	DO WHILE ( io_stat == 0 )
233	READ( config_file_list_unit, '(A)', IOSTAT=io_stat ) file_name
234	IF ( io_stat == 0 ) ngroups = ngroups + 1
235	ENDDO
236	REWIND( config_file_list_unit )
237
238	IF ( ngroups /= 0 ) THEN
239
240	ALLOCATE( group_names(ngroups) )
241
242	!-- Extract the group names
243	DO i = 1, ngroups
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	! ------------
275	!> Read configuration file.
276	!--------------------------------------------------------------------------------------------------!
277	SUBROUTINE read_config( group_name, return_value )
278
279	CHARACTER(LEN=:), ALLOCATABLE :: read_string !< string read from file
280	CHARACTER(LEN=*), INTENT(IN) :: group_name !< group name
281	CHARACTER(LEN=*), PARAMETER :: routine_name = 'read_config' !< name of routine
282
283	CHARACTER(LEN=charlen_internal) :: config_file_name !< config file name with additional suffix
284
285	CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE :: filename_list_tmp !< temporary list of file names
286
287	INTEGER :: filename_prefix_length !< length of string containing the filname prefix
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
294	config_file_name = config_file_name_base // group_name
295
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
301	CALL internal_message( 'error', routine_name // &
302	': error while opening configuration file "' // &
303	TRIM( config_file_name ) // '"' )
304	ENDIF
305
306	IF ( return_value == 0 ) THEN
307
308	READ( config_file_unit ) dom_nranks
309
310	IF ( dom_nranks > 1000000 ) THEN
311	dom_nranks = 1000000
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
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
353	filename_list(nfiles) = TRIM( read_string ) // group_name
354
355	ENDIF
356
357	ELSEIF ( io_stat > 0 ) THEN
358	return_value = 1
359	CALL internal_message( 'error', routine_name // &
360	': error while reading file names from config' )
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
380	CHARACTER(LEN=*), INTENT(IN) :: bin_filename_body !< body of binary filename which to read
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
390	INTEGER :: variable_ndims !< number of dimensions of a variable
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
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
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
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
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
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 )
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
500	READ( bin_file_unit ) attribute_list(n_attributes)%variable_id
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
548	CLOSE( bin_file_unit )
549
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
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
569
570	INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids of a variable
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
585	ALLOCATE( dimension_id_netcdf(1:MAXVAL(dimension_list(:)%id)) )
586
587	DO i = 1, SIZE( dimension_list )
588
589	IF ( dimension_list(i)%length < 0 ) THEN
590	nc_dimension_length = NF90_UNLIMITED
591	ELSE
592	nc_dimension_length = dimension_list(i)%length
593	ENDIF
594
595	nc_stat = NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dimension_length, &
596	dimension_id_netcdf(dimension_list(i)%id) )
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
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 ) ) ) )
618
619	!-- Map global id from binary file to that of the netcdf file
620	variable_id_netcdf(dom_global_id) = NF90_GLOBAL
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
656	ALLOCATE( dimension_ids(1:SIZE( variable_list(i)%dimension_ids )) )
657
658	DO j = 1, SIZE( variable_list(i)%dimension_ids )
659
660	dimension_ids(j) = dimension_id_netcdf(variable_list(i)%dimension_ids(j))
661
662	ENDDO
663
664	nc_stat = NF90_DEF_VAR( nc_file_id, variable_list(i)%name, nc_data_type, &
665	dimension_ids, variable_id_netcdf(variable_list(i)%id) )
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
673	DEALLOCATE( dimension_ids )
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' )
691	nc_stat = NF90_PUT_ATT( nc_file_id, &
692	variable_id_netcdf(attribute_list(i)%variable_id), &
693	TRIM(attribute_list(i)%name), &
694	TRIM(attribute_list(i)%value_char) )
695
696	CASE ( 'int8' )
697	nc_stat = NF90_PUT_ATT( nc_file_id, &
698	variable_id_netcdf(attribute_list(i)%variable_id), &
699	TRIM(attribute_list(i)%name), &
700	attribute_list(i)%value_int8 )
701
702	CASE ( 'int16' )
703	nc_stat = NF90_PUT_ATT( nc_file_id, &
704	variable_id_netcdf(attribute_list(i)%variable_id), &
705	TRIM(attribute_list(i)%name), &
706	attribute_list(i)%value_int16 )
707
708	CASE ( 'int32' )
709	nc_stat = NF90_PUT_ATT( nc_file_id, &
710	variable_id_netcdf(attribute_list(i)%variable_id), &
711	TRIM(attribute_list(i)%name), &
712	attribute_list(i)%value_int32 )
713
714	CASE ( 'real32' )
715	nc_stat = NF90_PUT_ATT( nc_file_id, &
716	variable_id_netcdf(attribute_list(i)%variable_id), &
717	TRIM(attribute_list(i)%name), &
718	attribute_list(i)%value_real32 )
719
720	CASE ( 'real64' )
721	nc_stat = NF90_PUT_ATT( nc_file_id, &
722	variable_id_netcdf(attribute_list(i)%variable_id), &
723	TRIM(attribute_list(i)%name), &
724	attribute_list(i)%value_real64 )
725
726	CASE DEFAULT
727	return_value = 1
728	CALL internal_message( 'error', routine_name // &
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
738	CALL internal_message( 'error', routine_name // &
739	': attribute "' // TRIM( attribute_list(i)%name ) // &
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 // &
755	': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
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
777	INTEGER :: rank !< loop index for loop over rank files
778	INTEGER :: n_dimensions !< number of dimensions of a variable
779	INTEGER :: nc_stat !< return value of Netcdf calls
780	INTEGER, INTENT(OUT) :: return_value !< return value
781	INTEGER :: variable_id !< variable id read from binary file
782
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
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
802	!-- Open binary files of every possible MPI rank
803	DO rank = 0, dom_nranks - 1
804
805	WRITE( bin_filename, '(A, I6.6)' ) &
806	TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', rank
807
808	INQUIRE( FILE=bin_filename, EXIST=file_exists )
809
810	!-- Read file if it exists
811	IF ( file_exists ) THEN
812
813	OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD' )
814
815	CALL internal_message( 'debug', routine_name // &
816	': read binary file ' // TRIM( bin_filename ) )
817
818	read_string = ''
819	DO WHILE ( TRIM( read_string ) /= '* end file header *' )
820
821	READ( bin_file_unit ) read_string
822
823	SELECT CASE ( TRIM( read_string ) )
824
825	CASE ( 'char' )
826	READ( bin_file_unit ) read_string
827
828	CASE ( 'int8' )
829	READ( bin_file_unit ) dummy_int8
830
831	CASE ( 'int16' )
832	READ( bin_file_unit ) dummy_int16
833
834	CASE ( 'int32' )
835	READ( bin_file_unit ) dummy_int32
836
837	CASE ( 'real32' )
838	READ( bin_file_unit ) dummy_real32
839
840	CASE ( 'real64' )
841	READ( bin_file_unit ) dummy_real64
842
843	END SELECT
844
845	ENDDO
846
847	!-- Read variable data
848	io_stat = 0
849	DO WHILE ( io_stat == 0 .AND. return_value == 0 )
850
851	READ( bin_file_unit, IOSTAT=io_stat ) variable_id
852	IF ( io_stat < 0 ) EXIT ! End-of-file
853
854	DO i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 )
855	IF ( variable_id == variable_list(i)%id ) THEN
856	n_dimensions = SIZE( variable_list(i)%dimension_ids )
857	variable_name = variable_list(i)%name
858
859	CALL internal_message( 'debug', routine_name // ': read variable "' // &
860	TRIM( variable_name ) // '"' )
861	WRITE( temp_string, * ) n_dimensions
862	CALL internal_message( 'debug', routine_name // &
863	': n_dimensions = ' // TRIM( temp_string ) )
864
865	EXIT
866	ENDIF
867	ENDDO
868
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) )
873
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 )
877
878	WRITE( temp_string, * ) bounds_start
879	CALL internal_message( 'debug', routine_name // &
880	': bounds_start = ' // TRIM( temp_string ) )
881	WRITE( temp_string, * ) data_count_per_dimension
882	CALL internal_message( 'debug', routine_name // &
883	': data_count_per_dimension = ' // TRIM( temp_string ) )
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
890	DO i = 1, n_dimensions
891	data_count = data_count * data_count_per_dimension(i)
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
905	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
906	values_int8, &
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
916	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
917	values_int16, &
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
927	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
928	values_int32, &
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
938	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
939	values_intwp, &
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
949	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
950	values_real32, &
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
960	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
961	values_real64, &
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
971	nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
972	values_realwp, &
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
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 )
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
1022	CHARACTER(LEN=*), INTENT(IN) :: level !< message importance level
1023	CHARACTER(LEN=*), INTENT(IN) :: string !< message string
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 |