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

Last change on this file since 4521 was 4481, checked in by maronga, 5 years ago

Bugfix for copyright updates in document_changes; copyright update applied to all files

  • Property svn:keywords set to Id
File size: 42.4 KB
Line 
1!> @file binary_to_netcdf.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 2019-2020 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: binary_to_netcdf.f90 4481 2020-03-31 18:55:54Z schwenkel $
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!--------------------------------------------------------------------------------------------------!
44PROGRAM 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
187CONTAINS
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!--------------------------------------------------------------------------------------------------!
196SUBROUTINE 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
270END SUBROUTINE get_group_names
271
272!--------------------------------------------------------------------------------------------------!
273! Description:
274! ------------
275!> Read configuration file.
276!--------------------------------------------------------------------------------------------------!
277SUBROUTINE 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
370END SUBROUTINE read_config
371
372!--------------------------------------------------------------------------------------------------!
373! Description:
374! ------------
375!> Read header information from binary files.
376!--------------------------------------------------------------------------------------------------!
377SUBROUTINE 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
550END SUBROUTINE read_binary_header
551
552!--------------------------------------------------------------------------------------------------!
553! Description:
554! ------------
555!> Define all netcdf files.
556!--------------------------------------------------------------------------------------------------!
557SUBROUTINE 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
758END SUBROUTINE define_netcdf_files
759
760!--------------------------------------------------------------------------------------------------!
761! Description:
762! ------------
763!> Read variable data from binary and write them into netcdf files.
764!--------------------------------------------------------------------------------------------------!
765SUBROUTINE 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
1013END SUBROUTINE convert_data_to_netcdf
1014
1015!--------------------------------------------------------------------------------------------------!
1016! Description:
1017! ------------
1018!> Message routine for internal use.
1019!--------------------------------------------------------------------------------------------------!
1020SUBROUTINE 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
1036END SUBROUTINE internal_message
1037
1038END PROGRAM binary_to_netcdf
Note: See TracBrowser for help on using the repository browser.