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

Last change on this file since 4084 was 4075, checked in by gronemeier, 5 years ago

add program to convert the new binary output into netcdf (binary_to_netcdf.f90)

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