Home

Context Navigation

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

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |