Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 4141


Ignore:
Timestamp:
Aug 5, 2019 12:24:51 PM (5 years 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
Location:
palm/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/data_output_binary_module.f90

    r4123 r4141  
    5252   IMPLICIT NONE
    5353
    54    INTEGER(iwp), PARAMETER ::  charlen = 100_iwp  !< maximum length of character variables
     54   INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
    5555
    5656   CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
    … …  
    6262   CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
    6363
    64    INTEGER(iwp) ::  binary_file_lowest_unit = 1000  !< lowest unit number of all binary files created by this module
    65    INTEGER(iwp) ::  config_file_unit                !< unit number of config file
    66    INTEGER(iwp) ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
    67    INTEGER(iwp) ::  global_id_in_file = -1          !< value of global ID within a file
    68    INTEGER      ::  master_rank                     !< master rank for tasks to be executed by single PE only
    69    INTEGER(iwp) ::  next_available_unit             !< next unit number available for new file
    70    INTEGER      ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
    71 
    72    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id  !< highest assigned ID of variable or dimension in a file
     64   INTEGER ::  binary_file_lowest_unit = 1000  !< lowest unit number of all binary files created by this module
     65   INTEGER ::  config_file_unit                !< unit number of config file
     66   INTEGER ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
     67   INTEGER ::  global_id_in_file = -1          !< value of global ID within a file
     68   INTEGER ::  master_rank                     !< master rank for tasks to be executed by single PE only
     69   INTEGER ::  next_available_unit             !< next unit number available for new file
     70   INTEGER ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
     71
     72   INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id  !< highest assigned ID of variable or dimension in a file
    7373
    7474   LOGICAL ::  binary_open_file_first_call = .TRUE.  !< true if binary_open_file routine was not called yet
    … …  
    100100   END INTERFACE binary_write_attribute
    101101
    102    INTERFACE binary_init_end
    103       MODULE PROCEDURE binary_init_end
    104    END INTERFACE binary_init_end
     102   INTERFACE binary_stop_file_header_definition
     103      MODULE PROCEDURE binary_stop_file_header_definition
     104   END INTERFACE binary_stop_file_header_definition
    105105
    106106   INTERFACE binary_write_variable
    … …  
    120120      binary_get_error_message, &
    121121      binary_init_dimension, &
    122       binary_init_end, &
     122      binary_stop_file_header_definition, &
    123123      binary_init_module, &
    124124      binary_init_variable, &
    … …  
    143143                                                                 !> must be unique for each output group
    144144
    145    INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
    146    INTEGER,      INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
    147    INTEGER,      INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    148    INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
     145   INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
     146   INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
     147   INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
     148   INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
    149149
    150150   LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
    … …  
    167167!> Open binary file.
    168168!--------------------------------------------------------------------------------------------------!
    169 SUBROUTINE binary_open_file( mode, filename, file_id, return_value )
     169SUBROUTINE binary_open_file( mode, file_name, file_id, return_value )
    170170
    171171   CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    172    CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
     172   CHARACTER(LEN=charlen), INTENT(IN) ::  file_name          !< name of file
    173173   CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
    174174   CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
    … …  
    176176   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
    177177
    178    INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    179    INTEGER                   ::  my_rank       !< MPI rank of local processor
    180    INTEGER                   ::  nrank         !< number of MPI ranks participating in output
    181    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    182 
    183    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id_tmp  !< temporary list of given variable IDs in file
     178   INTEGER, INTENT(OUT) ::  file_id       !< file ID
     179   INTEGER              ::  my_rank       !< MPI rank of local processor
     180   INTEGER              ::  nranks        !< number of MPI ranks participating in output
     181   INTEGER, INTENT(OUT) ::  return_value  !< return value
     182
     183   INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id_tmp  !< temporary list of given variable IDs in file
    184184
    185185   LOGICAL ::  file_exists  !< true if file to be opened already exists
    … …  
    189189
    190190#if defined( __parallel )
    191    CALL MPI_COMM_SIZE( output_group_comm, nrank, return_value )
     191   CALL MPI_COMM_SIZE( output_group_comm, nranks, return_value )
    192192   IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    193193   IF ( return_value == 0 )  THEN
    … …  
    197197   ENDIF
    198198#else
    199    nrank = 1
     199   nranks = 1
    200200   my_rank = master_rank
    201201   WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    … …  
    237237
    238238            !-- Write some general information to config file
    239             WRITE( config_file_unit )  nrank
     239            WRITE( config_file_unit )  nranks
    240240            WRITE( config_file_unit )  master_rank
    241241            WRITE( config_file_unit )  LEN( file_prefix )
    … …  
    260260   IF ( return_value == 0 )  THEN
    261261
    262       bin_filename = file_prefix // TRIM( filename ) // TRIM( file_suffix ) // my_rank_char
     262      bin_filename = file_prefix // TRIM( file_name ) // TRIM( file_suffix ) // my_rank_char
    263263
    264264      !-- Remove any pre-existing file
    … …  
    267267      IF ( file_exists )  THEN
    268268         CALL internal_message( 'debug', routine_name // &
    269                                          ': remove existing file ' // TRIM( bin_filename ) )
     269                                ': remove existing file ' // TRIM( bin_filename ) )
    270270         !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
    271271         !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
    … …  
    282282      IF ( return_value == 0 )  THEN
    283283
    284          !-- Add filename to config file
     284         !-- Add file_name to config file
    285285         IF ( my_rank == master_rank )  THEN
    286             WRITE( config_file_unit )  filename
     286            WRITE( config_file_unit )  file_name
    287287         ENDIF
    288288
    … …  
    294294         WRITE ( file_id )  charlen
    295295         WRITE ( file_id )  file_id
    296          WRITE ( file_id )  filename
     296         WRITE ( file_id )  file_name
    297297
    298298         !-- Extend file-variable/dimension-ID list by 1 and set it to 0 for new file.
    299          IF ( ALLOCATED( files_highest_var_id ) )  THEN
    300             ALLOCATE( files_highest_var_id_tmp(SIZE( files_highest_var_id )) )
    301             files_highest_var_id_tmp = files_highest_var_id
    302             DEALLOCATE( files_highest_var_id )
    303             ALLOCATE( files_highest_var_id(binary_file_lowest_unit+1:file_id) )
    304             files_highest_var_id(:file_id-1) = files_highest_var_id_tmp
    305             DEALLOCATE( files_highest_var_id_tmp )
     299         IF ( ALLOCATED( files_highest_variable_id ) )  THEN
     300            ALLOCATE( files_highest_variable_id_tmp(SIZE( files_highest_variable_id )) )
     301            files_highest_variable_id_tmp = files_highest_variable_id
     302            DEALLOCATE( files_highest_variable_id )
     303            ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
     304            files_highest_variable_id(:file_id-1) = files_highest_variable_id_tmp
     305            DEALLOCATE( files_highest_variable_id_tmp )
    306306         ELSE
    307             ALLOCATE( files_highest_var_id(binary_file_lowest_unit+1:file_id) )
     307            ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
    308308         ENDIF
    309          files_highest_var_id(file_id) = 0_iwp
     309         files_highest_variable_id(file_id) = 0
    310310
    311311      ELSE
    312312         return_value = 1
    313313         CALL internal_message( 'error', routine_name // &
    314                                          ': could not open file "' // TRIM( filename ) // '"')
     314                                ': could not open file "' // TRIM( file_name ) // '"')
    315315      ENDIF
    316316
    … …  
    324324!> Write attribute to file.
    325325!--------------------------------------------------------------------------------------------------!
    326 SUBROUTINE binary_write_attribute( file_id, var_id, att_name, att_value_char, &
    327               att_value_int8, att_value_int16, att_value_int32,               &
    328               att_value_real32, att_value_real64, return_value )
     326SUBROUTINE binary_write_attribute( file_id, variable_id, attribute_name, &
     327              value_char, value_int8, value_int16, value_int32,          &
     328              value_real32, value_real64, return_value )
    329329
    330330   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_attribute'  !< name of this routine
    331331
    332    CHARACTER(LEN=charlen), INTENT(IN)           ::  att_name        !< name of attribute
    333    CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL ::  att_value_char  !< value of attribute
    334    CHARACTER(LEN=charlen)                       ::  att_type        !< data type of attribute
    335    CHARACTER(LEN=charlen)                       ::  out_str         !< output string
    336 
    337    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  att_value_int8   !< value of attribute
    338    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  att_value_int16  !< value of attribute
    339    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  att_value_int32  !< value of attribute
    340 
    341    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    342    INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
    343    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    344 
    345    REAL(KIND=4), INTENT(IN), OPTIONAL ::  att_value_real32  !< value of attribute
    346    REAL(KIND=8), INTENT(IN), OPTIONAL ::  att_value_real64  !< value of attribute
     332   CHARACTER(LEN=charlen), INTENT(IN)           ::  attribute_name        !< name of attribute
     333   CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL ::  value_char  !< value of attribute
     334   CHARACTER(LEN=charlen)                       ::  attribute_type        !< data type of attribute
     335   CHARACTER(LEN=charlen)                       ::  output_string         !< output string
     336
     337   INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
     338   INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
     339   INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
     340
     341   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     342   INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     343   INTEGER, INTENT(OUT) ::  return_value  !< return value
     344
     345   REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
     346   REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
    347347
    348348
    … …  
    350350
    351351   CALL internal_message( 'debug', TRIM( routine_name ) // &
    352                                    ': write attribute ' // TRIM( att_name ) )
     352                          ': write attribute ' // TRIM( attribute_name ) )
    353353
    354354   !-- Write attribute to file
    355    out_str = 'attribute'
    356    WRITE( file_id )  out_str
    357 
    358    WRITE( file_id )  var_id
    359    WRITE( file_id )  att_name
    360 
    361    IF ( PRESENT( att_value_char ) )  THEN
    362       att_type = 'char'
    363       WRITE( file_id )  att_type
    364       WRITE( file_id )  att_value_char
    365    ELSEIF ( PRESENT( att_value_int8 ) )  THEN
    366       att_type = 'int8'
    367       WRITE( file_id )  att_type
    368       WRITE( file_id )  att_value_int8
    369    ELSEIF ( PRESENT( att_value_int16 ) )  THEN
    370       att_type = 'int16'
    371       WRITE( file_id )  att_type
    372       WRITE( file_id )  att_value_int16
    373    ELSEIF ( PRESENT( att_value_int32 ) )  THEN
    374       att_type = 'int32'
    375       WRITE( file_id )  att_type
    376       WRITE( file_id )  att_value_int32
    377    ELSEIF ( PRESENT( att_value_real32 ) )  THEN
    378       att_type = 'real32'
    379       WRITE( file_id )  att_type
    380       WRITE( file_id )  att_value_real32
    381    ELSEIF ( PRESENT( att_value_real64 ) )  THEN
    382       att_type = 'real64'
    383       WRITE( file_id )  att_type
    384       WRITE( file_id )  att_value_real64
     355   output_string = 'attribute'
     356   WRITE( file_id )  output_string
     357
     358   WRITE( file_id )  variable_id
     359   WRITE( file_id )  attribute_name
     360
     361   IF ( PRESENT( value_char ) )  THEN
     362      attribute_type = 'char'
     363      WRITE( file_id )  attribute_type
     364      WRITE( file_id )  value_char
     365   ELSEIF ( PRESENT( value_int8 ) )  THEN
     366      attribute_type = 'int8'
     367      WRITE( file_id )  attribute_type
     368      WRITE( file_id )  value_int8
     369   ELSEIF ( PRESENT( value_int16 ) )  THEN
     370      attribute_type = 'int16'
     371      WRITE( file_id )  attribute_type
     372      WRITE( file_id )  value_int16
     373   ELSEIF ( PRESENT( value_int32 ) )  THEN
     374      attribute_type = 'int32'
     375      WRITE( file_id )  attribute_type
     376      WRITE( file_id )  value_int32
     377   ELSEIF ( PRESENT( value_real32 ) )  THEN
     378      attribute_type = 'real32'
     379      WRITE( file_id )  attribute_type
     380      WRITE( file_id )  value_real32
     381   ELSEIF ( PRESENT( value_real64 ) )  THEN
     382      attribute_type = 'real64'
     383      WRITE( file_id )  attribute_type
     384      WRITE( file_id )  value_real64
    385385   ELSE
    386386      return_value = 1
    387387      CALL internal_message( 'error', TRIM( routine_name ) // &
    388                              ': attribute "' // TRIM( att_name ) // '": no value given' )
     388                             ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
    389389   ENDIF
    390390
    … …  
    394394! Description:
    395395! ------------
    396 !> Initialize dimension. Write information in file header and save dimension
    397 !> values to be later written to file.
    398 !--------------------------------------------------------------------------------------------------!
    399 SUBROUTINE binary_init_dimension( mode, file_id, dim_id, var_id, &
    400               dim_name, dim_type, dim_length, return_value )
    401 
    402    CHARACTER(LEN=charlen), INTENT(IN) ::  dim_name  !< name of dimension
    403    CHARACTER(LEN=charlen), INTENT(IN) ::  dim_type  !< data type of dimension
    404    CHARACTER(LEN=charlen)             ::  out_str   !< output string
    405    CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
     396!> Initialize dimension. Write information in file header
     397!> and save dimension values to be later written to file.
     398!--------------------------------------------------------------------------------------------------!
     399SUBROUTINE binary_init_dimension( mode, file_id, dimension_id, variable_id, &
     400              dimension_name, dimension_type, dimension_length, return_value )
     401
     402   CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_name  !< name of dimension
     403   CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_type  !< data type of dimension
     404   CHARACTER(LEN=charlen)             ::  output_string   !< output string
     405   CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
    406406
    407407   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
    408408
    409    INTEGER(iwp), INTENT(OUT) ::  dim_id        !< dimension ID
    410    INTEGER(iwp), INTENT(IN)  ::  dim_length    !< length of dimension
    411    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    412    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    413    INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
     409   INTEGER, INTENT(OUT) ::  dimension_id      !< dimension ID
     410   INTEGER, INTENT(IN)  ::  dimension_length  !< length of dimension
     411   INTEGER, INTENT(IN)  ::  file_id           !< file ID
     412   INTEGER, INTENT(OUT) ::  return_value      !< return value
     413   INTEGER, INTENT(OUT) ::  variable_id       !< variable ID
    414414
    415415
    416416   return_value = 0
    417417
    418    CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dim_name ) )
     418   CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) )
    419419
    420420   !-- Check mode (not required, added for compatibility reasons only)
    … …  
    422422
    423423   !-- Assign dimension ID
    424    dim_id = files_highest_var_id( file_id ) + 1
    425    files_highest_var_id( file_id ) = dim_id
     424   dimension_id = files_highest_variable_id( file_id ) + 1
     425   files_highest_variable_id( file_id ) = dimension_id
    426426
    427427   !-- Define dimension in file
    428    out_str = 'dimension'
    429    WRITE( file_id )  out_str
    430    WRITE( file_id )  dim_name
    431    WRITE( file_id )  dim_id
    432    WRITE( file_id )  dim_type
    433    WRITE( file_id )  dim_length
     428   output_string = 'dimension'
     429   WRITE( file_id )  output_string
     430   WRITE( file_id )  dimension_name
     431   WRITE( file_id )  dimension_id
     432   WRITE( file_id )  dimension_type
     433   WRITE( file_id )  dimension_length
    434434
    435435   !-- Define variable associated with dimension
    436    CALL binary_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
    437                               is_global=.TRUE., return_value=return_value )
     436   CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
     437                              (/ dimension_id /), is_global=.TRUE., return_value=return_value )
    438438   IF ( return_value /= 0 )  THEN
    439439      CALL internal_message( 'error', routine_name // &
    440                                       ': init dimension "' // TRIM( dim_name ) // '"' )
     440                             ': init dimension "' // TRIM( dimension_name ) // '"' )
    441441   ENDIF
    442442
    … …  
    448448!> Initialize variable. Write information of variable into file header.
    449449!--------------------------------------------------------------------------------------------------!
    450 SUBROUTINE binary_init_variable( mode, file_id, var_id, var_name, var_type, &
    451                                  var_dim_ids, is_global, return_value )
    452 
    453    CHARACTER(LEN=charlen)             ::  out_str   !< output string
    454    CHARACTER(LEN=charlen), INTENT(IN) ::  var_name  !< name of variable
    455    CHARACTER(LEN=charlen), INTENT(IN) ::  var_type  !< data type of variable
    456    CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
     450SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type, &
     451                                 dimension_ids, is_global, return_value )
     452
     453   CHARACTER(LEN=charlen)             ::  output_string   !< output string
     454   CHARACTER(LEN=charlen), INTENT(IN) ::  variable_name   !< name of variable
     455   CHARACTER(LEN=charlen), INTENT(IN) ::  variable_type   !< data type of variable
     456   CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
    457457
    458458   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
    459459
    460    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    461    INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
    462    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    463 
    464    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_ids  !< list of dimension IDs used by variable
     460   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     461   INTEGER, INTENT(OUT) ::  variable_id   !< variable ID
     462   INTEGER, INTENT(OUT) ::  return_value  !< return value
     463
     464   INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
    465465
    466466   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    … …  
    469469   return_value = 0
    470470
    471    CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( var_name ) )
     471   CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) )
    472472
    473473   !-- Check mode (not required, added for compatibility reasons only)
    … …  
    478478
    479479   !-- Assign variable ID
    480    var_id = files_highest_var_id( file_id ) + 1
    481    files_highest_var_id( file_id ) = var_id
     480   variable_id = files_highest_variable_id( file_id ) + 1
     481   files_highest_variable_id( file_id ) = variable_id
    482482
    483483   !-- Write variable information in file
    484    out_str = 'variable'
    485    WRITE( file_id )  out_str
    486    WRITE( file_id )  var_name
    487    WRITE( file_id )  var_id
    488    WRITE( file_id )  var_type
    489    WRITE( file_id )  SIZE( var_dim_ids )
    490    WRITE( file_id )  var_dim_ids
     484   output_string = 'variable'
     485   WRITE( file_id )  output_string
     486   WRITE( file_id )  variable_name
     487   WRITE( file_id )  variable_id
     488   WRITE( file_id )  variable_type
     489   WRITE( file_id )  SIZE( dimension_ids )
     490   WRITE( file_id )  dimension_ids
    491491
    492492END SUBROUTINE binary_init_variable
    … …  
    497497!> Leave file definition state.
    498498!--------------------------------------------------------------------------------------------------!
    499 SUBROUTINE binary_init_end( file_id, return_value )
    500 
    501    CHARACTER(LEN=charlen) ::  out_str  !< output string
    502 
    503    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_end'  !< name of this routine
    504 
    505    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    506    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     499SUBROUTINE binary_stop_file_header_definition( file_id, return_value )
     500
     501   CHARACTER(LEN=charlen) ::  output_string  !< output string
     502
     503   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_stop_file_header_definition'  !< name of this routine
     504
     505   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     506   INTEGER, INTENT(OUT) ::  return_value  !< return value
    507507
    508508
    … …  
    510510
    511511   WRITE( temp_string, * ) file_id
    512    CALL internal_message( 'debug', &
    513                           routine_name // &
     512   CALL internal_message( 'debug', routine_name // &
    514513                          ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
    515514
    516    out_str = '*** end file header ***'
    517    WRITE( file_id )  out_str
    518 
    519 END SUBROUTINE binary_init_end
     515   output_string = '*** end file header ***'
     516   WRITE( file_id )  output_string
     517
     518END SUBROUTINE binary_stop_file_header_definition
    520519
    521520!--------------------------------------------------------------------------------------------------!
    … …  
    524523!> Write variable to file.
    525524!--------------------------------------------------------------------------------------------------!
    526 SUBROUTINE binary_write_variable(                                         &
    527               file_id, var_id, bounds_start, value_counts, bounds_origin, &
    528               is_global,                                                  &
    529               var_int8_0d,   var_int8_1d,   var_int8_2d,   var_int8_3d,   &
    530               var_int16_0d,  var_int16_1d,  var_int16_2d,  var_int16_3d,  &
    531               var_int32_0d,  var_int32_1d,  var_int32_2d,  var_int32_3d,  &
    532               var_intwp_0d,  var_intwp_1d,  var_intwp_2d,  var_intwp_3d,  &
    533               var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
    534               var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
    535               var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
     525SUBROUTINE binary_write_variable(                                                     &
     526              file_id, variable_id, bounds_start, value_counts, bounds_origin,        &
     527              is_global,                                                              &
     528              values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
     529              values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     530              values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,  &
     531              values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,  &
     532              values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
     533              values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
     534              values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &
    536535              return_value )
    537536
    538    CHARACTER(LEN=charlen) ::  out_str  !< output string
     537   CHARACTER(LEN=charlen) ::  output_string  !< output string
    539538
    540539   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
    541540
    542    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    543    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    544    INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
    545 
    546    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds_origin  !< starting index of each dimension
    547    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds_start   !< starting index of variable
    548    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  value_counts   !< count of values along each dimension to be written
    549 
    550    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                               ::  var_int8_0d  !< output variable
    551    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int8_1d  !< output variable
    552    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int8_2d  !< output variable
    553    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int8_3d  !< output variable
    554 
    555    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                               ::  var_int16_0d  !< output variable
    556    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int16_1d  !< output variable
    557    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int16_2d  !< output variable
    558    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int16_3d  !< output variable
    559 
    560    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_int32_0d  !< output variable
    561    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int32_1d  !< output variable
    562    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int32_2d  !< output variable
    563    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int32_3d  !< output variable
    564 
    565    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL                               ::  var_intwp_0d  !< output variable
    566    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_intwp_1d  !< output variable
    567    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_intwp_2d  !< output variable
    568    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_intwp_3d  !< output variable
     541   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     542   INTEGER, INTENT(OUT) ::  return_value  !< return value
     543   INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     544
     545   INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_origin  !< starting index of each dimension
     546   INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_start   !< starting index of variable
     547   INTEGER, DIMENSION(:), INTENT(IN) ::  value_counts   !< count of values along each dimension to be written
     548
     549   INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
     550   INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
     551   INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
     552   INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
     553   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
     554   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
     555   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
     556   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
     557   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
     558   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
     559   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
     560   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
     561   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
     562   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
     563   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
     564   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
    569565
    570566   LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)
    571567
    572    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_real32_0d  !< output variable
    573    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real32_1d  !< output variable
    574    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real32_2d  !< output variable
    575    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real32_3d  !< output variable
    576 
    577    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                               ::  var_real64_0d  !< output variable
    578    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real64_1d  !< output variable
    579    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real64_2d  !< output variable
    580    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real64_3d  !< output variable
    581 
    582    REAL(wp), POINTER, INTENT(IN), OPTIONAL                               ::  var_realwp_0d  !< output variable
    583    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_realwp_1d  !< output variable
    584    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_realwp_2d  !< output variable
    585    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_realwp_3d  !< output variable
     568   REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
     569   REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
     570   REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
     571   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
     572   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
     573   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
     574   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
     575   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
     576   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
     577   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
     578   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
     579   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
    586580
    587581
    588582   return_value = 0
    589583
    590    WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) var_id, file_id
     584   WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id
    591585   CALL internal_message( 'debug', routine_name // TRIM( temp_string ) )
    592586
    … …  
    594588
    595589   IF ( .NOT. ANY( value_counts == 0 ) )  THEN
    596       WRITE( file_id )  var_id
     590      WRITE( file_id )  variable_id
    597591      WRITE( file_id )  bounds_start
    598592      WRITE( file_id )  value_counts
    599593      WRITE( file_id )  bounds_origin
    600594      !-- 8bit integer output
    601       IF ( PRESENT( var_int8_0d ) )  THEN
    602          out_str = 'int8'
    603          WRITE( file_id )  out_str
    604          WRITE( file_id )  var_int8_0d
    605       ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    606          out_str = 'int8'
    607          WRITE( file_id )  out_str
    608          WRITE( file_id )  var_int8_1d
    609       ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    610          out_str = 'int8'
    611          WRITE( file_id )  out_str
    612          WRITE( file_id )  var_int8_2d
    613       ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    614          out_str = 'int8'
    615          WRITE( file_id )  out_str
    616          WRITE( file_id )  var_int8_3d
     595      IF ( PRESENT( values_int8_0d ) )  THEN
     596         output_string = 'int8'
     597         WRITE( file_id )  output_string
     598         WRITE( file_id )  values_int8_0d
     599      ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     600         output_string = 'int8'
     601         WRITE( file_id )  output_string
     602         WRITE( file_id )  values_int8_1d
     603      ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     604         output_string = 'int8'
     605         WRITE( file_id )  output_string
     606         WRITE( file_id )  values_int8_2d
     607      ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     608         output_string = 'int8'
     609         WRITE( file_id )  output_string
     610         WRITE( file_id )  values_int8_3d
    617611      !-- 16bit integer output
    618       ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    619          out_str = 'int16'
    620          WRITE( file_id )  out_str
    621          WRITE( file_id )  var_int16_0d
    622       ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    623          out_str = 'int16'
    624          WRITE( file_id )  out_str
    625          WRITE( file_id )  var_int16_1d
    626       ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    627          out_str = 'int16'
    628          WRITE( file_id )  out_str
    629          WRITE( file_id )  var_int16_2d
    630       ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    631          out_str = 'int16'
    632          WRITE( file_id )  out_str
    633          WRITE( file_id )  var_int16_3d
     612      ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     613         output_string = 'int16'
     614         WRITE( file_id )  output_string
     615         WRITE( file_id )  values_int16_0d
     616      ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     617         output_string = 'int16'
     618         WRITE( file_id )  output_string
     619         WRITE( file_id )  values_int16_1d
     620      ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     621         output_string = 'int16'
     622         WRITE( file_id )  output_string
     623         WRITE( file_id )  values_int16_2d
     624      ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     625         output_string = 'int16'
     626         WRITE( file_id )  output_string
     627         WRITE( file_id )  values_int16_3d
    634628      !-- 32bit integer output
    635       ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    636          out_str = 'int32'
    637          WRITE( file_id )  out_str
    638          WRITE( file_id )  var_int32_0d
    639       ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    640          out_str = 'int32'
    641          WRITE( file_id )  out_str
    642          WRITE( file_id )  var_int32_1d
    643       ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    644          out_str = 'int32'
    645          WRITE( file_id )  out_str
    646          WRITE( file_id )  var_int32_2d
    647       ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    648          out_str = 'int32'
    649          WRITE( file_id )  out_str
    650          WRITE( file_id )  var_int32_3d
     629      ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     630         output_string = 'int32'
     631         WRITE( file_id )  output_string
     632         WRITE( file_id )  values_int32_0d
     633      ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     634         output_string = 'int32'
     635         WRITE( file_id )  output_string
     636         WRITE( file_id )  values_int32_1d
     637      ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     638         output_string = 'int32'
     639         WRITE( file_id )  output_string
     640         WRITE( file_id )  values_int32_2d
     641      ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     642         output_string = 'int32'
     643         WRITE( file_id )  output_string
     644         WRITE( file_id )  values_int32_3d
    651645      !-- working-precision integer output
    652       ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    653          out_str = 'intwp'
    654          WRITE( file_id )  out_str
    655          WRITE( file_id )  var_intwp_0d
    656       ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    657          out_str = 'intwp'
    658          WRITE( file_id )  out_str
    659          WRITE( file_id )  var_intwp_1d
    660       ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    661          out_str = 'intwp'
    662          WRITE( file_id )  out_str
    663          WRITE( file_id )  var_intwp_2d
    664       ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    665          out_str = 'intwp'
    666          WRITE( file_id )  out_str
    667          WRITE( file_id )  var_intwp_3d
     646      ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     647         output_string = 'intwp'
     648         WRITE( file_id )  output_string
     649         WRITE( file_id )  values_intwp_0d
     650      ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     651         output_string = 'intwp'
     652         WRITE( file_id )  output_string
     653         WRITE( file_id )  values_intwp_1d
     654      ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     655         output_string = 'intwp'
     656         WRITE( file_id )  output_string
     657         WRITE( file_id )  values_intwp_2d
     658      ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     659         output_string = 'intwp'
     660         WRITE( file_id )  output_string
     661         WRITE( file_id )  values_intwp_3d
    668662      !-- 32bit real output
    669       ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    670          out_str = 'real32'
    671          WRITE( file_id )  out_str
    672          WRITE( file_id )  var_real32_0d
    673       ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    674          out_str = 'real32'
    675          WRITE( file_id )  out_str
    676          WRITE( file_id )  var_real32_1d
    677       ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    678          out_str = 'real32'
    679          WRITE( file_id )  out_str
    680          WRITE( file_id )  var_real32_2d
    681       ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    682          out_str = 'real32'
    683          WRITE( file_id )  out_str
    684          WRITE( file_id )  var_real32_3d
     663      ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     664         output_string = 'real32'
     665         WRITE( file_id )  output_string
     666         WRITE( file_id )  values_real32_0d
     667      ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     668         output_string = 'real32'
     669         WRITE( file_id )  output_string
     670         WRITE( file_id )  values_real32_1d
     671      ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     672         output_string = 'real32'
     673         WRITE( file_id )  output_string
     674         WRITE( file_id )  values_real32_2d
     675      ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     676         output_string = 'real32'
     677         WRITE( file_id )  output_string
     678         WRITE( file_id )  values_real32_3d
    685679      !-- 64bit real output
    686       ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    687          out_str = 'real64'
    688          WRITE( file_id )  out_str
    689          WRITE( file_id )  var_real64_0d
    690       ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    691          out_str = 'real64'
    692          WRITE( file_id )  out_str
    693          WRITE( file_id )  var_real64_1d
    694       ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    695          out_str = 'real64'
    696          WRITE( file_id )  out_str
    697          WRITE( file_id )  var_real64_2d
    698       ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    699          out_str = 'real64'
    700          WRITE( file_id )  out_str
    701          WRITE( file_id )  var_real64_3d
     680      ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     681         output_string = 'real64'
     682         WRITE( file_id )  output_string
     683         WRITE( file_id )  values_real64_0d
     684      ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     685         output_string = 'real64'
     686         WRITE( file_id )  output_string
     687         WRITE( file_id )  values_real64_1d
     688      ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     689         output_string = 'real64'
     690         WRITE( file_id )  output_string
     691         WRITE( file_id )  values_real64_2d
     692      ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     693         output_string = 'real64'
     694         WRITE( file_id )  output_string
     695         WRITE( file_id )  values_real64_3d
    702696      !-- working-precision real output
    703       ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    704          out_str = 'realwp'
    705          WRITE( file_id )  out_str
    706          WRITE( file_id )  var_realwp_0d
    707       ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    708          out_str = 'realwp'
    709          WRITE( file_id )  out_str
    710          WRITE( file_id )  var_realwp_1d
    711       ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    712          out_str = 'realwp'
    713          WRITE( file_id )  out_str
    714          WRITE( file_id )  var_realwp_2d
    715       ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    716          out_str = 'realwp'
    717          WRITE( file_id )  out_str
    718          WRITE( file_id )  var_realwp_3d
     697      ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     698         output_string = 'realwp'
     699         WRITE( file_id )  output_string
     700         WRITE( file_id )  values_realwp_0d
     701      ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     702         output_string = 'realwp'
     703         WRITE( file_id )  output_string
     704         WRITE( file_id )  values_realwp_1d
     705      ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     706         output_string = 'realwp'
     707         WRITE( file_id )  output_string
     708         WRITE( file_id )  values_realwp_2d
     709      ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     710         output_string = 'realwp'
     711         WRITE( file_id )  output_string
     712         WRITE( file_id )  values_realwp_3d
    719713      ELSE
    720714         return_value = 1
    … …  
    733727SUBROUTINE binary_finalize( file_id, return_value )
    734728
    735    CHARACTER(LEN=charlen) ::  out_str  !< output string
     729   CHARACTER(LEN=charlen) ::  output_string  !< output string
    736730
    737731   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_finalize'  !< name of this routine
    738732
    739    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    740    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     733   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     734   INTEGER, INTENT(OUT) ::  return_value  !< return value
    741735
    742736
    743737   IF ( config_file_open )  THEN
    744738
    745       out_str = '*** end config file ***'
    746       WRITE( config_file_unit )  out_str
     739      output_string = '*** end config file ***'
     740      WRITE( config_file_unit )  output_string
    747741
    748742      CLOSE( config_file_unit, IOSTAT=return_value )
    … …  
    762756   IF ( return_value == 0 )  THEN
    763757
    764       WRITE(temp_string,*) file_id
     758      WRITE( temp_string, * ) file_id
    765759      CALL internal_message( 'debug', routine_name // &
    766                                       ': close file (file_id=' // TRIM( temp_string ) // ')' )
     760                             ': close file (file_id=' // TRIM( temp_string ) // ')' )
    767761
    768762      CLOSE( file_id, IOSTAT=return_value )
    769763      IF ( return_value /= 0 )  THEN
    770          WRITE(temp_string,*) file_id
    771          CALL internal_message( 'error',        &
    772                                 routine_name // &
     764         WRITE( temp_string, * ) file_id
     765         CALL internal_message( 'error', routine_name // &
    773766                                ': cannot close file (file_id=' // TRIM( temp_string ) // ')' )
    774767      ENDIF
    … …  
    778771END SUBROUTINE binary_finalize
    779772
    780 
    781773!--------------------------------------------------------------------------------------------------!
    782774! Description:
    … …  
    809801!> Return the last created error message.
    810802!--------------------------------------------------------------------------------------------------!
    811 SUBROUTINE binary_get_error_message( error_message )
    812 
    813    CHARACTER(LEN=800), INTENT(OUT) ::  error_message  !< return error message to main program
    814 
    815 
    816    error_message = internal_error_message
    817 
    818 END SUBROUTINE binary_get_error_message
    819 
     803FUNCTION binary_get_error_message() RESULT( error_message )
     804
     805   CHARACTER(LEN=800) ::  error_message  !< return error message to main program
     806
     807
     808   error_message = TRIM( internal_error_message )
     809   
     810   internal_error_message = ''
     811
     812END FUNCTION binary_get_error_message
    820813
    821814END MODULE data_output_binary_module

  • 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                       &nb