Ignore:
Timestamp:
Aug 5, 2019 12:24:51 PM (23 months ago)
Author:
gronemeier
Message:

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

  • renaming of variables
  • changes to formatting and layout
  • update routine descriptions
File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/data_output_module.f90

    r4124 r4141  
    3838!> Data-output module to handle output of variables into output files.
    3939!>
    40 !> The module first creates an interal database containing all meta data of all
    41 !> output quantities. Output files are then inititialized and prepared for
    42 !> storing data, which are finally written to file.
     40!> The module first creates an interal database containing all meta data of all output quantities.
     41!> After defining all meta data, the output files are initialized and prepared for writing. When
     42!> writing is finished, files can be finalized and closed.
     43!> The order of calls are as follows:
     44!>   1. Initialize the module via
     45!>      'dom_init'
     46!>   2. Define output files via (multiple calls of)
     47!>      'dom_def_file', 'dom_def_att', 'dom_def_dim', 'dom_def_var'
     48!>   3. Leave definition stage via
     49!>      'dom_def_end'
     50!>   4. Write output data into file via
     51!>      'dom_write_var'
     52!>   5. Finalize the output via
     53!>      'dom_finalize_output'
     54!> If any routine exits with a non-zero return value, the error message of the last encountered
     55!> error can be fetched via 'dom_get_error_message'.
     56!> For debugging purposes, the content of the database can be written to the debug output via
     57!> 'dom_database_debug_output'.
    4358!>
    4459!> @todo Convert variable if type of given values do not fit specified type.
    45 !> @todo Remove iwp from index (and similar) variables.
    4660!--------------------------------------------------------------------------------------------------!
    4761MODULE data_output_module
     
    5266      ONLY: netcdf4_init_dimension, &
    5367            netcdf4_get_error_message, &
    54             netcdf4_init_end, &
     68            netcdf4_stop_file_header_definition, &
    5569            netcdf4_init_module, &
    5670            netcdf4_init_variable, &
     
    6478            binary_get_error_message, &
    6579            binary_init_dimension, &
    66             binary_init_end, &
     80            binary_stop_file_header_definition, &
    6781            binary_init_module, &
    6882            binary_init_variable, &
     
    7387   IMPLICIT NONE
    7488
    75    INTEGER(iwp), PARAMETER ::  charlen = 100_iwp  !< maximum length of character variables
     89   INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
     90   INTEGER, PARAMETER ::  no_id = -1     !< default ID if no ID was assigned
    7691
    7792   TYPE attribute_type
     
    87102
    88103   TYPE variable_type
    89       CHARACTER(LEN=charlen) ::  data_type = ''       !< data type
    90       CHARACTER(LEN=charlen) ::  name                 !< variable name
    91       INTEGER(iwp)           ::  id = -1              !< id within file
    92       LOGICAL                ::  is_global = .FALSE.  !< true if global variable
    93       CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE ::  dimension_names  !< list of dimension names
    94       INTEGER(iwp),           DIMENSION(:), ALLOCATABLE ::  dimension_ids    !< list of dimension ids
    95       TYPE(attribute_type),   DIMENSION(:), ALLOCATABLE ::  attributes       !< list of attributes
     104      CHARACTER(LEN=charlen)                            ::  data_type = ''       !< data type
     105      CHARACTER(LEN=charlen)                            ::  name                 !< variable name
     106      INTEGER                                           ::  id = no_id           !< id within file
     107      LOGICAL                                           ::  is_global = .FALSE.  !< true if global variable
     108      CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE ::  dimension_names      !< list of dimension names used by variable
     109      INTEGER,                DIMENSION(:), ALLOCATABLE ::  dimension_ids        !< list of dimension ids used by variable
     110      TYPE(attribute_type),   DIMENSION(:), ALLOCATABLE ::  attributes           !< list of attributes
    96111   END TYPE variable_type
    97112
    98113   TYPE dimension_type
    99       CHARACTER(LEN=charlen) ::  data_type = ''       !< data type
    100       CHARACTER(LEN=charlen) ::  name                 !< dimension name
    101       INTEGER(iwp)           ::  id = -1              !< dimension id within file
    102       INTEGER(iwp)           ::  length               !< length of dimension
    103       INTEGER(iwp)           ::  length_mask          !< length of masked dimension
    104       INTEGER(iwp)           ::  var_id = -1          !< associated variable id within file
    105       LOGICAL                ::  is_masked = .FALSE.  !< true if masked
    106       INTEGER(iwp),    DIMENSION(2)              ::  bounds                !< lower and upper bound of dimension
    107       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_indices        !< list of masked indices of dimension
     114      CHARACTER(LEN=charlen)                     ::  data_type = ''        !< data type
     115      CHARACTER(LEN=charlen)                     ::  name                  !< dimension name
     116      INTEGER                                    ::  id = no_id            !< dimension id within file
     117      INTEGER                                    ::  length                !< length of dimension
     118      INTEGER                                    ::  length_mask           !< length of masked dimension
     119      INTEGER                                    ::  variable_id = no_id   !< associated variable id within file
     120      LOGICAL                                    ::  is_masked = .FALSE.   !< true if masked
     121      INTEGER,         DIMENSION(2)              ::  bounds                !< lower and upper bound of dimension
     122      INTEGER,         DIMENSION(:), ALLOCATABLE ::  masked_indices        !< list of masked indices of dimension
    108123      INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  masked_values_int8    !< masked dimension values if 16bit integer
    109124      INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  masked_values_int16   !< masked dimension values if 16bit integer
     
    125140
    126141   TYPE file_type
    127       CHARACTER(LEN=charlen) ::  format = ''        !< file format
    128       CHARACTER(LEN=charlen) ::  name = ''          !< file name
    129       INTEGER(iwp)           ::  id = -1            !< id of file
    130       LOGICAL                ::  is_init = .FALSE.  !< true if initialized
    131       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes  !< list of attributes
    132       TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions  !< list of dimensions
    133       TYPE(variable_type),  DIMENSION(:), ALLOCATABLE ::  variables   !< list of variables
     142      CHARACTER(LEN=charlen)                          ::  format = ''        !< file format
     143      CHARACTER(LEN=charlen)                          ::  name = ''          !< file name
     144      INTEGER                                         ::  id = no_id         !< id of file
     145      LOGICAL                                         ::  is_init = .FALSE.  !< true if initialized
     146      TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes         !< list of attributes
     147      TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions         !< list of dimensions
     148      TYPE(variable_type),  DIMENSION(:), ALLOCATABLE ::  variables          !< list of variables
    134149   END TYPE file_type
    135150
    136151
    137    CHARACTER(LEN=charlen) ::  output_file_format = 'binary'  !< file format (namelist parameter)
    138    CHARACTER(LEN=charlen) ::  output_file_suffix = ''        !< file suffix added to each file name
    139 
    140    CHARACTER(LEN=800) ::  internal_error_message = '' !< string containing the last error message
    141    CHARACTER(LEN=800) ::  temp_string                 !< dummy string
    142 
    143    INTEGER(iwp) ::  debug_output_unit  !< Fortran Unit Number of the debug-output file
    144    INTEGER      ::  nf = 0             !< number of files
    145    INTEGER      ::  master_rank = 0    !< master rank for tasks to be executed by single PE only
    146    INTEGER      ::  output_group_comm  !< MPI communicator addressing all MPI ranks which participate in output
    147 
    148    INTEGER(iwp), PARAMETER ::  no_var_id = -1  !< value of var_id if no variable is selected
     152   CHARACTER(LEN=charlen) ::  output_file_suffix = ''      !< file suffix added to each file name
     153   CHARACTER(LEN=800)     ::  internal_error_message = ''  !< string containing the last error message
     154   CHARACTER(LEN=800)     ::  temp_string                  !< dummy string
     155
     156   INTEGER ::  debug_output_unit  !< Fortran Unit Number of the debug-output file
     157   INTEGER ::  nfiles = 0         !< number of files
     158   INTEGER ::  master_rank = 0    !< master rank for tasks to be executed by single PE only
     159   INTEGER ::  output_group_comm  !< MPI communicator addressing all MPI ranks which participate in output
    149160
    150161   LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
     
    187198
    188199   !> Prepare for output: evaluate database and create files
    189    INTERFACE dom_start_output
    190       MODULE PROCEDURE dom_start_output
    191    END INTERFACE dom_start_output
     200   INTERFACE dom_def_end
     201      MODULE PROCEDURE dom_def_end
     202   END INTERFACE dom_def_end
    192203
    193204   !> Write variables to file
     
    206217   END INTERFACE dom_get_error_message
    207218
     219   !> Write database to debug output
     220   INTERFACE dom_database_debug_output
     221      MODULE PROCEDURE dom_database_debug_output
     222   END INTERFACE dom_database_debug_output
     223
    208224   PUBLIC &
    209       dom_database_debug_output, &
     225      dom_init, &
     226      dom_def_file, &
     227      dom_def_dim, &
     228      dom_def_var, &
    210229      dom_def_att, &
    211       dom_def_dim, &
    212       dom_def_file, &
    213       dom_def_var, &
     230      dom_def_end, &
     231      dom_write_var, &
    214232      dom_finalize_output, &
    215233      dom_get_error_message, &
    216       dom_init, &
    217       dom_start_output, &
    218       dom_write_var
     234      dom_database_debug_output
    219235
    220236CONTAINS
     
    224240! Description:
    225241! ------------
    226 !> Initialize data-output module
     242!> Initialize data-output module.
     243!> Provide some general information of the main program.
     244!> The optional argument 'file_suffix_of_output_group' defines a file suffix which is added to all
     245!> output files. If multiple output groups (groups of MPI ranks, defined by
     246!> 'mpi_comm_of_output_group') exist, a unique file suffix must be given for each group. This
     247!> prevents that multiple groups try to open and write to the same output file.
    227248!--------------------------------------------------------------------------------------------------!
    228249SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &
     
    238259   INTEGER, INTENT(IN)           ::  program_debug_output_unit  !< file unit number for debug output
    239260
    240    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
     261   LOGICAL, INTENT(IN)           ::  debug_output               !< if true, debug output is printed
    241262
    242263
     
    250271
    251272   CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &
    252                             debug_output_unit, debug_output, no_var_id )
     273                            debug_output_unit, debug_output, no_id )
    253274
    254275   CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &
    255                             debug_output_unit, debug_output, no_var_id )
     276                            debug_output_unit, debug_output, no_id )
    256277
    257278END SUBROUTINE dom_init
    258 
    259 !--------------------------------------------------------------------------------------------------!
    260 ! Description:
    261 ! ------------
    262 !> Debugging output. Print contents of output database to debug_output_unit.
    263 !--------------------------------------------------------------------------------------------------!
    264 SUBROUTINE dom_database_debug_output
    265 
    266    CHARACTER(LEN=*), PARAMETER ::  separation_string = '---'                   !< string separating blocks in output
    267    CHARACTER(LEN=50)           ::  format1                                     !< format for write statements
    268    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_database_debug_output'  !< name of this routine
    269 
    270    INTEGER            ::  f                       !< loop index
    271    INTEGER, PARAMETER ::  indent_depth = 3        !< space per indentation
    272    INTEGER            ::  indent_level            !< indentation level
    273    INTEGER, PARAMETER ::  max_keyname_length = 6  !< length of longest key name
    274    INTEGER            ::  natt                    !< number of attributes
    275    INTEGER            ::  ndim                    !< number of dimensions
    276    INTEGER            ::  nvar                    !< number of variables
    277 
    278 
    279    CALL internal_message( 'debug', routine_name // ': write data base to debug output' )
    280 
    281    WRITE( debug_output_unit, '(A)' ) 'DOM data base:'
    282    WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 )
    283 
    284    IF ( .NOT. ALLOCATED( files ) .OR. nf == 0 )  THEN
    285 
    286       WRITE( debug_output_unit, '(A)' ) 'database is empty'
    287 
    288    ELSE
    289 
    290       indent_level = 1
    291       WRITE( format1, '(A,I3,A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A,T',        &
    292                                         indent_level * indent_depth + 1 + max_keyname_length, &
    293                                         ',(": ")'
    294 
    295       DO  f = 1, nf
    296 
    297          natt = 0
    298          ndim = 0
    299          nvar = 0
    300          IF ( ALLOCATED( files(f)%attributes ) ) natt = SIZE( files(f)%attributes )
    301          IF ( ALLOCATED( files(f)%dimensions ) ) ndim = SIZE( files(f)%dimensions )
    302          IF ( ALLOCATED( files(f)%variables  ) ) nvar = SIZE( files(f)%variables  )
    303 
    304          WRITE( debug_output_unit, '(A)' ) 'file:'
    305          WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) 'name', TRIM( files(f)%name )
    306          WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) 'format', TRIM( files(f)%format )
    307          WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) 'id', files(f)%id
    308          WRITE( debug_output_unit, TRIM( format1 ) // ',L1)' ) 'is init', files(f)%is_init
    309          WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#atts', natt
    310          WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#dims', ndim
    311          WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#vars', nvar
    312 
    313          IF ( natt /= 0 )  CALL print_attributes( indent_level, files(f)%attributes )
    314          IF ( ndim /= 0 )  CALL print_dimensions( indent_level, files(f)%dimensions )
    315          IF ( nvar /= 0 )  CALL print_variables( indent_level, files(f)%variables )
    316 
    317          WRITE( debug_output_unit, '(/A/)' ) REPEAT( separation_string // ' ', 4 )
    318 
    319       ENDDO
    320 
    321    ENDIF
    322 
    323    CONTAINS
    324 
    325       !--------------------------------------------------------------------------------------------!
    326       ! Description:
    327       ! ------------
    328       !> Print list of attributes.
    329       !--------------------------------------------------------------------------------------------!
    330       SUBROUTINE print_attributes( indent_level, attributes )
    331 
    332          CHARACTER(LEN=50) ::  format1  !< format for write statements
    333          CHARACTER(LEN=50) ::  format2  !< format for write statements
    334 
    335          INTEGER             ::  i                       !< loop index
    336          INTEGER, INTENT(IN) ::  indent_level            !< indentation level
    337          INTEGER, PARAMETER  ::  max_keyname_length = 6  !< length of longest key name
    338          INTEGER             ::  nelement                !< number of elements to print
    339 
    340          TYPE(attribute_type), DIMENSION(:), INTENT(IN) ::  attributes  !< list of attributes
    341 
    342 
    343          WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
    344          WRITE( format2, '(A,I3,A,I3,A)' ) &
    345             '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
    346             ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
    347 
    348          WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
    349          WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'attributes:'
    350 
    351          nelement = SIZE( attributes )
    352          DO  i = 1, nelement
    353             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    354                'name', TRIM( attributes(i)%name )
    355             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    356                'type', TRIM( attributes(i)%data_type )
    357 
    358             IF ( TRIM( attributes(i)%data_type ) == 'char' )  THEN
    359                WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    360                   'value', TRIM( attributes(i)%value_char )
    361             ELSEIF ( TRIM( attributes(i)%data_type ) == 'int8' )  THEN
    362                WRITE( debug_output_unit, TRIM( format2 ) // ',I4)' ) &
    363                   'value', attributes(i)%value_int8
    364             ELSEIF ( TRIM( attributes(i)%data_type ) == 'int16' )  THEN
    365                WRITE( debug_output_unit, TRIM( format2 ) // ',I6)' ) &
    366                   'value', attributes(i)%value_int16
    367             ELSEIF ( TRIM( attributes(i)%data_type ) == 'int32' )  THEN
    368                WRITE( debug_output_unit, TRIM( format2 ) // ',I11)' ) &
    369                   'value', attributes(i)%value_int32
    370             ELSEIF ( TRIM( attributes(i)%data_type ) == 'real32' )  THEN
    371                WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)' ) &
    372                   'value', attributes(i)%value_real32
    373             ELSEIF (  TRIM(attributes(i)%data_type) == 'real64' )  THEN
    374                WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)' ) &
    375                   'value', attributes(i)%value_real64
    376             ENDIF
    377             IF ( i < nelement )  &
    378                WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
    379          ENDDO
    380 
    381       END SUBROUTINE print_attributes
    382 
    383       !--------------------------------------------------------------------------------------------!
    384       ! Description:
    385       ! ------------
    386       !> Print list of dimensions.
    387       !--------------------------------------------------------------------------------------------!
    388       SUBROUTINE print_dimensions( indent_level, dimensions )
    389 
    390          CHARACTER(LEN=50) ::  format1  !< format for write statements
    391          CHARACTER(LEN=50) ::  format2  !< format for write statements
    392 
    393          INTEGER             ::  i                        !< loop index
    394          INTEGER, INTENT(IN) ::  indent_level             !< indentation level
    395          INTEGER             ::  j                        !< loop index
    396          INTEGER, PARAMETER  ::  max_keyname_length = 15  !< length of longest key name
    397          INTEGER             ::  nelement                 !< number of elements to print
    398 
    399          LOGICAL ::  is_masked  !< true if dimension is masked
    400 
    401          TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< list of dimensions
    402 
    403 
    404          WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
    405          WRITE( format2, '(A,I3,A,I3,A)' ) &
    406             '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
    407             ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
    408 
    409          WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
    410          WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'dimensions:'
    411 
    412          nelement = SIZE( dimensions )
    413          DO  i = 1, nelement
    414             is_masked = dimensions(i)%is_masked
    415 
    416             !-- Print general information
    417             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    418                'name', TRIM( dimensions(i)%name )
    419             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    420                'type', TRIM( dimensions(i)%data_type )
    421             WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
    422                'id', dimensions(i)%id
    423             WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
    424                'length', dimensions(i)%length
    425             WRITE( debug_output_unit, TRIM( format2 ) // ',I7,A,I7)' ) &
    426                'bounds', dimensions(i)%bounds(1), ',', dimensions(i)%bounds(2)
    427             WRITE( debug_output_unit, TRIM( format2 ) // ',L1)' ) &
    428                'is masked', dimensions(i)%is_masked
    429 
    430             !-- Print information about mask
    431             IF ( is_masked )  THEN
    432                WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
    433                   'masked length', dimensions(i)%length_mask
    434 
    435                WRITE( debug_output_unit, TRIM( format2 ) // ',L1)', ADVANCE='no' ) &
    436                   'mask', dimensions(i)%mask(dimensions(i)%bounds(1))
    437                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    438                   WRITE( debug_output_unit, '(A,L1)', ADVANCE='no' ) ',', dimensions(i)%mask(j)
    439                ENDDO
    440                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    441 
    442                WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
    443                   'masked indices', dimensions(i)%masked_indices(0)
    444                DO  j = 1, dimensions(i)%length_mask-1
    445                   WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
    446                      ',', dimensions(i)%masked_indices(j)
    447                ENDDO
    448                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    449             ENDIF
    450 
    451             !-- Print saved values
    452             IF ( ALLOCATED( dimensions(i)%values_int8 ) )  THEN
    453 
    454                WRITE( debug_output_unit, TRIM( format2 ) // ',I4)', ADVANCE='no' ) &
    455                   'values', dimensions(i)%values_int8(dimensions(i)%bounds(1))
    456                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    457                   WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
    458                      ',', dimensions(i)%values_int8(j)
    459                ENDDO
    460                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    461                IF ( is_masked )  THEN
    462                   WRITE( debug_output_unit, TRIM( format2 ) // ',I4)', ADVANCE='no' ) &
    463                      'masked values', dimensions(i)%masked_values_int8(0)
    464                   DO  j = 1, dimensions(i)%length_mask-1
    465                      WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
    466                         ',', dimensions(i)%masked_values_int8(j)
    467                   ENDDO
    468                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    469                ENDIF
    470 
    471             ELSEIF ( ALLOCATED( dimensions(i)%values_int16 ) )  THEN
    472 
    473                WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
    474                   'values', dimensions(i)%values_int16(dimensions(i)%bounds(1))
    475                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    476                   WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
    477                      ',', dimensions(i)%values_int16(j)
    478                ENDDO
    479                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    480                IF ( is_masked )  THEN
    481                   WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
    482                      'masked values', dimensions(i)%masked_values_int16(0)
    483                   DO  j = 1, dimensions(i)%length_mask-1
    484                      WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
    485                         ',', dimensions(i)%masked_values_int16(j)
    486                   ENDDO
    487                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    488                ENDIF
    489 
    490             ELSEIF ( ALLOCATED( dimensions(i)%values_int32 ) )  THEN
    491 
    492                WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
    493                   'values', dimensions(i)%values_int32(dimensions(i)%bounds(1))
    494                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    495                   WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
    496                      ',', dimensions(i)%values_int32(j)
    497                ENDDO
    498                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    499                IF ( is_masked )  THEN
    500                   WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
    501                      'masked values', dimensions(i)%masked_values_int32(0)
    502                   DO  j = 1, dimensions(i)%length_mask-1
    503                      WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
    504                         ',', dimensions(i)%masked_values_int32(j)
    505                   ENDDO
    506                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    507                ENDIF
    508 
    509             ELSEIF ( ALLOCATED( dimensions(i)%values_intwp ) )  THEN
    510 
    511                WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
    512                   'values', dimensions(i)%values_intwp(dimensions(i)%bounds(1))
    513                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    514                   WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
    515                      ',', dimensions(i)%values_intwp(j)
    516                ENDDO
    517                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    518                IF ( is_masked )  THEN
    519                   WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
    520                      'masked values', dimensions(i)%masked_values_intwp(0)
    521                   DO  j = 1, dimensions(i)%length_mask-1
    522                      WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
    523                         ',', dimensions(i)%masked_values_intwp(j)
    524                   ENDDO
    525                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    526                ENDIF
    527 
    528             ELSEIF ( ALLOCATED( dimensions(i)%values_real32 ) )  THEN
    529 
    530                WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)', ADVANCE='no' ) &
    531                   'values', dimensions(i)%values_real32(dimensions(i)%bounds(1))
    532                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    533                   WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
    534                      ',', dimensions(i)%values_real32(j)
    535                ENDDO
    536                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    537                IF ( is_masked )  THEN
    538                   WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)', ADVANCE='no' ) &
    539                      'masked values', dimensions(i)%masked_values_real32(0)
    540                   DO  j = 1, dimensions(i)%length_mask-1
    541                      WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
    542                         ',', dimensions(i)%masked_values_real32(j)
    543                   ENDDO
    544                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    545                ENDIF
    546 
    547             ELSEIF ( ALLOCATED( dimensions(i)%values_real64 ) )  THEN
    548 
    549                WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
    550                   'values', dimensions(i)%values_real64(dimensions(i)%bounds(1))
    551                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    552                   WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
    553                      ',', dimensions(i)%values_real64(j)
    554                ENDDO
    555                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    556                IF ( is_masked )  THEN
    557                   WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
    558                      'masked values', dimensions(i)%masked_values_real64(0)
    559                   DO  j = 1, dimensions(i)%length_mask-1
    560                      WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
    561                         ',', dimensions(i)%masked_values_real64(j)
    562                   ENDDO
    563                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    564                ENDIF
    565 
    566             ELSEIF ( ALLOCATED( dimensions(i)%values_realwp ) )  THEN
    567 
    568                WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
    569                   'values', dimensions(i)%values_realwp(dimensions(i)%bounds(1))
    570                DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
    571                   WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
    572                      ',', dimensions(i)%values_realwp(j)
    573                ENDDO
    574                WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    575                IF ( is_masked )  THEN
    576                   WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
    577                      'masked values', dimensions(i)%masked_values_realwp(0)
    578                   DO  j = 1, dimensions(i)%length_mask-1
    579                      WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
    580                         ',', dimensions(i)%masked_values_realwp(j)
    581                   ENDDO
    582                   WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    583                ENDIF
    584 
    585             ENDIF
    586 
    587             IF ( ALLOCATED( dimensions(i)%attributes ) )  &
    588                CALL print_attributes( indent_level+1, dimensions(i)%attributes )
    589 
    590             IF ( i < nelement )  &
    591                WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
    592          ENDDO
    593 
    594       END SUBROUTINE print_dimensions
    595 
    596       !--------------------------------------------------------------------------------------------!
    597       ! Description:
    598       ! ------------
    599       !> Print list of variables.
    600       !--------------------------------------------------------------------------------------------!
    601       SUBROUTINE print_variables( indent_level, variables )
    602 
    603          CHARACTER(LEN=50) ::  format1  !< format for write statements
    604          CHARACTER(LEN=50) ::  format2  !< format for write statements
    605 
    606          INTEGER             ::  i                        !< loop index
    607          INTEGER, INTENT(IN) ::  indent_level             !< indentation level
    608          INTEGER             ::  j                        !< loop index
    609          INTEGER, PARAMETER  ::  max_keyname_length = 16  !< length of longest key name
    610          INTEGER             ::  nelement                 !< number of elements to print
    611 
    612          TYPE(variable_type), DIMENSION(:), INTENT(IN) ::  variables  !< list of variables
    613 
    614 
    615          WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
    616          WRITE( format2, '(A,I3,A,I3,A)' ) &
    617             '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
    618             ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
    619 
    620          WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
    621          WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'variables:'
    622 
    623          nelement = SIZE( variables )
    624          DO  i = 1, nelement
    625             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    626                'name', TRIM( variables(i)%name )
    627             WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
    628                'type', TRIM( variables(i)%data_type )
    629             WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
    630                'id', variables(i)%id
    631             WRITE( debug_output_unit, TRIM( format2 ) // ',L1)' ) &
    632                'is global', variables(i)%is_global
    633 
    634             WRITE( debug_output_unit, TRIM( format2 ) // ',A)', ADVANCE='no' ) &
    635                'dimension names', TRIM( variables(i)%dimension_names(1) )
    636             DO  j = 2, SIZE( variables(i)%dimension_names )
    637                WRITE( debug_output_unit, '(A,A)', ADVANCE='no' ) &
    638                   ',', TRIM( variables(i)%dimension_names(j) )
    639             ENDDO
    640             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    641 
    642             WRITE( debug_output_unit, TRIM( format2 ) // ',I7)', ADVANCE='no' ) &
    643                'dimension ids', variables(i)%dimension_ids(1)
    644             DO  j = 2, SIZE( variables(i)%dimension_names )
    645                WRITE( debug_output_unit, '(A,I7)', ADVANCE='no' ) &
    646                   ',', variables(i)%dimension_ids(j)
    647             ENDDO
    648             WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
    649 
    650             IF ( ALLOCATED( variables(i)%attributes ) )  &
    651                CALL print_attributes( indent_level+1, variables(i)%attributes )
    652             IF ( i < nelement )  &
    653                WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
    654          ENDDO
    655 
    656       END SUBROUTINE print_variables
    657 
    658 END SUBROUTINE dom_database_debug_output
    659279
    660280!--------------------------------------------------------------------------------------------------!
     
    662282! ------------
    663283!> Define output file.
    664 !--------------------------------------------------------------------------------------------------!
    665 FUNCTION dom_def_file( filename, format ) RESULT( return_value )
    666 
    667    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file to be created
    668    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  format    !< format of file to be created
     284!> Example call:
     285!>   status = dom_def_file( 'my_output_file_name', 'binary' )
     286!--------------------------------------------------------------------------------------------------!
     287FUNCTION dom_def_file( file_name, file_format ) RESULT( return_value )
     288
     289   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file to be created
     290   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< format of file to be created
    669291
    670292   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_file'  !< name of this routine
    671293
    672    INTEGER(iwp) ::  f             !< loop index
    673    INTEGER(iwp) ::  return_value  !< return value
     294   INTEGER ::  f             !< loop index
     295   INTEGER ::  return_value  !< return value
    674296
    675297   TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files_tmp  !< temporary file list
     
    678300   return_value = 0
    679301
    680    CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( filename ) // '"' )
     302   CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( file_name ) // '"' )
    681303
    682304   !-- Allocate file list or extend it by 1
    683305   IF ( .NOT. ALLOCATED( files ) ) THEN
    684306
    685       nf = 1
    686       ALLOCATE( files(nf) )
     307      nfiles = 1
     308      ALLOCATE( files(nfiles) )
    687309
    688310   ELSE
    689311
    690       nf = SIZE( files )
     312      nfiles = SIZE( files )
    691313      !-- Check if file already exists
    692       DO  f = 1, nf
    693          IF ( files(f)%name == TRIM( filename ) )  THEN
     314      DO  f = 1, nfiles
     315         IF ( files(f)%name == TRIM( file_name ) )  THEN
    694316            return_value = 1
    695             CALL internal_message( 'error', routine_name // ': file "' // TRIM( filename ) // &
    696                                             '" already exists' )
     317            CALL internal_message( 'error', routine_name // &
     318                    ': file "' // TRIM( file_name ) // '" already exists' )
    697319            EXIT
    698320         ENDIF
     
    701323      !-- Extend file list
    702324      IF ( return_value == 0 )  THEN
    703          ALLOCATE( files_tmp(nf) )
     325         ALLOCATE( files_tmp(nfiles) )
    704326         files_tmp = files
    705327         DEALLOCATE( files )
    706          nf = nf + 1
    707          ALLOCATE( files(nf) )
    708          files(:nf-1) = files_tmp
     328         nfiles = nfiles + 1
     329         ALLOCATE( files(nfiles) )
     330         files(:nfiles-1) = files_tmp
    709331         DEALLOCATE( files_tmp )
    710332      ENDIF
     
    714336   !-- Add new file to database
    715337   IF ( return_value == 0 )  THEN
    716       files(nf)%name = TRIM( filename )
    717       IF ( PRESENT( format ) )  THEN
    718          files(nf)%format = TRIM( format )
    719       ELSE
    720          files(nf)%format = TRIM( output_file_format )
    721       ENDIF
     338      files(nfiles)%name = TRIM( file_name )
     339      files(nfiles)%format = TRIM( file_format )
    722340   ENDIF
    723341
     
    727345! Description:
    728346! ------------
    729 !> Define dimension of type integer.
     347!> Define dimension.
     348!> Dimensions can either be limited (a lower and upper bound is given) or unlimited (only a lower
     349!> bound is given). Also, instead of providing all values of the dimension, a single value can be
     350!> given which is then used to fill the entire dimension.
     351!> An optional mask can be given to mask limited dimensions.
     352!> Example call:
     353!>   - fixed dimension with 100 entries (values known):
     354!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
     355!>                             output_type='real32', bounds=(/1,100/), &
     356!>                             values_real32=my_dim(1:100), mask=my_dim_mask(1:100) )
     357!>   - fixed dimension with 50 entries (values not yet known):
     358!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
     359!>                             output_type='int32', bounds=(/0,49/), &
     360!>                             values_int32=(/fill_value/) )
     361!>   - masked dimension with 75 entries:
     362!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
     363!>                             output_type='real64', bounds=(/101,175/), &
     364!>                             values_real64=my_dim(1:75), mask=my_dim_mask(1:75) )
     365!>   - unlimited dimension:
     366!>       status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', &
     367!>                             output_type='real32', bounds=(/1/), &
     368!>                             values_real32=(/fill_value/) )
    730369!>
    731370!> @todo Convert given values into selected output_type.
    732371!--------------------------------------------------------------------------------------------------!
    733 FUNCTION dom_def_dim( filename, name, output_type, bounds,                   &
     372FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds,        &
    734373                      values_int8, values_int16, values_int32, values_intwp, &
    735374                      values_real32, values_real64, values_realwp,           &
    736375                      mask ) RESULT( return_value )
    737376
    738    CHARACTER(LEN=*), INTENT(IN) ::  filename     !< name of file
    739    CHARACTER(LEN=*), INTENT(IN) ::  name         !< name of dimension
    740    CHARACTER(LEN=*), INTENT(IN) ::  output_type  !< data type of dimension variable in output file
     377   CHARACTER(LEN=*), INTENT(IN) ::  file_name       !< name of file
     378   CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
     379   CHARACTER(LEN=*), INTENT(IN) ::  output_type     !< data type of dimension variable in output file
    741380
    742381   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_dim'  !< name of this routine
    743382
    744    INTEGER(iwp) ::  d             !< loop index
    745    INTEGER(iwp) ::  f             !< loop index
    746    INTEGER(iwp) ::  i             !< loop index
    747    INTEGER(iwp) ::  j             !< loop index
    748    INTEGER(iwp) ::  ndim          !< number of dimensions in file
    749    INTEGER(iwp) ::  return_value  !< return value
    750 
    751    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds  !< lower and upper bound of dimension variable
    752 
    753    INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int8   !< values of dimension
    754    INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int16  !< values of dimension
    755    INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int32  !< values of dimension
    756    INTEGER(iwp),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_intwp  !< values of dimension
    757 
    758    LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL ::  mask  !< mask of dimesion
    759 
    760    REAL(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real32  !< values of dimension
    761    REAL(KIND=8), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real64  !< values of dimension
    762    REAL(wp),     DIMENSION(:), INTENT(IN), OPTIONAL ::  values_realwp  !< values of dimension
    763 
    764    TYPE(dimension_type) ::  dimension  !< new dimension
    765 
    766    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dims_tmp  !< temporary dimension list
     383   INTEGER ::  d             !< loop index
     384   INTEGER ::  f             !< loop index
     385   INTEGER ::  i             !< loop index
     386   INTEGER ::  j             !< loop index
     387   INTEGER ::  ndims         !< number of dimensions in file
     388   INTEGER ::  return_value  !< return value
     389
     390   INTEGER,         DIMENSION(:), INTENT(IN)           ::  bounds         !< lower and upper bound of dimension variable
     391   INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int8    !< values of dimension
     392   INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int16   !< values of dimension
     393   INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int32   !< values of dimension
     394   INTEGER(iwp),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_intwp   !< values of dimension
     395
     396   LOGICAL,         DIMENSION(:), INTENT(IN), OPTIONAL ::  mask           !< mask of dimesion
     397
     398   REAL(KIND=4),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real32  !< values of dimension
     399   REAL(KIND=8),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real64  !< values of dimension
     400   REAL(wp),        DIMENSION(:), INTENT(IN), OPTIONAL ::  values_realwp  !< values of dimension
     401
     402   TYPE(dimension_type)                            ::  dimension       !< new dimension
     403   TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions_tmp  !< temporary dimension list
    767404
    768405
    769406   return_value = 0
    770407
    771    CALL internal_message( 'debug', routine_name //                  &
    772                           ': define dimension "' // TRIM( name ) // &
    773                           '" in file "' // TRIM( filename ) // '"' )
    774 
    775    dimension%name      = TRIM( name )
     408   CALL internal_message( 'debug', routine_name //                    &
     409                          ': define dimension ' //                    &
     410                          '(dimension "' // TRIM( dimension_name ) // &
     411                          '", file "' // TRIM( file_name ) // '")' )
     412
     413   dimension%name      = TRIM( dimension_name )
    776414   dimension%data_type = TRIM( output_type )
    777415
     
    783421      !-- Set length to -1 as indicator.
    784422      dimension%bounds(:) = bounds(1)
    785       dimension%length    = -1_iwp
     423      dimension%length    = -1
    786424
    787425      IF ( PRESENT( mask ) )  THEN
    788426         return_value = 1
    789          CALL internal_message( 'error', routine_name //                              &
    790                                          ': unlimited dimension "' // TRIM( name ) // &
    791                                          '" in file "' // TRIM( filename ) // '" cannot be masked' )
     427         CALL internal_message( 'error', routine_name //                      &
     428                                ': unlimited dimensions cannot be masked ' // &
     429                                '(dimension "' // TRIM( dimension_name ) //   &
     430                                '", file "' // TRIM( file_name ) // '")!' )
    792431      ENDIF
    793432
     
    803442            dimension%values_int8 = values_int8
    804443         ELSEIF ( SIZE( values_int8 ) == 1 )  THEN
    805             dimension%values_int8(:) = values_int8
     444            dimension%values_int8(:) = values_int8(1)
    806445         ELSE
    807446            return_value = 2
     
    812451            dimension%values_int16 = values_int16
    813452         ELSEIF ( SIZE( values_int16 ) == 1 )  THEN
    814             dimension%values_int16(:) = values_int16
     453            dimension%values_int16(:) = values_int16(1)
    815454         ELSE
    816455            return_value = 2
     
    821460            dimension%values_int32 = values_int32
    822461         ELSEIF ( SIZE( values_int32 ) == 1 )  THEN
    823             dimension%values_int32(:) = values_int32
     462            dimension%values_int32(:) = values_int32(1)
    824463         ELSE
    825464            return_value = 2
     
    830469            dimension%values_intwp = values_intwp
    831470         ELSEIF ( SIZE( values_intwp ) == 1 )  THEN
    832             dimension%values_intwp(:) = values_intwp
     471            dimension%values_intwp(:) = values_intwp(1)
    833472         ELSE
    834473            return_value = 2
     
    839478            dimension%values_real32 = values_real32
    840479         ELSEIF ( SIZE( values_real32 ) == 1 )  THEN
    841             dimension%values_real32(:) = values_real32
     480            dimension%values_real32(:) = values_real32(1)
    842481         ELSE
    843482            return_value = 2
     
    848487            dimension%values_real64 = values_real64
    849488         ELSEIF ( SIZE( values_real64 ) == 1 )  THEN
    850             dimension%values_real64(:) = values_real64
     489            dimension%values_real64(:) = values_real64(1)
    851490         ELSE
    852491            return_value = 2
     
    857496            dimension%values_realwp = values_realwp
    858497         ELSEIF ( SIZE( values_realwp ) == 1 )  THEN
    859             dimension%values_realwp(:) = values_realwp
     498            dimension%values_realwp(:) = values_realwp(1)
    860499         ELSE
    861500            return_value = 2
     
    863502      ELSE
    864503         return_value = 1
    865          CALL internal_message( 'error', routine_name // ': ' // &
    866                                          TRIM( name ) // ': no values given' )
     504         CALL internal_message( 'error', routine_name //                    &
     505                                ': no values given ' //                     &
     506                                '(dimension "' // TRIM( dimension_name ) // &
     507                                '", file "' // TRIM( file_name ) // '")!' )
    867508      ENDIF
    868509
    869510      IF ( return_value == 2 )  THEN
    870511         return_value = 1
    871          CALL internal_message( 'error', routine_name //                   &
    872                                          ': dimension ' // TRIM( name ) // &
    873                                          ': number of values and given bounds do not match' )
     512         CALL internal_message( 'error', routine_name //                               &
     513                                ': number of values and given bounds do not match ' // &
     514                                '(dimension "' // TRIM( dimension_name ) //            &
     515                                '", file "' // TRIM( file_name ) // '")!' )
    874516      ENDIF
    875517
     
    877519      IF ( PRESENT( mask )  .AND.  return_value == 0 )  THEN
    878520
    879          dimension%is_masked = .TRUE.
    880 
    881521         IF ( dimension%length == SIZE( mask ) )  THEN
    882522
    883             dimension%length_mask = COUNT( mask )
    884 
    885             ALLOCATE( dimension%mask(dimension%bounds(1):dimension%bounds(2)) )
    886             ALLOCATE( dimension%masked_indices(0:dimension%length_mask-1) )
    887 
    888             dimension%mask = mask
    889 
    890             !-- Save masked positions and masked values
    891             IF ( ALLOCATED( dimension%values_int8 ) )  THEN
    892 
    893                ALLOCATE( dimension%masked_values_int8(0:dimension%length_mask-1) )
    894                j = 0
    895                DO  i = 0, dimension%length-1
    896                   IF ( dimension%mask(i) )  THEN
    897                      dimension%masked_values_int8(j) = dimension%values_int8(i)
    898                      dimension%masked_indices(j) = i
    899                      j = j + 1
    900                   ENDIF
    901                ENDDO
    902 
    903             ELSEIF ( ALLOCATED( dimension%values_int16 ) )  THEN
    904 
    905                ALLOCATE( dimension%masked_values_int16(0:dimension%length_mask-1) )
    906                j = 0
    907                DO  i = 0, dimension%length-1
    908                   IF ( dimension%mask(i) )  THEN
    909                      dimension%masked_values_int16(j) = dimension%values_int16(i)
    910                      dimension%masked_indices(j) = i
    911                      j = j + 1
    912                   ENDIF
    913                ENDDO
    914 
    915             ELSEIF ( ALLOCATED( dimension%values_int32 ) )  THEN
    916 
    917                ALLOCATE( dimension%masked_values_int32(0:dimension%length_mask-1) )
    918                j = 0
    919                DO  i = 0, dimension%length-1
    920                   IF ( dimension%mask(i) )  THEN
    921                      dimension%masked_values_int32(j) = dimension%values_int32(i)
    922                      dimension%masked_indices(j) = i
    923                      j = j + 1
    924                   ENDIF
    925                ENDDO
    926 
    927             ELSEIF ( ALLOCATED( dimension%values_intwp ) )  THEN
    928 
    929                ALLOCATE( dimension%masked_values_intwp(0:dimension%length_mask-1) )
    930                j = 0
    931                DO  i = 0, dimension%length-1
    932                   IF ( dimension%mask(i) )  THEN
    933                      dimension%masked_values_intwp(j) = dimension%values_intwp(i)
    934                      dimension%masked_indices(j) = i
    935                      j = j + 1
    936                   ENDIF
    937                ENDDO
    938 
    939             ELSEIF ( ALLOCATED( dimension%values_real32 ) )  THEN
    940 
    941                ALLOCATE( dimension%masked_values_real32(0:dimension%length_mask-1) )
    942                j = 0
    943                DO  i = 0, dimension%length-1
    944                   IF ( dimension%mask(i) )  THEN
    945                      dimension%masked_values_real32(j) = dimension%values_real32(i)
    946                      dimension%masked_indices(j) = i
    947                      j = j + 1
    948                   ENDIF
    949                ENDDO
    950 
    951             ELSEIF ( ALLOCATED(dimension%values_real64) )  THEN
    952 
    953                ALLOCATE( dimension%masked_values_real64(0:dimension%length_mask-1) )
    954                j = 0
    955                DO  i = 0, dimension%length-1
    956                   IF ( dimension%mask(i) )  THEN
    957                      dimension%masked_values_real64(j) = dimension%values_real64(i)
    958                      dimension%masked_indices(j) = i
    959                      j = j + 1
    960                   ENDIF
    961                ENDDO
    962 
    963             ELSEIF ( ALLOCATED(dimension%values_realwp) )  THEN
    964 
    965                ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) )
    966                j = 0
    967                DO  i = dimension%bounds(1), dimension%bounds(2)   !> @todo change loop also for other data types
    968                   IF ( dimension%mask(i) )  THEN
    969                      dimension%masked_values_realwp(j) = dimension%values_realwp(i)
    970                      dimension%masked_indices(j) = i
    971                      j = j + 1
    972                   ENDIF
    973                ENDDO
    974 
    975             ENDIF
     523            IF ( ALL( mask ) )  THEN
     524
     525               CALL internal_message( 'debug', routine_name //                              &
     526                                      ': mask contains only TRUE values. Ignoring mask ' // &
     527                                      '(dimension "' // TRIM( dimension_name ) //           &
     528                                      '", file "' // TRIM( file_name ) // '")!' )
     529
     530            ELSE
     531
     532               dimension%is_masked = .TRUE.
     533               dimension%length_mask = COUNT( mask )
     534
     535               ALLOCATE( dimension%mask(dimension%bounds(1):dimension%bounds(2)) )
     536               ALLOCATE( dimension%masked_indices(0:dimension%length_mask-1) )
     537
     538               dimension%mask = mask
     539
     540               !-- Save masked positions and masked values
     541               IF ( ALLOCATED( dimension%values_int8 ) )  THEN
     542
     543                  ALLOCATE( dimension%masked_values_int8(0:dimension%length_mask-1) )
     544                  j = 0
     545                  DO  i = dimension%bounds(1), dimension%bounds(2)
     546                     IF ( dimension%mask(i) )  THEN
     547                        dimension%masked_values_int8(j) = dimension%values_int8(i)
     548                        dimension%masked_indices(j) = i
     549                        j = j + 1
     550                     ENDIF
     551                  ENDDO
     552
     553               ELSEIF ( ALLOCATED( dimension%values_int16 ) )  THEN
     554
     555                  ALLOCATE( dimension%masked_values_int16(0:dimension%length_mask-1) )
     556                  j = 0
     557                  DO  i = dimension%bounds(1), dimension%bounds(2)
     558                     IF ( dimension%mask(i) )  THEN
     559                        dimension%masked_values_int16(j) = dimension%values_int16(i)
     560                        dimension%masked_indices(j) = i
     561                        j = j + 1
     562                     ENDIF
     563                  ENDDO
     564
     565               ELSEIF ( ALLOCATED( dimension%values_int32 ) )  THEN
     566
     567                  ALLOCATE( dimension%masked_values_int32(0:dimension%length_mask-1) )
     568                  j = 0
     569                  DO  i =dimension%bounds(1), dimension%bounds(2)
     570                     IF ( dimension%mask(i) )  THEN
     571                        dimension%masked_values_int32(j) = dimension%values_int32(i)
     572                        dimension%masked_indices(j) = i
     573                        j = j + 1
     574                     ENDIF
     575                  ENDDO
     576
     577               ELSEIF ( ALLOCATED( dimension%values_intwp ) )  THEN
     578
     579                  ALLOCATE( dimension%masked_values_intwp(0:dimension%length_mask-1) )
     580                  j = 0
     581                  DO  i = dimension%bounds(1), dimension%bounds(2)
     582                     IF ( dimension%mask(i) )  THEN
     583                        dimension%masked_values_intwp(j) = dimension%values_intwp(i)
     584                        dimension%masked_indices(j) = i
     585                        j = j + 1
     586                     ENDIF
     587                  ENDDO
     588
     589               ELSEIF ( ALLOCATED( dimension%values_real32 ) )  THEN
     590
     591                  ALLOCATE( dimension%masked_values_real32(0:dimension%length_mask-1) )
     592                  j = 0
     593                  DO  i = dimension%bounds(1), dimension%bounds(2)
     594                     IF ( dimension%mask(i) )  THEN
     595                        dimension%masked_values_real32(j) = dimension%values_real32(i)
     596                        dimension%masked_indices(j) = i
     597                        j = j + 1
     598                     ENDIF
     599                  ENDDO
     600
     601               ELSEIF ( ALLOCATED(dimension%values_real64) )  THEN
     602
     603                  ALLOCATE( dimension%masked_values_real64(0:dimension%length_mask-1) )
     604                  j = 0
     605                  DO  i = dimension%bounds(1), dimension%bounds(2)
     606                     IF ( dimension%mask(i) )  THEN
     607                        dimension%masked_values_real64(j) = dimension%values_real64(i)
     608                        dimension%masked_indices(j) = i
     609                        j = j + 1
     610                     ENDIF
     611                  ENDDO
     612
     613               ELSEIF ( ALLOCATED(dimension%values_realwp) )  THEN
     614
     615                  ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) )
     616                  j = 0
     617                  DO  i = dimension%bounds(1), dimension%bounds(2)
     618                     IF ( dimension%mask(i) )  THEN
     619                        dimension%masked_values_realwp(j) = dimension%values_realwp(i)
     620                        dimension%masked_indices(j) = i
     621                        j = j + 1
     622                     ENDIF
     623                  ENDDO
     624
     625               ENDIF
     626
     627            ENDIF  ! if not all mask = true
    976628
    977629         ELSE
    978630            return_value = 1
    979             CALL internal_message( 'error', routine_name //                   &
    980                                             ': dimension ' // TRIM( name ) // &
    981                                             ': size of mask and given bounds do not match' )
     631            CALL internal_message( 'error', routine_name //                           &
     632                                   ': size of mask and given bounds do not match ' // &
     633                                   '(dimension "' // TRIM( dimension_name ) //        &
     634                                   '", file "' // TRIM( file_name ) // '")!' )
    982635         ENDIF
    983636
     
    989642      CALL internal_message( 'error', routine_name //                                       &
    990643                             ': at least one but no more than two bounds must be given ' // &
    991                              '(dimension "' // TRIM( name ) //                              &
    992                              '", file "' // TRIM( filename ) //                             &
    993                              '")!' )
     644                             '(dimension "' // TRIM( dimension_name ) //                    &
     645                             '", file "' // TRIM( file_name ) // '")!' )
    994646
    995647   ENDIF
     
    998650   IF ( return_value == 0 )  THEN
    999651
    1000       DO  f = 1, nf
    1001 
    1002          IF ( TRIM( filename ) == files(f)%name )  THEN
     652      DO  f = 1, nfiles
     653
     654         IF ( TRIM( file_name ) == files(f)%name )  THEN
    1003655
    1004656            IF ( files(f)%is_init )  THEN
    1005657
    1006658               return_value = 1
    1007                CALL internal_message( 'error',                           &
    1008                        routine_name // ': file "' // TRIM( filename ) // &
    1009                        '" is already initialized. No further dimension definition allowed!' )
     659               CALL internal_message( 'error', routine_name //                      &
     660                                      ': file already initialized. ' //             &
     661                                      'No further dimension definition allowed ' // &
     662                                      '(dimension "' // TRIM( dimension_name ) //   &
     663                                      '", file "' // TRIM( file_name ) // '")!' )
    1010664               EXIT
    1011665
    1012666            ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
    1013667
    1014                ndim = 1
    1015                ALLOCATE( files(f)%dimensions(ndim) )
     668               ndims = 1
     669               ALLOCATE( files(f)%dimensions(ndims) )
    1016670
    1017671            ELSE
     
    1022676                     IF ( files(f)%variables(i)%name == dimension%name )  THEN
    1023677                        return_value = 1
    1024                         CALL internal_message( 'error', routine_name //                   &
    1025                                                ': file "' // TRIM( filename ) //          &
    1026                                                '" already has a variable of name "' //    &
    1027                                                TRIM( dimension%name ) // '" defined. ' // &
    1028                                                'Defining a dimension of the same ' //     &
    1029                                                'name is not allowed.' )
     678                        CALL internal_message( 'error', routine_name //                    &
     679                                ': file already has a variable of this name defined. ' //  &
     680                                'Defining a dimension of the same name is not allowed ' // &
     681                                '(dimension "' // TRIM( dimension_name ) //                &
     682                                '", file "' // TRIM( file_name ) // '")!' )
    1030683                        EXIT
    1031684                     ENDIF
     
    1035688               IF ( return_value == 0 )  THEN
    1036689                  !-- Check if dimension already exists in file
    1037                   ndim = SIZE( files(f)%dimensions )
    1038 
    1039                   DO  d = 1, ndim
     690                  ndims = SIZE( files(f)%dimensions )
     691
     692                  DO  d = 1, ndims
    1040693                     IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
    1041694                        return_value = 1
    1042                         CALL internal_message( 'error',            &
    1043                                 routine_name //                    &
    1044                                 ': dimension "' // TRIM( name ) // &
    1045                                 '" already exists in file "' // TRIM( filename ) // '"' )
     695                        CALL internal_message( 'error', routine_name //     &
     696                                ': dimension already exists in file ' //    &
     697                                '(dimension "' // TRIM( dimension_name ) // &
     698                                '", file "' // TRIM( file_name ) // '")!' )
    1046699                        EXIT
    1047700                     ENDIF
     
    1050703                  !-- Extend dimension list
    1051704                  IF ( return_value == 0 )  THEN
    1052                      ALLOCATE( dims_tmp(ndim) )
    1053                      dims_tmp = files(f)%dimensions
     705                     ALLOCATE( dimensions_tmp(ndims) )
     706                     dimensions_tmp = files(f)%dimensions
    1054707                     DEALLOCATE( files(f)%dimensions )
    1055                      ndim = ndim + 1
    1056                      ALLOCATE( files(f)%dimensions(ndim) )
    1057                      files(f)%dimensions(:ndim-1) = dims_tmp
    1058                      DEALLOCATE( dims_tmp )
     708                     ndims = ndims + 1
     709                     ALLOCATE( files(f)%dimensions(ndims) )
     710                     files(f)%dimensions(:ndims-1) = dimensions_tmp
     711                     DEALLOCATE( dimensions_tmp )
    1059712                  ENDIF
    1060713               ENDIF
     
    1063716
    1064717            !-- Add new dimension to database
    1065             IF ( return_value == 0 )  files(f)%dimensions(ndim) = dimension
     718            IF ( return_value == 0 )  files(f)%dimensions(ndims) = dimension
    1066719
    1067720            EXIT
     
    1070723      ENDDO
    1071724
    1072       IF ( f > nf )  THEN
     725      IF ( f > nfiles )  THEN
    1073726         return_value = 1
    1074          CALL internal_message( 'error', routine_name //                           &
    1075                                 ': file not found (dimension "' // TRIM( name ) // &
    1076                                 '", file "' // TRIM( filename ) // '")!' )
     727         CALL internal_message( 'error', routine_name //                                     &
     728                                ': file not found (dimension "' // TRIM( dimension_name ) // &
     729                                '", file "' // TRIM( file_name ) // '")!' )
    1077730      ENDIF
    1078731
     
    1085738! ------------
    1086739!> Add variable to database.
     740!> If a variable is identical for each MPI rank, the optional argument 'is_global' should be set to
     741!> TRUE. This flags the variable to be a global variable and is later only written once by the
     742!> master output rank.
    1087743!> Example call:
    1088 !>   dom_def_var( filename =  'DATA_OUTPUT_3D', &
    1089 !>                name = 'u', &
     744!>   dom_def_var( file_name =  'my_output_file_name', &
     745!>                variable_name = 'u', &
    1090746!>                dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
    1091747!>                output_type = 'real32' )
     
    1103759!>          ALLOCATE( u(<z>,<y>,<x>) )
    1104760!--------------------------------------------------------------------------------------------------!
    1105 FUNCTION dom_def_var( filename, name, dimension_names, output_type, is_global ) &
     761FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, is_global ) &
    1106762            RESULT( return_value )
    1107763
    1108    CHARACTER(LEN=*), INTENT(IN) ::  filename     !< name of file
    1109    CHARACTER(LEN=*), INTENT(IN) ::  name         !< name of variable
    1110    CHARACTER(LEN=*), INTENT(IN) ::  output_type  !< data type of variable
     764   CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< name of file
     765   CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
     766   CHARACTER(LEN=*), INTENT(IN) ::  output_type    !< data type of variable
    1111767
    1112768   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_var'  !< name of this routine
     
    1114770   CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) ::  dimension_names  !< list of dimension names
    1115771
    1116    INTEGER(iwp) ::  d             !< loop index
    1117    INTEGER(iwp) ::  f             !< loop index
    1118    INTEGER(iwp) ::  i             !< loop index
    1119    INTEGER(iwp) ::  nvar          !< number of variables in file
    1120    INTEGER(iwp) ::  return_value  !< return value
    1121 
    1122    LOGICAL                       ::  found = .FALSE.  !< true if requested dimension is defined in file
    1123    LOGICAL, INTENT(IN), OPTIONAL ::  is_global        !< true if variable is global (same on all PE)
    1124 
    1125    TYPE(variable_type) ::  variable  !< new variable
    1126 
    1127    TYPE(variable_type), DIMENSION(:), ALLOCATABLE ::  vars_tmp  !< temporary variable list
     772   INTEGER ::  d             !< loop index
     773   INTEGER ::  f             !< loop index
     774   INTEGER ::  i             !< loop index
     775   INTEGER ::  nvars         !< number of variables in file
     776   INTEGER ::  return_value  !< return value
     777
     778   LOGICAL                       ::  found      !< true if requested dimension is defined in file
     779   LOGICAL, INTENT(IN), OPTIONAL ::  is_global  !< true if variable is global (same on all PE)
     780
     781   TYPE(variable_type)                            ::  variable       !< new variable
     782   TYPE(variable_type), DIMENSION(:), ALLOCATABLE ::  variables_tmp  !< temporary variable list
    1128783
    1129784
    1130785   return_value = 0
    1131 
    1132    CALL internal_message( 'debug', routine_name //                  &
    1133                           ': define variable "' // TRIM( name ) // &
    1134                           '" in file "' // TRIM( filename ) // '"' )
    1135 
    1136    variable%name = TRIM( name )
     786   found = .FALSE.
     787
     788   CALL internal_message( 'debug', routine_name //                                     &
     789                          ': define variable (variable "' // TRIM( variable_name ) //  &
     790                          '", file "' // TRIM( file_name ) // '")' )
     791
     792   variable%name = TRIM( variable_name )
    1137793
    1138794   ALLOCATE( variable%dimension_names(SIZE( dimension_names )) )
     
    1150806
    1151807   !-- Add variable to database
    1152    DO  f = 1, nf
    1153 
    1154       IF ( TRIM( filename ) == files(f)%name )  THEN
     808   DO  f = 1, nfiles
     809
     810      IF ( TRIM( file_name ) == files(f)%name )  THEN
    1155811
    1156812         IF ( files(f)%is_init )  THEN
    1157813
    1158814            return_value = 1
    1159             CALL internal_message( 'error', routine_name // ': file "' // TRIM( filename ) // &
    1160                     '" is already initialized. No further variable definition allowed!' )
     815            CALL internal_message( 'error', routine_name //                                  &
     816                    ': file already initialized. No further variable definition allowed ' // &
     817                    '(variable "' // TRIM( variable_name ) //                                &
     818                    '", file "' // TRIM( file_name ) // '")!' )
    1161819            EXIT
    1162820
     
    1167825               IF ( files(f)%dimensions(d)%name == variable%name )  THEN
    1168826                  return_value = 1
    1169                   CALL internal_message( 'error', routine_name //                  &
    1170                                          ': file "' // TRIM( filename ) //        &
    1171                                          '" already has a dimension of name "' //  &
    1172                                          TRIM( variable%name ) // '" defined. ' // &
    1173                                          'Defining a variable of the same name is not allowed.' )
     827                  CALL internal_message( 'error', routine_name //                    &
     828                          ': file already has a dimension of this name defined. ' // &
     829                          'Defining a variable of the same name is not allowed ' //  &
     830                          '(variable "' // TRIM( variable_name ) //                  &
     831                          '", file "' // TRIM( file_name ) // '")!' )
    1174832                  EXIT
    1175833               ENDIF
     
    1188846                  IF ( .NOT. found )  THEN
    1189847                     return_value = 1
    1190                      CALL internal_message( 'error',                                            &
    1191                                             routine_name //                                     &
    1192                                             ': required dimension "' //                         &
    1193                                             TRIM( variable%dimension_names(i) ) //              &
    1194                                             '" for variable "' // TRIM( name ) //               &
    1195                                             '" is not defined in file "' // TRIM( filename ) // &
    1196                                             '"!' )
     848                     CALL internal_message( 'error', routine_name //                            &
     849                             ': required dimension "'//  TRIM( variable%dimension_names(i) ) // &
     850                             '" for variable is not defined ' //                                &
     851                             '(variable "' // TRIM( variable_name ) //                          &
     852                             '", file "' // TRIM( file_name ) // '")!' )
    1197853                     EXIT
    1198854                  ENDIF
     
    1203859
    1204860            return_value = 1
    1205             CALL internal_message( 'error', routine_name //                        &
    1206                                    ': cannot define variable "' // TRIM( name ) // &
    1207                                    '" in file "' // TRIM( filename ) //            &
    1208                                    '" because no dimensions defined in file.' )
     861            CALL internal_message( 'error', routine_name //                      &
     862                    ': no dimensions defined in file. Cannot define variable '// &
     863                    '(variable "' // TRIM( variable_name ) //                    &
     864                    '", file "' // TRIM( file_name ) // '")!' )
    1209865
    1210866         ENDIF
     
    1215871            IF ( .NOT. ALLOCATED( files(f)%variables ) )  THEN
    1216872
    1217                nvar = 1
    1218                ALLOCATE( files(f)%variables(nvar) )
     873               nvars = 1
     874               ALLOCATE( files(f)%variables(nvars) )
    1219875
    1220876            ELSE
    1221877
    1222                nvar = SIZE( files(f)%variables )
    1223                DO  i = 1, nvar
     878               nvars = SIZE( files(f)%variables )
     879               DO  i = 1, nvars
    1224880                  IF ( files(f)%variables(i)%name == variable%name )  THEN
    1225881                     return_value = 1
    1226                      CALL internal_message( 'error', routine_name //          &
    1227                                             ': variable "' // TRIM( name ) // &
    1228                                             '" already exists in file "' //  &
    1229                                             TRIM( filename ) // '"!' )
     882                     CALL internal_message( 'error', routine_name //   &
     883                             ': variable already exists '//            &
     884                             '(variable "' // TRIM( variable_name ) // &
     885                             '", file "' // TRIM( file_name ) // '")!' )
    1230886                     EXIT
    1231887                  ENDIF
     
    1234890               IF ( return_value == 0 )  THEN
    1235891                  !-- Extend variable list
    1236                   ALLOCATE( vars_tmp(nvar) )
    1237                   vars_tmp = files(f)%variables
     892                  ALLOCATE( variables_tmp(nvars) )
     893                  variables_tmp = files(f)%variables
    1238894                  DEALLOCATE( files(f)%variables )
    1239                   nvar = nvar + 1
    1240                   ALLOCATE( files(f)%variables(nvar) )
    1241                   files(f)%variables(:nvar-1) = vars_tmp
    1242                   DEALLOCATE( vars_tmp )
     895                  nvars = nvars + 1
     896                  ALLOCATE( files(f)%variables(nvars) )
     897                  files(f)%variables(:nvars-1) = variables_tmp
     898                  DEALLOCATE( variables_tmp )
    1243899               ENDIF
    1244900
     
    1246902
    1247903            !-- Add new variable to database
    1248             IF ( return_value == 0 )  files(f)%variables(nvar) = variable
     904            IF ( return_value == 0 )  files(f)%variables(nvars) = variable
    1249905
    1250906         ENDIF
     
    1256912   ENDDO
    1257913
    1258    IF ( f > nf )  THEN
     914   IF ( f > nfiles )  THEN
    1259915      return_value = 1
    1260       CALL internal_message( 'error', routine_name //                           &
    1261                              ': file not found (variable "' // TRIM( name ) // &
    1262                              '", file "' // TRIM( filename ) // '")!' )
     916      CALL internal_message( 'error', routine_name //                                   &
     917                             ': file not found (variable "' // TRIM( variable_name ) // &
     918                             '", file "' // TRIM( file_name ) // '")!' )
    1263919   ENDIF
    1264920
     
    1269925! ------------
    1270926!> Create attribute with value of type character.
    1271 !--------------------------------------------------------------------------------------------------!
    1272 FUNCTION dom_def_att_char( filename, variable, name, value, append ) RESULT( return_value )
    1273 
    1274    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1275    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1276    CHARACTER(LEN=*), INTENT(IN)           ::  value     !< attribute value
    1277    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     927!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     928!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     929!> the file itself.
     930!> If an attribute of similar name already exists, it is updated (overwritten) with the new value.
     931!> If the optional argument 'append' is set TRUE, the value of an already existing attribute of
     932!> similar name is appended by the new value instead of overwritten.
     933!> Example call:
     934!>   - define a global file attribute:
     935!>      dom_def_att( file_name='my_output_file_name', &
     936!>                   attribute_name='my_attribute', &
     937!>                   value='This is the attribute value' )
     938!>   - define a variable attribute:
     939!>      dom_def_att( file_name='my_output_file_name', &
     940!>                   variable_name='my_variable', &
     941!>                   attribute_name='my_attribute', &
     942!>                   value='This is the attribute value' )
     943!>   - append an attribute:
     944!>      dom_def_att( file_name='my_output_file_name', &
     945!>                   attribute_name='my_attribute', &
     946!>                   value=' and this part was appended', append=.TRUE. )
     947!--------------------------------------------------------------------------------------------------!
     948FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append ) &
     949            RESULT( return_value )
     950
     951   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     952   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     953   CHARACTER(LEN=*),      INTENT(IN)           ::  value                   !< attribute value
     954   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     955   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    1278956
    1279957   ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_char'  !< name of routine
    1280958
    1281    INTEGER(iwp) ::  return_value  !< return value
     959   INTEGER ::  return_value  !< return value
    1282960
    1283961   LOGICAL                       ::  append_internal  !< same as 'append'
     
    1295973   ENDIF
    1296974
    1297    attribute%name       = TRIM( name )
     975   attribute%name       = TRIM( attribute_name )
    1298976   attribute%data_type  = 'char'
    1299977   attribute%value_char = TRIM( value )
    1300978
    1301    IF ( PRESENT( variable ) )  THEN
    1302       return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1303                                        attribute=attribute, append=append_internal )
     979   IF ( PRESENT( variable_name ) )  THEN
     980      variable_name_internal = TRIM( variable_name )
    1304981   ELSE
    1305       return_value = dom_def_att_save( TRIM( filename ), &
    1306                                        attribute=attribute, append=append_internal )
     982      variable_name_internal = ''
    1307983   ENDIF
     984
     985   return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     986                     variable_name=TRIM( variable_name_internal ),         &
     987                     attribute=attribute, append=append_internal )
    1308988
    1309989END FUNCTION dom_def_att_char
     
    1313993! ------------
    1314994!> Create attribute with value of type int8.
    1315 !--------------------------------------------------------------------------------------------------!
    1316 FUNCTION dom_def_att_int8( filename, variable, name, value, append ) RESULT( return_value )
    1317 
    1318    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1319    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1320    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     995!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     996!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     997!> the file itself.
     998!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
     999!> Example call:
     1000!>   - define a global file attribute:
     1001!>      dom_def_att( file_name='my_output_file_name', &
     1002!>                   attribute_name='my_attribute', &
     1003!>                   value=0_1 )
     1004!>   - define a variable attribute:
     1005!>      dom_def_att( file_name='my_output_file_name', &
     1006!>                   variable_name='my_variable', &
     1007!>                   attribute_name='my_attribute', &
     1008!>                   value=1_1 )
     1009!--------------------------------------------------------------------------------------------------!
     1010FUNCTION dom_def_att_int8( file_name, variable_name, attribute_name, value, append ) &
     1011            RESULT( return_value )
     1012
     1013   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1014   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1015   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1016   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    13211017
    13221018   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int8'  !< name of routine
     
    13241020   INTEGER(KIND=1), INTENT(IN) ::  value  !< attribute value
    13251021
    1326    INTEGER(iwp) ::  return_value  !< return value
     1022   INTEGER ::  return_value  !< return value
    13271023
    13281024   LOGICAL                       ::  append_internal  !< same as 'append'
     
    13331029
    13341030   return_value = 0
     1031
     1032   IF ( PRESENT( variable_name ) )  THEN
     1033      variable_name_internal = TRIM( variable_name )
     1034   ELSE
     1035      variable_name_internal = ''
     1036   ENDIF
    13351037
    13361038   IF ( PRESENT( append ) )  THEN
    13371039      IF ( append )  THEN
    13381040         return_value = 1
    1339          CALL internal_message( 'error',                           &
    1340                                 routine_name //                    &
    1341                                 ': attribute "' // TRIM( name ) // &
    1342                                 '": append of numeric attribute not possible.' )
     1041         CALL internal_message( 'error', routine_name //                             &
     1042                                ': numeric attribute cannot be appended ' //         &
     1043                                '(attribute "' // TRIM( attribute_name ) //          &
     1044                                '", variable "' // TRIM( variable_name_internal ) // &
     1045                                '", file "' // TRIM( file_name ) // '")!' )
    13431046      ENDIF
    13441047   ENDIF
     
    13471050      append_internal = .FALSE.
    13481051
    1349       attribute%name       = TRIM( name )
     1052      attribute%name       = TRIM( attribute_name )
    13501053      attribute%data_type  = 'int8'
    13511054      attribute%value_int8 = value
    13521055
    1353       IF ( PRESENT( variable ) )  THEN
    1354          return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1355                                               attribute=attribute, append=append_internal )
    1356       ELSE
    1357          return_value = dom_def_att_save( TRIM( filename ), &
    1358                                               attribute=attribute, append=append_internal )
    1359       ENDIF
     1056      return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1057                        variable_name=TRIM( variable_name_internal ),         &
     1058                        attribute=attribute, append=append_internal )
    13601059   ENDIF
    13611060
     
    13661065! ------------
    13671066!> Create attribute with value of type int16.
    1368 !--------------------------------------------------------------------------------------------------!
    1369 FUNCTION dom_def_att_int16( filename, variable, name, value, append ) RESULT( return_value )
    1370 
    1371    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1372    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1373    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     1067!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     1068!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     1069!> the file itself.
     1070!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
     1071!> Example call:
     1072!>   - define a global file attribute:
     1073!>      dom_def_att( file_name='my_output_file_name', &
     1074!>                   attribute_name='my_attribute', &
     1075!>                   value=0_2 )
     1076!>   - define a variable attribute:
     1077!>      dom_def_att( file_name='my_output_file_name', &
     1078!>                   variable_name='my_variable', &
     1079!>                   attribute_name='my_attribute', &
     1080!>                   value=1_2 )
     1081!--------------------------------------------------------------------------------------------------!
     1082FUNCTION dom_def_att_int16( file_name, variable_name, attribute_name, value, append ) &
     1083            RESULT( return_value )
     1084
     1085   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1086   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1087   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1088   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    13741089
    13751090   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int16'  !< name of routine
     
    13771092   INTEGER(KIND=2), INTENT(IN) ::  value  !< attribute value
    13781093
    1379    INTEGER(iwp) ::  return_value  !< return value
     1094   INTEGER ::  return_value  !< return value
    13801095
    13811096   LOGICAL                       ::  append_internal  !< same as 'append'
     
    13861101
    13871102   return_value = 0
     1103
     1104   IF ( PRESENT( variable_name ) )  THEN
     1105      variable_name_internal = TRIM( variable_name )
     1106   ELSE
     1107      variable_name_internal = ''
     1108   ENDIF
    13881109
    13891110   IF ( PRESENT( append ) )  THEN
    13901111      IF ( append )  THEN
    13911112         return_value = 1
    1392          CALL internal_message( 'error',                           &
    1393                                 routine_name //                    &
    1394                                 ': attribute "' // TRIM( name ) // &
    1395                                 '": append of numeric attribute not possible.' )
     1113         CALL internal_message( 'error', routine_name //                             &
     1114                                ': numeric attribute cannot be appended ' //         &
     1115                                '(attribute "' // TRIM( attribute_name ) //          &
     1116                                '", variable "' // TRIM( variable_name_internal ) // &
     1117                                '", file "' // TRIM( file_name ) // '")!' )
    13961118      ENDIF
    13971119   ENDIF
     
    14001122      append_internal = .FALSE.
    14011123
    1402       attribute%name        = TRIM( name )
     1124      attribute%name        = TRIM( attribute_name )
    14031125      attribute%data_type   = 'int16'
    14041126      attribute%value_int16 = value
    14051127
    1406       IF ( PRESENT( variable ) )  THEN
    1407          return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1408                                                attribute=attribute, append=append_internal )
    1409       ELSE
    1410          return_value = dom_def_att_save( TRIM( filename ), &
    1411                                                attribute=attribute, append=append_internal )
    1412       ENDIF
     1128      return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1129                        variable_name=TRIM( variable_name_internal ),         &
     1130                        attribute=attribute, append=append_internal )
    14131131   ENDIF
    14141132
     
    14191137! ------------
    14201138!> Create attribute with value of type int32.
    1421 !--------------------------------------------------------------------------------------------------!
    1422 FUNCTION dom_def_att_int32( filename, variable, name, value, append ) RESULT( return_value )
    1423 
    1424    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1425    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1426    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     1139!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     1140!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     1141!> the file itself.
     1142!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
     1143!> Example call:
     1144!>   - define a global file attribute:
     1145!>      dom_def_att( file_name='my_output_file_name', &
     1146!>                   attribute_name='my_attribute', &
     1147!>                   value=0_4 )
     1148!>   - define a variable attribute:
     1149!>      dom_def_att( file_name='my_output_file_name', &
     1150!>                   variable_name='my_variable', &
     1151!>                   attribute_name='my_attribute', &
     1152!>                   value=1_4 )
     1153!--------------------------------------------------------------------------------------------------!
     1154FUNCTION dom_def_att_int32( file_name, variable_name, attribute_name, value, append ) &
     1155            RESULT( return_value )
     1156
     1157   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1158   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1159   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1160   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    14271161
    14281162   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int32'  !< name of routine
     
    14301164   INTEGER(KIND=4), INTENT(IN) ::  value  !< attribute value
    14311165
    1432    INTEGER(iwp) ::  return_value  !< return value
     1166   INTEGER ::  return_value  !< return value
    14331167
    14341168   LOGICAL                       ::  append_internal  !< same as 'append'
     
    14391173
    14401174   return_value = 0
     1175
     1176   IF ( PRESENT( variable_name ) )  THEN
     1177      variable_name_internal = TRIM( variable_name )
     1178   ELSE
     1179      variable_name_internal = ''
     1180   ENDIF
    14411181
    14421182   IF ( PRESENT( append ) )  THEN
    14431183      IF ( append )  THEN
    14441184         return_value = 1
    1445          CALL internal_message( 'error',                           &
    1446                                 routine_name //                    &
    1447                                 ': attribute "' // TRIM( name ) // &
    1448                                 '": append of numeric attribute not possible.' )
     1185         CALL internal_message( 'error', routine_name //                             &
     1186                                ': numeric attribute cannot be appended ' //         &
     1187                                '(attribute "' // TRIM( attribute_name ) //          &
     1188                                '", variable "' // TRIM( variable_name_internal ) // &
     1189                                '", file "' // TRIM( file_name ) // '")!' )
    14491190      ENDIF
    14501191   ENDIF
     
    14531194      append_internal = .FALSE.
    14541195
    1455       attribute%name        = TRIM( name )
     1196      attribute%name        = TRIM( attribute_name )
    14561197      attribute%data_type   = 'int32'
    14571198      attribute%value_int32 = value
    14581199
    1459       IF ( PRESENT( variable ) )  THEN
    1460          return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1461                                                attribute=attribute, append=append_internal )
    1462       ELSE
    1463          return_value = dom_def_att_save( TRIM( filename ), &
    1464                                                attribute=attribute, append=append_internal )
    1465       ENDIF
     1200      return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1201                        variable_name=TRIM( variable_name_internal ),         &
     1202                        attribute=attribute, append=append_internal )
    14661203   ENDIF
    14671204
     
    14721209! ------------
    14731210!> Create attribute with value of type real32.
    1474 !--------------------------------------------------------------------------------------------------!
    1475 FUNCTION dom_def_att_real32( filename, variable, name, value, append ) RESULT( return_value )
    1476 
    1477    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1478    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1479    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     1211!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     1212!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     1213!> the file itself.
     1214!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
     1215!> Example call:
     1216!>   - define a global file attribute:
     1217!>      dom_def_att( file_name='my_output_file_name', &
     1218!>                   attribute_name='my_attribute', &
     1219!>                   value=1.0_4 )
     1220!>   - define a variable attribute:
     1221!>      dom_def_att( file_name='my_output_file_name', &
     1222!>                   variable_name='my_variable', &
     1223!>                   attribute_name='my_attribute', &
     1224!>                   value=1.0_4 )
     1225!--------------------------------------------------------------------------------------------------!
     1226FUNCTION dom_def_att_real32( file_name, variable_name, attribute_name, value, append ) &
     1227            RESULT( return_value )
     1228
     1229   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1230   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1231   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1232   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    14801233
    14811234   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real32'  !< name of routine
    14821235
    1483    INTEGER(iwp) ::  return_value  !< return value
     1236   INTEGER ::  return_value  !< return value
    14841237
    14851238   LOGICAL                       ::  append_internal  !< same as 'append'
     
    14921245
    14931246   return_value = 0
     1247
     1248   IF ( PRESENT( variable_name ) )  THEN
     1249      variable_name_internal = TRIM( variable_name )
     1250   ELSE
     1251      variable_name_internal = ''
     1252   ENDIF
    14941253
    14951254   IF ( PRESENT( append ) )  THEN
    14961255      IF ( append )  THEN
    14971256         return_value = 1
    1498          CALL internal_message( 'error',                           &
    1499                                 routine_name //                    &
    1500                                 ': attribute "' // TRIM( name ) // &
    1501                                 '": append of numeric attribute not possible.' )
     1257         CALL internal_message( 'error', routine_name //                             &
     1258                                ': numeric attribute cannot be appended ' //         &
     1259                                '(attribute "' // TRIM( attribute_name ) //          &
     1260                                '", variable "' // TRIM( variable_name_internal ) // &
     1261                                '", file "' // TRIM( file_name ) // '")!' )
    15021262      ENDIF
    15031263   ENDIF
     
    15061266      append_internal = .FALSE.
    15071267
    1508       attribute%name         = TRIM( name )
     1268      attribute%name         = TRIM( attribute_name )
    15091269      attribute%data_type    = 'real32'
    15101270      attribute%value_real32 = value
    15111271
    1512       IF ( PRESENT( variable ) )  THEN
    1513          return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1514                                                 attribute=attribute, append=append_internal )
    1515       ELSE
    1516          return_value = dom_def_att_save( TRIM( filename ), &
    1517                                                 attribute=attribute, append=append_internal )
    1518       ENDIF
     1272      return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1273                        variable_name=TRIM( variable_name_internal ),         &
     1274                        attribute=attribute, append=append_internal )
    15191275   ENDIF
    15201276
     
    15251281! ------------
    15261282!> Create attribute with value of type real64.
    1527 !--------------------------------------------------------------------------------------------------!
    1528 FUNCTION dom_def_att_real64( filename, variable, name, value, append ) RESULT( return_value )
    1529 
    1530    CHARACTER(LEN=*), INTENT(IN)           ::  filename  !< name of file
    1531    CHARACTER(LEN=*), INTENT(IN)           ::  name      !< name of attribute
    1532    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable  !< name of variable
     1283!> If the optional argument 'variable_name' is given, the attribute is added to the respective
     1284!> variable or dimension of that name. Otherwise, the attribute is added as a global attribute to
     1285!> the file itself.
     1286!> Numerical attributes cannot be appended, only updated (append=.TRUE. will cause an error).
     1287!> Example call:
     1288!>   - define a global file attribute:
     1289!>      dom_def_att( file_name='my_output_file_name', &
     1290!>                   attribute_name='my_attribute', &
     1291!>                   value=0.0_8 )
     1292!>   - define a variable attribute:
     1293!>      dom_def_att( file_name='my_output_file_name', &
     1294!>                   variable_name='my_variable', &
     1295!>                   attribute_name='my_attribute', &
     1296!>                   value=1.0_8 )
     1297!--------------------------------------------------------------------------------------------------!
     1298FUNCTION dom_def_att_real64( file_name, variable_name, attribute_name, value, append ) &
     1299            RESULT( return_value )
     1300
     1301   CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1302   CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1303   CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1304   CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
    15331305
    15341306   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real64'  !< name of routine
    15351307
    1536    INTEGER(iwp) ::  return_value  !< return value
     1308   INTEGER ::  return_value  !< return value
    15371309
    15381310   LOGICAL                       ::  append_internal  !< same as 'append'
     
    15451317
    15461318   return_value = 0
     1319
     1320   IF ( PRESENT( variable_name ) )  THEN
     1321      variable_name_internal = TRIM( variable_name )
     1322   ELSE
     1323      variable_name_internal = ''
     1324   ENDIF
    15471325
    15481326   IF ( PRESENT( append ) )  THEN
    15491327      IF ( append )  THEN
    15501328         return_value = 1
    1551          CALL internal_message( 'error',                           &
    1552                                 routine_name //                    &
    1553                                 ': attribute "' // TRIM( name ) // &
    1554                                 '": append of numeric attribute not possible.' )
     1329         CALL internal_message( 'error', routine_name //                             &
     1330                                ': numeric attribute cannot be appended ' //         &
     1331                                '(attribute "' // TRIM( attribute_name ) //          &
     1332                                '", variable "' // TRIM( variable_name_internal ) // &
     1333                                '", file "' // TRIM( file_name ) // '")!' )
    15551334      ENDIF
    15561335   ENDIF
     
    15591338      append_internal = .FALSE.
    15601339
    1561       attribute%name         = TRIM( name )
     1340      attribute%name         = TRIM( attribute_name )
    15621341      attribute%data_type    = 'real64'
    15631342      attribute%value_real64 = value
    15641343
    1565       IF ( PRESENT( variable ) )  THEN
    1566          return_value = dom_def_att_save( TRIM( filename ), TRIM( variable ), &
    1567                                                 attribute=attribute, append=append_internal )
     1344      return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1345                        variable_name=TRIM( variable_name_internal ),         &
     1346                        attribute=attribute, append=append_internal )
     1347   ENDIF
     1348
     1349END FUNCTION dom_def_att_real64
     1350
     1351!--------------------------------------------------------------------------------------------------!
     1352! Description:
     1353! ------------
     1354!> End output definition.
     1355!> The database is cleared from unused files and dimensions. Then, the output files are initialized
     1356!> and prepared for writing output values to them. The saved values of the dimensions are written
     1357!> to the files.
     1358!--------------------------------------------------------------------------------------------------!
     1359FUNCTION dom_def_end() RESULT( return_value )
     1360
     1361   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_end'  !< name of routine
     1362
     1363   INTEGER ::  d             !< loop index
     1364   INTEGER ::  f             !< loop index
     1365   INTEGER ::  return_value  !< return value
     1366
     1367   INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int8           !< target array for dimension values
     1368   INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int16          !< target array for dimension values
     1369   INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int32          !< target array for dimension values
     1370   INTEGER(iwp),    DIMENSION(:), ALLOCATABLE, TARGET ::  values_intwp          !< target array for dimension values
     1371   
     1372   INTEGER(KIND=1), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int8_pointer   !< pointer to target array
     1373   INTEGER(KIND=2), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int16_pointer  !< pointer to target array
     1374   INTEGER(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int32_pointer  !< pointer to target array
     1375   INTEGER(iwp),    DIMENSION(:), POINTER, CONTIGUOUS ::  values_intwp_pointer  !< pointer to target array
     1376
     1377   REAL(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real32            !< target array for dimension values
     1378   REAL(KIND=8), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real64            !< target array for dimension values
     1379   REAL(wp),     DIMENSION(:), ALLOCATABLE, TARGET ::  values_realwp            !< target array for dimension values
     1380
     1381   REAL(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real32_pointer    !< pointer to target array
     1382   REAL(KIND=8), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real64_pointer    !< pointer to target array
     1383   REAL(wp),     DIMENSION(:), POINTER, CONTIGUOUS ::  values_realwp_pointer    !< pointer to target array
     1384
     1385
     1386   return_value = 0
     1387   CALL internal_message( 'debug', routine_name // ': start' )
     1388
     1389   !-- Clear database from empty files and unused dimensions
     1390   IF ( nfiles > 0 )  return_value = cleanup_database()
     1391
     1392   IF ( return_value == 0 )  THEN
     1393      DO  f = 1, nfiles
     1394
     1395         !-- Skip initialization if file is already initialized
     1396         IF ( files(f)%is_init )  CYCLE
     1397
     1398         CALL internal_message( 'debug', routine_name // ': initialize file "' // &
     1399                                TRIM( files(f)%name ) // '"' )
     1400
     1401         !-- Open file
     1402         CALL open_output_file( files(f)%format, files(f)%name, files(f)%id, &
     1403                                return_value=return_value )
     1404
     1405         !-- Initialize file header:
     1406         !-- define dimensions and variables and write attributes
     1407         IF ( return_value == 0 )  &
     1408            CALL init_file_header( files(f), return_value=return_value )
     1409
     1410         !-- End file definition
     1411         IF ( return_value == 0 )  &
     1412            CALL stop_file_header_definition( files(f)%format, files(f)%id, &
     1413                                              files(f)%name, return_value )
     1414
     1415         IF ( return_value == 0 )  THEN
     1416
     1417            !-- Flag file as initialized
     1418            files(f)%is_init = .TRUE.
     1419
     1420            !-- Write dimension values into file
     1421            DO  d = 1, SIZE( files(f)%dimensions )
     1422               IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) )  THEN
     1423                  ALLOCATE( values_int8(files(f)%dimensions(d)%bounds(1): &
     1424                                        files(f)%dimensions(d)%bounds(2)) )
     1425                  values_int8 = files(f)%dimensions(d)%values_int8
     1426                  values_int8_pointer => values_int8
     1427                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1428                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1429                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1430                                    values_int8_1d=values_int8_pointer )
     1431                  DEALLOCATE( values_int8 )
     1432               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int16 ) )  THEN
     1433                  ALLOCATE( values_int16(files(f)%dimensions(d)%bounds(1): &
     1434                                         files(f)%dimensions(d)%bounds(2)) )
     1435                  values_int16 = files(f)%dimensions(d)%values_int16
     1436                  values_int16_pointer => values_int16
     1437                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1438                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1439                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1440                                    values_int16_1d=values_int16_pointer )
     1441                  DEALLOCATE( values_int16 )
     1442               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int32 ) )  THEN
     1443                  ALLOCATE( values_int32(files(f)%dimensions(d)%bounds(1): &
     1444                                         files(f)%dimensions(d)%bounds(2)) )
     1445                  values_int32 = files(f)%dimensions(d)%values_int32
     1446                  values_int32_pointer => values_int32
     1447                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1448                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1449                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1450                                    values_int32_1d=values_int32_pointer )
     1451                  DEALLOCATE( values_int32 )
     1452               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_intwp ) )  THEN
     1453                  ALLOCATE( values_intwp(files(f)%dimensions(d)%bounds(1): &
     1454                                         files(f)%dimensions(d)%bounds(2)) )
     1455                  values_intwp = files(f)%dimensions(d)%values_intwp
     1456                  values_intwp_pointer => values_intwp
     1457                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1458                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1459                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1460                                    values_intwp_1d=values_intwp_pointer )
     1461                  DEALLOCATE( values_intwp )
     1462               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real32 ) )  THEN
     1463                  ALLOCATE( values_real32(files(f)%dimensions(d)%bounds(1): &
     1464                                          files(f)%dimensions(d)%bounds(2)) )
     1465                  values_real32 = files(f)%dimensions(d)%values_real32
     1466                  values_real32_pointer => values_real32
     1467                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1468                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1469                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1470                                    values_real32_1d=values_real32_pointer )
     1471                  DEALLOCATE( values_real32 )
     1472               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real64 ) )  THEN
     1473                  ALLOCATE( values_real64(files(f)%dimensions(d)%bounds(1): &
     1474                                          files(f)%dimensions(d)%bounds(2)) )
     1475                  values_real64 = files(f)%dimensions(d)%values_real64
     1476                  values_real64_pointer => values_real64
     1477                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1478                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1479                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1480                                    values_real64_1d=values_real64_pointer )
     1481                  DEALLOCATE( values_real64 )
     1482               ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_realwp ) )  THEN
     1483                  ALLOCATE( values_realwp(files(f)%dimensions(d)%bounds(1): &
     1484                                          files(f)%dimensions(d)%bounds(2)) )
     1485                  values_realwp = files(f)%dimensions(d)%values_realwp
     1486                  values_realwp_pointer => values_realwp
     1487                  return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1488                                    bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1489                                    bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1490                                    values_realwp_1d=values_realwp_pointer )
     1491                  DEALLOCATE( values_realwp )
     1492               ENDIF
     1493               IF ( return_value /= 0 )  EXIT
     1494            ENDDO
     1495
     1496         ENDIF
     1497
     1498         IF ( return_value /= 0 )  EXIT
     1499
     1500      ENDDO
     1501   ENDIF
     1502
     1503   CALL internal_message( 'debug', routine_name // ': finished' )
     1504
     1505END FUNCTION dom_def_end
     1506
     1507!--------------------------------------------------------------------------------------------------!
     1508! Description:
     1509! ------------
     1510!> Write variable to file.
     1511!> Example call:
     1512!>   dom_write_var( file_name = 'my_output_file_name', &
     1513!>                  name = 'u', &
     1514!>                  bounds_start = (/nxl, nys, nzb, time_step/), &
     1515!>                  bounds_end = (/nxr, nyn, nzt, time_step/), &
     1516!>                  values_real64_3d = u )
     1517!> @note The order of dimension bounds must match to the order of dimensions given in call
     1518!>       'dom_def_var'. I.e., the corresponding variable definition should be like:
     1519!>          dom_def_var( file_name =  'my_output_file_name', &
     1520!>                       name = 'u', &
     1521!>                       dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
     1522!>                       output_type = <desired-output-type> )
     1523!> @note The values given do not need to be of the same data type as was defined in the
     1524!>       corresponding 'dom_def_var' call. If the output format 'netcdf' was chosen, the values are
     1525!>       automatically converted to the data type given during the definition. If 'binary' was
     1526!>       chosen, the values are written to file as given in the 'dom_write_var' call.
     1527!--------------------------------------------------------------------------------------------------!
     1528FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end,         &
     1529            values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
     1530            values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     1531            values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,  &
     1532            values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,  &
     1533            values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
     1534            values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
     1535            values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d  &
     1536            ) RESULT( return_value )
     1537
     1538   CHARACTER(LEN=charlen)            ::  file_format    !< file format chosen for file
     1539   CHARACTER(LEN=*),      INTENT(IN) ::  file_name      !< name of file
     1540   CHARACTER(LEN=*),      INTENT(IN) ::  variable_name  !< name of variable
     1541
     1542   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
     1543
     1544   INTEGER ::  file_id              !< file ID
     1545   INTEGER ::  i                    !< loop index
     1546   INTEGER ::  j                    !< loop index
     1547   INTEGER ::  k                    !< loop index
     1548   INTEGER ::  output_return_value  !< return value of a called output routine
     1549   INTEGER ::  return_value         !< return value
     1550   INTEGER ::  variable_id          !< variable ID
     1551
     1552   INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_end             !< end index per dimension of variable
     1553   INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_start           !< start index per dimension of variable
     1554   INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_origin          !< first index of each dimension
     1555   INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_start_internal  !< start index per dim. for output after masking
     1556   INTEGER, DIMENSION(:),   ALLOCATABLE ::  value_counts           !< count of indices to be written per dimension
     1557   INTEGER, DIMENSION(:,:), ALLOCATABLE ::  masked_indices         !< list containing all output indices along a dimension
     1558
     1559   LOGICAL ::  do_output  !< true if any data lies within given range of masked dimension
     1560   LOGICAL ::  is_global  !< true if variable is global
     1561
     1562   INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                   ::  values_int8_0d             !< output variable
     1563   INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                   ::  values_int16_0d            !< output variable
     1564   INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  values_int32_0d            !< output variable
     1565   INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL                   ::  values_intwp_0d            !< output variable
     1566   INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d             !< output variable
     1567   INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d            !< output variable
     1568   INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d            !< output variable
     1569   INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d            !< output variable
     1570   INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d             !< output variable
     1571   INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d            !< output variable
     1572   INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d            !< output variable
     1573   INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d            !< output variable
     1574   INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d             !< output variable
     1575   INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d            !< output variable
     1576   INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d            !< output variable
     1577   INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d            !< output variable
     1578
     1579   INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int8_1d_resorted    !< resorted output variable
     1580   INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int16_1d_resorted   !< resorted output variable
     1581   INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int32_1d_resorted   !< resorted output variable
     1582   INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_intwp_1d_resorted   !< resorted output variable
     1583   INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int8_2d_resorted    !< resorted output variable
     1584   INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int16_2d_resorted   !< resorted output variable
     1585   INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int32_2d_resorted   !< resorted output variable
     1586   INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_intwp_2d_resorted   !< resorted output variable
     1587   INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int8_3d_resorted    !< resorted output variable
     1588   INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int16_3d_resorted   !< resorted output variable
     1589   INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int32_3d_resorted   !< resorted output variable
     1590   INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_intwp_3d_resorted   !< resorted output variable
     1591
     1592   INTEGER(KIND=1), POINTER                                         ::  values_int8_0d_pointer     !< pointer to resortet array
     1593   INTEGER(KIND=2), POINTER                                         ::  values_int16_0d_pointer    !< pointer to resortet array
     1594   INTEGER(KIND=4), POINTER                                         ::  values_int32_0d_pointer    !< pointer to resortet array
     1595   INTEGER(iwp),    POINTER                                         ::  values_intwp_0d_pointer    !< pointer to resortet array
     1596   INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int8_1d_pointer     !< pointer to resortet array
     1597   INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int16_1d_pointer    !< pointer to resortet array
     1598   INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int32_1d_pointer    !< pointer to resortet array
     1599   INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_intwp_1d_pointer    !< pointer to resortet array
     1600   INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int8_2d_pointer     !< pointer to resortet array
     1601   INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int16_2d_pointer    !< pointer to resortet array
     1602   INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int32_2d_pointer    !< pointer to resortet array
     1603   INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_intwp_2d_pointer    !< pointer to resortet array
     1604   INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int8_3d_pointer     !< pointer to resortet array
     1605   INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int16_3d_pointer    !< pointer to resortet array
     1606   INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int32_3d_pointer    !< pointer to resortet array
     1607   INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_intwp_3d_pointer    !< pointer to resortet array
     1608
     1609   REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                      ::  values_real32_0d           !< output variable
     1610   REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                      ::  values_real64_0d           !< output variable
     1611   REAL(wp),     POINTER, INTENT(IN), OPTIONAL                      ::  values_realwp_0d           !< output variable
     1612   REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real32_1d           !< output variable
     1613   REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real64_1d           !< output variable
     1614   REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_realwp_1d           !< output variable
     1615   REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real32_2d           !< output variable
     1616   REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real64_2d           !< output variable
     1617   REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_realwp_2d           !< output variable
     1618   REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real32_3d           !< output variable
     1619   REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real64_3d           !< output variable
     1620   REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_realwp_3d           !< output variable
     1621
     1622   REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real32_1d_resorted  !< resorted output variable
     1623   REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real64_1d_resorted  !< resorted output variable
     1624   REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_realwp_1d_resorted  !< resorted output variable
     1625   REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real32_2d_resorted  !< resorted output variable
     1626   REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real64_2d_resorted  !< resorted output variable
     1627   REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_realwp_2d_resorted  !< resorted output variable
     1628   REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real32_3d_resorted  !< resorted output variable
     1629   REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real64_3d_resorted  !< resorted output variable
     1630   REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_realwp_3d_resorted  !< resorted output variable
     1631
     1632   REAL(KIND=4), POINTER                                            ::  values_real32_0d_pointer   !< pointer to resortet array
     1633   REAL(KIND=8), POINTER                                            ::  values_real64_0d_pointer   !< pointer to resortet array
     1634   REAL(wp),     POINTER                                            ::  values_realwp_0d_pointer   !< pointer to resortet array
     1635   REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real32_1d_pointer   !< pointer to resortet array
     1636   REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real64_1d_pointer   !< pointer to resortet array
     1637   REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_realwp_1d_pointer   !< pointer to resortet array
     1638   REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real32_2d_pointer   !< pointer to resortet array
     1639   REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real64_2d_pointer   !< pointer to resortet array
     1640   REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_realwp_2d_pointer   !< pointer to resortet array
     1641   REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real32_3d_pointer   !< pointer to resortet array
     1642   REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real64_3d_pointer   !< pointer to resortet array
     1643   REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_realwp_3d_pointer   !< pointer to resortet array
     1644
     1645   TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimension_list  !< list of used dimensions of variable
     1646
     1647
     1648   return_value = 0
     1649   output_return_value = 0
     1650
     1651   CALL internal_message( 'debug', routine_name // ': write ' // TRIM( variable_name ) // &
     1652                          ' into file ' // TRIM( file_name ) )
     1653
     1654   !-- Search for variable within file
     1655   CALL find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, &
     1656                          is_global, dimension_list, return_value=return_value  )
     1657
     1658   IF ( return_value == 0 )  THEN
     1659
     1660      !-- Check if the correct amount of variable bounds were given
     1661      IF ( SIZE( bounds_start ) /= SIZE( dimension_list )  .OR.  &
     1662           SIZE( bounds_end ) /= SIZE( dimension_list ) )  THEN
     1663         return_value = 1
     1664         CALL internal_message( 'error', routine_name //                  &
     1665                                ': number bounds do not match with ' //   &
     1666                                'number of dimensions of variable ' //    &
     1667                                '(variable "' // TRIM( variable_name ) // &
     1668                                '", file "' // TRIM( file_name ) // '")!' )
     1669      ENDIF
     1670
     1671   ENDIF
     1672
     1673   IF ( return_value == 0 )  THEN
     1674
     1675      !-- Save starting index (lower bounds) of each dimension
     1676      ALLOCATE( bounds_origin(SIZE( dimension_list )) )
     1677      ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
     1678      ALLOCATE( value_counts(SIZE( dimension_list )) )
     1679
     1680      WRITE( temp_string, * ) bounds_start
     1681      CALL internal_message( 'debug', routine_name //                    &
     1682                             ': file "' // TRIM( file_name ) //          &
     1683                             '", variable "' // TRIM( variable_name ) // &
     1684                             '", bounds_start =' // TRIM( temp_string ) )
     1685      WRITE( temp_string, * ) bounds_end
     1686      CALL internal_message( 'debug', routine_name //                    &
     1687                             ': file "' // TRIM( file_name ) //          &
     1688                             '", variable "' // TRIM( variable_name ) // &
     1689                             '", bounds_end =' // TRIM( temp_string ) )
     1690
     1691      !-- Get bounds for masking
     1692      CALL get_masked_indices_and_masked_dimension_bounds( dimension_list,                  &
     1693              bounds_start, bounds_end, bounds_start_internal, value_counts, bounds_origin, &
     1694              masked_indices )
     1695
     1696      do_output = .NOT. ANY( value_counts == 0 )
     1697
     1698      WRITE( temp_string, * ) bounds_start_internal
     1699      CALL internal_message( 'debug', routine_name //                    &
     1700                             ': file "' // TRIM( file_name ) //          &
     1701                             '", variable "' // TRIM( variable_name ) // &
     1702                             '", bounds_start_internal =' // TRIM( temp_string ) )
     1703      WRITE( temp_string, * ) value_counts
     1704      CALL internal_message( 'debug', routine_name //                    &
     1705                             ': file "' // TRIM( file_name ) //          &
     1706                             '", variable "' // TRIM( variable_name ) // &
     1707                             '", value_counts =' // TRIM( temp_string ) )
     1708
     1709      !-- Mask and resort variable
     1710      !-- 8bit integer output
     1711      IF ( PRESENT( values_int8_0d ) )  THEN
     1712         values_int8_0d_pointer => values_int8_0d
     1713      ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     1714         IF ( do_output ) THEN
     1715            ALLOCATE( values_int8_1d_resorted(0:value_counts(1)-1) )
     1716            !$OMP PARALLEL PRIVATE (i)
     1717            !$OMP DO
     1718            DO  i = 0, value_counts(1) - 1
     1719               values_int8_1d_resorted(i) = values_int8_1d(masked_indices(1,i))
     1720            ENDDO
     1721            !$OMP END PARALLEL
     1722         ELSE
     1723            ALLOCATE( values_int8_1d_resorted(1) )
     1724            values_int8_1d_resorted = 0_1
     1725         ENDIF
     1726         values_int8_1d_pointer => values_int8_1d_resorted
     1727      ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     1728         IF ( do_output ) THEN
     1729            ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1, &
     1730                                              0:value_counts(2)-1) )
     1731            !$OMP PARALLEL PRIVATE (i,j)
     1732            !$OMP DO
     1733            DO  i = 0, value_counts(1) - 1
     1734               DO  j = 0, value_counts(2) - 1
     1735                  values_int8_2d_resorted(i,j) = values_int8_2d(masked_indices(2,j), &
     1736                                                                masked_indices(1,i)  )
     1737               ENDDO
     1738            ENDDO
     1739            !$OMP END PARALLEL
     1740         ELSE
     1741            ALLOCATE( values_int8_2d_resorted(1,1) )
     1742            values_int8_2d_resorted = 0_1
     1743         ENDIF
     1744         values_int8_2d_pointer => values_int8_2d_resorted
     1745      ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     1746         IF ( do_output ) THEN
     1747            ALLOCATE( values_int8_3d_resorted(0:value_counts(1)-1, &
     1748                                              0:value_counts(2)-1, &
     1749                                              0:value_counts(3)-1) )
     1750            !$OMP PARALLEL PRIVATE (i,j,k)
     1751            !$OMP DO
     1752            DO  i = 0, value_counts(1) - 1
     1753               DO  j = 0, value_counts(2) - 1
     1754                  DO  k = 0, value_counts(3) - 1
     1755                     values_int8_3d_resorted(i,j,k) = values_int8_3d(masked_indices(3,k), &
     1756                                                                     masked_indices(2,j), &
     1757                                                                     masked_indices(1,i)  )
     1758                  ENDDO
     1759               ENDDO
     1760            ENDDO
     1761            !$OMP END PARALLEL
     1762         ELSE
     1763            ALLOCATE( values_int8_3d_resorted(1,1,1) )
     1764            values_int8_3d_resorted = 0_1
     1765         ENDIF
     1766         values_int8_3d_pointer => values_int8_3d_resorted
     1767
     1768      !-- 16bit integer output
     1769      ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     1770         values_int16_0d_pointer => values_int16_0d
     1771      ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     1772         IF ( do_output ) THEN
     1773            ALLOCATE( values_int16_1d_resorted(0:value_counts(1)-1) )
     1774            !$OMP PARALLEL PRIVATE (i)
     1775            !$OMP DO
     1776            DO  i = 0, value_counts(1) - 1
     1777               values_int16_1d_resorted(i) = values_int16_1d(masked_indices(1,i))
     1778            ENDDO
     1779            !$OMP END PARALLEL
     1780         ELSE
     1781            ALLOCATE( values_int16_1d_resorted(1) )
     1782            values_int16_1d_resorted = 0_1
     1783         ENDIF
     1784         values_int16_1d_pointer => values_int16_1d_resorted
     1785      ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     1786         IF ( do_output ) THEN
     1787            ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1, &
     1788                                               0:value_counts(2)-1) )
     1789            !$OMP PARALLEL PRIVATE (i,j)
     1790            !$OMP DO
     1791            DO  i = 0, value_counts(1) - 1
     1792               DO  j = 0, value_counts(2) - 1
     1793                  values_int16_2d_resorted(i,j) = values_int16_2d(masked_indices(2,j), &
     1794                                                                  masked_indices(1,i))
     1795               ENDDO
     1796            ENDDO
     1797            !$OMP END PARALLEL
     1798         ELSE
     1799            ALLOCATE( values_int16_2d_resorted(1,1) )
     1800            values_int16_2d_resorted = 0_1
     1801         ENDIF
     1802         values_int16_2d_pointer => values_int16_2d_resorted
     1803      ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     1804         IF ( do_output ) THEN
     1805            ALLOCATE( values_int16_3d_resorted(0:value_counts(1)-1, &
     1806                                               0:value_counts(2)-1, &
     1807                                               0:value_counts(3)-1) )
     1808            !$OMP PARALLEL PRIVATE (i,j,k)
     1809            !$OMP DO
     1810            DO  i = 0, value_counts(1) - 1
     1811               DO  j = 0, value_counts(2) - 1
     1812                  DO  k = 0, value_counts(3) - 1
     1813                     values_int16_3d_resorted(i,j,k) = values_int16_3d(masked_indices(3,k), &
     1814                                                                       masked_indices(2,j), &
     1815                                                                       masked_indices(1,i)  )
     1816                  ENDDO
     1817               ENDDO
     1818            ENDDO
     1819            !$OMP END PARALLEL
     1820         ELSE
     1821            ALLOCATE( values_int16_3d_resorted(1,1,1) )
     1822            values_int16_3d_resorted = 0_1
     1823         ENDIF
     1824         values_int16_3d_pointer => values_int16_3d_resorted
     1825
     1826      !-- 32bit integer output
     1827      ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     1828         values_int32_0d_pointer => values_int32_0d
     1829      ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     1830         IF ( do_output ) THEN
     1831            ALLOCATE( values_int32_1d_resorted(0:value_counts(1)-1) )
     1832            !$OMP PARALLEL PRIVATE (i)
     1833            !$OMP DO
     1834            DO  i = 0, value_counts(1) - 1
     1835               values_int32_1d_resorted(i) = values_int32_1d(masked_indices(1,i))
     1836            ENDDO
     1837            !$OMP END PARALLEL
     1838         ELSE
     1839            ALLOCATE( values_int32_1d_resorted(1) )
     1840            values_int32_1d_resorted = 0_1
     1841         ENDIF
     1842         values_int32_1d_pointer => values_int32_1d_resorted
     1843      ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     1844         IF ( do_output ) THEN
     1845            ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1, &
     1846                                               0:value_counts(2)-1) )
     1847            !$OMP PARALLEL PRIVATE (i,j)
     1848            !$OMP DO
     1849            DO  i = 0, value_counts(1) - 1
     1850               DO  j = 0, value_counts(2) - 1
     1851                  values_int32_2d_resorted(i,j) = values_int32_2d(masked_indices(2,j), &
     1852                                                                  masked_indices(1,i)  )
     1853               ENDDO
     1854            ENDDO
     1855            !$OMP END PARALLEL
     1856         ELSE
     1857            ALLOCATE( values_int32_2d_resorted(1,1) )
     1858            values_int32_2d_resorted = 0_1
     1859         ENDIF
     1860         values_int32_2d_pointer => values_int32_2d_resorted
     1861      ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     1862         IF ( do_output ) THEN
     1863            ALLOCATE( values_int32_3d_resorted(0:value_counts(1)-1, &
     1864                                               0:value_counts(2)-1, &
     1865                                               0:value_counts(3)-1) )
     1866            !$OMP PARALLEL PRIVATE (i,j,k)
     1867            !$OMP DO
     1868            DO  i = 0, value_counts(1) - 1
     1869               DO  j = 0, value_counts(2) - 1
     1870                  DO  k = 0, value_counts(3) - 1
     1871                     values_int32_3d_resorted(i,j,k) = values_int32_3d(masked_indices(3,k), &
     1872                                                                       masked_indices(2,j), &
     1873                                                                       masked_indices(1,i)  )
     1874                  ENDDO
     1875               ENDDO
     1876            ENDDO
     1877            !$OMP END PARALLEL
     1878         ELSE
     1879            ALLOCATE( values_int32_3d_resorted(1,1,1) )
     1880            values_int32_3d_resorted = 0_1
     1881         ENDIF
     1882         values_int32_3d_pointer => values_int32_3d_resorted
     1883
     1884      !-- working-precision integer output
     1885      ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     1886         values_intwp_0d_pointer => values_intwp_0d
     1887      ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     1888         IF ( do_output ) THEN
     1889            ALLOCATE( values_intwp_1d_resorted(0:value_counts(1)-1) )
     1890            !$OMP PARALLEL PRIVATE (i)
     1891            !$OMP DO
     1892            DO  i = 0, value_counts(1) - 1
     1893               values_intwp_1d_resorted(i) = values_intwp_1d(masked_indices(1,i))
     1894            ENDDO
     1895            !$OMP END PARALLEL
     1896         ELSE
     1897            ALLOCATE( values_intwp_1d_resorted(1) )
     1898            values_intwp_1d_resorted = 0_1
     1899         ENDIF
     1900         values_intwp_1d_pointer => values_intwp_1d_resorted
     1901      ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     1902         IF ( do_output ) THEN
     1903            ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1, &
     1904                                               0:value_counts(2)-1) )
     1905            !$OMP PARALLEL PRIVATE (i,j)
     1906            !$OMP DO
     1907            DO  i = 0, value_counts(1) - 1
     1908               DO  j = 0, value_counts(2) - 1
     1909                  values_intwp_2d_resorted(i,j) = values_intwp_2d(masked_indices(2,j), &
     1910                                                                  masked_indices(1,i)  )
     1911               ENDDO
     1912            ENDDO
     1913            !$OMP END PARALLEL
     1914         ELSE
     1915            ALLOCATE( values_intwp_2d_resorted(1,1) )
     1916            values_intwp_2d_resorted = 0_1
     1917         ENDIF
     1918         values_intwp_2d_pointer => values_intwp_2d_resorted
     1919      ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     1920         IF ( do_output ) THEN
     1921            ALLOCATE( values_intwp_3d_resorted(0:value_counts(1)-1, &
     1922                                               0:value_counts(2)-1, &
     1923                                               0:value_counts(3)-1) )
     1924            !$OMP PARALLEL PRIVATE (i,j,k)
     1925            !$OMP DO
     1926            DO  i = 0, value_counts(1) - 1
     1927               DO  j = 0, value_counts(2) - 1
     1928                  DO  k = 0, value_counts(3) - 1
     1929                     values_intwp_3d_resorted(i,j,k) = values_intwp_3d(masked_indices(3,k), &
     1930                                                                       masked_indices(2,j), &
     1931                                                                       masked_indices(1,i)  )
     1932                  ENDDO
     1933               ENDDO
     1934            ENDDO
     1935            !$OMP END PARALLEL
     1936         ELSE
     1937            ALLOCATE( values_intwp_3d_resorted(1,1,1) )
     1938            values_intwp_3d_resorted = 0_1
     1939         ENDIF
     1940         values_intwp_3d_pointer => values_intwp_3d_resorted
     1941
     1942      !-- 32bit real output
     1943      ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     1944         values_real32_0d_pointer => values_real32_0d
     1945      ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     1946         IF ( do_output ) THEN
     1947            ALLOCATE( values_real32_1d_resorted(0:value_counts(1)-1) )
     1948            !$OMP PARALLEL PRIVATE (i)
     1949            !$OMP DO
     1950            DO  i = 0, value_counts(1) - 1
     1951               values_real32_1d_resorted(i) = values_real32_1d(masked_indices(1,i))
     1952            ENDDO
     1953            !$OMP END PARALLEL
     1954         ELSE
     1955            ALLOCATE( values_real32_1d_resorted(1) )
     1956            values_real32_1d_resorted = 0_1
     1957         ENDIF
     1958         values_real32_1d_pointer => values_real32_1d_resorted
     1959      ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     1960         IF ( do_output ) THEN
     1961            ALLOCATE( values_real32_2d_resorted(0:value_counts(1)-1, &
     1962                                                0:value_counts(2)-1) )
     1963            !$OMP PARALLEL PRIVATE (i,j)
     1964            !$OMP DO
     1965            DO  i = 0, value_counts(1) - 1
     1966               DO  j = 0, value_counts(2) - 1
     1967                  values_real32_2d_resorted(i,j) = values_real32_2d(masked_indices(2,j), &
     1968                                                                    masked_indices(1,i)  )
     1969               ENDDO
     1970            ENDDO
     1971            !$OMP END PARALLEL
     1972         ELSE
     1973            ALLOCATE( values_real32_2d_resorted(1,1) )
     1974            values_real32_2d_resorted = 0_1
     1975         ENDIF
     1976         values_real32_2d_pointer => values_real32_2d_resorted
     1977      ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     1978         IF ( do_output ) THEN
     1979            ALLOCATE( values_real32_3d_resorted(0:value_counts(1)-1, &
     1980                                                0:value_counts(2)-1, &
     1981                                                0:value_counts(3)-1) )
     1982            !$OMP PARALLEL PRIVATE (i,j,k)
     1983            !$OMP DO
     1984            DO  i = 0, value_counts(1) - 1
     1985               DO  j = 0, value_counts(2) - 1
     1986                  DO  k = 0, value_counts(3) - 1
     1987                     values_real32_3d_resorted(i,j,k) = values_real32_3d(masked_indices(3,k), &
     1988                                                                         masked_indices(2,j), &
     1989                                                                         masked_indices(1,i)  )
     1990                  ENDDO
     1991               ENDDO
     1992            ENDDO
     1993            !$OMP END PARALLEL
     1994         ELSE
     1995            ALLOCATE( values_real32_3d_resorted(1,1,1) )
     1996            values_real32_3d_resorted = 0_1
     1997         ENDIF
     1998         values_real32_3d_pointer => values_real32_3d_resorted
     1999
     2000      !-- 64bit real output
     2001      ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     2002         values_real64_0d_pointer => values_real64_0d
     2003      ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     2004         IF ( do_output ) THEN
     2005            ALLOCATE( values_real64_1d_resorted(0:value_counts(1)-1) )
     2006            !$OMP PARALLEL PRIVATE (i)
     2007            !$OMP DO
     2008            DO  i = 0, value_counts(1) - 1
     2009               values_real64_1d_resorted(i) = values_real64_1d(masked_indices(1,i))
     2010            ENDDO
     2011            !$OMP END PARALLEL
     2012         ELSE
     2013            ALLOCATE( values_real64_1d_resorted(1) )
     2014            values_real64_1d_resorted = 0_1
     2015         ENDIF
     2016         values_real64_1d_pointer => values_real64_1d_resorted
     2017      ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     2018         IF ( do_output ) THEN
     2019            ALLOCATE( values_real64_2d_resorted(0:value_counts(1)-1, &
     2020                                                0:value_counts(2)-1) )
     2021            !$OMP PARALLEL PRIVATE (i,j)
     2022            !$OMP DO
     2023            DO  i = 0, value_counts(1) - 1
     2024               DO  j = 0, value_counts(2) - 1
     2025                  values_real64_2d_resorted(i,j) = values_real64_2d(masked_indices(2,j), &
     2026                                                                    masked_indices(1,i)  )
     2027               ENDDO
     2028            ENDDO
     2029            !$OMP END PARALLEL
     2030         ELSE
     2031            ALLOCATE( values_real64_2d_resorted(1,1) )
     2032            values_real64_2d_resorted = 0_1
     2033         ENDIF
     2034         values_real64_2d_pointer => values_real64_2d_resorted
     2035      ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     2036         IF ( do_output ) THEN
     2037            ALLOCATE( values_real64_3d_resorted(0:value_counts(1)-1, &
     2038                                                0:value_counts(2)-1, &
     2039                                                0:value_counts(3)-1) )
     2040            !$OMP PARALLEL PRIVATE (i,j,k)
     2041            !$OMP DO
     2042            DO  i = 0, value_counts(1) - 1
     2043               DO  j = 0, value_counts(2) - 1
     2044                  DO  k = 0, value_counts(3) - 1
     2045                     values_real64_3d_resorted(i,j,k) = values_real64_3d(masked_indices(3,k), &
     2046                                                                         masked_indices(2,j), &
     2047                                                                         masked_indices(1,i)  )
     2048                  ENDDO
     2049               ENDDO
     2050            ENDDO
     2051            !$OMP END PARALLEL
     2052         ELSE
     2053            ALLOCATE( values_real64_3d_resorted(1,1,1) )
     2054            values_real64_3d_resorted = 0_1
     2055         ENDIF
     2056         values_real64_3d_pointer => values_real64_3d_resorted
     2057
     2058      !-- working-precision real output
     2059      ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     2060         values_realwp_0d_pointer => values_realwp_0d
     2061      ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     2062         IF ( do_output ) THEN
     2063            ALLOCATE( values_realwp_1d_resorted(0:value_counts(1)-1) )
     2064            !$OMP PARALLEL PRIVATE (i)
     2065            !$OMP DO
     2066            DO  i = 0, value_counts(1) - 1
     2067               values_realwp_1d_resorted(i) = values_realwp_1d(masked_indices(1,i))
     2068            ENDDO
     2069            !$OMP END PARALLEL
     2070         ELSE
     2071            ALLOCATE( values_realwp_1d_resorted(1) )
     2072            values_realwp_1d_resorted = 0_1
     2073         ENDIF
     2074         values_realwp_1d_pointer => values_realwp_1d_resorted
     2075      ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     2076         IF ( do_output ) THEN
     2077            ALLOCATE( values_realwp_2d_resorted(0:value_counts(1)-1, &
     2078                                                0:value_counts(2)-1) )
     2079            !$OMP PARALLEL PRIVATE (i,j)
     2080            !$OMP DO
     2081            DO  i = 0, value_counts(1) - 1
     2082               DO  j = 0, value_counts(2) - 1
     2083                  values_realwp_2d_resorted(i,j) = values_realwp_2d(masked_indices(2,j), &
     2084                                                                    masked_indices(1,i)  )
     2085               ENDDO
     2086            ENDDO
     2087            !$OMP END PARALLEL
     2088         ELSE
     2089            ALLOCATE( values_realwp_2d_resorted(1,1) )
     2090            values_realwp_2d_resorted = 0_1
     2091         ENDIF
     2092         values_realwp_2d_pointer => values_realwp_2d_resorted
     2093      ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     2094         IF ( do_output ) THEN
     2095            ALLOCATE( values_realwp_3d_resorted(0:value_counts(1)-1, &
     2096                                                0:value_counts(2)-1, &
     2097                                                0:value_counts(3)-1) )
     2098            !$OMP PARALLEL PRIVATE (i,j,k)
     2099            !$OMP DO
     2100            DO  i = 0, value_counts(1) - 1
     2101               DO  j = 0, value_counts(2) - 1
     2102                  DO  k = 0, value_counts(3) - 1
     2103                     values_realwp_3d_resorted(i,j,k) = values_realwp_3d(masked_indices(3,k), &
     2104                                                                         masked_indices(2,j), &
     2105                                                                         masked_indices(1,i)  )
     2106                  ENDDO
     2107               ENDDO
     2108            ENDDO
     2109            !$OMP END PARALLEL
     2110         ELSE
     2111            ALLOCATE( values_realwp_3d_resorted(1,1,1) )
     2112            values_realwp_3d_resorted = 0_1
     2113         ENDIF
     2114         values_realwp_3d_pointer => values_realwp_3d_resorted
     2115
    15682116      ELSE
    1569          return_value = dom_def_att_save( TRIM( filename ), &
    1570                                                 attribute=attribute, append=append_internal )
     2117         return_value = 1
     2118         CALL internal_message( 'error', routine_name //                  &
     2119                                ': no output values given ' //            &
     2120                                '(variable "' // TRIM( variable_name ) // &
     2121                                '", file "' // TRIM( file_name ) // '")!'  )
    15712122      ENDIF
     2123
     2124      DEALLOCATE( masked_indices )
     2125
     2126   ENDIF  ! Check for error
     2127
     2128   IF ( return_value == 0 )  THEN
     2129
     2130      !-- Write variable into file
     2131      SELECT CASE ( TRIM( file_format ) )
     2132
     2133         CASE ( 'binary' )
     2134            !-- 8bit integer output
     2135            IF ( PRESENT( values_int8_0d ) )  THEN
     2136               CALL binary_write_variable( file_id, variable_id,                      &
     2137                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2138                       values_int8_0d=values_int8_0d_pointer, return_value=output_return_value )
     2139            ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     2140               CALL binary_write_variable( file_id, variable_id,                      &
     2141                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2142                       values_int8_1d=values_int8_1d_pointer, return_value=output_return_value )
     2143            ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     2144               CALL binary_write_variable( file_id, variable_id,                      &
     2145                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2146                       values_int8_2d=values_int8_2d_pointer, return_value=output_return_value )
     2147            ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     2148               CALL binary_write_variable( file_id, variable_id,                      &
     2149                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2150                       values_int8_3d=values_int8_3d_pointer, return_value=output_return_value )
     2151            !-- 16bit integer output
     2152            ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     2153               CALL binary_write_variable( file_id, variable_id,                      &
     2154                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2155                       values_int16_0d=values_int16_0d_pointer, return_value=output_return_value )
     2156            ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     2157               CALL binary_write_variable( file_id, variable_id,                      &
     2158                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2159                       values_int16_1d=values_int16_1d_pointer, return_value=output_return_value )
     2160            ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     2161               CALL binary_write_variable( file_id, variable_id,                      &
     2162                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2163                       values_int16_2d=values_int16_2d_pointer, return_value=output_return_value )
     2164            ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     2165               CALL binary_write_variable( file_id, variable_id,                      &
     2166                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2167                       values_int16_3d=values_int16_3d_pointer, return_value=output_return_value )
     2168            !-- 32bit integer output
     2169            ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     2170               CALL binary_write_variable( file_id, variable_id,                      &
     2171                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2172                       values_int32_0d=values_int32_0d_pointer, return_value=output_return_value )
     2173            ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     2174               CALL binary_write_variable( file_id, variable_id,                      &
     2175                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2176                       values_int32_1d=values_int32_1d_pointer, return_value=output_return_value )
     2177            ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     2178               CALL binary_write_variable( file_id, variable_id,                      &
     2179                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2180                       values_int32_2d=values_int32_2d_pointer, return_value=output_return_value )
     2181            ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     2182               CALL binary_write_variable( file_id, variable_id,                      &
     2183                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2184                       values_int32_3d=values_int32_3d_pointer, return_value=output_return_value )
     2185            !-- working-precision integer output
     2186            ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     2187               CALL binary_write_variable( file_id, variable_id,                      &
     2188                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2189                       values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value )
     2190            ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     2191               CALL binary_write_variable( file_id, variable_id,                      &
     2192                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2193                       values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value )
     2194            ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     2195               CALL binary_write_variable( file_id, variable_id,                      &
     2196                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2197                       values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value )
     2198            ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     2199               CALL binary_write_variable( file_id, variable_id,                      &
     2200                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2201                       values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value )
     2202            !-- 32bit real output
     2203            ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     2204               CALL binary_write_variable( file_id, variable_id,                      &
     2205                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2206                       values_real32_0d=values_real32_0d_pointer, return_value=output_return_value )
     2207            ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     2208               CALL binary_write_variable( file_id, variable_id,                      &
     2209                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2210                       values_real32_1d=values_real32_1d_pointer, return_value=output_return_value )
     2211            ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     2212               CALL binary_write_variable( file_id, variable_id,                      &
     2213                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2214                       values_real32_2d=values_real32_2d_pointer, return_value=output_return_value )
     2215            ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     2216               CALL binary_write_variable( file_id, variable_id,                      &
     2217                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2218                       values_real32_3d=values_real32_3d_pointer, return_value=output_return_value )
     2219            !-- 64bit real output
     2220            ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     2221               CALL binary_write_variable( file_id, variable_id,                      &
     2222                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2223                       values_real64_0d=values_real64_0d_pointer, return_value=output_return_value )
     2224            ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     2225               CALL binary_write_variable( file_id, variable_id,                      &
     2226                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2227                       values_real64_1d=values_real64_1d_pointer, return_value=output_return_value )
     2228            ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     2229               CALL binary_write_variable( file_id, variable_id,                      &
     2230                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2231                       values_real64_2d=values_real64_2d_pointer, return_value=output_return_value )
     2232            ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     2233               CALL binary_write_variable( file_id, variable_id,                      &
     2234                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2235                       values_real64_3d=values_real64_3d_pointer, return_value=output_return_value )
     2236            !-- working-precision real output
     2237            ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     2238               CALL binary_write_variable( file_id, variable_id,                      &
     2239                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2240                       values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value )
     2241            ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     2242               CALL binary_write_variable( file_id, variable_id,                      &
     2243                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2244                       values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value )
     2245            ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     2246               CALL binary_write_variable( file_id, variable_id,                      &
     2247                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2248                       values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value )
     2249            ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     2250               CALL binary_write_variable( file_id, variable_id,                      &
     2251                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2252                       values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value )
     2253            ELSE
     2254               return_value = 1
     2255               CALL internal_message( 'error', routine_name //                          &
     2256                                      ': output_type not supported by file format "' // &
     2257                                      TRIM( file_format ) // '" ' //                    &
     2258                                      '(variable "' // TRIM( variable_name ) //         &
     2259                                      '", file "' // TRIM( file_name ) // '")!' )
     2260            ENDIF
     2261
     2262         CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     2263            !-- 8bit integer output
     2264            IF ( PRESENT( values_int8_0d ) )  THEN
     2265               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2266                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2267                       values_int8_0d=values_int8_0d_pointer, return_value=output_return_value )
     2268            ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     2269               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2270                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2271                       values_int8_1d=values_int8_1d_pointer, return_value=output_return_value )
     2272            ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     2273               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2274                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2275                       values_int8_2d=values_int8_2d_pointer, return_value=output_return_value )
     2276            ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     2277               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2278                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2279                       values_int8_3d=values_int8_3d_pointer, return_value=output_return_value )
     2280            !-- 16bit integer output
     2281            ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     2282               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2283                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2284                       values_int16_0d=values_int16_0d_pointer, return_value=output_return_value )
     2285            ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     2286               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2287                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2288                       values_int16_1d=values_int16_1d_pointer, return_value=output_return_value )
     2289            ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     2290               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2291                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2292                       values_int16_2d=values_int16_2d_pointer, return_value=output_return_value )
     2293            ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     2294               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2295                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2296                       values_int16_3d=values_int16_3d_pointer, return_value=output_return_value )
     2297            !-- 32bit integer output
     2298            ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     2299               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2300                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2301                       values_int32_0d=values_int32_0d_pointer, return_value=output_return_value )
     2302            ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     2303               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2304                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2305                       values_int32_1d=values_int32_1d_pointer, return_value=output_return_value )
     2306            ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     2307               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2308                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2309                       values_int32_2d=values_int32_2d_pointer, return_value=output_return_value )
     2310            ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     2311               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2312                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2313                       values_int32_3d=values_int32_3d_pointer, return_value=output_return_value )
     2314            !-- working-precision integer output
     2315            ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     2316               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2317                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2318                       values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value )
     2319            ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     2320               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2321                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2322                       values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value )
     2323            ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     2324               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2325                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2326                       values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value )
     2327            ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     2328               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2329                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2330                       values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value )
     2331            !-- 32bit real output
     2332            ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     2333               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2334                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2335                       values_real32_0d=values_real32_0d_pointer, return_value=output_return_value )
     2336            ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     2337               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2338                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2339                       values_real32_1d=values_real32_1d_pointer, return_value=output_return_value )
     2340            ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     2341               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2342                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2343                       values_real32_2d=values_real32_2d_pointer, return_value=output_return_value )
     2344            ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     2345               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2346                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2347                       values_real32_3d=values_real32_3d_pointer, return_value=output_return_value )
     2348            !-- 64bit real output
     2349            ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     2350               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2351                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2352                       values_real64_0d=values_real64_0d_pointer, return_value=output_return_value )
     2353            ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     2354               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2355                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2356                       values_real64_1d=values_real64_1d_pointer, return_value=output_return_value )
     2357            ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     2358               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2359                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2360                       values_real64_2d=values_real64_2d_pointer, return_value=output_return_value )
     2361            ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     2362               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2363                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2364                       values_real64_3d=values_real64_3d_pointer, return_value=output_return_value )
     2365            !-- working-precision real output
     2366            ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     2367               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2368                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2369                       values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value )
     2370            ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     2371               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2372                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2373                       values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value )
     2374            ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     2375               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2376                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2377                       values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value )
     2378            ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     2379               CALL netcdf4_write_variable( file_id, variable_id,                     &
     2380                       bounds_start_internal, value_counts, bounds_origin, is_global, &
     2381                       values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value )
     2382            ELSE
     2383               return_value = 1
     2384               CALL internal_message( 'error', routine_name //                          &
     2385                                      ': output_type not supported by file format "' // &
     2386                                      TRIM( file_format ) // '" ' //                    &
     2387                                      '(variable "' // TRIM( variable_name ) //         &
     2388                                      '", file "' // TRIM( file_name ) // '")!' )
     2389            ENDIF
     2390
     2391         CASE DEFAULT
     2392            return_value = 1
     2393            CALL internal_message( 'error', routine_name //                    &
     2394                                   ': file format "' // TRIM( file_format ) // &
     2395                                   '" not supported ' //                       &
     2396                                   '(variable "' // TRIM( variable_name ) //   &
     2397                                   '", file "' // TRIM( file_name ) // '")!' )
     2398
     2399      END SELECT
     2400
     2401      IF ( return_value == 0  .AND.  output_return_value /= 0 )  THEN
     2402         return_value = 1
     2403         CALL internal_message( 'error', routine_name //                  &
     2404                                ': error while writing variable ' //      &
     2405                                '(variable "' // TRIM( variable_name ) // &
     2406                                '", file "' // TRIM( file_name ) // '")!' )
     2407      ENDIF
     2408
    15722409   ENDIF
    15732410
    1574 END FUNCTION dom_def_att_real64
     2411END FUNCTION dom_write_var
     2412
     2413!--------------------------------------------------------------------------------------------------!
     2414! Description:
     2415! ------------
     2416!> Finalize output.
     2417!> All necessary steps are carried out to close all output files. If a file could not be closed,
     2418!> this is noted in the error message.
     2419!>
     2420!> @bug if multiple files failed to be closed, only the last failure is given in the error message.
     2421!--------------------------------------------------------------------------------------------------!
     2422FUNCTION dom_finalize_output() RESULT( return_value )
     2423
     2424   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_finalize_output'  !< name of routine
     2425
     2426   INTEGER ::  f                      !< loop index
     2427   INTEGER ::  output_return_value    !< return value from called routines
     2428   INTEGER ::  return_value           !< return value
     2429   INTEGER ::  return_value_internal  !< error code after closing a single file
     2430
     2431
     2432   return_value = 0
     2433
     2434   DO  f = 1, nfiles
     2435
     2436      IF ( files(f)%is_init )  THEN
     2437
     2438         output_return_value = 0
     2439         return_value_internal = 0
     2440
     2441         SELECT CASE ( TRIM( files(f)%format ) )
     2442
     2443            CASE ( 'binary' )
     2444               CALL binary_finalize( files(f)%id, output_return_value )
     2445
     2446            CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     2447               CALL netcdf4_finalize( files(f)%id, output_return_value )
     2448
     2449            CASE DEFAULT
     2450               return_value_internal = 1
     2451
     2452         END SELECT
     2453
     2454         IF ( output_return_value /= 0 )  THEN
     2455            return_value = output_return_value
     2456            CALL internal_message( 'error', routine_name //             &
     2457                                   ': error while finalizing file "' // &
     2458                                   TRIM( files(f)%name ) // '"' )
     2459         ELSEIF ( return_value_internal /= 0 )  THEN
     2460            return_value = return_value_internal
     2461            CALL internal_message( 'error', routine_name //                     &
     2462                                   ': unsupported file format "' //             &
     2463                                   TRIM( files(f)%format ) // '" for file "' // &
     2464                                   TRIM( files(f)%name ) // '"' )
     2465         ENDIF
     2466
     2467      ENDIF
     2468
     2469   ENDDO
     2470
     2471END FUNCTION dom_finalize_output
     2472
     2473!--------------------------------------------------------------------------------------------------!
     2474! Description:
     2475! ------------
     2476!> Return the last created error message.
     2477!--------------------------------------------------------------------------------------------------!
     2478FUNCTION dom_get_error_message() RESULT( error_message )
     2479
     2480   CHARACTER(LEN=800) ::  error_message  !< return error message to main program
     2481
     2482
     2483   error_message = TRIM( internal_error_message )
     2484
     2485   error_message = TRIM( error_message ) // TRIM( binary_get_error_message() )
     2486   
     2487   error_message = TRIM( error_message ) // TRIM( netcdf4_get_error_message() )
     2488   
     2489   internal_error_message = ''
     2490
     2491END FUNCTION dom_get_error_message
    15752492
    15762493!--------------------------------------------------------------------------------------------------!
     
    15812498!> @todo Try to combine similar code parts and shorten routine.
    15822499!--------------------------------------------------------------------------------------------------!
    1583 FUNCTION dom_def_att_save( filename, variable_name, attribute, append ) RESULT( return_value )
    1584 
    1585    CHARACTER(LEN=*), INTENT(IN) ::  filename                 !< name of file
    1586    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  variable_name  !< name of variable
    1587 
    1588    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_save'  !< name of routine
    1589 
    1590    INTEGER(iwp) ::  a             !< loop index
    1591    INTEGER(iwp) ::  d             !< loop index
    1592    INTEGER(iwp) ::  f             !< loop index
    1593    INTEGER(iwp) ::  natt          !< number of attributes
    1594    INTEGER(iwp) ::  return_value  !< return value
     2500FUNCTION save_attribute_in_database( file_name, variable_name, attribute, append ) &
     2501            RESULT( return_value )
     2502
     2503   CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< name of file
     2504   CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
     2505
     2506   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'save_attribute_in_database'  !< name of routine
     2507
     2508   INTEGER ::  a             !< loop index
     2509   INTEGER ::  d             !< loop index
     2510   INTEGER ::  f             !< loop index
     2511   INTEGER ::  natts         !< number of attributes
     2512   INTEGER ::  return_value  !< return value
    15952513
    15962514   LOGICAL             ::  found   !< true if variable or dimension of name 'variable_name' found
     
    16052523   found = .FALSE.
    16062524
    1607    IF ( PRESENT( variable_name ) )  THEN
    1608       CALL internal_message( 'debug', routine_name //                            &
    1609                              ': define attribute "' // TRIM( attribute%name ) // &
    1610                              '" of variable "' // TRIM( variable_name ) //       &
    1611                              '" in file "' // TRIM( filename ) // '"' )
    1612    ELSE
    1613       CALL internal_message( 'debug', routine_name //                            &
    1614                              ': define attribute "' // TRIM( attribute%name ) // &
    1615                              '" in file "' // TRIM( filename ) // '"' )
    1616    ENDIF
    1617 
    1618    DO  f = 1, nf
    1619 
    1620       IF ( TRIM( filename ) == files(f)%name )  THEN
     2525   CALL internal_message( 'debug', routine_name //                            &
     2526                          ': define attribute "' // TRIM( attribute%name ) // &
     2527                          '" of variable "' // TRIM( variable_name ) //       &
     2528                          '" in file "' // TRIM( file_name ) // '"' )
     2529
     2530   DO  f = 1, nfiles
     2531
     2532      IF ( TRIM( file_name ) == files(f)%name )  THEN
    16212533
    16222534         IF ( files(f)%is_init )  THEN
    16232535            return_value = 1
    1624             CALL internal_message( 'error', routine_name // ': file "' // TRIM( filename ) // &
     2536            CALL internal_message( 'error', routine_name // ': file "' // TRIM( file_name ) // &
    16252537                    '" is already initialized. No further attribute definition allowed!' )
    16262538            EXIT
     
    16282540
    16292541         !-- Add attribute to file
    1630          IF ( .NOT. PRESENT( variable_name ) )  THEN
     2542         IF ( TRIM( variable_name ) == '' )  THEN
    16312543
    16322544            !-- Initialize first file attribute
    16332545            IF ( .NOT. ALLOCATED( files(f)%attributes ) )  THEN
    1634                natt = 1
    1635                ALLOCATE( files(f)%attributes(natt) )
     2546               natts = 1
     2547               ALLOCATE( files(f)%attributes(natts) )
    16362548            ELSE
    1637                natt = SIZE( files(f)%attributes )
     2549               natts = SIZE( files(f)%attributes )
    16382550
    16392551               !-- Check if attribute already exists
    1640                DO  a = 1, natt
     2552               DO  a = 1, natts
    16412553                  IF ( files(f)%attributes(a)%name == attribute%name )  THEN
    16422554                     IF ( append )  THEN
     
    16552567               !-- Extend attribute list by 1
    16562568               IF ( .NOT. found )  THEN
    1657                   ALLOCATE( atts_tmp(natt) )
     2569                  ALLOCATE( atts_tmp(natts) )
    16582570                  atts_tmp = files(f)%attributes
    16592571                  DEALLOCATE( files(f)%attributes )
    1660                   natt = natt + 1
    1661                   ALLOCATE( files(f)%attributes(natt) )
    1662                   files(f)%attributes(:natt-1) = atts_tmp
     2572                  natts = natts + 1
     2573                  ALLOCATE( files(f)%attributes(natts) )
     2574                  files(f)%attributes(:natts-1) = atts_tmp
    16632575                  DEALLOCATE( atts_tmp )
    16642576               ENDIF
     
    16672579            !-- Save new attribute to the end of the attribute list
    16682580            IF ( .NOT. found )  THEN
    1669                files(f)%attributes(natt) = attribute
     2581               files(f)%attributes(natts) = attribute
    16702582               found = .TRUE.
    16712583            ENDIF
     
    16842596                     IF ( .NOT. ALLOCATED( files(f)%dimensions(d)%attributes ) )  THEN
    16852597                        !-- Initialize first attribute
    1686                         natt = 1
    1687                         ALLOCATE( files(f)%dimensions(d)%attributes(natt) )
     2598                        natts = 1
     2599                        ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
    16882600                     ELSE
    1689                         natt = SIZE( files(f)%dimensions(d)%attributes )
     2601                        natts = SIZE( files(f)%dimensions(d)%attributes )
    16902602
    16912603                        !-- Check if attribute already exists
    1692                         DO  a = 1, natt
     2604                        DO  a = 1, natts
    16932605                           IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name ) &
    16942606                           THEN
     
    17092621                        !-- Extend attribute list
    17102622                        IF ( .NOT. found )  THEN
    1711                            ALLOCATE( atts_tmp(natt) )
     2623                           ALLOCATE( atts_tmp(natts) )
    17122624                           atts_tmp = files(f)%dimensions(d)%attributes
    17132625                           DEALLOCATE( files(f)%dimensions(d)%attributes )
    1714                            natt = natt + 1
    1715                            ALLOCATE( files(f)%dimensions(d)%attributes(natt) )
    1716                            files(f)%dimensions(d)%attributes(:natt-1) = atts_tmp
     2626                           natts = natts + 1
     2627                           ALLOCATE( files(f)%dimensions(d)%attributes(natts) )
     2628                           files(f)%dimensions(d)%attributes(:natts-1) = atts_tmp
    17172629                           DEALLOCATE( atts_tmp )
    17182630                        ENDIF
     
    17212633                     !-- Add new attribute to database
    17222634                     IF ( .NOT. found )  THEN
    1723                         files(f)%dimensions(d)%attributes(natt) = attribute
     2635                        files(f)%dimensions(d)%attributes(natts) = attribute
    17242636                        found = .TRUE.
    17252637                     ENDIF
     
    17422654                     IF ( .NOT. ALLOCATED( files(f)%variables(d)%attributes ) )  THEN
    17432655                        !-- Initialize first attribute
    1744                         natt = 1
    1745                         ALLOCATE( files(f)%variables(d)%attributes(natt) )
     2656                        natts = 1
     2657                        ALLOCATE( files(f)%variables(d)%attributes(natts) )
    17462658                     ELSE
    1747                         natt = SIZE( files(f)%variables(d)%attributes )
     2659                        natts = SIZE( files(f)%variables(d)%attributes )
    17482660
    17492661                        !-- Check if attribute already exists
    1750                         DO  a = 1, natt
     2662                        DO  a = 1, natts
    17512663                           IF ( files(f)%variables(d)%attributes(a)%name == attribute%name )  &
    17522664                           THEN
     
    17672679                        !-- Extend attribute list
    17682680                        IF ( .NOT. found )  THEN
    1769                            ALLOCATE( atts_tmp(natt) )
     2681                           ALLOCATE( atts_tmp(natts) )
    17702682                           atts_tmp = files(f)%variables(d)%attributes
    17712683                           DEALLOCATE( files(f)%variables(d)%attributes )
    1772                            natt = natt + 1
    1773                            ALLOCATE( files(f)%variables(d)%attributes(natt) )
    1774                            files(f)%variables(d)%attributes(:natt-1) = atts_tmp
     2684                           natts = natts + 1
     2685                           ALLOCATE( files(f)%variables(d)%attributes(natts) )
     2686                           files(f)%variables(d)%attributes(:natts-1) = atts_tmp
    17752687                           DEALLOCATE( atts_tmp )
    17762688                        ENDIF
     
    17802692                     !-- Add new attribute to database
    17812693                     IF ( .NOT. found )  THEN
    1782                         files(f)%variables(d)%attributes(natt) = attribute
     2694                        files(f)%variables(d)%attributes(natts) = attribute
    17832695                        found = .TRUE.
    17842696                     ENDIF
     
    17982710                       ': requested dimension/variable "' // TRIM( variable_name ) // &
    17992711                       '" for attribute "' // TRIM( attribute%name ) //               &
    1800                        '" does not exist in file "' // TRIM( filename ) // '"' )
     2712                       '" does not exist in file "' // TRIM( file_name ) // '"' )
    18012713            ENDIF
    18022714
    18032715            EXIT
    18042716
    1805          ENDIF  ! variable_name present
    1806 
    1807       ENDIF  ! check filename
     2717         ENDIF  ! variable_name not empty
     2718
     2719      ENDIF  ! check file_name
    18082720
    18092721   ENDDO  ! loop over files
     
    18132725      CALL internal_message( 'error',                                         &
    18142726                             routine_name //                                  &
    1815                              ': requested file "' // TRIM( filename ) //      &
     2727                             ': requested file "' // TRIM( file_name ) //     &
    18162728                             '" for attribute "' // TRIM( attribute%name ) // &
    18172729                             '" does not exist' )
    18182730   ENDIF
    18192731
    1820 END FUNCTION dom_def_att_save
    1821 
    1822 !--------------------------------------------------------------------------------------------------!
    1823 ! Description:
    1824 ! ------------
    1825 !> Start with output: clear database from unused files/dimensions, initialize
    1826 !> files and write dimension values to files.
    1827 !--------------------------------------------------------------------------------------------------!
    1828 FUNCTION dom_start_output() RESULT( return_value )
    1829 
    1830    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_start_output'  !< name of routine
    1831 
    1832    INTEGER(iwp) ::  d             !< loop index
    1833    INTEGER(iwp) ::  f             !< loop index
    1834    INTEGER(iwp) ::  return_value  !< return value
    1835 
    1836    INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int8          !< target array for dimension values
    1837    INTEGER(KIND=1), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int8_pointer  !< pointer to target array
    1838 
    1839    INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int16          !< target array for dimension values
    1840    INTEGER(KIND=2), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int16_pointer  !< pointer to target array
    1841 
    1842    INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int32          !< target array for dimension values
    1843    INTEGER(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int32_pointer  !< pointer to target array
    1844 
    1845    INTEGER(iwp), DIMENSION(:), ALLOCATABLE, TARGET ::  values_intwp          !< target array for dimension values
    1846    INTEGER(iwp), DIMENSION(:), POINTER, CONTIGUOUS ::  values_intwp_pointer  !< pointer to target array
    1847 
    1848    REAL(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real32          !< target array for dimension values
    1849    REAL(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real32_pointer  !< pointer to target array
    1850 
    1851    REAL(KIND=8), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real64          !< target array for dimension values
    1852    REAL(KIND=8), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real64_pointer  !< pointer to target array
    1853 
    1854    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET ::  values_realwp          !< target array for dimension values
    1855    REAL(wp), DIMENSION(:), POINTER, CONTIGUOUS ::  values_realwp_pointer  !< pointer to target array
    1856 
    1857 
    1858    return_value = 0
    1859    CALL internal_message( 'debug', routine_name // ': start' )
    1860 
    1861    !-- Clear database from empty files and unused dimensions
    1862    IF ( nf > 0 )  return_value = cleanup_database()
    1863 
    1864    IF ( return_value == 0 )  THEN
    1865       DO  f = 1, nf
    1866 
    1867          !-- Skip initialization if file is already initialized
    1868          IF ( files(f)%is_init )  CYCLE
    1869 
    1870          CALL internal_message( 'debug', routine_name // ': initialize file "' // &
    1871                                 TRIM( files(f)%name ) // '"' )
    1872 
    1873          !-- Open file
    1874          CALL open_output_file( files(f)%format, files(f)%name, files(f)%id, &
    1875                                 return_value=return_value )
    1876 
    1877          !-- Initialize file header:
    1878          !-- define dimensions and variables and write attributes
    1879          IF ( return_value == 0 )  &
    1880             CALL dom_init_file_header( files(f), return_value=return_value )
    1881 
    1882          !-- End file definition
    1883          IF ( return_value == 0 )  &
    1884             CALL dom_init_end( files(f)%format, files(f)%id, files(f)%name, return_value )
    1885 
    1886          IF ( return_value == 0 )  THEN
    1887 
    1888             !-- Flag file as initialized
    1889             files(f)%is_init = .TRUE.
    1890 
    1891             !-- Write dimension values into file
    1892             DO  d = 1, SIZE( files(f)%dimensions )
    1893                IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) )  THEN
    1894                   ALLOCATE( values_int8(files(f)%dimensions(d)%bounds(1): &
    1895                                         files(f)%dimensions(d)%bounds(2)) )
    1896                   values_int8 = files(f)%dimensions(d)%values_int8
    1897                   values_int8_pointer => values_int8
    1898                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1899                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1900                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1901                                     var_int8_1d=values_int8_pointer )
    1902                   DEALLOCATE( values_int8 )
    1903                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int16 ) )  THEN
    1904                   ALLOCATE( values_int16(files(f)%dimensions(d)%bounds(1): &
    1905                                          files(f)%dimensions(d)%bounds(2)) )
    1906                   values_int16 = files(f)%dimensions(d)%values_int16
    1907                   values_int16_pointer => values_int16
    1908                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1909                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1910                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1911                                     var_int16_1d=values_int16_pointer )
    1912                   DEALLOCATE( values_int16 )
    1913                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int32 ) )  THEN
    1914                   ALLOCATE( values_int32(files(f)%dimensions(d)%bounds(1): &
    1915                                          files(f)%dimensions(d)%bounds(2)) )
    1916                   values_int32 = files(f)%dimensions(d)%values_int32
    1917                   values_int32_pointer => values_int32
    1918                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1919                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1920                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1921                                     var_int32_1d=values_int32_pointer )
    1922                   DEALLOCATE( values_int32 )
    1923                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_intwp ) )  THEN
    1924                   ALLOCATE( values_intwp(files(f)%dimensions(d)%bounds(1): &
    1925                                          files(f)%dimensions(d)%bounds(2)) )
    1926                   values_intwp = files(f)%dimensions(d)%values_intwp
    1927                   values_intwp_pointer => values_intwp
    1928                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1929                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1930                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1931                                     var_intwp_1d=values_intwp_pointer )
    1932                   DEALLOCATE( values_intwp )
    1933                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real32 ) )  THEN
    1934                   ALLOCATE( values_real32(files(f)%dimensions(d)%bounds(1): &
    1935                                           files(f)%dimensions(d)%bounds(2)) )
    1936                   values_real32 = files(f)%dimensions(d)%values_real32
    1937                   values_real32_pointer => values_real32
    1938                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1939                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1940                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1941                                     var_real32_1d=values_real32_pointer )
    1942                   DEALLOCATE( values_real32 )
    1943                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real64 ) )  THEN
    1944                   ALLOCATE( values_real64(files(f)%dimensions(d)%bounds(1): &
    1945                                           files(f)%dimensions(d)%bounds(2)) )
    1946                   values_real64 = files(f)%dimensions(d)%values_real64
    1947                   values_real64_pointer => values_real64
    1948                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1949                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1950                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1951                                     var_real64_1d=values_real64_pointer )
    1952                   DEALLOCATE( values_real64 )
    1953                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_realwp ) )  THEN
    1954                   ALLOCATE( values_realwp(files(f)%dimensions(d)%bounds(1): &
    1955                                           files(f)%dimensions(d)%bounds(2)) )
    1956                   values_realwp = files(f)%dimensions(d)%values_realwp
    1957                   values_realwp_pointer => values_realwp
    1958                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
    1959                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
    1960                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
    1961                                     var_realwp_1d=values_realwp_pointer )
    1962                   DEALLOCATE( values_realwp )
    1963                ENDIF
    1964                IF ( return_value /= 0 )  EXIT
    1965             ENDDO
    1966 
    1967          ENDIF
    1968 
    1969          IF ( return_value /= 0 )  EXIT
    1970 
    1971       ENDDO
    1972    ENDIF
    1973 
    1974    CALL internal_message( 'debug', routine_name // ': finished' )
    1975 
    1976 END FUNCTION dom_start_output
     2732END FUNCTION save_attribute_in_database
    19772733
    19782734!--------------------------------------------------------------------------------------------------!
     
    19862742   ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'cleanup_database'  !< name of routine
    19872743
    1988    INTEGER(iwp) ::  d             !< loop index
    1989    INTEGER(iwp) ::  f             !< loop index
    1990    INTEGER(iwp) ::  i             !< loop index
    1991    INTEGER(iwp) ::  ndim          !< number of dimensions in a file
    1992    INTEGER(iwp) ::  ndim_used     !< number of used dimensions in a file
    1993    INTEGER(iwp) ::  nf_used       !< number of used files
    1994    INTEGER(iwp) ::  nvar          !< number of variables in a file
    1995    INTEGER(iwp) ::  return_value  !< return value
    1996 
    1997    LOGICAL, DIMENSION(1:nf)           ::  file_is_used       !< true if file contains variables
    1998    LOGICAL, DIMENSION(:), ALLOCATABLE ::  dimension_is_used  !< true if dimension is used by any variable
     2744   INTEGER ::  d             !< loop index
     2745   INTEGER ::  f             !< loop index
     2746   INTEGER ::  i             !< loop index
     2747   INTEGER ::  ndims         !< number of dimensions in a file
     2748   INTEGER ::  ndims_used    !< number of used dimensions in a file
     2749   INTEGER ::  nfiles_used   !< number of used files
     2750   INTEGER ::  nvars         !< number of variables in a file
     2751   INTEGER ::  return_value  !< return value
     2752
     2753   LOGICAL, DIMENSION(1:nfiles)             ::  file_is_used       !< true if file contains variables
     2754   LOGICAL, DIMENSION(:),       ALLOCATABLE ::  dimension_is_used  !< true if dimension is used by any variable
    19992755
    20002756   TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  used_dimensions  !< list of used dimensions
     
    20072763   !-- Flag files which contain output variables as used
    20082764   file_is_used(:) = .FALSE.
    2009    DO  f = 1, nf
     2765   DO  f = 1, nfiles
    20102766      IF ( ALLOCATED( files(f)%variables ) )  THEN
    20112767         file_is_used(f) = .TRUE.
     
    20142770
    20152771   !-- Copy flagged files into temporary list
    2016    nf_used = COUNT( file_is_used )
    2017    ALLOCATE( used_files(nf_used) )
     2772   nfiles_used = COUNT( file_is_used )
     2773   ALLOCATE( used_files(nfiles_used) )
    20182774   i = 0
    2019    DO  f = 1, nf
     2775   DO  f = 1, nfiles
    20202776      IF ( file_is_used(f) )  THEN
    20212777         i = i + 1
     
    20262782   !-- Replace file list with list of used files
    20272783   DEALLOCATE( files )
    2028    nf = nf_used
    2029    ALLOCATE( files(nf) )
     2784   nfiles = nfiles_used
     2785   ALLOCATE( files(nfiles) )
    20302786   files = used_files
    20312787   DEALLOCATE( used_files )
    20322788
    20332789   !-- Check every file for unused dimensions
    2034    DO  f = 1, nf
     2790   DO  f = 1, nfiles
    20352791
    20362792      !-- If a file is already initialized, it was already checked previously
     
    20382794
    20392795      !-- Get number of defined dimensions
    2040       ndim = SIZE( files(f)%dimensions )
    2041       ALLOCATE( dimension_is_used(ndim) )
     2796      ndims = SIZE( files(f)%dimensions )
     2797      ALLOCATE( dimension_is_used(ndims) )
    20422798
    20432799      !-- Go through all variables and flag all used dimensions
    2044       nvar = SIZE( files(f)%variables )
    2045       DO  d = 1, ndim
    2046          DO  i = 1, nvar
     2800      nvars = SIZE( files(f)%variables )
     2801      DO  d = 1, ndims
     2802         DO  i = 1, nvars
    20472803            dimension_is_used(d) = &
    20482804               ANY( files(f)%dimensions(d)%name == files(f)%variables(i)%dimension_names )
     
    20522808
    20532809      !-- Copy used dimensions to temporary list
    2054       ndim_used = COUNT( dimension_is_used )
    2055       ALLOCATE( used_dimensions(ndim_used) )
     2810      ndims_used = COUNT( dimension_is_used )
     2811      ALLOCATE( used_dimensions(ndims_used) )
    20562812      i = 0
    2057       DO  d = 1, ndim
     2813      DO  d = 1, ndims
    20582814         IF ( dimension_is_used(d) )  THEN
    20592815            i = i + 1
     
    20642820      !-- Replace dimension list with list of used dimensions
    20652821      DEALLOCATE( files(f)%dimensions )
    2066       ndim = ndim_used
    2067       ALLOCATE( files(f)%dimensions(ndim) )
     2822      ndims = ndims_used
     2823      ALLOCATE( files(f)%dimensions(ndims) )
    20682824      files(f)%dimensions = used_dimensions
    20692825      DEALLOCATE( used_dimensions )
     
    20792835!> Open requested output file.
    20802836!--------------------------------------------------------------------------------------------------!
    2081 SUBROUTINE open_output_file( file_format, filename, file_id, return_value )
     2837SUBROUTINE open_output_file( file_format, file_name, file_id, return_value )
    20822838
    20832839   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
    2084    CHARACTER(LEN=*), INTENT(IN) ::  filename     !< name of file to be checked
     2840   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file to be checked
    20852841
    20862842   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'open_output_file'  !< name of routine
    20872843
    2088    INTEGER(iwp), INTENT(OUT) ::  file_id              !< file ID
    2089    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2090    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
     2844   INTEGER, INTENT(OUT) ::  file_id              !< file ID
     2845   INTEGER              ::  output_return_value  !< return value of a called output routine
     2846   INTEGER, INTENT(OUT) ::  return_value         !< return value
    20912847
    20922848
     
    20972853
    20982854      CASE ( 'binary' )
    2099          CALL binary_open_file( 'binary', filename, file_id, output_return_value )
     2855         CALL binary_open_file( 'binary', file_name, file_id, output_return_value )
    21002856
    21012857      CASE ( 'netcdf4-serial' )
    2102          CALL netcdf4_open_file( 'serial', filename, file_id, output_return_value )
     2858         CALL netcdf4_open_file( 'serial', file_name, file_id, output_return_value )
    21032859
    21042860      CASE ( 'netcdf4-parallel' )
    2105          CALL netcdf4_open_file( 'parallel', filename, file_id, output_return_value )
     2861         CALL netcdf4_open_file( 'parallel', file_name, file_id, output_return_value )
    21062862
    21072863      CASE DEFAULT
     
    21132869      return_value = output_return_value
    21142870      CALL internal_message( 'error', routine_name // &
    2115                              ': error while opening file "' // TRIM( filename ) // '"' )
     2871                             ': error while opening file "' // TRIM( file_name ) // '"' )
    21162872   ELSEIF ( return_value /= 0 )  THEN
    2117       CALL internal_message( 'error', routine_name //                              &
    2118                                       ': file "' // TRIM( filename ) //            &
    2119                                       '": file format "' // TRIM( file_format ) // &
    2120                                       '" not supported' )
     2873      CALL internal_message( 'error', routine_name //                     &
     2874                             ': file "' // TRIM( file_name ) //           &
     2875                             '": file format "' // TRIM( file_format ) // &
     2876                             '" not supported' )
    21212877   ENDIF
    21222878
     
    21262882! Description:
    21272883! ------------
    2128 !> Define attributes, dimensions and variables.
    2129 !--------------------------------------------------------------------------------------------------!
    2130 SUBROUTINE dom_init_file_header( file, return_value )
    2131 
    2132    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_init_file_header'  !< name of routine
    2133 
    2134    INTEGER(iwp)              ::  a             !< loop index
    2135    INTEGER(iwp)              ::  d             !< loop index
    2136    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     2884!> Initialize attributes, dimensions and variables in a file.
     2885!--------------------------------------------------------------------------------------------------!
     2886SUBROUTINE init_file_header( file, return_value )
     2887
     2888   ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_header'  !< name of routine
     2889
     2890   INTEGER              ::  a             !< loop index
     2891   INTEGER              ::  d             !< loop index
     2892   INTEGER, INTENT(OUT) ::  return_value  !< return value
    21372893
    21382894   TYPE(file_type), INTENT(INOUT) ::  file  !< initialize header of this file
     
    21442900   IF ( ALLOCATED( file%attributes ) )  THEN
    21452901      DO  a = 1, SIZE( file%attributes )
    2146          return_value = write_attribute( file%format, file%id, file%name, var_id=no_var_id, &
     2902         return_value = write_attribute( file%format, file%id, file%name,     &
     2903                                         variable_id=no_id, variable_name='', &
    21472904                                         attribute=file%attributes(a) )
    21482905         IF ( return_value /= 0 )  EXIT
     
    21582915
    21592916            !-- Initialize non-masked dimension
    2160             CALL init_file_dimension( file%format, file%id, file%name,     &
    2161                     file%dimensions(d)%id, file%dimensions(d)%var_id,      &
    2162                     file%dimensions(d)%name, file%dimensions(d)%data_type, &
    2163                     file%dimensions(d)%length, return_value )
     2917            CALL init_file_dimension( file%format, file%id, file%name,       &
     2918                    file%dimensions(d)%id, file%dimensions(d)%name,          &
     2919                    file%dimensions(d)%data_type, file%dimensions(d)%length, &
     2920                    file%dimensions(d)%variable_id, return_value )
    21642921
    21652922         ELSE
    21662923
    21672924            !-- Initialize masked dimension
    2168             CALL init_file_dimension( file%format, file%id, file%name,     &
    2169                     file%dimensions(d)%id, file%dimensions(d)%var_id,      &
    2170                     file%dimensions(d)%name, file%dimensions(d)%data_type, &
    2171                     file%dimensions(d)%length_mask, return_value )
     2925            CALL init_file_dimension( file%format, file%id, file%name,            &
     2926                    file%dimensions(d)%id, file%dimensions(d)%name,               &
     2927                    file%dimensions(d)%data_type, file%dimensions(d)%length_mask, &
     2928                    file%dimensions(d)%variable_id, return_value )
    21722929
    21732930         ENDIF
     
    21772934            DO  a = 1, SIZE( file%dimensions(d)%attributes )
    21782935               return_value = write_attribute( file%format, file%id, file%name, &
    2179                                  var_id=file%dimensions(d)%var_id,              &
    2180                                  var_name=file%dimensions(d)%name,              &
     2936                                 variable_id=file%dimensions(d)%variable_id,    &
     2937                                 variable_name=file%dimensions(d)%name,         &
    21812938                                 attribute=file%dimensions(d)%attributes(a) )
    21822939               IF ( return_value /= 0 )  EXIT
     
    21902947      !-- Save dimension IDs for variables wihtin database
    21912948      IF ( return_value == 0 )  &
    2192          CALL collect_dimesion_ids_for_variables( file%variables, file%dimensions, return_value )
     2949         CALL collect_dimesion_ids_for_variables( file%name, file%variables, file%dimensions, &
     2950                                                  return_value )
    21932951
    21942952      !-- Initialize file variables
     
    22052963               DO  a = 1, SIZE( file%variables(d)%attributes )
    22062964                  return_value = write_attribute( file%format, file%id, file%name, &
    2207                                     var_id=file%variables(d)%id,                   &
    2208                                     var_name=file%variables(d)%name,               &
     2965                                    variable_id=file%variables(d)%id,              &
     2966                                    variable_name=file%variables(d)%name,          &
    22092967                                    attribute=file%variables(d)%attributes(a) )
    22102968                  IF ( return_value /= 0 )  EXIT
     
    22192977   ENDIF
    22202978
    2221 END SUBROUTINE dom_init_file_header
     2979END SUBROUTINE init_file_header
     2980
     2981!--------------------------------------------------------------------------------------------------!
     2982! Description:
     2983! ------------
     2984!> Initialize dimension in file.
     2985!--------------------------------------------------------------------------------------------------!
     2986SUBROUTINE init_file_dimension( file_format, file_id, file_name,              &
     2987              dimension_id, dimension_name, dimension_type, dimension_length, &
     2988              variable_id, return_value )
     2989
     2990   CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
     2991   CHARACTER(LEN=*), INTENT(IN) ::  dimension_type  !< data type of dimension
     2992   CHARACTER(LEN=*), INTENT(IN) ::  file_format     !< file format chosen for file
     2993   CHARACTER(LEN=*), INTENT(IN) ::  file_name       !< name of file
     2994
     2995   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_dimension'  !< file format chosen for file
     2996
     2997   INTEGER, INTENT(OUT) ::  dimension_id         !< dimension ID
     2998   INTEGER, INTENT(IN)  ::  dimension_length     !< length of dimension
     2999   INTEGER, INTENT(IN)  ::  file_id              !< file ID
     3000   INTEGER              ::  output_return_value  !< return value of a called output routine
     3001   INTEGER, INTENT(OUT) ::  return_value         !< return value
     3002   INTEGER, INTENT(OUT) ::  variable_id          !< associated variable ID
     3003
     3004
     3005   return_value = 0
     3006   output_return_value = 0
     3007
     3008   temp_string = '(file "' // TRIM( file_name ) // &
     3009                 '", dimension "' // TRIM( dimension_name ) // '")'
     3010
     3011   SELECT CASE ( TRIM( file_format ) )
     3012
     3013      CASE ( 'binary' )
     3014         CALL binary_init_dimension( 'binary', file_id, dimension_id, variable_id, &
     3015                 dimension_name, dimension_type, dimension_length,                 &
     3016                 return_value=output_return_value )
     3017
     3018      CASE ( 'netcdf4-serial' )
     3019         CALL netcdf4_init_dimension( 'serial', file_id, dimension_id, variable_id, &
     3020                 dimension_name, dimension_type, dimension_length,                  &
     3021                 return_value=output_return_value )
     3022
     3023      CASE ( 'netcdf4-parallel' )
     3024         CALL netcdf4_init_dimension( 'parallel', file_id, dimension_id, variable_id, &
     3025                 dimension_name, dimension_type, dimension_length,                    &
     3026                 return_value=output_return_value )
     3027
     3028      CASE DEFAULT
     3029         return_value = 1
     3030         CALL internal_message( 'error', routine_name //                    &
     3031                                ': file format "' // TRIM( file_format ) // &
     3032                                '" not supported ' // TRIM( temp_string ) )
     3033
     3034   END SELECT
     3035
     3036   IF ( output_return_value /= 0 )  THEN
     3037      return_value = output_return_value
     3038      CALL internal_message( 'error', routine_name // &
     3039                             ': error while defining dimension ' // TRIM( temp_string ) )
     3040   ENDIF
     3041
     3042END SUBROUTINE init_file_dimension
     3043
     3044!--------------------------------------------------------------------------------------------------!
     3045! Description:
     3046! ------------
     3047!> Initialize variable.
     3048!--------------------------------------------------------------------------------------------------!
     3049SUBROUTINE init_file_variable( file_format, file_id, file_name,        &
     3050                               variable_id, variable_name, variable_type, dimension_ids, &
     3051                               is_global, return_value )
     3052
     3053   CHARACTER(LEN=*), INTENT(IN) ::  file_format    !< file format chosen for file
     3054   CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< file name
     3055   CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
     3056   CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
     3057
     3058   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_variable'  !< file format chosen for file
     3059
     3060   INTEGER, INTENT(IN)  ::  file_id              !< file ID
     3061   INTEGER              ::  output_return_value  !< return value of a called output routine
     3062   INTEGER, INTENT(OUT) ::  return_value         !< return value
     3063   INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
     3064
     3065   INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
     3066
     3067   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global
     3068
     3069
     3070   return_value = 0
     3071   output_return_value = 0
     3072
     3073   temp_string = '(file "' // TRIM( file_name ) // &
     3074                 '", variable "' // TRIM( variable_name ) // '")'
     3075
     3076   SELECT CASE ( TRIM( file_format ) )
     3077
     3078      CASE ( 'binary' )
     3079         CALL binary_init_variable( 'binary', file_id, variable_id, variable_name, &
     3080                 variable_type, dimension_ids, is_global, return_value=output_return_value )
     3081
     3082      CASE ( 'netcdf4-serial' )
     3083         CALL netcdf4_init_variable( 'serial', file_id, variable_id, variable_name, &
     3084                 variable_type, dimension_ids, is_global, return_value=output_return_value )
     3085
     3086      CASE ( 'netcdf4-parallel' )
     3087         CALL netcdf4_init_variable( 'parallel', file_id, variable_id, variable_name, &
     3088                 variable_type, dimension_ids, is_global, return_value=output_return_value )
     3089
     3090      CASE DEFAULT
     3091         return_value = 1
     3092         CALL internal_message( 'error', routine_name //                    &
     3093                                ': file format "' // TRIM( file_format ) // &
     3094                                '" not supported ' // TRIM( temp_string ) )
     3095
     3096   END SELECT
     3097
     3098   IF ( output_return_value /= 0 )  THEN
     3099      return_value = output_return_value
     3100      CALL internal_message( 'error', routine_name // &
     3101                             ': error while defining variable ' // TRIM( temp_string ) )
     3102   ENDIF
     3103
     3104END SUBROUTINE init_file_variable
    22223105
    22233106!--------------------------------------------------------------------------------------------------!
     
    22263109!> Write attribute to file.
    22273110!--------------------------------------------------------------------------------------------------!
    2228 FUNCTION write_attribute( file_format, file_id, file_name, var_id, var_name, attribute ) RESULT( return_value )
    2229 
    2230    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
    2231    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    2232    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  var_name     !< variable name
     3111FUNCTION write_attribute( file_format, file_id, file_name,        &
     3112                          variable_id, variable_name, attribute ) RESULT( return_value )
     3113
     3114   CHARACTER(LEN=*), INTENT(IN) ::  file_format    !< file format chosen for file
     3115   CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< file name
     3116   CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< variable name
    22333117
    22343118   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'write_attribute'  !< file format chosen for file
    22353119
    2236    INTEGER(iwp), INTENT(IN) ::  file_id              !< file ID
    2237    INTEGER(iwp)             ::  return_value         !< return value
    2238    INTEGER(iwp)             ::  output_return_value  !< return value of a called output routine
    2239    INTEGER(iwp), INTENT(IN) ::  var_id               !< variable ID
     3120   INTEGER, INTENT(IN) ::  file_id              !< file ID
     3121   INTEGER             ::  return_value         !< return value
     3122   INTEGER             ::  output_return_value  !< return value of a called output routine
     3123   INTEGER, INTENT(IN) ::  variable_id          !< variable ID
    22403124
    22413125   TYPE(attribute_type), INTENT(IN) ::  attribute  !< attribute to be written
     
    22463130
    22473131   !-- Prepare for possible error message
    2248    IF ( PRESENT( var_name ) )  THEN
    2249       temp_string = '(file "' // TRIM( file_name ) //      &
    2250                     '", variable "' // TRIM( var_name ) // &
    2251                     '", attribute "' // TRIM( attribute%name ) // '")'
    2252    ELSE
    2253       temp_string = '(file "' // TRIM( file_name ) // &
    2254                     '", attribute "' // TRIM( attribute%name ) // '")'
    2255    ENDIF
     3132   temp_string = '(file "' // TRIM( file_name ) //           &
     3133                 '", variable "' // TRIM( variable_name ) // &
     3134                 '", attribute "' // TRIM( attribute%name ) // '")'
    22563135
    22573136   !-- Write attribute to file
     
    22633142
    22643143            CASE( 'char' )
    2265                CALL binary_write_attribute( file_id=file_id, var_id=var_id,          &
    2266                        att_name=attribute%name, att_value_char=attribute%value_char, &
     3144               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,  &
     3145                       attribute_name=attribute%name, value_char=attribute%value_char, &
    22673146                       return_value=output_return_value )
    22683147
    22693148            CASE( 'int8' )
    2270                CALL binary_write_attribute( file_id=file_id, var_id=var_id,          &
    2271                        att_name=attribute%name, att_value_int8=attribute%value_int8, &
     3149               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,  &
     3150                       attribute_name=attribute%name, value_int8=attribute%value_int8, &
    22723151                       return_value=output_return_value )
    22733152
    22743153            CASE( 'int16' )
    2275                CALL binary_write_attribute( file_id=file_id, var_id=var_id,            &
    2276                        att_name=attribute%name, att_value_int16=attribute%value_int16, &
     3154               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,    &
     3155                       attribute_name=attribute%name, value_int16=attribute%value_int16, &
    22773156                       return_value=output_return_value )
    22783157
    22793158            CASE( 'int32' )
    2280                CALL binary_write_attribute( file_id=file_id, var_id=var_id,            &
    2281                        att_name=attribute%name, att_value_int32=attribute%value_int32, &
     3159               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,    &
     3160                       attribute_name=attribute%name, value_int32=attribute%value_int32, &
    22823161                       return_value=output_return_value )
    22833162
    22843163            CASE( 'real32' )
    2285                CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    2286                        att_name=attribute%name, att_value_real32=attribute%value_real32, &
     3164               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,      &
     3165                       attribute_name=attribute%name, value_real32=attribute%value_real32, &
    22873166                       return_value=output_return_value )
    22883167
    22893168            CASE( 'real64' )
    2290                CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    2291                        att_name=attribute%name, att_value_real64=attribute%value_real64, &
     3169               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,      &
     3170                       attribute_name=attribute%name, value_real64=attribute%value_real64, &
    22923171                       return_value=output_return_value )
    22933172
     
    23073186
    23083187            CASE( 'char' )
    2309                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id, &
    2310                        att_name=attribute%name, att_value_char=attribute%value_char, &
     3188               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
     3189                       attribute_name=attribute%name, value_char=attribute%value_char, &
    23113190                       return_value=output_return_value )
    23123191
    23133192            CASE( 'int8' )
    2314                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id, &
    2315                        att_name=attribute%name, att_value_int8=attribute%value_int8, &
     3193               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
     3194                       attribute_name=attribute%name, value_int8=attribute%value_int8, &
    23163195                       return_value=output_return_value )
    23173196
    23183197            CASE( 'int16' )
    2319                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    2320                        att_name=attribute%name, att_value_int16=attribute%value_int16, &
     3198               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,   &
     3199                       attribute_name=attribute%name, value_int16=attribute%value_int16, &
    23213200                       return_value=output_return_value )
    23223201
    23233202            CASE( 'int32' )
    2324                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    2325                        att_name=attribute%name, att_value_int32=attribute%value_int32, &
     3203               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,   &
     3204                       attribute_name=attribute%name, value_int32=attribute%value_int32, &
    23263205                       return_value=output_return_value )
    23273206
    23283207            CASE( 'real32' )
    2329                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    2330                        att_name=attribute%name, att_value_real32=attribute%value_real32, &
     3208               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,     &
     3209                       attribute_name=attribute%name, value_real32=attribute%value_real32, &
    23313210                       return_value=output_return_value )
    23323211
    23333212            CASE( 'real64' )
    2334                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    2335                        att_name=attribute%name, att_value_real64=attribute%value_real64, &
     3213               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,     &
     3214                       attribute_name=attribute%name, value_real64=attribute%value_real64, &
    23363215                       return_value=output_return_value )
    23373216
     
    23483227      CASE DEFAULT
    23493228         return_value = 1
    2350          CALL internal_message( 'error',        &
    2351                                 routine_name // &
     3229         CALL internal_message( 'error', routine_name //                                &
    23523230                                ': unsupported file format "' // TRIM( file_format ) // &
    23533231                                '" ' // TRIM( temp_string ) )
    2354 
    2355    END SELECT
    2356 
    2357    IF ( output_return_value /= 0 )  THEN
    2358       return_value = output_return_value
    2359       CALL internal_message( 'error',        &
    2360                              routine_name // &
    2361                              ': error while writing attribute ' // TRIM( temp_string ) )
    2362    ENDIF
    2363 
    2364 END FUNCTION write_attribute
    2365 
    2366 !--------------------------------------------------------------------------------------------------!
    2367 ! Description:
    2368 ! ------------
    2369 !> Initialize dimension in file.
    2370 !--------------------------------------------------------------------------------------------------!
    2371 SUBROUTINE init_file_dimension( file_format, file_id, file_name, dim_id, var_id, &
    2372                                 dim_name, dim_type, dim_length, return_value )
    2373 
    2374    CHARACTER(LEN=*), INTENT(IN) ::  dim_name     !< name of dimension
    2375    CHARACTER(LEN=*), INTENT(IN) ::  dim_type     !< data type of dimension
    2376    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
    2377    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file
    2378 
    2379    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_dimension'  !< file format chosen for file
    2380 
    2381    INTEGER(iwp), INTENT(OUT) ::  dim_id               !< dimension ID
    2382    INTEGER(iwp), INTENT(IN)  ::  dim_length           !< length of dimension
    2383    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
    2384    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2385    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2386    INTEGER(iwp), INTENT(OUT) ::  var_id               !< associated variable ID
    2387 
    2388 
    2389    return_value = 0
    2390    output_return_value = 0
    2391 
    2392    temp_string = '(file "' // TRIM( file_name ) // &
    2393                  '", dimension "' // TRIM( dim_name ) // '")'
    2394 
    2395    SELECT CASE ( TRIM( file_format ) )
    2396 
    2397       CASE ( 'binary' )
    2398          CALL binary_init_dimension( 'binary', file_id, dim_id, var_id, &
    2399                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2400 
    2401       CASE ( 'netcdf4-serial' )
    2402          CALL netcdf4_init_dimension( 'serial', file_id, dim_id, var_id, &
    2403                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2404 
    2405       CASE ( 'netcdf4-parallel' )
    2406          CALL netcdf4_init_dimension( 'parallel', file_id, dim_id, var_id, &
    2407                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2408 
    2409       CASE DEFAULT
    2410          return_value = 1
    2411          CALL internal_message( 'error', routine_name //                    &
    2412                                 ': file format "' // TRIM( file_format ) // &
    2413                                 '" not supported ' // TRIM( temp_string ) )
    24143232
    24153233   END SELECT
     
    24183236      return_value = output_return_value
    24193237      CALL internal_message( 'error', routine_name // &
    2420                              ': error while defining dimension ' // TRIM( temp_string ) )
     3238                             ': error while writing attribute ' // TRIM( temp_string ) )
    24213239   ENDIF
    24223240
    2423 END SUBROUTINE init_file_dimension
     3241END FUNCTION write_attribute
    24243242
    24253243!--------------------------------------------------------------------------------------------------!
     
    24283246!> Get dimension IDs and save them to variables.
    24293247!--------------------------------------------------------------------------------------------------!
    2430 SUBROUTINE collect_dimesion_ids_for_variables( variables, dimensions, return_value )
     3248SUBROUTINE collect_dimesion_ids_for_variables( file_name, variables, dimensions, return_value )
     3249
     3250   CHARACTER(LEN=*), INTENT(IN) ::  file_name !< name of file
    24313251
    24323252   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'collect_dimesion_ids_for_variables'  !< file format chosen for file
    24333253
    2434    INTEGER(iwp) ::  d             !< loop index
    2435    INTEGER(iwp) ::  i             !< loop index
    2436    INTEGER(iwp) ::  j             !< loop index
    2437    INTEGER(iwp) ::  ndim          !< number of dimensions
    2438    INTEGER(iwp) ::  nvar          !< number of variables
    2439    INTEGER(iwp) ::  return_value  !< return value
     3254   INTEGER              ::  d             !< loop index
     3255   INTEGER              ::  i             !< loop index
     3256   INTEGER              ::  j             !< loop index
     3257   INTEGER              ::  ndims         !< number of dimensions
     3258   INTEGER              ::  nvars         !< number of variables
     3259   INTEGER, INTENT(OUT) ::  return_value  !< return value
    24403260
    24413261   LOGICAL ::  found  !< true if dimension required by variable was found in dimension list
     
    24473267
    24483268   return_value  = 0
    2449    ndim = SIZE( dimensions )
    2450    nvar = SIZE( variables )
    2451 
    2452    DO  i = 1, nvar
     3269   ndims = SIZE( dimensions )
     3270   nvars = SIZE( variables )
     3271
     3272   DO  i = 1, nvars
    24533273      DO  j = 1, SIZE( variables(i)%dimension_names )
    24543274         found = .FALSE.
    2455          DO  d = 1, ndim
     3275         DO  d = 1, ndims
    24563276            IF ( variables(i)%dimension_names(j) == dimensions(d)%name )  THEN
    24573277               variables(i)%dimension_ids(j) = dimensions(d)%id
     
    24623282         IF ( .NOT. found )  THEN
    24633283            return_value = 1
    2464             CALL internal_message( 'error',                                                 &
    2465                     routine_name // ': variable "' // TRIM( variables(i)%name ) //          &
    2466                     '": required dimension "' // TRIM( variables(i)%dimension_names(j) ) // &
    2467                     '" is undefined' )
     3284            CALL internal_message( 'error', routine_name //                                &
     3285                    ': required dimension "' // TRIM( variables(i)%dimension_names(j) ) // &
     3286                    '" is undefined (variable "' // TRIM( variables(i)%name ) //          &
     3287                    '", file "' // TRIM( file_name ) // '")!' )
    24683288            EXIT
    24693289         ENDIF
     
    24773297! Description:
    24783298! ------------
    2479 !> Initialize variable.
    2480 !--------------------------------------------------------------------------------------------------!
    2481 SUBROUTINE init_file_variable( file_format, file_id, file_name,        &
    2482                                var_id, var_name, var_type, var_dim_id, &
    2483                                is_global, return_value )
    2484 
    2485    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
     3299!> Leave file definition/initialization.
     3300!>
     3301!> @todo Do we need an MPI barrier at the end?
     3302!--------------------------------------------------------------------------------------------------!
     3303SUBROUTINE stop_file_header_definition( file_format, file_id, file_name, return_value )
     3304
     3305   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
    24863306   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    2487    CHARACTER(LEN=*), INTENT(IN) ::  var_name     !< name of variable
    2488    CHARACTER(LEN=*), INTENT(IN) ::  var_type     !< data type of variable
    2489 
    2490    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_variable'  !< file format chosen for file
    2491 
    2492    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
    2493    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2494    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2495    INTEGER(iwp), INTENT(OUT) ::  var_id               !< variable ID
    2496 
    2497    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_id  !< list of dimension IDs used by variable
    2498 
    2499    LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global
     3307
     3308   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'stop_file_header_definition'  !< name of routine
     3309
     3310   INTEGER, INTENT(IN)  ::  file_id              !< file id
     3311   INTEGER              ::  output_return_value  !< return value of a called output routine
     3312   INTEGER, INTENT(OUT) ::  return_value         !< return value
    25003313
    25013314
     
    25033316   output_return_value = 0
    25043317
    2505    temp_string = '(file "' // TRIM( file_name ) // &
    2506                  '", variable "' // TRIM( var_name ) // '")'
     3318   temp_string = '(file "' // TRIM( file_name ) // '")'
    25073319
    25083320   SELECT CASE ( TRIM( file_format ) )
    25093321
    25103322      CASE ( 'binary' )
    2511          CALL binary_init_variable( 'binary', file_id, var_id, var_name, var_type, &
    2512                                     var_dim_id, is_global, return_value=output_return_value )
    2513 
    2514       CASE ( 'netcdf4-serial' )
    2515          CALL netcdf4_init_variable( 'serial', file_id, var_id, var_name, var_type, &
    2516                                      var_dim_id, is_global, return_value=output_return_value )
    2517 
    2518       CASE ( 'netcdf4-parallel' )
    2519          CALL netcdf4_init_variable( 'parallel', file_id, var_id, var_name, var_type, &
    2520                                      var_dim_id, is_global, return_value=output_return_value )
     3323         CALL binary_stop_file_header_definition( file_id, output_return_value )
     3324
     3325      CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     3326         CALL netcdf4_stop_file_header_definition( file_id, output_return_value )
    25213327
    25223328      CASE DEFAULT
     
    25303336   IF ( output_return_value /= 0 )  THEN
    25313337      return_value = output_return_value
    2532       CALL internal_message( 'error', routine_name // &
    2533                              ': error while defining variable ' // TRIM( temp_string ) )
    2534    ENDIF
    2535 
    2536 END SUBROUTINE init_file_variable
    2537 
    2538 !--------------------------------------------------------------------------------------------------!
    2539 ! Description:
    2540 ! ------------
    2541 !> Finalize file definition/initialization.
    2542 !>
    2543 !> @todo Do we need an MPI barrier at the end?
    2544 !--------------------------------------------------------------------------------------------------!
    2545 SUBROUTINE dom_init_end( file_format, file_id, file_name, return_value )
    2546 
    2547    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
    2548    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    2549 
    2550    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_init_end'  !< name of routine
    2551 
    2552    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file id
    2553    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2554    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2555 
    2556 
    2557    return_value = 0
    2558    output_return_value = 0
    2559 
    2560    temp_string = '(file "' // TRIM( file_name ) // '")'
    2561 
    2562    SELECT CASE ( TRIM( file_format ) )
    2563 
    2564       CASE ( 'binary' )
    2565          CALL binary_init_end( file_id, output_return_value )
    2566 
    2567       CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    2568          CALL netcdf4_init_end( file_id, output_return_value )
    2569 
    2570       CASE DEFAULT
    2571          return_value = 1
    2572          CALL internal_message( 'error', routine_name //                    &
    2573                                 ': file format "' // TRIM( file_format ) // &
    2574                                 '" not supported ' // TRIM( temp_string ) )
    2575 
    2576    END SELECT
    2577 
    2578    IF ( output_return_value /= 0 )  THEN
    2579       return_value = output_return_value
    2580       CALL internal_message( 'error', routine_name // &
     3338      CALL internal_message( 'error', routine_name //                          &
    25813339                             ': error while leaving file-definition state ' // &
    25823340                             TRIM( temp_string ) )
     
    25853343   ! CALL MPI_Barrier( MPI_COMM_WORLD, return_value )
    25863344
    2587 END SUBROUTINE dom_init_end
     3345END SUBROUTINE stop_file_header_definition
    25883346
    25893347!--------------------------------------------------------------------------------------------------!
    25903348! Description:
    25913349! ------------
    2592 !> Write variable to file.
    2593 !> Example call:
    2594 !>   dom_write_var( file_format = 'binary', &
    2595 !>                  filename = 'DATA_OUTPUT_3D', &
    2596 !>                  name = 'u', &
    2597 !>                  var_real64_3d = u, &
    2598 !>                  bounds_start = (/nxl, nys, nzb, time_step/), &
    2599 !>                  bounds_end = (/nxr, nyn, nzt, time_step/)  )
    2600 !> @note The order of dimension bounds must match to the order of dimensions given in call
    2601 !>       'dom_def_var'. I.e., the corresponding variable definition should be like:
    2602 !>          dom_def_var( filename =  'DATA_OUTPUT_3D', &
    2603 !>                       name = 'u', &
    2604 !>                       dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
    2605 !>                       output_type = <desired-output-type> )
    2606 !--------------------------------------------------------------------------------------------------!
    2607 FUNCTION dom_write_var( filename, name, bounds_start, bounds_end,       &
    2608             var_int8_0d,   var_int8_1d,   var_int8_2d,   var_int8_3d,   &
    2609             var_int16_0d,  var_int16_1d,  var_int16_2d,  var_int16_3d,  &
    2610             var_int32_0d,  var_int32_1d,  var_int32_2d,  var_int32_3d,  &
    2611             var_intwp_0d,  var_intwp_1d,  var_intwp_2d,  var_intwp_3d,  &
    2612             var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
    2613             var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
    2614             var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d  &
    2615             ) RESULT( return_value )
    2616 
    2617    CHARACTER(LEN=charlen)       ::  file_format  !< file format chosen for file
    2618    CHARACTER(LEN=*), INTENT(IN) ::  filename     !< name of file
    2619    CHARACTER(LEN=*), INTENT(IN) ::  name         !< name of variable
    2620 
    2621    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
    2622 
    2623    INTEGER(iwp) ::  file_id              !< file ID
    2624    INTEGER(iwp) ::  i                    !< loop index
    2625    INTEGER(iwp) ::  j                    !< loop index
    2626    INTEGER(iwp) ::  k                    !< loop index
    2627    INTEGER(iwp) ::  output_return_value  !< return value of a called output routine
    2628    INTEGER(iwp) ::  return_value         !< return value
    2629    INTEGER(iwp) ::  var_id               !< variable ID
    2630 
    2631    INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_end             !< end index per dimension of variable
    2632    INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_start           !< start index per dimension of variable
    2633    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_origin          !< first index of each dimension
    2634    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_start_internal  !< start index per dim. for output after masking
    2635    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  value_counts           !< count of indices to be written per dimension
    2636    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  masked_indices         !< list containing all output indices along a dimension
    2637 
    2638    LOGICAL ::  do_output  !< true if any data lies within given range of masked dimension
    2639    LOGICAL ::  is_global  !< true if variable is global
    2640 
    2641    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                   ::  var_int8_0d  !< output variable
    2642    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int8_1d  !< output variable
    2643    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int8_2d  !< output variable
    2644    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int8_3d  !< output variable
    2645 
    2646    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int8_1d_resorted  !< resorted output variable
    2647    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int8_2d_resorted  !< resorted output variable
    2648    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int8_3d_resorted  !< resorted output variable
    2649 
    2650    INTEGER(KIND=1), POINTER                               ::  var_int8_0d_pointer  !< output variable
    2651    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int8_1d_pointer  !< output variable
    2652    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int8_2d_pointer  !< output variable
    2653    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int8_3d_pointer  !< output variable
    2654 
    2655    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                   ::  var_int16_0d  !< output variable
    2656    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int16_1d  !< output variable
    2657    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int16_2d  !< output variable
    2658    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int16_3d  !< output variable
    2659 
    2660    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int16_1d_resorted  !< resorted output variable
    2661    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int16_2d_resorted  !< resorted output variable
    2662    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int16_3d_resorted  !< resorted output variable
    2663 
    2664    INTEGER(KIND=2), POINTER                               ::  var_int16_0d_pointer  !< output variable
    2665    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int16_1d_pointer  !< output variable
    2666    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int16_2d_pointer  !< output variable
    2667    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int16_3d_pointer  !< output variable
    2668 
    2669    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  var_int32_0d  !< output variable
    2670    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int32_1d  !< output variable
    2671    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int32_2d  !< output variable
    2672    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int32_3d  !< output variable
    2673 
    2674    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int32_1d_resorted  !< resorted output variable
    2675    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int32_2d_resorted  !< resorted output variable
    2676    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int32_3d_resorted  !< resorted output variable
    2677 
    2678    INTEGER(KIND=4), POINTER                               ::  var_int32_0d_pointer  !< output variable
    2679    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int32_1d_pointer  !< output variable
    2680    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int32_2d_pointer  !< output variable
    2681    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int32_3d_pointer  !< output variable
    2682 
    2683    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL                   ::  var_intwp_0d  !< output variable
    2684    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_intwp_1d  !< output variable
    2685    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_intwp_2d  !< output variable
    2686    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_intwp_3d  !< output variable
    2687 
    2688    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_intwp_1d_resorted  !< resorted output variable
    2689    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_intwp_2d_resorted  !< resorted output variable
    2690    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_intwp_3d_resorted  !< resorted output variable
    2691 
    2692    INTEGER(iwp), POINTER                               ::  var_intwp_0d_pointer  !< output variable
    2693    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_intwp_1d_pointer  !< output variable
    2694    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_intwp_2d_pointer  !< output variable
    2695    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_intwp_3d_pointer  !< output variable
    2696 
    2697    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  var_real32_0d  !< output variable
    2698    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real32_1d  !< output variable
    2699    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real32_2d  !< output variable
    2700    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real32_3d  !< output variable
    2701 
    2702    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_real32_1d_resorted  !< resorted output variable
    2703    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_real32_2d_resorted  !< resorted output variable
    2704    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_real32_3d_resorted  !< resorted output variable
    2705 
    2706    REAL(KIND=4), POINTER                               ::  var_real32_0d_pointer  !< output variable
    2707    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_real32_1d_pointer  !< output variable
    2708    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_real32_2d_pointer  !< output variable
    2709    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_real32_3d_pointer  !< output variable
    2710 
    2711    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                   ::  var_real64_0d  !< output variable
    2712    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real64_1d  !< output variable
    2713    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real64_2d  !< output variable
    2714    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real64_3d  !< output variable
    2715 
    2716    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_real64_1d_resorted  !< resorted output variable
    2717    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_real64_2d_resorted  !< resorted output variable
    2718    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_real64_3d_resorted  !< resorted output variable
    2719 
    2720    REAL(KIND=8), POINTER                               ::  var_real64_0d_pointer  !< output variable
    2721    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_real64_1d_pointer  !< output variable
    2722    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_real64_2d_pointer  !< output variable
    2723    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_real64_3d_pointer  !< output variable
    2724 
    2725    REAL(wp), POINTER, INTENT(IN), OPTIONAL                   ::  var_realwp_0d  !< output variable
    2726    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_realwp_1d  !< output variable
    2727    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_realwp_2d  !< output variable
    2728    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_realwp_3d  !< output variable
    2729 
    2730    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_realwp_1d_resorted  !< resorted output variable
    2731    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_realwp_2d_resorted  !< resorted output variable
    2732    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_realwp_3d_resorted  !< resorted output variable
    2733 
    2734    REAL(wp), POINTER                               ::  var_realwp_0d_pointer  !< output variable
    2735    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_realwp_1d_pointer  !< output variable
    2736    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_realwp_2d_pointer  !< output variable
    2737    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_realwp_3d_pointer  !< output variable
    2738 
    2739    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimension_list  !< list of used dimensions of variable
    2740 
    2741 
    2742    return_value = 0
    2743    output_return_value = 0
    2744 
    2745    CALL internal_message( 'debug', routine_name // ': write ' // TRIM( name ) // &
    2746                                    ' into file ' // TRIM( filename ) )
    2747 
    2748    !-- Search for variable within file
    2749    CALL find_var_in_file( filename, name, file_format, file_id, var_id, &
    2750                       is_global, dimension_list, return_value=return_value  )
    2751 
    2752    IF ( return_value == 0 )  THEN
    2753 
    2754       !-- Check if the correct amount of variable bounds were given
    2755       IF ( SIZE( bounds_start ) /= SIZE( dimension_list )  .OR.  &
    2756            SIZE( bounds_end ) /= SIZE( dimension_list ) )  THEN
    2757          return_value = 1
    2758          CALL internal_message( 'error', routine_name //             &
    2759                                 ': variable "' // TRIM( name ) //    &
    2760                                 '" in file "' // TRIM( filename ) // &
    2761                                 '": given bounds do not match with number of dimensions' )
    2762       ENDIF
    2763 
    2764    ENDIF
    2765 
    2766 
    2767    IF ( return_value == 0 )  THEN
    2768 
    2769       !-- Save starting index (lower bounds) of each dimension
    2770       ALLOCATE( bounds_origin(SIZE( dimension_list )) )
    2771       ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
    2772       ALLOCATE( value_counts(SIZE( dimension_list )) )
    2773 
    2774       WRITE( temp_string, * ) bounds_start
    2775       CALL internal_message( 'debug', routine_name //                     &
    2776                                       ': file "' // TRIM( filename ) //   &
    2777                                        '": variable "' // TRIM( name ) // &
    2778                                        '": bounds_start =' // TRIM( temp_string ) )
    2779       WRITE( temp_string, * ) bounds_end
    2780       CALL internal_message( 'debug', routine_name //                     &
    2781                                       ': file "' // TRIM( filename ) //   &
    2782                                        '": variable "' // TRIM( name ) // &
    2783                                        '": bounds_end =' // TRIM( temp_string ) )
    2784 
    2785       !-- Get bounds for masking
    2786       CALL get_masked_indices_and_masked_dimension_bounds( dimension_list,                  &
    2787               bounds_start, bounds_end, bounds_start_internal, value_counts, bounds_origin, &
    2788               masked_indices )
    2789 
    2790       do_output = .NOT. ANY( value_counts == 0 )
    2791 
    2792       WRITE( temp_string, * ) bounds_start_internal
    2793       CALL internal_message( 'debug', routine_name //                     &
    2794                                       ': file "' // TRIM( filename ) //   &
    2795                                        '": variable "' // TRIM( name ) // &
    2796                                        '": bounds_start_internal =' // TRIM( temp_string ) )
    2797       WRITE( temp_string, * ) value_counts
    2798       CALL internal_message( 'debug', routine_name //                     &
    2799                                       ': file "' // TRIM( filename ) //   &
    2800                                        '": variable "' // TRIM( name ) // &
    2801                                        '": value_counts =' // TRIM( temp_string ) )
    2802 
    2803       !-- Mask and resort variable
    2804       !-- 8bit integer output
    2805       IF ( PRESENT( var_int8_0d ) )  THEN
    2806          var_int8_0d_pointer => var_int8_0d
    2807       ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    2808          IF ( do_output ) THEN
    2809             ALLOCATE( var_int8_1d_resorted(0:value_counts(1)-1) )
    2810             !$OMP PARALLEL PRIVATE (i)
    2811             !$OMP DO
    2812             DO  i = 0, value_counts(1) - 1
    2813                var_int8_1d_resorted(i) = var_int8_1d(masked_indices(1,i))
    2814             ENDDO
    2815             !$OMP END PARALLEL
    2816          ELSE
    2817             ALLOCATE( var_int8_1d_resorted(1) )
    2818             var_int8_1d_resorted = 0_1
    2819          ENDIF
    2820          var_int8_1d_pointer => var_int8_1d_resorted
    2821       ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    2822          IF ( do_output ) THEN
    2823             ALLOCATE( var_int8_2d_resorted(0:value_counts(1)-1, &
    2824                                            0:value_counts(2)-1) )
    2825             !$OMP PARALLEL PRIVATE (i,j)
    2826             !$OMP DO
    2827             DO  i = 0, value_counts(1) - 1
    2828                DO  j = 0, value_counts(2) - 1
    2829                   var_int8_2d_resorted(i,j) = var_int8_2d(masked_indices(2,j), &
    2830                                                           masked_indices(1,i)  )
    2831                ENDDO
    2832             ENDDO
    2833             !$OMP END PARALLEL
    2834          ELSE
    2835             ALLOCATE( var_int8_2d_resorted(1,1) )
    2836             var_int8_2d_resorted = 0_1
    2837          ENDIF
    2838          var_int8_2d_pointer => var_int8_2d_resorted
    2839       ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    2840          IF ( do_output ) THEN
    2841             ALLOCATE( var_int8_3d_resorted(0:value_counts(1)-1, &
    2842                                            0:value_counts(2)-1, &
    2843                                            0:value_counts(3)-1) )
    2844             !$OMP PARALLEL PRIVATE (i,j,k)
    2845             !$OMP DO
    2846             DO  i = 0, value_counts(1) - 1
    2847                DO  j = 0, value_counts(2) - 1
    2848                   DO  k = 0, value_counts(3) - 1
    2849                      var_int8_3d_resorted(i,j,k) = var_int8_3d(masked_indices(3,k), &
    2850                                                                masked_indices(2,j), &
    2851                                                                masked_indices(1,i)  )
    2852                   ENDDO
    2853                ENDDO
    2854             ENDDO
    2855             !$OMP END PARALLEL
    2856          ELSE
    2857             ALLOCATE( var_int8_3d_resorted(1,1,1) )
    2858             var_int8_3d_resorted = 0_1
    2859          ENDIF
    2860          var_int8_3d_pointer => var_int8_3d_resorted
    2861 
    2862       !-- 16bit integer output
    2863       ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    2864          var_int16_0d_pointer => var_int16_0d
    2865       ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    2866          IF ( do_output ) THEN
    2867             ALLOCATE( var_int16_1d_resorted(0:value_counts(1)-1) )
    2868             !$OMP PARALLEL PRIVATE (i)
    2869             !$OMP DO
    2870             DO  i = 0, value_counts(1) - 1
    2871                var_int16_1d_resorted(i) = var_int16_1d(masked_indices(1,i))
    2872             ENDDO
    2873             !$OMP END PARALLEL
    2874          ELSE
    2875             ALLOCATE( var_int16_1d_resorted(1) )
    2876             var_int16_1d_resorted = 0_1
    2877          ENDIF
    2878          var_int16_1d_pointer => var_int16_1d_resorted
    2879       ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    2880          IF ( do_output ) THEN
    2881             ALLOCATE( var_int16_2d_resorted(0:value_counts(1)-1, &
    2882                                             0:value_counts(2)-1) )
    2883             !$OMP PARALLEL PRIVATE (i,j)
    2884             !$OMP DO
    2885             DO  i = 0, value_counts(1) - 1
    2886                DO  j = 0, value_counts(2) - 1
    2887                   var_int16_2d_resorted(i,j) = var_int16_2d(masked_indices(2,j), &
    2888                                                             masked_indices(1,i))
    2889                ENDDO
    2890             ENDDO
    2891             !$OMP END PARALLEL
    2892          ELSE
    2893             ALLOCATE( var_int16_2d_resorted(1,1) )
    2894             var_int16_2d_resorted = 0_1
    2895          ENDIF
    2896          var_int16_2d_pointer => var_int16_2d_resorted
    2897       ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    2898          IF ( do_output ) THEN
    2899             ALLOCATE( var_int16_3d_resorted(0:value_counts(1)-1, &
    2900                                             0:value_counts(2)-1, &
    2901                                             0:value_counts(3)-1) )
    2902             !$OMP PARALLEL PRIVATE (i,j,k)
    2903             !$OMP DO
    2904             DO  i = 0, value_counts(1) - 1
    2905                DO  j = 0, value_counts(2) - 1
    2906                   DO  k = 0, value_counts(3) - 1
    2907                      var_int16_3d_resorted(i,j,k) = var_int16_3d(masked_indices(3,k), &
    2908                                                                  masked_indices(2,j), &
    2909                                                                  masked_indices(1,i)  )
    2910                   ENDDO
    2911                ENDDO
    2912             ENDDO
    2913             !$OMP END PARALLEL
    2914          ELSE
    2915             ALLOCATE( var_int16_3d_resorted(1,1,1) )
    2916             var_int16_3d_resorted = 0_1
    2917          ENDIF
    2918          var_int16_3d_pointer => var_int16_3d_resorted
    2919 
    2920       !-- 32bit integer output
    2921       ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    2922          var_int32_0d_pointer => var_int32_0d
    2923       ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    2924          IF ( do_output ) THEN
    2925             ALLOCATE( var_int32_1d_resorted(0:value_counts(1)-1) )
    2926             !$OMP PARALLEL PRIVATE (i)
    2927             !$OMP DO
    2928             DO  i = 0, value_counts(1) - 1
    2929                var_int32_1d_resorted(i) = var_int32_1d(masked_indices(1,i))
    2930             ENDDO
    2931             !$OMP END PARALLEL
    2932          ELSE
    2933             ALLOCATE( var_int32_1d_resorted(1) )
    2934             var_int32_1d_resorted = 0_1
    2935          ENDIF
    2936          var_int32_1d_pointer => var_int32_1d_resorted
    2937       ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    2938          IF ( do_output ) THEN
    2939             ALLOCATE( var_int32_2d_resorted(0:value_counts(1)-1, &
    2940                                             0:value_counts(2)-1) )
    2941             !$OMP PARALLEL PRIVATE (i,j)
    2942             !$OMP DO
    2943             DO  i = 0, value_counts(1) - 1
    2944                DO  j = 0, value_counts(2) - 1
    2945                   var_int32_2d_resorted(i,j) = var_int32_2d(masked_indices(2,j), &
    2946                                                             masked_indices(1,i)  )
    2947                ENDDO
    2948             ENDDO
    2949             !$OMP END PARALLEL
    2950          ELSE
    2951             ALLOCATE( var_int32_2d_resorted(1,1) )
    2952             var_int32_2d_resorted = 0_1
    2953          ENDIF
    2954          var_int32_2d_pointer => var_int32_2d_resorted
    2955       ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    2956          IF ( do_output ) THEN
    2957             ALLOCATE( var_int32_3d_resorted(0:value_counts(1)-1, &
    2958                                             0:value_counts(2)-1, &
    2959                                             0:value_counts(3)-1) )
    2960             !$OMP PARALLEL PRIVATE (i,j,k)
    2961             !$OMP DO
    2962             DO  i = 0, value_counts(1) - 1
    2963                DO  j = 0, value_counts(2) - 1
    2964                   DO  k = 0, value_counts(3) - 1
    2965                      var_int32_3d_resorted(i,j,k) = var_int32_3d(masked_indices(3,k), &
    2966                                                                  masked_indices(2,j), &
    2967                                                                  masked_indices(1,i)  )
    2968                   ENDDO
    2969                ENDDO
    2970             ENDDO
    2971             !$OMP END PARALLEL
    2972          ELSE
    2973             ALLOCATE( var_int32_3d_resorted(1,1,1) )
    2974             var_int32_3d_resorted = 0_1
    2975          ENDIF
    2976          var_int32_3d_pointer => var_int32_3d_resorted
    2977 
    2978       !-- working-precision integer output
    2979       ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    2980          var_intwp_0d_pointer => var_intwp_0d
    2981       ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    2982          IF ( do_output ) THEN
    2983             ALLOCATE( var_intwp_1d_resorted(0:value_counts(1)-1) )
    2984             !$OMP PARALLEL PRIVATE (i)
    2985             !$OMP DO
    2986             DO  i = 0, value_counts(1) - 1
    2987                var_intwp_1d_resorted(i) = var_intwp_1d(masked_indices(1,i))
    2988             ENDDO
    2989             !$OMP END PARALLEL
    2990          ELSE
    2991             ALLOCATE( var_intwp_1d_resorted(1) )
    2992             var_intwp_1d_resorted = 0_1
    2993          ENDIF
    2994          var_intwp_1d_pointer => var_intwp_1d_resorted
    2995       ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    2996          IF ( do_output ) THEN
    2997             ALLOCATE( var_intwp_2d_resorted(0:value_counts(1)-1, &
    2998                                             0:value_counts(2)-1) )
    2999             !$OMP PARALLEL PRIVATE (i,j)
    3000             !$OMP DO
    3001             DO  i = 0, value_counts(1) - 1
    3002                DO  j = 0, value_counts(2) - 1
    3003                   var_intwp_2d_resorted(i,j) = var_intwp_2d(masked_indices(2,j), &
    3004                                                             masked_indices(1,i)  )
    3005                ENDDO
    3006             ENDDO
    3007             !$OMP END PARALLEL
    3008          ELSE
    3009             ALLOCATE( var_intwp_2d_resorted(1,1) )
    3010             var_intwp_2d_resorted = 0_1
    3011          ENDIF
    3012          var_intwp_2d_pointer => var_intwp_2d_resorted
    3013       ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3014          IF ( do_output ) THEN
    3015             ALLOCATE( var_intwp_3d_resorted(0:value_counts(1)-1, &
    3016                                             0:value_counts(2)-1, &
    3017                                             0:value_counts(3)-1) )
    3018             !$OMP PARALLEL PRIVATE (i,j,k)
    3019             !$OMP DO
    3020             DO  i = 0, value_counts(1) - 1
    3021                DO  j = 0, value_counts(2) - 1
    3022                   DO  k = 0, value_counts(3) - 1
    3023                      var_intwp_3d_resorted(i,j,k) = var_intwp_3d(masked_indices(3,k), &
    3024                                                                  masked_indices(2,j), &
    3025                                                                  masked_indices(1,i)  )
    3026                   ENDDO
    3027                ENDDO
    3028             ENDDO
    3029             !$OMP END PARALLEL
    3030          ELSE
    3031             ALLOCATE( var_intwp_3d_resorted(1,1,1) )
    3032             var_intwp_3d_resorted = 0_1
    3033          ENDIF
    3034          var_intwp_3d_pointer => var_intwp_3d_resorted
    3035 
    3036       !-- 32bit real output
    3037       ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3038          var_real32_0d_pointer => var_real32_0d
    3039       ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3040          IF ( do_output ) THEN
    3041             ALLOCATE( var_real32_1d_resorted(0:value_counts(1)-1) )
    3042             !$OMP PARALLEL PRIVATE (i)
    3043             !$OMP DO
    3044             DO  i = 0, value_counts(1) - 1
    3045                var_real32_1d_resorted(i) = var_real32_1d(masked_indices(1,i))
    3046             ENDDO
    3047             !$OMP END PARALLEL
    3048          ELSE
    3049             ALLOCATE( var_real32_1d_resorted(1) )
    3050             var_real32_1d_resorted = 0_1
    3051          ENDIF
    3052          var_real32_1d_pointer => var_real32_1d_resorted
    3053       ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3054          IF ( do_output ) THEN
    3055             ALLOCATE( var_real32_2d_resorted(0:value_counts(1)-1, &
    3056                                              0:value_counts(2)-1) )
    3057             !$OMP PARALLEL PRIVATE (i,j)
    3058             !$OMP DO
    3059             DO  i = 0, value_counts(1) - 1
    3060                DO  j = 0, value_counts(2) - 1
    3061                   var_real32_2d_resorted(i,j) = var_real32_2d(masked_indices(2,j), &
    3062                                                               masked_indices(1,i)  )
    3063                ENDDO
    3064             ENDDO
    3065             !$OMP END PARALLEL
    3066          ELSE
    3067             ALLOCATE( var_real32_2d_resorted(1,1) )
    3068             var_real32_2d_resorted = 0_1
    3069          ENDIF
    3070          var_real32_2d_pointer => var_real32_2d_resorted
    3071       ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3072          IF ( do_output ) THEN
    3073             ALLOCATE( var_real32_3d_resorted(0:value_counts(1)-1, &
    3074                                              0:value_counts(2)-1, &
    3075                                              0:value_counts(3)-1) )
    3076             !$OMP PARALLEL PRIVATE (i,j,k)
    3077             !$OMP DO
    3078             DO  i = 0, value_counts(1) - 1
    3079                DO  j = 0, value_counts(2) - 1
    3080                   DO  k = 0, value_counts(3) - 1
    3081                      var_real32_3d_resorted(i,j,k) = var_real32_3d(masked_indices(3,k), &
    3082                                                                    masked_indices(2,j), &
    3083                                                                    masked_indices(1,i)  )
    3084                   ENDDO
    3085                ENDDO
    3086             ENDDO
    3087             !$OMP END PARALLEL
    3088          ELSE
    3089             ALLOCATE( var_real32_3d_resorted(1,1,1) )
    3090             var_real32_3d_resorted = 0_1
    3091          ENDIF
    3092          var_real32_3d_pointer => var_real32_3d_resorted
    3093 
    3094       !-- 64bit real output
    3095       ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3096          var_real64_0d_pointer => var_real64_0d
    3097       ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3098          IF ( do_output ) THEN
    3099             ALLOCATE( var_real64_1d_resorted(0:value_counts(1)-1) )
    3100             !$OMP PARALLEL PRIVATE (i)
    3101             !$OMP DO
    3102             DO  i = 0, value_counts(1) - 1
    3103                var_real64_1d_resorted(i) = var_real64_1d(masked_indices(1,i))
    3104             ENDDO
    3105             !$OMP END PARALLEL
    3106          ELSE
    3107             ALLOCATE( var_real64_1d_resorted(1) )
    3108             var_real64_1d_resorted = 0_1
    3109          ENDIF
    3110          var_real64_1d_pointer => var_real64_1d_resorted
    3111       ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3112          IF ( do_output ) THEN
    3113             ALLOCATE( var_real64_2d_resorted(0:value_counts(1)-1, &
    3114                                              0:value_counts(2)-1) )
    3115             !$OMP PARALLEL PRIVATE (i,j)
    3116             !$OMP DO
    3117             DO  i = 0, value_counts(1) - 1
    3118                DO  j = 0, value_counts(2) - 1
    3119                   var_real64_2d_resorted(i,j) = var_real64_2d(masked_indices(2,j), &
    3120                                                               masked_indices(1,i)  )
    3121                ENDDO
    3122             ENDDO
    3123             !$OMP END PARALLEL
    3124          ELSE
    3125             ALLOCATE( var_real64_2d_resorted(1,1) )
    3126             var_real64_2d_resorted = 0_1
    3127          ENDIF
    3128          var_real64_2d_pointer => var_real64_2d_resorted
    3129       ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3130          IF ( do_output ) THEN
    3131             ALLOCATE( var_real64_3d_resorted(0:value_counts(1)-1, &
    3132                                              0:value_counts(2)-1, &
    3133                                              0:value_counts(3)-1) )
    3134             !$OMP PARALLEL PRIVATE (i,j,k)
    3135             !$OMP DO
    3136             DO  i = 0, value_counts(1) - 1
    3137                DO  j = 0, value_counts(2) - 1
    3138                   DO  k = 0, value_counts(3) - 1
    3139                      var_real64_3d_resorted(i,j,k) = var_real64_3d(masked_indices(3,k), &
    3140                                                                    masked_indices(2,j), &
    3141                                                                    masked_indices(1,i)  )
    3142                   ENDDO
    3143                ENDDO
    3144             ENDDO
    3145             !$OMP END PARALLEL
    3146          ELSE
    3147             ALLOCATE( var_real64_3d_resorted(1,1,1) )
    3148             var_real64_3d_resorted = 0_1
    3149          ENDIF
    3150          var_real64_3d_pointer => var_real64_3d_resorted
    3151 
    3152       !-- working-precision real output
    3153       ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3154          var_realwp_0d_pointer => var_realwp_0d
    3155       ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3156          IF ( do_output ) THEN
    3157             ALLOCATE( var_realwp_1d_resorted(0:value_counts(1)-1) )
    3158             !$OMP PARALLEL PRIVATE (i)
    3159             !$OMP DO
    3160             DO  i = 0, value_counts(1) - 1
    3161                var_realwp_1d_resorted(i) = var_realwp_1d(masked_indices(1,i))
    3162             ENDDO
    3163             !$OMP END PARALLEL
    3164          ELSE
    3165             ALLOCATE( var_realwp_1d_resorted(1) )
    3166             var_realwp_1d_resorted = 0_1
    3167          ENDIF
    3168          var_realwp_1d_pointer => var_realwp_1d_resorted
    3169       ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3170          IF ( do_output ) THEN
    3171             ALLOCATE( var_realwp_2d_resorted(0:value_counts(1)-1, &
    3172                                              0:value_counts(2)-1) )
    3173             !$OMP PARALLEL PRIVATE (i,j)
    3174             !$OMP DO
    3175             DO  i = 0, value_counts(1) - 1
    3176                DO  j = 0, value_counts(2) - 1
    3177                   var_realwp_2d_resorted(i,j) = var_realwp_2d(masked_indices(2,j), &
    3178                                                               masked_indices(1,i)  )
    3179                ENDDO
    3180             ENDDO
    3181             !$OMP END PARALLEL
    3182          ELSE
    3183             ALLOCATE( var_realwp_2d_resorted(1,1) )
    3184             var_realwp_2d_resorted = 0_1
    3185          ENDIF
    3186          var_realwp_2d_pointer => var_realwp_2d_resorted
    3187       ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3188          IF ( do_output ) THEN
    3189             ALLOCATE( var_realwp_3d_resorted(0:value_counts(1)-1, &
    3190                                              0:value_counts(2)-1, &
    3191                                              0:value_counts(3)-1) )
    3192             !$OMP PARALLEL PRIVATE (i,j,k)
    3193       &