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

Last change on this file since 4107 was 4107, checked in by gronemeier, 2 years ago

changes in data-output module (data_output_module.f90, data_output_binary_module.f90, data_output_netcdf4_module.f90, binary_to_netcdf.f90):

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