Home

Context Navigation

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

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

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 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 |