source: palm/trunk/UTIL/binary_to_netcdf.f90

Last change on this file was 4843, checked in by raasch, 23 months ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

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