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

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

bugfix: do not assue that output arrays start with index 0

  • Property svn:keywords set to Id
File size: 41.1 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 4123 2019-07-26 13:45:03Z 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_origin             !< lower bounds of dimensions in output file
784
785   INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8   !< variable values
786   INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  values_int16  !< variable values
787   INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  values_int32  !< variable values
788   INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  values_intwp  !< variable values
789
790   LOGICAL ::  file_exists  !< true if file exists
791
792   REAL(KIND=4), DIMENSION(:), ALLOCATABLE ::  values_real32  !< variable values
793   REAL(KIND=8), DIMENSION(:), ALLOCATABLE ::  values_real64  !< variable values
794   REAL(wp),     DIMENSION(:), ALLOCATABLE ::  values_realwp  !< variable values
795
796
797   return_value = 0
798
799   !-- Open binary files of every possible PE
800   DO  pe_id = 0, dom_nrank - 1
801
802      WRITE( bin_filename, '(A, I6.6)' ) &
803         TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', pe_id
804
805      INQUIRE( FILE=bin_filename, EXIST=file_exists )
806
807      !-- Read file if it exists
808      IF ( file_exists )  THEN
809
810         OPEN( bin_file_unit, FILE=bin_filename, FORM='UNFORMATTED', STATUS='OLD' )
811
812         CALL internal_message( 'debug', routine_name // &
813                                ': read binary file ' // TRIM( bin_filename ) )
814
815         read_string = ''
816         DO WHILE ( TRIM( read_string ) /= '*** end file header ***' )
817
818            READ( bin_file_unit ) read_string
819
820            SELECT CASE ( TRIM( read_string ) )
821
822               CASE ( 'char' )
823                  READ( bin_file_unit ) read_string
824
825               CASE ( 'int8' )
826                  READ( bin_file_unit ) dummy_int8
827
828               CASE ( 'int16' )
829                  READ( bin_file_unit ) dummy_int16
830
831               CASE ( 'int32' )
832                  READ( bin_file_unit ) dummy_int32
833
834               CASE ( 'real32' )
835                  READ( bin_file_unit ) dummy_real32
836
837               CASE ( 'real64' )
838                  READ( bin_file_unit ) dummy_real64
839
840            END SELECT
841
842         ENDDO
843
844         !-- Read variable data
845         io_stat = 0
846         DO WHILE ( io_stat == 0  .AND.  return_value == 0 )
847
848            READ( bin_file_unit, IOSTAT=io_stat ) var_id
849            IF ( io_stat < 0 )  EXIT  ! End-of-file
850
851            DO  i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 )
852               IF ( var_id == variable_list(i)%id )  THEN
853                  n_dim = SIZE( variable_list(i)%dimension_ids )
854                  variable_name = variable_list(i)%name
855
856                  CALL internal_message( 'debug', routine_name // ': read variable "' // &
857                                         TRIM( variable_name ) // '"' )
858                  WRITE( temp_string, * ) n_dim
859                  CALL internal_message( 'debug', routine_name // &
860                                         ':  n_dim = ' // TRIM( temp_string ) )
861
862                  EXIT
863               ENDIF
864            ENDDO
865
866            ALLOCATE( bounds_start(1:n_dim) )
867            ALLOCATE( bounds_origin(1:n_dim) )
868            ALLOCATE( start_positions(1:n_dim) )
869            ALLOCATE( data_count_per_dimension(1:n_dim) )
870
871            READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dim )
872            READ( bin_file_unit ) ( data_count_per_dimension(i), i = 1, n_dim )
873            READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dim )
874
875            WRITE( temp_string, * ) bounds_start
876            CALL internal_message( 'debug', routine_name // &
877                                   ': bounds_start = ' // TRIM( temp_string ) )
878            WRITE( temp_string, * ) data_count_per_dimension
879            CALL internal_message( 'debug', routine_name // &
880                                   ': data_count_per_dimension = ' // TRIM( temp_string ) )
881            WRITE( temp_string, * ) bounds_origin
882            CALL internal_message( 'debug', routine_name // &
883                                   ': bounds_origin = ' // TRIM( temp_string ) )
884
885            data_count = 1
886
887            DO  i = 1, n_dim
888               data_count = data_count * data_count_per_dimension(i)
889               start_positions(i) = bounds_start(i) - bounds_origin(i) + 1
890            ENDDO
891
892            read_string = ''
893            READ( bin_file_unit ) read_string  ! read data type of following values
894
895            SELECT CASE ( TRIM( read_string ) )
896
897               CASE ( 'int8' )
898                  ALLOCATE( values_int8(1:data_count) )
899
900                  READ( bin_file_unit ) ( values_int8(i), i = 1, data_count )
901
902                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int8, &
903                               start = start_positions, count = data_count_per_dimension )
904
905                  DEALLOCATE( values_int8 )
906
907               CASE ( 'int16' )
908                  ALLOCATE( values_int16(1:data_count) )
909
910                  READ( bin_file_unit ) ( values_int16(i), i = 1, data_count )
911
912                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int16, &
913                               start = start_positions, count = data_count_per_dimension )
914
915                  DEALLOCATE( values_int16 )
916
917               CASE ( 'int32' )
918                  ALLOCATE( values_int32(1:data_count) )
919
920                  READ( bin_file_unit ) ( values_int32(i), i = 1, data_count )
921
922                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int32, &
923                               start = start_positions, count = data_count_per_dimension )
924
925                  DEALLOCATE( values_int32 )
926
927               CASE ( 'intwp' )
928                  ALLOCATE( values_intwp(1:data_count) )
929
930                  READ( bin_file_unit ) ( values_intwp(i), i = 1, data_count )
931
932                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_intwp, &
933                               start = start_positions, count = data_count_per_dimension )
934
935                  DEALLOCATE( values_intwp )
936
937               CASE ( 'real32' )
938                  ALLOCATE( values_real32(1:data_count) )
939
940                  READ( bin_file_unit ) ( values_real32(i), i = 1, data_count )
941
942                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real32, &
943                               start = start_positions, count = data_count_per_dimension )
944
945                  DEALLOCATE( values_real32 )
946
947               CASE ( 'real64' )
948                  ALLOCATE( values_real64(1:data_count) )
949
950                  READ( bin_file_unit ) ( values_real64(i), i = 1, data_count )
951
952                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real64, &
953                               start = start_positions, count = data_count_per_dimension )
954
955                  DEALLOCATE( values_real64 )
956
957               CASE ( 'realwp' )
958                  ALLOCATE( values_realwp(1:data_count) )
959
960                  READ( bin_file_unit ) ( values_realwp(i), i = 1, data_count )
961
962                  nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_realwp, &
963                               start = start_positions, count = data_count_per_dimension )
964
965                  DEALLOCATE( values_realwp )
966
967            END SELECT
968
969            IF ( nc_stat /= NF90_NOERR )  THEN
970               return_value = 1
971               CALL internal_message( 'error', routine_name //    &
972                       ': variable "' // TRIM( variable_name ) // &
973                       '": NF90_PUT_VAR error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
974            ENDIF
975
976            !-- Deallocate fields for next variable
977            DEALLOCATE( start_positions )
978            DEALLOCATE( data_count_per_dimension )
979            DEALLOCATE( bounds_start )
980            DEALLOCATE( bounds_origin )
981
982         ENDDO  ! end loop over variables in a file
983
984         CLOSE( bin_file_unit )
985
986      ENDIF  ! if file exists
987
988   ENDDO  ! end loop over all PE
989
990   nc_stat = NF90_CLOSE( nc_file_id )
991
992   IF ( nc_stat /= NF90_NOERR )  THEN
993      return_value = 1
994      CALL internal_message( 'error', routine_name // &
995                             ': NF90_CLOSE error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
996   ENDIF
997
998   !-- Deallocate fields for next file
999   IF ( ALLOCATED( variable_list ) )  DEALLOCATE( variable_list )
1000   IF ( ALLOCATED( dim_id_netcdf ) )  DEALLOCATE( dim_id_netcdf )
1001   IF ( ALLOCATED( var_id_netcdf ) )  DEALLOCATE( var_id_netcdf )
1002
1003END SUBROUTINE convert_data_to_netcdf
1004
1005!--------------------------------------------------------------------------------------------------!
1006! Description:
1007! ------------
1008!> Message routine for internal use.
1009!--------------------------------------------------------------------------------------------------!
1010SUBROUTINE internal_message( level, string )
1011
1012   CHARACTER(LEN=*), INTENT(IN) :: level  !< message importance level
1013   CHARACTER(LEN=*), INTENT(IN) :: string !< message string
1014
1015   IF ( TRIM( level ) == 'error' )  THEN
1016      WRITE( *, '(A,A)' ) ' ## ERROR ', string
1017      FLUSH(6)
1018   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
1019      WRITE( *, '(A,A)' ) ' ++ DEBUG ', string
1020      FLUSH(6)
1021   ELSEIF ( TRIM( level ) == 'info' )  THEN
1022      WRITE( *, '(A,A)' ) ' -- INFO  ', string
1023      FLUSH(6)
1024   ENDIF
1025
1026END SUBROUTINE internal_message
1027
1028END PROGRAM binary_to_netcdf
Note: See TracBrowser for help on using the repository browser.