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