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

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