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                        att_name=attribute%name, att_value_int16=attribute%value_int16, &
     3154               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,    &
     3155                       attribute_name=attribute%name, value_int16=attribute%value_int16, &
    22773156                       return_value=output_return_value )
    22783157
    22793158            CASE( 'int32' )
    2280                CALL binary_write_attribute( file_id=file_id, var_id=var_id,            &
    2281                        att_name=attribute%name, att_value_int32=attribute%value_int32, &
     3159               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,    &
     3160                       attribute_name=attribute%name, value_int32=attribute%value_int32, &
    22823161                       return_value=output_return_value )
    22833162
    22843163            CASE( 'real32' )
    2285                CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    2286                        att_name=attribute%name, att_value_real32=attribute%value_real32, &
     3164               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,      &
     3165                       attribute_name=attribute%name, value_real32=attribute%value_real32, &
    22873166                       return_value=output_return_value )
    22883167
    22893168            CASE( 'real64' )
    2290                CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    2291                        att_name=attribute%name, att_value_real64=attribute%value_real64, &
     3169               CALL binary_write_attribute( file_id=file_id, variable_id=variable_id,      &
     3170                       attribute_name=attribute%name, value_real64=attribute%value_real64, &
    22923171                       return_value=output_return_value )
    22933172
    … …  
    23073186
    23083187            CASE( 'char' )
    2309                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id, &
    2310                        att_name=attribute%name, att_value_char=attribute%value_char, &
     3188               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
     3189                       attribute_name=attribute%name, value_char=attribute%value_char, &
    23113190                       return_value=output_return_value )
    23123191
    23133192            CASE( 'int8' )
    2314                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id, &
    2315                        att_name=attribute%name, att_value_int8=attribute%value_int8, &
     3193               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id, &
     3194                       attribute_name=attribute%name, value_int8=attribute%value_int8, &
    23163195                       return_value=output_return_value )
    23173196
    23183197            CASE( 'int16' )
    2319                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    2320                        att_name=attribute%name, att_value_int16=attribute%value_int16, &
     3198               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,   &
     3199                       attribute_name=attribute%name, value_int16=attribute%value_int16, &
    23213200                       return_value=output_return_value )
    23223201
    23233202            CASE( 'int32' )
    2324                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    2325                        att_name=attribute%name, att_value_int32=attribute%value_int32, &
     3203               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,   &
     3204                       attribute_name=attribute%name, value_int32=attribute%value_int32, &
    23263205                       return_value=output_return_value )
    23273206
    23283207            CASE( 'real32' )
    2329                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    2330                        att_name=attribute%name, att_value_real32=attribute%value_real32, &
     3208               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,     &
     3209                       attribute_name=attribute%name, value_real32=attribute%value_real32, &
    23313210                       return_value=output_return_value )
    23323211
    23333212            CASE( 'real64' )
    2334                CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    2335                        att_name=attribute%name, att_value_real64=attribute%value_real64, &
     3213               CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,     &
     3214                       attribute_name=attribute%name, value_real64=attribute%value_real64, &
    23363215                       return_value=output_return_value )
    23373216
    … …  
    23483227      CASE DEFAULT
    23493228         return_value = 1
    2350          CALL internal_message( 'error',        &
    2351                                 routine_name // &
     3229         CALL internal_message( 'error', routine_name //                                &
    23523230                                ': unsupported file format "' // TRIM( file_format ) // &
    23533231                                '" ' // TRIM( temp_string ) )
    2354 
    2355    END SELECT
    2356 
    2357    IF ( output_return_value /= 0 )  THEN
    2358       return_value = output_return_value
    2359       CALL internal_message( 'error',        &
    2360                              routine_name // &
    2361                              ': error while writing attribute ' // TRIM( temp_string ) )
    2362    ENDIF
    2363 
    2364 END FUNCTION write_attribute
    2365 
    2366 !--------------------------------------------------------------------------------------------------!
    2367 ! Description:
    2368 ! ------------
    2369 !> Initialize dimension in file.
    2370 !--------------------------------------------------------------------------------------------------!
    2371 SUBROUTINE init_file_dimension( file_format, file_id, file_name, dim_id, var_id, &
    2372                                 dim_name, dim_type, dim_length, return_value )
    2373 
    2374    CHARACTER(LEN=*), INTENT(IN) ::  dim_name     !< name of dimension
    2375    CHARACTER(LEN=*), INTENT(IN) ::  dim_type     !< data type of dimension
    2376    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
    2377    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file
    2378 
    2379    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_dimension'  !< file format chosen for file
    2380 
    2381    INTEGER(iwp), INTENT(OUT) ::  dim_id               !< dimension ID
    2382    INTEGER(iwp), INTENT(IN)  ::  dim_length           !< length of dimension
    2383    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
    2384    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2385    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2386    INTEGER(iwp), INTENT(OUT) ::  var_id               !< associated variable ID
    2387 
    2388 
    2389    return_value = 0
    2390    output_return_value = 0
    2391 
    2392    temp_string = '(file "' // TRIM( file_name ) // &
    2393                  '", dimension "' // TRIM( dim_name ) // '")'
    2394 
    2395    SELECT CASE ( TRIM( file_format ) )
    2396 
    2397       CASE ( 'binary' )
    2398          CALL binary_init_dimension( 'binary', file_id, dim_id, var_id, &
    2399                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2400 
    2401       CASE ( 'netcdf4-serial' )
    2402          CALL netcdf4_init_dimension( 'serial', file_id, dim_id, var_id, &
    2403                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2404 
    2405       CASE ( 'netcdf4-parallel' )
    2406          CALL netcdf4_init_dimension( 'parallel', file_id, dim_id, var_id, &
    2407                  dim_name, dim_type, dim_length, return_value=output_return_value )
    2408 
    2409       CASE DEFAULT
    2410          return_value = 1
    2411          CALL internal_message( 'error', routine_name //                    &
    2412                                 ': file format "' // TRIM( file_format ) // &
    2413                                 '" not supported ' // TRIM( temp_string ) )
    24143232
    24153233   END SELECT
    … …  
    24183236      return_value = output_return_value
    24193237      CALL internal_message( 'error', routine_name // &
    2420                              ': error while defining dimension ' // TRIM( temp_string ) )
     3238                             ': error while writing attribute ' // TRIM( temp_string ) )
    24213239   ENDIF
    24223240
    2423 END SUBROUTINE init_file_dimension
     3241END FUNCTION write_attribute
    24243242
    24253243!--------------------------------------------------------------------------------------------------!
    … …  
    24283246!> Get dimension IDs and save them to variables.
    24293247!--------------------------------------------------------------------------------------------------!
    2430 SUBROUTINE collect_dimesion_ids_for_variables( variables, dimensions, return_value )
     3248SUBROUTINE collect_dimesion_ids_for_variables( file_name, variables, dimensions, return_value )
     3249
     3250   CHARACTER(LEN=*), INTENT(IN) ::  file_name !< name of file
    24313251
    24323252   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'collect_dimesion_ids_for_variables'  !< file format chosen for file
    24333253
    2434    INTEGER(iwp) ::  d             !< loop index
    2435    INTEGER(iwp) ::  i             !< loop index
    2436    INTEGER(iwp) ::  j             !< loop index
    2437    INTEGER(iwp) ::  ndim          !< number of dimensions
    2438    INTEGER(iwp) ::  nvar          !< number of variables
    2439    INTEGER(iwp) ::  return_value  !< return value
     3254   INTEGER              ::  d             !< loop index
     3255   INTEGER              ::  i             !< loop index
     3256   INTEGER              ::  j             !< loop index
     3257   INTEGER              ::  ndims         !< number of dimensions
     3258   INTEGER              ::  nvars         !< number of variables
     3259   INTEGER, INTENT(OUT) ::  return_value  !< return value
    24403260
    24413261   LOGICAL ::  found  !< true if dimension required by variable was found in dimension list
    … …  
    24473267
    24483268   return_value  = 0
    2449    ndim = SIZE( dimensions )
    2450    nvar = SIZE( variables )
    2451 
    2452    DO  i = 1, nvar
     3269   ndims = SIZE( dimensions )
     3270   nvars = SIZE( variables )
     3271
     3272   DO  i = 1, nvars
    24533273      DO  j = 1, SIZE( variables(i)%dimension_names )
    24543274         found = .FALSE.
    2455          DO  d = 1, ndim
     3275         DO  d = 1, ndims
    24563276            IF ( variables(i)%dimension_names(j) == dimensions(d)%name )  THEN
    24573277               variables(i)%dimension_ids(j) = dimensions(d)%id
    … …  
    24623282         IF ( .NOT. found )  THEN
    24633283            return_value = 1
    2464             CALL internal_message( 'error',                                                 &
    2465                     routine_name // ': variable "' // TRIM( variables(i)%name ) //          &
    2466                     '": required dimension "' // TRIM( variables(i)%dimension_names(j) ) // &
    2467                     '" is undefined' )
     3284            CALL internal_message( 'error', routine_name //                                &
     3285                    ': required dimension "' // TRIM( variables(i)%dimension_names(j) ) // &
     3286                    '" is undefined (variable "' // TRIM( variables(i)%name ) //          &
     3287                    '", file "' // TRIM( file_name ) // '")!' )
    24683288            EXIT
    24693289         ENDIF
    … …  
    24773297! Description:
    24783298! ------------
    2479 !> Initialize variable.
    2480 !--------------------------------------------------------------------------------------------------!
    2481 SUBROUTINE init_file_variable( file_format, file_id, file_name,        &
    2482                                var_id, var_name, var_type, var_dim_id, &
    2483                                is_global, return_value )
    2484 
    2485    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
     3299!> Leave file definition/initialization.
     3300!>
     3301!> @todo Do we need an MPI barrier at the end?
     3302!--------------------------------------------------------------------------------------------------!
     3303SUBROUTINE stop_file_header_definition( file_format, file_id, file_name, return_value )
     3304
     3305   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
    24863306   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    2487    CHARACTER(LEN=*), INTENT(IN) ::  var_name     !< name of variable
    2488    CHARACTER(LEN=*), INTENT(IN) ::  var_type     !< data type of variable
    2489 
    2490    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_variable'  !< file format chosen for file
    2491 
    2492    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
    2493    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2494    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2495    INTEGER(iwp), INTENT(OUT) ::  var_id               !< variable ID
    2496 
    2497    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_id  !< list of dimension IDs used by variable
    2498 
    2499    LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global
     3307
     3308   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'stop_file_header_definition'  !< name of routine
     3309
     3310   INTEGER, INTENT(IN)  ::  file_id              !< file id
     3311   INTEGER              ::  output_return_value  !< return value of a called output routine
     3312   INTEGER, INTENT(OUT) ::  return_value         !< return value
    25003313
    25013314
    … …  
    25033316   output_return_value = 0
    25043317
    2505    temp_string = '(file "' // TRIM( file_name ) // &
    2506                  '", variable "' // TRIM( var_name ) // '")'
     3318   temp_string = '(file "' // TRIM( file_name ) // '")'
    25073319
    25083320   SELECT CASE ( TRIM( file_format ) )
    25093321
    25103322      CASE ( 'binary' )
    2511          CALL binary_init_variable( 'binary', file_id, var_id, var_name, var_type, &
    2512                                     var_dim_id, is_global, return_value=output_return_value )
    2513 
    2514       CASE ( 'netcdf4-serial' )
    2515          CALL netcdf4_init_variable( 'serial', file_id, var_id, var_name, var_type, &
    2516                                      var_dim_id, is_global, return_value=output_return_value )
    2517 
    2518       CASE ( 'netcdf4-parallel' )
    2519          CALL netcdf4_init_variable( 'parallel', file_id, var_id, var_name, var_type, &
    2520                                      var_dim_id, is_global, return_value=output_return_value )
     3323         CALL binary_stop_file_header_definition( file_id, output_return_value )
     3324
     3325      CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     3326         CALL netcdf4_stop_file_header_definition( file_id, output_return_value )
    25213327
    25223328      CASE DEFAULT
    … …  
    25303336   IF ( output_return_value /= 0 )  THEN
    25313337      return_value = output_return_value
    2532       CALL internal_message( 'error', routine_name // &
    2533                              ': error while defining variable ' // TRIM( temp_string ) )
    2534    ENDIF
    2535 
    2536 END SUBROUTINE init_file_variable
    2537 
    2538 !--------------------------------------------------------------------------------------------------!
    2539 ! Description:
    2540 ! ------------
    2541 !> Finalize file definition/initialization.
    2542 !>
    2543 !> @todo Do we need an MPI barrier at the end?
    2544 !--------------------------------------------------------------------------------------------------!
    2545 SUBROUTINE dom_init_end( file_format, file_id, file_name, return_value )
    2546 
    2547    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
    2548    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    2549 
    2550    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_init_end'  !< name of routine
    2551 
    2552    INTEGER(iwp), INTENT(IN)  ::  file_id              !< file id
    2553    INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
    2554    INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
    2555 
    2556 
    2557    return_value = 0
    2558    output_return_value = 0
    2559 
    2560    temp_string = '(file "' // TRIM( file_name ) // '")'
    2561 
    2562    SELECT CASE ( TRIM( file_format ) )
    2563 
    2564       CASE ( 'binary' )
    2565          CALL binary_init_end( file_id, output_return_value )
    2566 
    2567       CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    2568          CALL netcdf4_init_end( file_id, output_return_value )
    2569 
    2570       CASE DEFAULT
    2571          return_value = 1
    2572          CALL internal_message( 'error', routine_name //                    &
    2573                                 ': file format "' // TRIM( file_format ) // &
    2574                                 '" not supported ' // TRIM( temp_string ) )
    2575 
    2576    END SELECT
    2577 
    2578    IF ( output_return_value /= 0 )  THEN
    2579       return_value = output_return_value
    2580       CALL internal_message( 'error', routine_name // &
     3338      CALL internal_message( 'error', routine_name //                          &
    25813339                             ': error while leaving file-definition state ' // &
    25823340                             TRIM( temp_string ) )
    … …  
    25853343   ! CALL MPI_Barrier( MPI_COMM_WORLD, return_value )
    25863344
    2587 END SUBROUTINE dom_init_end
     3345END SUBROUTINE stop_file_header_definition
    25883346
    25893347!--------------------------------------------------------------------------------------------------!
    25903348! Description:
    25913349! ------------
    2592 !> Write variable to file.
    2593 !> Example call:
    2594 !>   dom_write_var( file_format = 'binary', &
    2595 !>                  filename = 'DATA_OUTPUT_3D', &
    2596 !>                  name = 'u', &
    2597 !>                  var_real64_3d = u, &
    2598 !>                  bounds_start = (/nxl, nys, nzb, time_step/), &
    2599 !>                  bounds_end = (/nxr, nyn, nzt, time_step/)  )
    2600 !> @note The order of dimension bounds must match to the order of dimensions given in call
    2601 !>       'dom_def_var'. I.e., the corresponding variable definition should be like:
    2602 !>          dom_def_var( filename =  'DATA_OUTPUT_3D', &
    2603 !>                       name = 'u', &
    2604 !>                       dimension_names = (/'x   ', 'y   ', 'z   ', 'time'/), &
    2605 !>                       output_type = <desired-output-type> )
    2606 !--------------------------------------------------------------------------------------------------!
    2607 FUNCTION dom_write_var( filename, name, bounds_start, bounds_end,       &
    2608             var_int8_0d,   var_int8_1d,   var_int8_2d,   var_int8_3d,   &
    2609             var_int16_0d,  var_int16_1d,  var_int16_2d,  var_int16_3d,  &
    2610             var_int32_0d,  var_int32_1d,  var_int32_2d,  var_int32_3d,  &
    2611             var_intwp_0d,  var_intwp_1d,  var_intwp_2d,  var_intwp_3d,  &
    2612             var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
    2613             var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
    2614             var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d  &
    2615             ) RESULT( return_value )
    2616 
    2617    CHARACTER(LEN=charlen)       ::  file_format  !< file format chosen for file
    2618    CHARACTER(LEN=*), INTENT(IN) ::  filename     !< name of file
    2619    CHARACTER(LEN=*), INTENT(IN) ::  name         !< name of variable
    2620 
    2621    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
    2622 
    2623    INTEGER(iwp) ::  file_id              !< file ID
    2624    INTEGER(iwp) ::  i                    !< loop index
    2625    INTEGER(iwp) ::  j                    !< loop index
    2626    INTEGER(iwp) ::  k                    !< loop index
    2627    INTEGER(iwp) ::  output_return_value  !< return value of a called output routine
    2628    INTEGER(iwp) ::  return_value         !< return value
    2629    INTEGER(iwp) ::  var_id               !< variable ID
    2630 
    2631    INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_end             !< end index per dimension of variable
    2632    INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_start           !< start index per dimension of variable
    2633    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_origin          !< first index of each dimension
    2634    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_start_internal  !< start index per dim. for output after masking
    2635    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  value_counts           !< count of indices to be written per dimension
    2636    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  masked_indices         !< list containing all output indices along a dimension
    2637 
    2638    LOGICAL ::  do_output  !< true if any data lies within given range of masked dimension
    2639    LOGICAL ::  is_global  !< true if variable is global
    2640 
    2641    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                   ::  var_int8_0d  !< output variable
    2642    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int8_1d  !< output variable
    2643    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int8_2d  !< output variable
    2644    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int8_3d  !< output variable
    2645 
    2646    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int8_1d_resorted  !< resorted output variable
    2647    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int8_2d_resorted  !< resorted output variable
    2648    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int8_3d_resorted  !< resorted output variable
    2649 
    2650    INTEGER(KIND=1), POINTER                               ::  var_int8_0d_pointer  !< output variable
    2651    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int8_1d_pointer  !< output variable
    2652    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int8_2d_pointer  !< output variable
    2653    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int8_3d_pointer  !< output variable
    2654 
    2655    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                   ::  var_int16_0d  !< output variable
    2656    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int16_1d  !< output variable
    2657    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int16_2d  !< output variable
    2658    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int16_3d  !< output variable
    2659 
    2660    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int16_1d_resorted  !< resorted output variable
    2661    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int16_2d_resorted  !< resorted output variable
    2662    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int16_3d_resorted  !< resorted output variable
    2663 
    2664    INTEGER(KIND=2), POINTER                               ::  var_int16_0d_pointer  !< output variable
    2665    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int16_1d_pointer  !< output variable
    2666    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int16_2d_pointer  !< output variable
    2667    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int16_3d_pointer  !< output variable
    2668 
    2669    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  var_int32_0d  !< output variable
    2670    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int32_1d  !< output variable
    2671    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int32_2d  !< output variable
    2672    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int32_3d  !< output variable
    2673 
    2674    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_int32_1d_resorted  !< resorted output variable
    2675    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_int32_2d_resorted  !< resorted output variable
    2676    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_int32_3d_resorted  !< resorted output variable
    2677 
    2678    INTEGER(KIND=4), POINTER                               ::  var_int32_0d_pointer  !< output variable
    2679    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_int32_1d_pointer  !< output variable
    2680    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_int32_2d_pointer  !< output variable
    2681    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_int32_3d_pointer  !< output variable
    2682 
    2683    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL                   ::  var_intwp_0d  !< output variable
    2684    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_intwp_1d  !< output variable
    2685    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_intwp_2d  !< output variable
    2686    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_intwp_3d  !< output variable
    2687 
    2688    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_intwp_1d_resorted  !< resorted output variable
    2689    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_intwp_2d_resorted  !< resorted output variable
    2690    INTEGER(iwp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_intwp_3d_resorted  !< resorted output variable
    2691 
    2692    INTEGER(iwp), POINTER                               ::  var_intwp_0d_pointer  !< output variable
    2693    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_intwp_1d_pointer  !< output variable
    2694    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_intwp_2d_pointer  !< output variable
    2695    INTEGER(iwp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_intwp_3d_pointer  !< output variable
    2696 
    2697    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  var_real32_0d  !< output variable
    2698    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real32_1d  !< output variable
    2699    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real32_2d  !< output variable
    2700    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real32_3d  !< output variable
    2701 
    2702    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_real32_1d_resorted  !< resorted output variable
    2703    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_real32_2d_resorted  !< resorted output variable
    2704    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_real32_3d_resorted  !< resorted output variable
    2705 
    2706    REAL(KIND=4), POINTER                               ::  var_real32_0d_pointer  !< output variable
    2707    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_real32_1d_pointer  !< output variable
    2708    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_real32_2d_pointer  !< output variable
    2709    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_real32_3d_pointer  !< output variable
    2710 
    2711    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                   ::  var_real64_0d  !< output variable
    2712    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real64_1d  !< output variable
    2713    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real64_2d  !< output variable
    2714    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real64_3d  !< output variable
    2715 
    2716    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_real64_1d_resorted  !< resorted output variable
    2717    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_real64_2d_resorted  !< resorted output variable
    2718    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_real64_3d_resorted  !< resorted output variable
    2719 
    2720    REAL(KIND=8), POINTER                               ::  var_real64_0d_pointer  !< output variable
    2721    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_real64_1d_pointer  !< output variable
    2722    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_real64_2d_pointer  !< output variable
    2723    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_real64_3d_pointer  !< output variable
    2724 
    2725    REAL(wp), POINTER, INTENT(IN), OPTIONAL                   ::  var_realwp_0d  !< output variable
    2726    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_realwp_1d  !< output variable
    2727    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_realwp_2d  !< output variable
    2728    REAL(wp), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_realwp_3d  !< output variable
    2729 
    2730    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:)     ::  var_realwp_1d_resorted  !< resorted output variable
    2731    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:)   ::  var_realwp_2d_resorted  !< resorted output variable
    2732    REAL(wp), TARGET, ALLOCATABLE, DIMENSION(:,:,:) ::  var_realwp_3d_resorted  !< resorted output variable
    2733 
    2734    REAL(wp), POINTER                               ::  var_realwp_0d_pointer  !< output variable
    2735    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:)     ::  var_realwp_1d_pointer  !< output variable
    2736    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:)   ::  var_realwp_2d_pointer  !< output variable
    2737    REAL(wp), POINTER, CONTIGUOUS, DIMENSION(:,:,:) ::  var_realwp_3d_pointer  !< output variable
    2738 
    2739    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimension_list  !< list of used dimensions of variable
    2740 
    2741 
    2742    return_value = 0
    2743    output_return_value = 0
    2744 
    2745    CALL internal_message( 'debug', routine_name // ': write ' // TRIM( name ) // &
    2746                                    ' into file ' // TRIM( filename ) )
    2747 
    2748    !-- Search for variable within file
    2749    CALL find_var_in_file( filename, name, file_format, file_id, var_id, &
    2750                       is_global, dimension_list, return_value=return_value  )
    2751 
    2752    IF ( return_value == 0 )  THEN
    2753 
    2754       !-- Check if the correct amount of variable bounds were given
    2755       IF ( SIZE( bounds_start ) /= SIZE( dimension_list )  .OR.  &
    2756            SIZE( bounds_end ) /= SIZE( dimension_list ) )  THEN
    2757          return_value = 1
    2758          CALL internal_message( 'error', routine_name //             &
    2759                                 ': variable "' // TRIM( name ) //    &
    2760                                 '" in file "' // TRIM( filename ) // &
    2761                                 '": given bounds do not match with number of dimensions' )
    2762       ENDIF
    2763 
    2764    ENDIF
    2765 
    2766 
    2767    IF ( return_value == 0 )  THEN
    2768 
    2769       !-- Save starting index (lower bounds) of each dimension
    2770       ALLOCATE( bounds_origin(SIZE( dimension_list )) )
    2771       ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
    2772       ALLOCATE( value_counts(SIZE( dimension_list )) )
    2773 
    2774       WRITE( temp_string, * ) bounds_start
    2775       CALL internal_message( 'debug', routine_name //                     &
    2776                                       ': file "' // TRIM( filename ) //   &
    2777                                        '": variable "' // TRIM( name ) // &
    2778                                        '": bounds_start =' // TRIM( temp_string ) )
    2779       WRITE( temp_string, * ) bounds_end
    2780       CALL internal_message( 'debug', routine_name //                     &
    2781                                       ': file "' // TRIM( filename ) //   &
    2782                                        '": variable "' // TRIM( name ) // &
    2783                                        '": bounds_end =' // TRIM( temp_string ) )
    2784 
    2785       !-- Get bounds for masking
    2786       CALL get_masked_indices_and_masked_dimension_bounds( dimension_list,                  &
    2787               bounds_start, bounds_end, bounds_start_internal, value_counts, bounds_origin, &
    2788               masked_indices )
    2789 
    2790       do_output = .NOT. ANY( value_counts == 0 )
    2791 
    2792       WRITE( temp_string, * ) bounds_start_internal
    2793       CALL internal_message( 'debug', routine_name //                     &
    2794                                       ': file "' // TRIM( filename ) //   &
    2795                                        '": variable "' // TRIM( name ) // &
    2796                                        '": bounds_start_internal =' // TRIM( temp_string ) )
    2797       WRITE( temp_string, * ) value_counts
    2798       CALL internal_message( 'debug', routine_name //                     &
    2799                                       ': file "' // TRIM( filename ) //   &
    2800                                        '": variable "' // TRIM( name ) // &
    2801                                        '": value_counts =' // TRIM( temp_string ) )
    2802 
    2803       !-- Mask and resort variable
    2804       !-- 8bit integer output
    2805       IF ( PRESENT( var_int8_0d ) )  THEN
    2806          var_int8_0d_pointer => var_int8_0d
    2807       ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    2808          IF ( do_output ) THEN
    2809             ALLOCATE( var_int8_1d_resorted(0:value_counts(1)-1) )
    2810             !$OMP PARALLEL PRIVATE (i)
    2811             !$OMP DO
    2812             DO  i = 0, value_counts(1) - 1
    2813                var_int8_1d_resorted(i) = var_int8_1d(masked_indices(1,i))
    2814             ENDDO
    2815             !$OMP END PARALLEL
    2816          ELSE
    2817             ALLOCATE( var_int8_1d_resorted(1) )
    2818             var_int8_1d_resorted = 0_1
    2819          ENDIF
    2820          var_int8_1d_pointer => var_int8_1d_resorted
    2821       ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    2822          IF ( do_output ) THEN
    2823             ALLOCATE( var_int8_2d_resorted(0:value_counts(1)-1, &
    2824                                            0:value_counts(2)-1) )
    2825             !$OMP PARALLEL PRIVATE (i,j)
    2826             !$OMP DO
    2827             DO  i = 0, value_counts(1) - 1
    2828                DO  j = 0, value_counts(2) - 1
    2829                   var_int8_2d_resorted(i,j) = var_int8_2d(masked_indices(2,j), &
    2830                                                           masked_indices(1,i)  )
    2831                ENDDO
    2832             ENDDO
    2833             !$OMP END PARALLEL
    2834          ELSE
    2835             ALLOCATE( var_int8_2d_resorted(1,1) )
    2836             var_int8_2d_resorted = 0_1
    2837          ENDIF
    2838          var_int8_2d_pointer => var_int8_2d_resorted
    2839       ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    2840          IF ( do_output ) THEN
    2841             ALLOCATE( var_int8_3d_resorted(0:value_counts(1)-1, &
    2842                                            0:value_counts(2)-1, &
    2843                                            0:value_counts(3)-1) )
    2844             !$OMP PARALLEL PRIVATE (i,j,k)
    2845             !$OMP DO
    2846             DO  i = 0, value_counts(1) - 1
    2847                DO  j = 0, value_counts(2) - 1
    2848                   DO  k = 0, value_counts(3) - 1
    2849                      var_int8_3d_resorted(i,j,k) = var_int8_3d(masked_indices(3,k), &
    2850                                                                masked_indices(2,j), &
    2851                                                                masked_indices(1,i)  )
    2852                   ENDDO
    2853                ENDDO
    2854             ENDDO
    2855             !$OMP END PARALLEL
    2856          ELSE
    2857             ALLOCATE( var_int8_3d_resorted(1,1,1) )
    2858             var_int8_3d_resorted = 0_1
    2859          ENDIF
    2860          var_int8_3d_pointer => var_int8_3d_resorted
    2861 
    2862       !-- 16bit integer output
    2863       ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    2864          var_int16_0d_pointer => var_int16_0d
    2865       ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    2866          IF ( do_output ) THEN
    2867             ALLOCATE( var_int16_1d_resorted(0:value_counts(1)-1) )
    2868             !$OMP PARALLEL PRIVATE (i)
    2869             !$OMP DO
    2870             DO  i = 0, value_counts(1) - 1
    2871                var_int16_1d_resorted(i) = var_int16_1d(masked_indices(1,i))
    2872             ENDDO
    2873             !$OMP END PARALLEL
    2874          ELSE
    2875             ALLOCATE( var_int16_1d_resorted(1) )
    2876             var_int16_1d_resorted = 0_1
    2877          ENDIF
    2878          var_int16_1d_pointer => var_int16_1d_resorted
    2879       ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    2880          IF ( do_output ) THEN
    2881             ALLOCATE( var_int16_2d_resorted(0:value_counts(1)-1, &
    2882                                             0:value_counts(2)-1) )
    2883             !$OMP PARALLEL PRIVATE (i,j)
    2884             !$OMP DO
    2885             DO  i = 0, value_counts(1) - 1
    2886                DO  j = 0, value_counts(2) - 1
    2887                   var_int16_2d_resorted(i,j) = var_int16_2d(masked_indices(2,j), &
    2888                                                             masked_indices(1,i))
    2889                ENDDO
    2890             ENDDO
    2891             !$OMP END PARALLEL
    2892          ELSE
    2893             ALLOCATE( var_int16_2d_resorted(1,1) )
    2894             var_int16_2d_resorted = 0_1
    2895          ENDIF
    2896          var_int16_2d_pointer => var_int16_2d_resorted
    2897       ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    2898          IF ( do_output ) THEN
    2899             ALLOCATE( var_int16_3d_resorted(0:value_counts(1)-1, &
    2900                                             0:value_counts(2)-1, &
    2901                                             0:value_counts(3)-1) )
    2902             !$OMP PARALLEL PRIVATE (i,j,k)
    2903             !$OMP DO
    2904             DO  i = 0, value_counts(1) - 1
    2905                DO  j = 0, value_counts(2) - 1
    2906                   DO  k = 0, value_counts(3) - 1
    2907                      var_int16_3d_resorted(i,j,k) = var_int16_3d(masked_indices(3,k), &
    2908                                                                  masked_indices(2,j), &
    2909                                                                  masked_indices(1,i)  )
    2910                   ENDDO
    2911                ENDDO
    2912             ENDDO
    2913             !$OMP END PARALLEL
    2914          ELSE
    2915             ALLOCATE( var_int16_3d_resorted(1,1,1) )
    2916             var_int16_3d_resorted = 0_1
    2917          ENDIF
    2918          var_int16_3d_pointer => var_int16_3d_resorted
    2919 
    2920       !-- 32bit integer output
    2921       ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    2922          var_int32_0d_pointer => var_int32_0d
    2923       ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    2924          IF ( do_output ) THEN
    2925             ALLOCATE( var_int32_1d_resorted(0:value_counts(1)-1) )
    2926             !$OMP PARALLEL PRIVATE (i)
    2927             !$OMP DO
    2928             DO  i = 0, value_counts(1) - 1
    2929                var_int32_1d_resorted(i) = var_int32_1d(masked_indices(1,i))
    2930             ENDDO
    2931             !$OMP END PARALLEL
    2932          ELSE
    2933             ALLOCATE( var_int32_1d_resorted(1) )
    2934             var_int32_1d_resorted = 0_1
    2935          ENDIF
    2936          var_int32_1d_pointer => var_int32_1d_resorted
    2937       ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    2938          IF ( do_output ) THEN
    2939             ALLOCATE( var_int32_2d_resorted(0:value_counts(1)-1, &
    2940                                             0:value_counts(2)-1) )
    2941             !$OMP PARALLEL PRIVATE (i,j)
    2942             !$OMP DO
    2943             DO  i = 0, value_counts(1) - 1
    2944                DO  j = 0, value_counts(2) - 1
    2945                   var_int32_2d_resorted(i,j) = var_int32_2d(masked_indices(2,j), &
    2946                                                             masked_indices(1,i)  )
    2947                ENDDO
    2948             ENDDO
    2949             !$OMP END PARALLEL
    2950          ELSE
    2951             ALLOCATE( var_int32_2d_resorted(1,1) )
    2952             var_int32_2d_resorted = 0_1
    2953          ENDIF
    2954          var_int32_2d_pointer => var_int32_2d_resorted
    2955       ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    2956          IF ( do_output ) THEN
    2957             ALLOCATE( var_int32_3d_resorted(0:value_counts(1)-1, &
    2958                                             0:value_counts(2)-1, &
    2959                                             0:value_counts(3)-1) )
    2960             !$OMP PARALLEL PRIVATE (i,j,k)
    2961             !$OMP DO
    2962             DO  i = 0, value_counts(1) - 1
    2963                DO  j = 0, value_counts(2) - 1
    2964                   DO  k = 0, value_counts(3) - 1
    2965                      var_int32_3d_resorted(i,j,k) = var_int32_3d(masked_indices(3,k), &
    2966                                                                  masked_indices(2,j), &
    2967                                                                  masked_indices(1,i)  )
    2968                   ENDDO
    2969                ENDDO
    2970             ENDDO
    2971             !$OMP END PARALLEL
    2972          ELSE
    2973             ALLOCATE( var_int32_3d_resorted(1,1,1) )
    2974             var_int32_3d_resorted = 0_1
    2975          ENDIF
    2976          var_int32_3d_pointer => var_int32_3d_resorted
    2977 
    2978       !-- working-precision integer output
    2979       ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    2980          var_intwp_0d_pointer => var_intwp_0d
    2981       ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    2982          IF ( do_output ) THEN
    2983             ALLOCATE( var_intwp_1d_resorted(0:value_counts(1)-1) )
    2984             !$OMP PARALLEL PRIVATE (i)
    2985             !$OMP DO
    2986             DO  i = 0, value_counts(1) - 1
    2987                var_intwp_1d_resorted(i) = var_intwp_1d(masked_indices(1,i))
    2988             ENDDO
    2989             !$OMP END PARALLEL
    2990          ELSE
    2991             ALLOCATE( var_intwp_1d_resorted(1) )
    2992             var_intwp_1d_resorted = 0_1
    2993          ENDIF
    2994          var_intwp_1d_pointer => var_intwp_1d_resorted
    2995       ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    2996          IF ( do_output ) THEN
    2997             ALLOCATE( var_intwp_2d_resorted(0:value_counts(1)-1, &
    2998                                             0:value_counts(2)-1) )
    2999             !$OMP PARALLEL PRIVATE (i,j)
    3000             !$OMP DO
    3001             DO  i = 0, value_counts(1) - 1
    3002                DO  j = 0, value_counts(2) - 1
    3003                   var_intwp_2d_resorted(i,j) = var_intwp_2d(masked_indices(2,j), &
    3004                                                             masked_indices(1,i)  )
    3005                ENDDO
    3006             ENDDO
    3007             !$OMP END PARALLEL
    3008          ELSE
    3009             ALLOCATE( var_intwp_2d_resorted(1,1) )
    3010             var_intwp_2d_resorted = 0_1
    3011          ENDIF
    3012          var_intwp_2d_pointer => var_intwp_2d_resorted
    3013       ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3014          IF ( do_output ) THEN
    3015             ALLOCATE( var_intwp_3d_resorted(0:value_counts(1)-1, &
    3016                                             0:value_counts(2)-1, &
    3017                                             0:value_counts(3)-1) )
    3018             !$OMP PARALLEL PRIVATE (i,j,k)
    3019             !$OMP DO
    3020             DO  i = 0, value_counts(1) - 1
    3021                DO  j = 0, value_counts(2) - 1
    3022                   DO  k = 0, value_counts(3) - 1
    3023                      var_intwp_3d_resorted(i,j,k) = var_intwp_3d(masked_indices(3,k), &
    3024                                                                  masked_indices(2,j), &
    3025                                                                  masked_indices(1,i)  )
    3026                   ENDDO
    3027                ENDDO
    3028             ENDDO
    3029             !$OMP END PARALLEL
    3030          ELSE
    3031             ALLOCATE( var_intwp_3d_resorted(1,1,1) )
    3032             var_intwp_3d_resorted = 0_1
    3033          ENDIF
    3034          var_intwp_3d_pointer => var_intwp_3d_resorted
    3035 
    3036       !-- 32bit real output
    3037       ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3038          var_real32_0d_pointer => var_real32_0d
    3039       ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3040          IF ( do_output ) THEN
    3041             ALLOCATE( var_real32_1d_resorted(0:value_counts(1)-1) )
    3042             !$OMP PARALLEL PRIVATE (i)
    3043             !$OMP DO
    3044             DO  i = 0, value_counts(1) - 1
    3045                var_real32_1d_resorted(i) = var_real32_1d(masked_indices(1,i))
    3046             ENDDO
    3047             !$OMP END PARALLEL
    3048          ELSE
    3049             ALLOCATE( var_real32_1d_resorted(1) )
    3050             var_real32_1d_resorted = 0_1
    3051          ENDIF
    3052          var_real32_1d_pointer => var_real32_1d_resorted
    3053       ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3054          IF ( do_output ) THEN
    3055             ALLOCATE( var_real32_2d_resorted(0:value_counts(1)-1, &
    3056                                              0:value_counts(2)-1) )
    3057             !$OMP PARALLEL PRIVATE (i,j)
    3058             !$OMP DO
    3059             DO  i = 0, value_counts(1) - 1
    3060                DO  j = 0, value_counts(2) - 1
    3061                   var_real32_2d_resorted(i,j) = var_real32_2d(masked_indices(2,j), &
    3062                                                               masked_indices(1,i)  )
    3063                ENDDO
    3064             ENDDO
    3065             !$OMP END PARALLEL
    3066          ELSE
    3067             ALLOCATE( var_real32_2d_resorted(1,1) )
    3068             var_real32_2d_resorted = 0_1
    3069          ENDIF
    3070          var_real32_2d_pointer => var_real32_2d_resorted
    3071       ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3072          IF ( do_output ) THEN
    3073             ALLOCATE( var_real32_3d_resorted(0:value_counts(1)-1, &
    3074                                              0:value_counts(2)-1, &
    3075                                              0:value_counts(3)-1) )
    3076             !$OMP PARALLEL PRIVATE (i,j,k)
    3077             !$OMP DO
    3078             DO  i = 0, value_counts(1) - 1
    3079                DO  j = 0, value_counts(2) - 1
    3080                   DO  k = 0, value_counts(3) - 1
    3081                      var_real32_3d_resorted(i,j,k) = var_real32_3d(masked_indices(3,k), &
    3082                                                                    masked_indices(2,j), &
    3083                                                                    masked_indices(1,i)  )
    3084                   ENDDO
    3085                ENDDO
    3086             ENDDO
    3087             !$OMP END PARALLEL
    3088          ELSE
    3089             ALLOCATE( var_real32_3d_resorted(1,1,1) )
    3090             var_real32_3d_resorted = 0_1
    3091          ENDIF
    3092          var_real32_3d_pointer => var_real32_3d_resorted
    3093 
    3094       !-- 64bit real output
    3095       ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3096          var_real64_0d_pointer => var_real64_0d
    3097       ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3098          IF ( do_output ) THEN
    3099             ALLOCATE( var_real64_1d_resorted(0:value_counts(1)-1) )
    3100             !$OMP PARALLEL PRIVATE (i)
    3101             !$OMP DO
    3102             DO  i = 0, value_counts(1) - 1
    3103                var_real64_1d_resorted(i) = var_real64_1d(masked_indices(1,i))
    3104             ENDDO
    3105             !$OMP END PARALLEL
    3106          ELSE
    3107             ALLOCATE( var_real64_1d_resorted(1) )
    3108             var_real64_1d_resorted = 0_1
    3109          ENDIF
    3110          var_real64_1d_pointer => var_real64_1d_resorted
    3111       ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3112          IF ( do_output ) THEN
    3113             ALLOCATE( var_real64_2d_resorted(0:value_counts(1)-1, &
    3114                                              0:value_counts(2)-1) )
    3115             !$OMP PARALLEL PRIVATE (i,j)
    3116             !$OMP DO
    3117             DO  i = 0, value_counts(1) - 1
    3118                DO  j = 0, value_counts(2) - 1
    3119                   var_real64_2d_resorted(i,j) = var_real64_2d(masked_indices(2,j), &
    3120                                                               masked_indices(1,i)  )
    3121                ENDDO
    3122             ENDDO
    3123             !$OMP END PARALLEL
    3124          ELSE
    3125             ALLOCATE( var_real64_2d_resorted(1,1) )
    3126             var_real64_2d_resorted = 0_1
    3127          ENDIF
    3128          var_real64_2d_pointer => var_real64_2d_resorted
    3129       ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3130          IF ( do_output ) THEN
    3131             ALLOCATE( var_real64_3d_resorted(0:value_counts(1)-1, &
    3132                                              0:value_counts(2)-1, &
    3133                                              0:value_counts(3)-1) )
    3134             !$OMP PARALLEL PRIVATE (i,j,k)
    3135             !$OMP DO
    3136             DO  i = 0, value_counts(1) - 1
    3137                DO  j = 0, value_counts(2) - 1
    3138                   DO  k = 0, value_counts(3) - 1
    3139                      var_real64_3d_resorted(i,j,k) = var_real64_3d(masked_indices(3,k), &
    3140                                                                    masked_indices(2,j), &
    3141                                                                    masked_indices(1,i)  )
    3142                   ENDDO
    3143                ENDDO
    3144             ENDDO
    3145             !$OMP END PARALLEL
    3146          ELSE
    3147             ALLOCATE( var_real64_3d_resorted(1,1,1) )
    3148             var_real64_3d_resorted = 0_1
    3149          ENDIF
    3150          var_real64_3d_pointer => var_real64_3d_resorted
    3151 
    3152       !-- working-precision real output
    3153       ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3154          var_realwp_0d_pointer => var_realwp_0d
    3155       ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3156          IF ( do_output ) THEN
    3157             ALLOCATE( var_realwp_1d_resorted(0:value_counts(1)-1) )
    3158             !$OMP PARALLEL PRIVATE (i)
    3159             !$OMP DO
    3160             DO  i = 0, value_counts(1) - 1
    3161                var_realwp_1d_resorted(i) = var_realwp_1d(masked_indices(1,i))
    3162             ENDDO
    3163             !$OMP END PARALLEL
    3164          ELSE
    3165             ALLOCATE( var_realwp_1d_resorted(1) )
    3166             var_realwp_1d_resorted = 0_1
    3167          ENDIF
    3168          var_realwp_1d_pointer => var_realwp_1d_resorted
    3169       ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3170          IF ( do_output ) THEN
    3171             ALLOCATE( var_realwp_2d_resorted(0:value_counts(1)-1, &
    3172                                              0:value_counts(2)-1) )
    3173             !$OMP PARALLEL PRIVATE (i,j)
    3174             !$OMP DO
    3175             DO  i = 0, value_counts(1) - 1
    3176                DO  j = 0, value_counts(2) - 1
    3177                   var_realwp_2d_resorted(i,j) = var_realwp_2d(masked_indices(2,j), &
    3178                                                               masked_indices(1,i)  )
    3179                ENDDO
    3180             ENDDO
    3181             !$OMP END PARALLEL
    3182          ELSE
    3183             ALLOCATE( var_realwp_2d_resorted(1,1) )
    3184             var_realwp_2d_resorted = 0_1
    3185          ENDIF
    3186          var_realwp_2d_pointer => var_realwp_2d_resorted
    3187       ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3188          IF ( do_output ) THEN
    3189             ALLOCATE( var_realwp_3d_resorted(0:value_counts(1)-1, &
    3190                                              0:value_counts(2)-1, &
    3191                                              0:value_counts(3)-1) )
    3192             !$OMP PARALLEL PRIVATE (i,j,k)
    3193             !$OMP DO
    3194             DO  i = 0, value_counts(1) - 1
    3195                DO  j = 0, value_counts(2) - 1
    3196                   DO  k = 0, value_counts(3) - 1
    3197                      var_realwp_3d_resorted(i,j,k) = var_realwp_3d(masked_indices(3,k), &
    3198                                                                    masked_indices(2,j), &
    3199                                                                    masked_indices(1,i)  )
    3200                   ENDDO
    3201                ENDDO
    3202             ENDDO
    3203             !$OMP END PARALLEL
    3204          ELSE
    3205             ALLOCATE( var_realwp_3d_resorted(1,1,1) )
    3206             var_realwp_3d_resorted = 0_1
    3207          ENDIF
    3208          var_realwp_3d_pointer => var_realwp_3d_resorted
    3209 
    3210       ELSE
    3211          return_value = 1
    3212          CALL internal_message( 'error', routine_name //                      &
    3213                                          ': variable "' // TRIM( name ) //    &
    3214                                          '" in file "' // TRIM( filename ) // &
    3215                                          '": no values given to output' )
    3216       ENDIF
    3217 
    3218       DEALLOCATE( masked_indices )
    3219 
    3220    ENDIF  ! Check for error
    3221 
    3222    IF ( return_value == 0 )  THEN
    3223 
    3224       !-- Write variable into file
    3225       SELECT CASE ( TRIM( file_format ) )
    3226 
    3227          CASE ( 'binary' )
    3228             !-- 8bit integer output
    3229             IF ( PRESENT( var_int8_0d ) )  THEN
    3230                CALL binary_write_variable( file_id, var_id,                           &
    3231                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3232                        var_int8_0d=var_int8_0d_pointer, return_value=output_return_value )
    3233             ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    3234                CALL binary_write_variable( file_id, var_id,                           &
    3235                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3236                        var_int8_1d=var_int8_1d_pointer, return_value=output_return_value )
    3237             ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    3238                CALL binary_write_variable( file_id, var_id,                           &
    3239                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3240                        var_int8_2d=var_int8_2d_pointer, return_value=output_return_value )
    3241             ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    3242                CALL binary_write_variable( file_id, var_id,                           &
    3243                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3244                        var_int8_3d=var_int8_3d_pointer, return_value=output_return_value )
    3245             !-- 16bit integer output
    3246             ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    3247                CALL binary_write_variable( file_id, var_id,                           &
    3248                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3249                        var_int16_0d=var_int16_0d_pointer, return_value=output_return_value )
    3250             ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    3251                CALL binary_write_variable( file_id, var_id,                           &
    3252                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3253                        var_int16_1d=var_int16_1d_pointer, return_value=output_return_value )
    3254             ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    3255                CALL binary_write_variable( file_id, var_id,                           &
    3256                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3257                        var_int16_2d=var_int16_2d_pointer, return_value=output_return_value )
    3258             ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    3259                CALL binary_write_variable( file_id, var_id,                           &
    3260                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3261                        var_int16_3d=var_int16_3d_pointer, return_value=output_return_value )
    3262             !-- 32bit integer output
    3263             ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    3264                CALL binary_write_variable( file_id, var_id,                           &
    3265                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3266                        var_int32_0d=var_int32_0d_pointer, return_value=output_return_value )
    3267             ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    3268                CALL binary_write_variable( file_id, var_id,                           &
    3269                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3270                        var_int32_1d=var_int32_1d_pointer, return_value=output_return_value )
    3271             ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    3272                CALL binary_write_variable( file_id, var_id,                           &
    3273                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3274                        var_int32_2d=var_int32_2d_pointer, return_value=output_return_value )
    3275             ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    3276                CALL binary_write_variable( file_id, var_id,                           &
    3277                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3278                        var_int32_3d=var_int32_3d_pointer, return_value=output_return_value )
    3279             !-- working-precision integer output
    3280             ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    3281                CALL binary_write_variable( file_id, var_id,                           &
    3282                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3283                        var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value )
    3284             ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    3285                CALL binary_write_variable( file_id, var_id,                           &
    3286                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3287                        var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value )
    3288             ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    3289                CALL binary_write_variable( file_id, var_id,                           &
    3290                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3291                        var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value )
    3292             ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3293                CALL binary_write_variable( file_id, var_id,                           &
    3294                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3295                        var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value )
    3296             !-- 32bit real output
    3297             ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3298                CALL binary_write_variable( file_id, var_id,                           &
    3299                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3300                        var_real32_0d=var_real32_0d_pointer, return_value=output_return_value )
    3301             ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3302                CALL binary_write_variable( file_id, var_id,                           &
    3303                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3304                        var_real32_1d=var_real32_1d_pointer, return_value=output_return_value )
    3305             ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3306                CALL binary_write_variable( file_id, var_id,                           &
    3307                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3308                        var_real32_2d=var_real32_2d_pointer, return_value=output_return_value )
    3309             ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3310                CALL binary_write_variable( file_id, var_id,                           &
    3311                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3312                        var_real32_3d=var_real32_3d_pointer, return_value=output_return_value )
    3313             !-- 64bit real output
    3314             ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3315                CALL binary_write_variable( file_id, var_id,                           &
    3316                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3317                        var_real64_0d=var_real64_0d_pointer, return_value=output_return_value )
    3318             ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3319                CALL binary_write_variable( file_id, var_id,                           &
    3320                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3321                        var_real64_1d=var_real64_1d_pointer, return_value=output_return_value )
    3322             ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3323                CALL binary_write_variable( file_id, var_id,                           &
    3324                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3325                        var_real64_2d=var_real64_2d_pointer, return_value=output_return_value )
    3326             ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3327                CALL binary_write_variable( file_id, var_id,                           &
    3328                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3329                        var_real64_3d=var_real64_3d_pointer, return_value=output_return_value )
    3330             !-- working-precision real output
    3331             ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3332                CALL binary_write_variable( file_id, var_id,                           &
    3333                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3334                        var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value )
    3335             ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3336                CALL binary_write_variable( file_id, var_id,                           &
    3337                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3338                        var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value )
    3339             ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3340                CALL binary_write_variable( file_id, var_id,                           &
    3341                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3342                        var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value )
    3343             ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3344                CALL binary_write_variable( file_id, var_id,                           &
    3345                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3346                        var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value )
    3347             ELSE
    3348                return_value = 1
    3349                CALL internal_message( 'error', routine_name //                           &
    3350                                       ': variable "' // TRIM( name ) //                  &
    3351                                       '" in file "' // TRIM( filename ) //               &
    3352                                       '": output_type not supported by file format "' // &
    3353                                       TRIM( file_format ) // '"' )
    3354             ENDIF
    3355 
    3356          CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    3357             !-- 8bit integer output
    3358             IF ( PRESENT( var_int8_0d ) )  THEN
    3359                CALL netcdf4_write_variable( file_id, var_id,                          &
    3360                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3361                        var_int8_0d=var_int8_0d_pointer, return_value=output_return_value )
    3362             ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    3363                CALL netcdf4_write_variable( file_id, var_id,                          &
    3364                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3365                        var_int8_1d=var_int8_1d_pointer, return_value=output_return_value )
    3366             ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    3367                CALL netcdf4_write_variable( file_id, var_id,                          &
    3368                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3369                        var_int8_2d=var_int8_2d_pointer, return_value=output_return_value )
    3370             ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    3371                CALL netcdf4_write_variable( file_id, var_id,                          &
    3372                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3373                        var_int8_3d=var_int8_3d_pointer, return_value=output_return_value )
    3374             !-- 16bit integer output
    3375             ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    3376                CALL netcdf4_write_variable( file_id, var_id,                          &
    3377                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3378                        var_int16_0d=var_int16_0d_pointer, return_value=output_return_value )
    3379             ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    3380                CALL netcdf4_write_variable( file_id, var_id,                          &
    3381                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3382                        var_int16_1d=var_int16_1d_pointer, return_value=output_return_value )
    3383             ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    3384                CALL netcdf4_write_variable( file_id, var_id,                          &
    3385                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3386                        var_int16_2d=var_int16_2d_pointer, return_value=output_return_value )
    3387             ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    3388                CALL netcdf4_write_variable( file_id, var_id,                          &
    3389                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3390                        var_int16_3d=var_int16_3d_pointer, return_value=output_return_value )
    3391             !-- 32bit integer output
    3392             ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    3393                CALL netcdf4_write_variable( file_id, var_id,                          &
    3394                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3395                        var_int32_0d=var_int32_0d_pointer, return_value=output_return_value )
    3396             ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    3397                CALL netcdf4_write_variable( file_id, var_id,                          &
    3398                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3399                        var_int32_1d=var_int32_1d_pointer, return_value=output_return_value )
    3400             ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    3401                CALL netcdf4_write_variable( file_id, var_id,                          &
    3402                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3403                        var_int32_2d=var_int32_2d_pointer, return_value=output_return_value )
    3404             ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    3405                CALL netcdf4_write_variable( file_id, var_id,                          &
    3406                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3407                        var_int32_3d=var_int32_3d_pointer, return_value=output_return_value )
    3408             !-- working-precision integer output
    3409             ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    3410                CALL netcdf4_write_variable( file_id, var_id,                          &
    3411                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3412                        var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value )
    3413             ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    3414                CALL netcdf4_write_variable( file_id, var_id,                          &
    3415                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3416                        var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value )
    3417             ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    3418                CALL netcdf4_write_variable( file_id, var_id,                          &
    3419                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3420                        var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value )
    3421             ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3422                CALL netcdf4_write_variable( file_id, var_id,                          &
    3423                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3424                        var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value )
    3425             !-- 32bit real output
    3426             ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3427                CALL netcdf4_write_variable( file_id, var_id,                          &
    3428                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3429                        var_real32_0d=var_real32_0d_pointer, return_value=output_return_value )
    3430             ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3431                CALL netcdf4_write_variable( file_id, var_id,                          &
    3432                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3433                        var_real32_1d=var_real32_1d_pointer, return_value=output_return_value )
    3434             ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3435                CALL netcdf4_write_variable( file_id, var_id,                          &
    3436                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3437                        var_real32_2d=var_real32_2d_pointer, return_value=output_return_value )
    3438             ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3439                CALL netcdf4_write_variable( file_id, var_id,                          &
    3440                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3441                        var_real32_3d=var_real32_3d_pointer, return_value=output_return_value )
    3442             !-- 64bit real output
    3443             ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3444                CALL netcdf4_write_variable( file_id, var_id,                          &
    3445                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3446                        var_real64_0d=var_real64_0d_pointer, return_value=output_return_value )
    3447             ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3448                CALL netcdf4_write_variable( file_id, var_id,                          &
    3449                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3450                        var_real64_1d=var_real64_1d_pointer, return_value=output_return_value )
    3451             ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3452                CALL netcdf4_write_variable( file_id, var_id,                          &
    3453                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3454                        var_real64_2d=var_real64_2d_pointer, return_value=output_return_value )
    3455             ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3456                CALL netcdf4_write_variable( file_id, var_id,                          &
    3457                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3458                        var_real64_3d=var_real64_3d_pointer, return_value=output_return_value )
    3459             !-- working-precision real output
    3460             ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3461                CALL netcdf4_write_variable( file_id, var_id,                          &
    3462                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3463                        var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value )
    3464             ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3465                CALL netcdf4_write_variable( file_id, var_id,                          &
    3466                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3467                        var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value )
    3468             ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3469                CALL netcdf4_write_variable( file_id, var_id,                          &
    3470                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3471                        var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value )
    3472             ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3473                CALL netcdf4_write_variable( file_id, var_id,                          &
    3474                        bounds_start_internal, value_counts, bounds_origin, is_global, &
    3475                        var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value )
    3476             ELSE
    3477                return_value = 1
    3478                CALL internal_message( 'error', routine_name //                           &
    3479                                       ': variable "' // TRIM( name ) //                  &
    3480                                       '" in file "' // TRIM( filename ) //               &
    3481                                       '": output_type not supported by file format "' // &
    3482                                       TRIM( file_format ) // '"' )
    3483             ENDIF
    3484 
    3485          CASE DEFAULT
    3486             return_value = 1
    3487             CALL internal_message( 'error', routine_name //                              &
    3488                                             ': file "' // TRIM( filename ) //            &
    3489                                             '": file format "' // TRIM( file_format ) // &
    3490                                             '" not supported' )
    3491 
    3492       END SELECT
    3493 
    3494       IF ( return_value == 0  .AND.  output_return_value /= 0 )  THEN
    3495          return_value = 1
    3496          CALL internal_message( 'error', routine_name //                              &
    3497                                 ': error while writing variable "' // TRIM( name ) // &
    3498                                 '" in file "' // TRIM( filename ) // '"' )
    3499       ENDIF
    3500 
    3501    ENDIF
    3502 
    3503 END FUNCTION dom_write_var
    3504 
    3505 !--------------------------------------------------------------------------------------------------!
    3506 ! Description:
    3507 ! ------------
    3508 !> Find a requested variable 'var_name' and its used dimensions in requested file 'filename'.
    3509 !--------------------------------------------------------------------------------------------------!
    3510 SUBROUTINE find_var_in_file( filename, var_name, file_format, file_id, var_id, &
     3350!> Find a requested variable 'variable_name' and its used dimensions in requested file 'file_name'.
     3351!--------------------------------------------------------------------------------------------------!
     3352SUBROUTINE find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, &
    35113353                             is_global, dimensions, return_value )
    35123354
    3513    CHARACTER(LEN=charlen), INTENT(OUT) ::  file_format  !< file format chosen for file
    3514    CHARACTER(LEN=*),       INTENT(IN)  ::  filename     !< name of file
    3515    CHARACTER(LEN=*),       INTENT(IN)  ::  var_name     !< name of variable
     3355   CHARACTER(LEN=charlen), INTENT(OUT) ::  file_format    !< file format chosen for file
     3356   CHARACTER(LEN=*),       INTENT(IN)  ::  file_name      !< name of file
     3357   CHARACTER(LEN=*),       INTENT(IN)  ::  variable_name  !< name of variable
    35163358
    35173359   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'find_var_in_file'  !< name of routine
    35183360
    3519    INTEGER(iwp)              ::  d             !< loop index
    3520    INTEGER(iwp)              ::  dd            !< loop index
    3521    INTEGER(iwp)              ::  f             !< loop index
    3522    INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    3523    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    3524    INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
    3525 
    3526    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_ids  !< list of dimension IDs used by variable
     3361   INTEGER              ::  d             !< loop index
     3362   INTEGER              ::  dd            !< loop index
     3363   INTEGER              ::  f             !< loop index
     3364   INTEGER, INTENT(OUT) ::  file_id       !< file ID
     3365   INTEGER, INTENT(OUT) ::  return_value  !< return value
     3366   INTEGER, INTENT(OUT) ::  variable_id   !< variable ID
     3367
     3368   INTEGER, DIMENSION(:), ALLOCATABLE ::  dimension_ids  !< list of dimension IDs used by variable
    35273369
    35283370   LOGICAL              ::  found      !< true if requested variable found in requested file
    … …  
    35323374
    35333375
    3534    return_value   = 0
     3376   return_value = 0
    35353377   found = .FALSE.
    35363378
    3537    DO  f = 1, nf
    3538       IF ( TRIM( filename ) == TRIM( files(f)%name ) )  THEN
     3379   DO  f = 1, nfiles
     3380      IF ( TRIM( file_name ) == TRIM( files(f)%name ) )  THEN
    35393381
    35403382         IF ( .NOT. files(f)%is_init )  THEN
    35413383            return_value = 1
    3542             CALL internal_message( 'error', routine_name //                    &
    3543                                    ': file "' // TRIM( filename ) //           &
    3544                                    '" is not initialized. ' //                &
    3545                                    'Writing variable "' // TRIM( var_name ) // &
    3546                                    '" to file is impossible.' )
     3384            CALL internal_message( 'error', routine_name //                     &
     3385                                   ': file not initialized. ' //                &
     3386                                   'Writing variable to file is impossible ' // &
     3387                                   '(variable "' // TRIM( variable_name ) //    &
     3388                                   '", file "' // TRIM( file_name ) // '")!' )
    35473389            EXIT
    35483390         ENDIF
    … …  
    35533395         !-- Search for variable in file
    35543396         DO  d = 1, SIZE( files(f)%variables )
    3555             IF ( TRIM( var_name ) == TRIM( files(f)%variables(d)%name ) )  THEN
    3556 
    3557                var_id    = files(f)%variables(d)%id
     3397            IF ( TRIM( variable_name ) == TRIM( files(f)%variables(d)%name ) )  THEN
     3398
     3399               variable_id    = files(f)%variables(d)%id
    35583400               is_global = files(f)%variables(d)%is_global
    35593401
    3560                ALLOCATE( dim_ids(SIZE( files(f)%variables(d)%dimension_ids )) )
     3402               ALLOCATE( dimension_ids(SIZE( files(f)%variables(d)%dimension_ids )) )
    35613403               ALLOCATE( dimensions(SIZE( files(f)%variables(d)%dimension_ids )) )
    35623404
    3563                dim_ids = files(f)%variables(d)%dimension_ids
     3405               dimension_ids = files(f)%variables(d)%dimension_ids
    35643406
    35653407               found = .TRUE.
    … …  
    35733415            !-- Get list of dimensions used by variable
    35743416            DO  d = 1, SIZE( files(f)%dimensions )
    3575                DO  dd = 1, SIZE( dim_ids )
    3576                   IF ( dim_ids(dd) == files(f)%dimensions(d)%id )  THEN
     3417               DO  dd = 1, SIZE( dimension_ids )
     3418                  IF ( dimension_ids(dd) == files(f)%dimensions(d)%id )  THEN
    35773419                     dimensions(dd) = files(f)%dimensions(d)
    35783420                     EXIT
    … …  
    35853427            !-- If variable was not found, search for a dimension instead
    35863428            DO  d = 1, SIZE( files(f)%dimensions )
    3587                IF ( TRIM( var_name ) == TRIM( files(f)%dimensions(d)%name ) )  THEN
    3588 
    3589                   var_id    = files(f)%dimensions(d)%var_id
     3429               IF ( TRIM( variable_name ) == TRIM( files(f)%dimensions(d)%name ) )  THEN
     3430
     3431                  variable_id    = files(f)%dimensions(d)%variable_id
    35903432                  is_global = .TRUE.
    35913433
    … …  
    36053447         IF ( .NOT. found )  THEN
    36063448            return_value = 1
    3607             CALL internal_message( 'error', routine_name //                       &
    3608                                             ': variable "' // TRIM( var_name ) // &
    3609                                             '" not found in file "' // TRIM( filename ) // '"' )
     3449            CALL internal_message( 'error', routine_name //                  &
     3450                                   ': variable not found in file ' //        &
     3451                                   '(variable "' // TRIM( variable_name ) // &
     3452                                   '", file "' // TRIM( file_name ) // '")!' )
    36103453         ENDIF
    36113454
    … …  
    36173460   IF ( .NOT. found  .AND.  return_value == 0 )  THEN
    36183461      return_value = 1
    3619       CALL internal_message( 'error', routine_name //                           &
    3620                                       ': file "' // TRIM( filename ) //         &
    3621                                       '" for variable "' // TRIM( var_name ) // &
    3622                                       '" not found' )
     3462      CALL internal_message( 'error', routine_name //                  &
     3463                             ': file not found ' //                    &
     3464                             '(variable "' // TRIM( variable_name ) // &
     3465                             '", file "' // TRIM( file_name ) // '")!' )
    36233466   ENDIF
    36243467
    … …  
    36413484   ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'get_masked_indices_and_masked_dimension_bounds'  !< name of routine
    36423485
    3643    INTEGER(iwp) ::  d  !< loop index
    3644    INTEGER(iwp) ::  i  !< loop index
    3645 
    3646    INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_end           !< upper bonuds to be searched in
    3647    INTEGER(iwp), DIMENSION(:), INTENT(OUT) ::  bounds_masked_start  !< lower bounds of masked dimensions within given bounds
    3648    INTEGER(iwp), DIMENSION(:), INTENT(OUT) ::  bounds_origin        !< first index of each dimension, 0 if dimension is masked
    3649    INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_start         !< lower bounds to be searched in
    3650    INTEGER(iwp), DIMENSION(:), INTENT(OUT) ::  value_counts         !< count of indices per dimension to be output
    3651 
    3652    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) ::  masked_indices  !< masked indices within given bounds
     3486   INTEGER ::  d  !< loop index
     3487   INTEGER ::  i  !< loop index
     3488
     3489   INTEGER, DIMENSION(:), INTENT(IN)  ::  bounds_end           !< upper bonuds to be searched in
     3490   INTEGER, DIMENSION(:), INTENT(OUT) ::  bounds_masked_start  !< lower bounds of masked dimensions within given bounds
     3491   INTEGER, DIMENSION(:), INTENT(OUT) ::  bounds_origin        !< first index of each dimension, 0 if dimension is masked
     3492   INTEGER, DIMENSION(:), INTENT(IN)  ::  bounds_start         !< lower bounds to be searched in
     3493   INTEGER, DIMENSION(:), INTENT(OUT) ::  value_counts         !< count of indices per dimension to be output
     3494
     3495   INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) ::  masked_indices  !< masked indices within given bounds
    36533496
    36543497   TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< dimensions to be searched for masked indices
    … …  
    36563499
    36573500   ALLOCATE( masked_indices(SIZE( dimensions ),0:MAXVAL( bounds_end - bounds_start + 1 )) )
    3658    masked_indices = -HUGE( 0_iwp )
     3501   masked_indices = -HUGE( 0 )
    36593502
    36603503   !-- Check for masking and update lower and upper bounds if masked
    … …  
    36653508         bounds_origin(d) = 0
    36663509
    3667          bounds_masked_start(d) = -HUGE( 0_iwp )
     3510         bounds_masked_start(d) = -HUGE( 0 )
    36683511
    36693512         !-- Find number of masked values within given variable bounds
    … …  
    36813524
    36823525               !-- Save bounds of mask within given bounds
    3683                IF ( bounds_masked_start(d) == -HUGE( 0_iwp ) )  bounds_masked_start(d) = i
     3526               IF ( bounds_masked_start(d) == -HUGE( 0 ) )  bounds_masked_start(d) = i
    36843527
    36853528            ENDIF
    … …  
    36903533         IF ( value_counts(d) == 0 )  THEN
    36913534            bounds_origin(:) = 0
    3692             bounds_masked_start(:) = 0_iwp
    3693             value_counts(:) = 0_iwp
     3535            bounds_masked_start(:) = 0
     3536            value_counts(:) = 0
    36943537            EXIT
    36953538         ENDIF
    … …  
    37153558! Description:
    37163559! ------------
    3717 !> Finalize output.
    3718 !--------------------------------------------------------------------------------------------------!
    3719 FUNCTION dom_finalize_output() RESULT( return_value )
    3720 
    3721    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_finalize_output'  !< name of routine
    3722 
    3723    INTEGER(iwp) ::  return_value           !< return value
    3724    INTEGER(iwp) ::  return_value_internal  !< error code after closing a single file
    3725    INTEGER(iwp) ::  output_return_value    !< return value from called routines
    3726    INTEGER(iwp) ::  f                      !< loop index
    3727 
    3728 
    3729    return_value = 0
    3730 
    3731    DO  f = 1, nf
    3732 
    3733       IF ( files(f)%is_init )  THEN
    3734 
    3735          output_return_value = 0
    3736          return_value_internal = 0
    3737 
    3738          SELECT CASE ( TRIM( files(f)%format ) )
    3739 
    3740             CASE ( 'binary' )
    3741                CALL binary_finalize( files(f)%id, output_return_value )
    3742 
    3743             CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    3744                CALL netcdf4_finalize( files(f)%id, output_return_value )
    3745 
    3746             CASE DEFAULT
    3747                return_value_internal = 1
    3748 
    3749          END SELECT
    3750 
    3751          IF ( output_return_value /= 0 )  THEN
    3752             return_value = output_return_value
    3753             CALL internal_message( 'error', routine_name //             &
    3754                                    ': error while finalizing file "' // &
    3755                                    TRIM( files(f)%name ) // '"' )
    3756          ELSEIF ( return_value_internal /= 0 )  THEN
    3757             return_value = return_value_internal
    3758             CALL internal_message( 'error', routine_name //         &
    3759                                    ': unsupported file format "' // &
    3760                                    TRIM( files(f)%format ) // '"' )
    3761          ENDIF
    3762 
    3763       ENDIF
    3764 
    3765    ENDDO
    3766 
    3767 END FUNCTION dom_finalize_output
     3560!> Message routine writing debug information into the debug file
     3561!> or creating the error message string.
     3562!--------------------------------------------------------------------------------------------------!
     3563SUBROUTINE internal_message( level, string )
     3564
     3565   CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
     3566   CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
     3567
     3568
     3569   IF ( TRIM( level ) == 'error' )  THEN
     3570
     3571      WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
     3572
     3573   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
     3574
     3575      WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
     3576      FLUSH( debug_output_unit )
     3577
     3578   ENDIF
     3579
     3580END SUBROUTINE internal_message
    37683581
    37693582!--------------------------------------------------------------------------------------------------!
    37703583! Description:
    37713584! ------------
    3772 !> Message routine writing debug information into the debug file
    3773 !> or creating the error message string.
    3774 !--------------------------------------------------------------------------------------------------!
    3775 SUBROUTINE internal_message( level, string )
    3776 
    3777    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
    3778    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
    3779 
    3780 
    3781    IF ( TRIM( level ) == 'error' )  THEN
    3782 
    3783       WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
    3784 
    3785    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
    3786 
    3787       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
    3788       FLUSH( debug_output_unit )
     3585!> Print contents of the created database to debug_output_unit. This routine can be called at any
     3586!> stage after the call to 'dom_init'. Multiple calls are possible.
     3587!--------------------------------------------------------------------------------------------------!
     3588SUBROUTINE dom_database_debug_output
     3589
     3590   CHARACTER(LEN=*), PARAMETER ::  separation_string = '---'                   !< string separating blocks in output
     3591   CHARACTER(LEN=50)           ::  write_format1                               !< format for write statements
     3592   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_database_debug_output'  !< name of this routine
     3593
     3594   INTEGER            ::  f                       !< loop index
     3595   INTEGER, PARAMETER ::  indent_depth = 3        !< space per indentation
     3596   INTEGER            ::  indent_level            !< indentation level
     3597   INTEGER, PARAMETER ::  max_keyname_length = 6  !< length of longest key name
     3598   INTEGER            ::  natts                   !< number of attributes
     3599   INTEGER            ::  ndims                   !< number of dimensions
     3600   INTEGER            ::  nvars                   !< number of variables
     3601
     3602
     3603   CALL internal_message( 'debug', routine_name // ': write database to debug output' )
     3604
     3605   WRITE( debug_output_unit, '(A)' ) 'DOM database:'
     3606   WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 )
     3607
     3608   IF ( .NOT. ALLOCATED( files ) .OR. nfiles == 0 )  THEN
     3609
     3610      WRITE( debug_output_unit, '(A)' ) 'database is empty'
     3611
     3612   ELSE
     3613
     3614      indent_level = 1
     3615      WRITE( write_format1, '(A,I3,A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A,T',  &
     3616                                        indent_level * indent_depth + 1 + max_keyname_length, &
     3617                                        ',(": ")'
     3618
     3619      DO  f = 1, nfiles
     3620
     3621         natts = 0
     3622         ndims = 0
     3623         nvars = 0
     3624         IF ( ALLOCATED( files(f)%attributes ) ) natts = SIZE( files(f)%attributes )
     3625         IF ( ALLOCATED( files(f)%dimensions ) ) ndims = SIZE( files(f)%dimensions )
     3626         IF ( ALLOCATED( files(f)%variables  ) ) nvars = SIZE( files(f)%variables  )
     3627
     3628         WRITE( debug_output_unit, '(A)' ) 'file:'
     3629         WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'name', TRIM( files(f)%name )
     3630         WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) 'format', TRIM(files(f)%format)
     3631         WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) 'id', files(f)%id
     3632         WRITE( debug_output_unit, TRIM( write_format1 ) // ',L1)' ) 'is init', files(f)%is_init
     3633         WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#atts', natts
     3634         WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#dims', ndims
     3635         WRITE( debug_output_unit, TRIM( write_format1 ) // ',I7)' ) '#vars', nvars
     3636
     3637         IF ( natts /= 0 )  CALL print_attributes( indent_level, files(f)%attributes )
     3638         IF ( ndims /= 0 )  CALL print_dimensions( indent_level, files(f)%dimensions )
     3639         IF ( nvars /= 0 )  CALL print_variables( indent_level, files(f)%variables )
     3640
     3641         WRITE( debug_output_unit, '(/A/)' ) REPEAT( separation_string // ' ', 4 )
     3642
     3643      ENDDO
    37893644
    37903645   ENDIF
    37913646
    3792 END SUBROUTINE internal_message
    3793 
    3794 !--------------------------------------------------------------------------------------------------!
    3795 ! Description:
    3796 ! ------------
    3797 !> Return the last created error message.
    3798 !--------------------------------------------------------------------------------------------------!
    3799 SUBROUTINE dom_get_error_message( error_message )
    3800 
    3801    CHARACTER(LEN=800), INTENT(OUT) ::  error_message         !< return error message to main program
    3802    CHARACTER(LEN=800)              ::  output_error_message  !< error message created by other module
    3803 
    3804 
    3805    CALL binary_get_error_message( output_error_message )
    3806    internal_error_message = TRIM( internal_error_message ) // output_error_message
    3807 
    3808    CALL netcdf4_get_error_message( output_error_message )
    3809    internal_error_message = TRIM( internal_error_message ) // output_error_message
    3810 
    3811    error_message = internal_error_message
    3812 
    3813 END SUBROUTINE dom_get_error_message
     3647   CONTAINS
     3648
     3649      !--------------------------------------------------------------------------------------------!
     3650      ! Description:
     3651      ! ------------
     3652      !> Print list of attributes.
     3653      !--------------------------------------------------------------------------------------------!
     3654      SUBROUTINE print_attributes( indent_level, attributes )
     3655
     3656         CHARACTER(LEN=50) ::  write_format1  !< format for write statements
     3657         CHARACTER(LEN=50) ::  write_format2  !< format for write statements
     3658
     3659         INTEGER             ::  i                       !< loop index
     3660         INTEGER, INTENT(IN) ::  indent_level            !< indentation level
     3661         INTEGER, PARAMETER  ::  max_keyname_length = 6  !< length of longest key name
     3662         INTEGER             ::  nelement                !< number of elements to print
     3663
     3664         TYPE(attribute_type), DIMENSION(:), INTENT(IN) ::  attributes  !< list of attributes
     3665
     3666
     3667         WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     3668         WRITE( write_format2, '(A,I3,A,I3,A)' ) &
     3669            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     3670            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     3671
     3672         WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
     3673            REPEAT( separation_string // ' ', 4 )
     3674         WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'attributes:'
     3675
     3676         nelement = SIZE( attributes )
     3677         DO  i = 1, nelement
     3678            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3679               'name', TRIM( attributes(i)%name )
     3680            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3681               'type', TRIM( attributes(i)%data_type )
     3682
     3683            IF ( TRIM( attributes(i)%data_type ) == 'char' )  THEN
     3684               WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3685                  'value', TRIM( attributes(i)%value_char )
     3686            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int8' )  THEN
     3687               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)' ) &
     3688                  'value', attributes(i)%value_int8
     3689            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int16' )  THEN
     3690               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)' ) &
     3691                  'value', attributes(i)%value_int16
     3692            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int32' )  THEN
     3693               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)' ) &
     3694                  'value', attributes(i)%value_int32
     3695            ELSEIF ( TRIM( attributes(i)%data_type ) == 'real32' )  THEN
     3696               WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)' ) &
     3697                  'value', attributes(i)%value_real32
     3698            ELSEIF (  TRIM(attributes(i)%data_type) == 'real64' )  THEN
     3699               WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)' ) &
     3700                  'value', attributes(i)%value_real64
     3701            ENDIF
     3702            IF ( i < nelement )  &
     3703               WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
     3704         ENDDO
     3705
     3706      END SUBROUTINE print_attributes
     3707
     3708      !--------------------------------------------------------------------------------------------!
     3709      ! Description:
     3710      ! ------------
     3711      !> Print list of dimensions.
     3712      !--------------------------------------------------------------------------------------------!
     3713      SUBROUTINE print_dimensions( indent_level, dimensions )
     3714
     3715         CHARACTER(LEN=50) ::  write_format1  !< format for write statements
     3716         CHARACTER(LEN=50) ::  write_format2  !< format for write statements
     3717
     3718         INTEGER             ::  i                        !< loop index
     3719         INTEGER, INTENT(IN) ::  indent_level             !< indentation level
     3720         INTEGER             ::  j                        !< loop index
     3721         INTEGER, PARAMETER  ::  max_keyname_length = 15  !< length of longest key name
     3722         INTEGER             ::  nelement                 !< number of elements to print
     3723
     3724         LOGICAL ::  is_masked  !< true if dimension is masked
     3725
     3726         TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< list of dimensions
     3727
     3728
     3729         WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     3730         WRITE( write_format2, '(A,I3,A,I3,A)' ) &
     3731            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     3732            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     3733
     3734         WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
     3735            REPEAT( separation_string // ' ', 4 )
     3736         WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'dimensions:'
     3737
     3738         nelement = SIZE( dimensions )
     3739         DO  i = 1, nelement
     3740            is_masked = dimensions(i)%is_masked
     3741
     3742            !-- Print general information
     3743            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3744               'name', TRIM( dimensions(i)%name )
     3745            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3746               'type', TRIM( dimensions(i)%data_type )
     3747            WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
     3748               'id', dimensions(i)%id
     3749            WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
     3750               'length', dimensions(i)%length
     3751            WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7,A,I7)' ) &
     3752               'bounds', dimensions(i)%bounds(1), ',', dimensions(i)%bounds(2)
     3753            WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) &
     3754               'is masked', dimensions(i)%is_masked
     3755
     3756            !-- Print information about mask
     3757            IF ( is_masked )  THEN
     3758               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
     3759                  'masked length', dimensions(i)%length_mask
     3760
     3761               WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)', ADVANCE='no' ) &
     3762                  'mask', dimensions(i)%mask(dimensions(i)%bounds(1))
     3763               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3764                  WRITE( debug_output_unit, '(A,L1)', ADVANCE='no' ) ',', dimensions(i)%mask(j)
     3765               ENDDO
     3766               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3767
     3768               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
     3769                  'masked indices', dimensions(i)%masked_indices(0)
     3770               DO  j = 1, dimensions(i)%length_mask-1
     3771                  WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     3772                     ',', dimensions(i)%masked_indices(j)
     3773               ENDDO
     3774               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3775            ENDIF
     3776
     3777            !-- Print saved values
     3778            IF ( ALLOCATED( dimensions(i)%values_int8 ) )  THEN
     3779
     3780               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' ) &
     3781                  'values', dimensions(i)%values_int8(dimensions(i)%bounds(1))
     3782               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3783                  WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
     3784                     ',', dimensions(i)%values_int8(j)
     3785               ENDDO
     3786               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3787               IF ( is_masked )  THEN
     3788                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',I4)', ADVANCE='no' ) &
     3789                     'masked values', dimensions(i)%masked_values_int8(0)
     3790                  DO  j = 1, dimensions(i)%length_mask-1
     3791                     WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
     3792                        ',', dimensions(i)%masked_values_int8(j)
     3793                  ENDDO
     3794                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3795               ENDIF
     3796
     3797            ELSEIF ( ALLOCATED( dimensions(i)%values_int16 ) )  THEN
     3798
     3799               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
     3800                  'values', dimensions(i)%values_int16(dimensions(i)%bounds(1))
     3801               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3802                  WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     3803                     ',', dimensions(i)%values_int16(j)
     3804               ENDDO
     3805               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3806               IF ( is_masked )  THEN
     3807                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',I6)', ADVANCE='no' ) &
     3808                     'masked values', dimensions(i)%masked_values_int16(0)
     3809                  DO  j = 1, dimensions(i)%length_mask-1
     3810                     WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     3811                        ',', dimensions(i)%masked_values_int16(j)
     3812                  ENDDO
     3813                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3814               ENDIF
     3815
     3816            ELSEIF ( ALLOCATED( dimensions(i)%values_int32 ) )  THEN
     3817
     3818               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
     3819                  'values', dimensions(i)%values_int32(dimensions(i)%bounds(1))
     3820               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3821                  WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     3822                     ',', dimensions(i)%values_int32(j)
     3823               ENDDO
     3824               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3825               IF ( is_masked )  THEN
     3826                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
     3827                     'masked values', dimensions(i)%masked_values_int32(0)
     3828                  DO  j = 1, dimensions(i)%length_mask-1
     3829                     WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     3830                        ',', dimensions(i)%masked_values_int32(j)
     3831                  ENDDO
     3832                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3833               ENDIF
     3834
     3835            ELSEIF ( ALLOCATED( dimensions(i)%values_intwp ) )  THEN
     3836
     3837               WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
     3838                  'values', dimensions(i)%values_intwp(dimensions(i)%bounds(1))
     3839               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3840                  WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     3841                     ',', dimensions(i)%values_intwp(j)
     3842               ENDDO
     3843               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3844               IF ( is_masked )  THEN
     3845                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',I11)', ADVANCE='no' ) &
     3846                     'masked values', dimensions(i)%masked_values_intwp(0)
     3847                  DO  j = 1, dimensions(i)%length_mask-1
     3848                     WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     3849                        ',', dimensions(i)%masked_values_intwp(j)
     3850                  ENDDO
     3851                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3852               ENDIF
     3853
     3854            ELSEIF ( ALLOCATED( dimensions(i)%values_real32 ) )  THEN
     3855
     3856               WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' ) &
     3857                  'values', dimensions(i)%values_real32(dimensions(i)%bounds(1))
     3858               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3859                  WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
     3860                     ',', dimensions(i)%values_real32(j)
     3861               ENDDO
     3862               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3863               IF ( is_masked )  THEN
     3864                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',E14.7)', ADVANCE='no' ) &
     3865                     'masked values', dimensions(i)%masked_values_real32(0)
     3866                  DO  j = 1, dimensions(i)%length_mask-1
     3867                     WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
     3868                        ',', dimensions(i)%masked_values_real32(j)
     3869                  ENDDO
     3870                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3871               ENDIF
     3872
     3873            ELSEIF ( ALLOCATED( dimensions(i)%values_real64 ) )  THEN
     3874
     3875               WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
     3876                  'values', dimensions(i)%values_real64(dimensions(i)%bounds(1))
     3877               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3878                  WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     3879                     ',', dimensions(i)%values_real64(j)
     3880               ENDDO
     3881               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3882               IF ( is_masked )  THEN
     3883                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
     3884                     'masked values', dimensions(i)%masked_values_real64(0)
     3885                  DO  j = 1, dimensions(i)%length_mask-1
     3886                     WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     3887                        ',', dimensions(i)%masked_values_real64(j)
     3888                  ENDDO
     3889                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3890               ENDIF
     3891
     3892            ELSEIF ( ALLOCATED( dimensions(i)%values_realwp ) )  THEN
     3893
     3894               WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
     3895                  'values', dimensions(i)%values_realwp(dimensions(i)%bounds(1))
     3896               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     3897                  WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     3898                     ',', dimensions(i)%values_realwp(j)
     3899               ENDDO
     3900               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3901               IF ( is_masked )  THEN
     3902                  WRITE( debug_output_unit, TRIM( write_format2 ) // ',E22.15)', ADVANCE='no' ) &
     3903                     'masked values', dimensions(i)%masked_values_realwp(0)
     3904                  DO  j = 1, dimensions(i)%length_mask-1
     3905                     WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     3906                        ',', dimensions(i)%masked_values_realwp(j)
     3907                  ENDDO
     3908                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3909               ENDIF
     3910
     3911            ENDIF
     3912
     3913            IF ( ALLOCATED( dimensions(i)%attributes ) )  &
     3914               CALL print_attributes( indent_level+1, dimensions(i)%attributes )
     3915
     3916            IF ( i < nelement )  &
     3917               WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
     3918         ENDDO
     3919
     3920      END SUBROUTINE print_dimensions
     3921
     3922      !--------------------------------------------------------------------------------------------!
     3923      ! Description:
     3924      ! ------------
     3925      !> Print list of variables.
     3926      !--------------------------------------------------------------------------------------------!
     3927      SUBROUTINE print_variables( indent_level, variables )
     3928
     3929         CHARACTER(LEN=50) ::  write_format1  !< format for write statements
     3930         CHARACTER(LEN=50) ::  write_format2  !< format for write statements
     3931
     3932         INTEGER             ::  i                        !< loop index
     3933         INTEGER, INTENT(IN) ::  indent_level             !< indentation level
     3934         INTEGER             ::  j                        !< loop index
     3935         INTEGER, PARAMETER  ::  max_keyname_length = 16  !< length of longest key name
     3936         INTEGER             ::  nelement                 !< number of elements to print
     3937
     3938         TYPE(variable_type), DIMENSION(:), INTENT(IN) ::  variables  !< list of variables
     3939
     3940
     3941         WRITE( write_format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     3942         WRITE( write_format2, '(A,I3,A,I3,A)' ) &
     3943            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     3944            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     3945
     3946         WRITE( debug_output_unit, TRIM( write_format1 ) // ',A)' ) &
     3947            REPEAT( separation_string // ' ', 4 )
     3948         WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) 'variables:'
     3949
     3950         nelement = SIZE( variables )
     3951         DO  i = 1, nelement
     3952            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3953               'name', TRIM( variables(i)%name )
     3954            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)' ) &
     3955               'type', TRIM( variables(i)%data_type )
     3956            WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) &
     3957               'id', variables(i)%id
     3958            WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) &
     3959               'is global', variables(i)%is_global
     3960
     3961            WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)', ADVANCE='no' ) &
     3962               'dimension names', TRIM( variables(i)%dimension_names(1) )
     3963            DO  j = 2, SIZE( variables(i)%dimension_names )
     3964               WRITE( debug_output_unit, '(A,A)', ADVANCE='no' ) &
     3965                  ',', TRIM( variables(i)%dimension_names(j) )
     3966            ENDDO
     3967            WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3968
     3969            WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)', ADVANCE='no' ) &
     3970               'dimension ids', variables(i)%dimension_ids(1)
     3971            DO  j = 2, SIZE( variables(i)%dimension_names )
     3972               WRITE( debug_output_unit, '(A,I7)', ADVANCE='no' ) &
     3973                  ',', variables(i)%dimension_ids(j)
     3974            ENDDO
     3975            WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     3976
     3977            IF ( ALLOCATED( variables(i)%attributes ) )  &
     3978               CALL print_attributes( indent_level+1, variables(i)%attributes )
     3979            IF ( i < nelement )  &
     3980               WRITE( debug_output_unit, TRIM( write_format1 ) // ')' ) separation_string
     3981         ENDDO
     3982
     3983      END SUBROUTINE print_variables
     3984
     3985END SUBROUTINE dom_database_debug_output
    38143986
    38153987END MODULE data_output_module

  • palm/trunk/SOURCE/data_output_netcdf4_module.f90

    r4123 r4141  
    6262   CHARACTER(LEN=*), PARAMETER ::  mode_serial   = 'serial'    !< string selecting netcdf4 serial mode
    6363
    64    INTEGER(iwp) ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
    65    INTEGER(iwp) ::  global_id_in_file = -1  !< value of global ID within a file
    66    INTEGER      ::  master_rank             !< master rank for tasks to be executed by single PE only
    67    INTEGER      ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
     64   INTEGER ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
     65   INTEGER ::  global_id_in_file = -1  !< value of global ID within a file
     66   INTEGER ::  master_rank             !< master rank for tasks to be executed by single PE only
     67   INTEGER ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
    6868
    6969   LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
    … …  
    9393   END INTERFACE netcdf4_write_attribute
    9494
    95    INTERFACE netcdf4_init_end
    96       MODULE PROCEDURE netcdf4_init_end
    97    END INTERFACE netcdf4_init_end
     95   INTERFACE netcdf4_stop_file_header_definition
     96      MODULE PROCEDURE netcdf4_stop_file_header_definition
     97   END INTERFACE netcdf4_stop_file_header_definition
    9898
    9999   INTERFACE netcdf4_write_variable
    … …  
    113113      netcdf4_get_error_message, &
    114114      netcdf4_init_dimension, &
    115       netcdf4_init_end, &
     115      netcdf4_stop_file_header_definition, &
    116116      netcdf4_init_module, &
    117117      netcdf4_init_variable, &
    … …  
    136136                                                                 !> must be unique for each output group
    137137
    138    INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
    139    INTEGER,      INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
    140    INTEGER,      INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
    141    INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
     138   INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
     139   INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
     140   INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
     141   INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
    142142
    143143   LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
    … …  
    160160!> Open netcdf file.
    161161!--------------------------------------------------------------------------------------------------!
    162 SUBROUTINE netcdf4_open_file( mode, filename, file_id, return_value )
    163 
    164    CHARACTER(LEN=*), INTENT(IN) ::  filename  !< name of file
    165    CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
     162SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value )
     163
     164   CHARACTER(LEN=*), INTENT(IN) ::  file_name  !< name of file
     165   CHARACTER(LEN=*), INTENT(IN) ::  mode       !< operation mode (either parallel or serial)
    166166
    167167   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_open_file'  !< name of this routine
    168168
    169    INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    170    INTEGER                   ::  my_rank       !< MPI rank of processor
    171    INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    172    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     169   INTEGER, INTENT(OUT) ::  file_id       !< file ID
     170   INTEGER              ::  my_rank       !< MPI rank of processor
     171   INTEGER              ::  nc_stat       !< netcdf return value
     172   INTEGER, INTENT(OUT) ::  return_value  !< return value
    173173
    174174
    … …  
    177177
    178178   !-- Open new file
    179    CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( filename ) // '"' )
     179   CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' )
    180180
    181181   IF ( TRIM( mode ) == mode_serial )  THEN
    … …  
    200200
    201201      IF ( return_value == 0 )  &
    202          nc_stat = NF90_CREATE( TRIM( filename ) // TRIM( file_suffix ), &
    203                                 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &
     202         nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &
     203                                IOR( NF90_NOCLOBBER, NF90_NETCDF4 ),      &
    204204                                file_id )
    205205#else
    … …  
    214214
    215215#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
    216       nc_stat = NF90_CREATE( TRIM( filename ) // TRIM( file_suffix ),                &
     216      nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),               &
    217217                             IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
    218218                             file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
    … …  
    229229      nc_stat = 0
    230230      return_value = 1
    231       CALL internal_message( 'error', routine_name // ': selected mode "' // &
     231      CALL internal_message( 'error', routine_name // ': selected mode "' //  &
    232232                                      TRIM( mode ) // '" must be either "' // &
    233233                                      mode_serial // '" or "' // mode_parallel // '"' )
    … …  
    237237   IF ( nc_stat /= NF90_NOERR  .AND.  return_value == 0 )  THEN
    238238      return_value = 1
    239       CALL internal_message( 'error', routine_name // ': NetCDF error while opening file "' // &
    240                                       TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) )
     239      CALL internal_message( 'error', routine_name //                 &
     240                             ': NetCDF error while opening file "' // &
     241                             TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    241242   ENDIF
    242243#endif
    … …  
    249250!> Write attribute to netcdf file.
    250251!--------------------------------------------------------------------------------------------------!
    251 SUBROUTINE netcdf4_write_attribute( file_id, var_id, att_name, att_value_char, &
    252                  att_value_int8, att_value_int16, att_value_int32,             &
    253                  att_value_real32, att_value_real64, return_value )
    254 
    255    CHARACTER(LEN=*), INTENT(IN)           ::  att_name        !< name of attribute
    256    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  att_value_char  !< value of attribute
     252SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name, &
     253                 value_char, value_int8, value_int16, value_int32,        &
     254                 value_real32, value_real64, return_value )
     255
     256   CHARACTER(LEN=*), INTENT(IN)           ::  attribute_name  !< name of attribute
     257   CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  value_char      !< value of attribute
    257258
    258259   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_attribute'  !< name of this routine
    259260
    260    INTEGER(iwp) ::  nc_stat    !< netcdf return value
    261    INTEGER(iwp) ::  target_id  !< ID of target which gets attribute (either global or var_id)
    262 
    263    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    264    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    265    INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
    266 
    267    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  att_value_int8   !< value of attribute
    268    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  att_value_int16  !< value of attribute
    269    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  att_value_int32  !< value of attribute
    270 
    271    REAL(KIND=4), INTENT(IN), OPTIONAL ::  att_value_real32  !< value of attribute
    272    REAL(KIND=8), INTENT(IN), OPTIONAL ::  att_value_real64  !< value of attribute
     261   INTEGER ::  nc_stat    !< netcdf return value
     262   INTEGER ::  target_id  !< ID of target which gets attribute (either global or variable_id)
     263
     264   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     265   INTEGER, INTENT(OUT) ::  return_value  !< return value
     266   INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     267
     268   INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
     269   INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
     270   INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
     271
     272   REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
     273   REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
    273274
    274275
    … …  
    276277   return_value = 0
    277278
    278    IF ( var_id == global_id_in_file )  THEN
     279   IF ( variable_id == global_id_in_file )  THEN
    279280      target_id = NF90_GLOBAL
    280281   ELSE
    281       target_id = var_id
    282    ENDIF
    283 
    284    CALL internal_message( 'debug', &
    285                           routine_name // ': write attribute "' // TRIM( att_name ) // '"' )
    286 
    287    IF ( PRESENT( att_value_char ) )  THEN
    288       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), TRIM( att_value_char ) )
    289    ELSEIF ( PRESENT( att_value_int8 ) )  THEN
    290       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int8 )
    291    ELSEIF ( PRESENT( att_value_int16 ) )  THEN
    292       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int16 )
    293    ELSEIF ( PRESENT( att_value_int32 ) )  THEN
    294       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_int32 )
    295    ELSEIF ( PRESENT( att_value_real32 ) )  THEN
    296       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real32 )
    297    ELSEIF ( PRESENT( att_value_real64 ) )  THEN
    298       nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att_name ), att_value_real64 )
     282      target_id = variable_id
     283   ENDIF
     284
     285   CALL internal_message( 'debug', routine_name // &
     286                          ': write attribute "' // TRIM( attribute_name ) // '"' )
     287
     288   IF ( PRESENT( value_char ) )  THEN
     289      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
     290   ELSEIF ( PRESENT( value_int8 ) )  THEN
     291      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
     292   ELSEIF ( PRESENT( value_int16 ) )  THEN
     293      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
     294   ELSEIF ( PRESENT( value_int32 ) )  THEN
     295      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
     296   ELSEIF ( PRESENT( value_real32 ) )  THEN
     297      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
     298   ELSEIF ( PRESENT( value_real64 ) )  THEN
     299      nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
    299300   ELSE
    300301      return_value = 1
    301       CALL internal_message( 'error', TRIM( routine_name ) // &
    302                                       ': attribute "' // TRIM( att_name ) // '": no value given' )
     302      CALL internal_message( 'error', routine_name // &
     303                             ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
    303304   ENDIF
    304305
    … …  
    306307      IF ( nc_stat /= NF90_NOERR )  THEN
    307308         return_value = 1
    308          CALL internal_message( 'error',                                       &
    309                  routine_name // ': NetCDF error while writing attribute "' // &
    310                  TRIM( att_name ) // '": ' // NF90_STRERROR( nc_stat ) )
     309         CALL internal_message( 'error', routine_name //                      &
     310                               ': NetCDF error while writing attribute "' // &
     311                                TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    311312      ENDIF
    312313   ENDIF
    … …  
    322323!> Initialize dimension.
    323324!--------------------------------------------------------------------------------------------------!
    324 SUBROUTINE netcdf4_init_dimension( mode, file_id, dim_id, var_id, &
    325               dim_name, dim_type, dim_length, return_value )
    326 
    327    CHARACTER(LEN=*), INTENT(IN) ::  dim_name  !< name of dimension
    328    CHARACTER(LEN=*), INTENT(IN) ::  dim_type  !< data type of dimension
    329    CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
     325SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, &
     326              dimension_name, dimension_type, dimension_length, return_value )
     327
     328   CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
     329   CHARACTER(LEN=*), INTENT(IN) ::  dimension_type  !< data type of dimension
     330   CHARACTER(LEN=*), INTENT(IN) ::  mode            !< operation mode (either parallel or serial)
    330331
    331332   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_dimension'  !< name of this routine
    332333
    333    INTEGER(iwp), INTENT(OUT) ::  dim_id         !< dimension ID
    334    INTEGER(iwp), INTENT(IN)  ::  dim_length     !< length of dimension
    335    INTEGER(iwp), INTENT(IN)  ::  file_id        !< file ID
    336    INTEGER(iwp)              ::  nc_dim_length  !< length of dimension
    337    INTEGER(iwp)              ::  nc_stat        !< netcdf return value
    338    INTEGER(iwp), INTENT(OUT) ::  return_value   !< return value
    339    INTEGER(iwp), INTENT(OUT) ::  var_id         !< variable ID
     334   INTEGER, INTENT(OUT) ::  dimension_id         !< dimension ID
     335   INTEGER, INTENT(IN)  ::  dimension_length     !< length of dimension
     336   INTEGER, INTENT(IN)  ::  file_id              !< file ID
     337   INTEGER              ::  nc_dimension_length  !< length of dimension
     338   INTEGER              ::  nc_stat              !< netcdf return value
     339   INTEGER, INTENT(OUT) ::  return_value         !< return value
     340   INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
    340341
    341342
    342343#if defined( __netcdf4 )
    343344   return_value = 0
    344    var_id = -1
    345 
    346    CALL internal_message( 'debug', &
    347                           routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
     345   variable_id = -1
     346
     347   CALL internal_message( 'debug', routine_name // &
     348                          ': init dimension "' // TRIM( dimension_name ) // '"' )
    348349
    349350   !-- Check if dimension is unlimited
    350    IF ( dim_length < 0 )  THEN
    351       nc_dim_length = NF90_UNLIMITED
     351   IF ( dimension_length < 0 )  THEN
     352      nc_dimension_length = NF90_UNLIMITED
    352353   ELSE
    353       nc_dim_length = dim_length
     354      nc_dimension_length = dimension_length
    354355   ENDIF
    355356
    356357   !-- Define dimension in file
    357    nc_stat = NF90_DEF_DIM( file_id, dim_name, nc_dim_length, dim_id )
     358   nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
    358359
    359360   IF ( nc_stat == NF90_NOERR )  THEN
    360361
    361362      !-- Define variable holding dimension values in file
    362       CALL netcdf4_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
    363                                           is_global=.TRUE., return_value=return_value )
     363      CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
     364                                  (/ dimension_id /), is_global=.TRUE., return_value=return_value )
    364365
    365366   ELSE
    366367      return_value = 1
    367       CALL internal_message( 'error', routine_name //                                    &
    368                                       ': NetCDF error while initializing dimension "' // &
    369                                       TRIM( dim_name ) // '": ' // NF90_STRERROR( nc_stat ) )
     368      CALL internal_message( 'error', routine_name //                           &
     369                             ': NetCDF error while initializing dimension "' // &
     370                             TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    370371   ENDIF
    371372#else
    372373   return_value = 1
    373    var_id = -1
    374    dim_id = -1
     374   variable_id = -1
     375   dimension_id = -1
    375376#endif
    376377
    … …  
    382383!> Initialize variable.
    383384!--------------------------------------------------------------------------------------------------!
    384 SUBROUTINE netcdf4_init_variable( mode, file_id, var_id, var_name, var_type, var_dim_ids, &
    385                                   is_global, return_value )
    386 
    387    CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
    388    CHARACTER(LEN=*), INTENT(IN) ::  var_name  !< name of variable
    389    CHARACTER(LEN=*), INTENT(IN) ::  var_type  !< data type of variable
     385SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, &
     386                                  dimension_ids, is_global, return_value )
     387
     388   CHARACTER(LEN=*), INTENT(IN) ::  mode           !< operation mode (either parallel or serial)
     389   CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
     390   CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
    390391
    391392   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_variable'  !< name of this routine
    392393
    393    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    394    INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    395    INTEGER(iwp)              ::  nc_var_type   !< netcdf data type
    396    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    397    INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
    398 
    399    INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_ids  !< list of dimension IDs used by variable
     394   INTEGER, INTENT(IN)  ::  file_id           !< file ID
     395   INTEGER              ::  nc_stat           !< netcdf return value
     396   INTEGER              ::  nc_variable_type  !< netcdf data type
     397   INTEGER, INTENT(OUT) ::  return_value      !< return value
     398   INTEGER, INTENT(OUT) ::  variable_id       !< variable ID
     399
     400   INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
    400401
    401402   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    … …  
    406407
    407408   WRITE( temp_string, * ) is_global
    408    CALL internal_message( 'debug', routine_name // ': init variable "' // TRIM( var_name ) // &
    409                                    '" ( is_global = ' // TRIM( temp_string ) // ')' )
    410 
    411    nc_var_type = get_netcdf_data_type( var_type )
    412 
    413    IF ( nc_var_type /= -1_iwp )  THEN
     409   CALL internal_message( 'debug', routine_name //                        &
     410                          ': init variable "' // TRIM( variable_name ) // &
     411                          '" ( is_global = ' // TRIM( temp_string ) // ')' )
     412
     413   nc_variable_type = get_netcdf_data_type( variable_type )
     414
     415   IF ( nc_variable_type /= -1 )  THEN
    414416
    415417      !-- Define variable in file
    416       nc_stat = NF90_DEF_VAR( file_id, var_name, nc_var_type, var_dim_ids, var_id )
     418      nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id )
    417419
    418420#if defined( __netcdf4_parallel )
    … …  
    420422      IF ( nc_stat == NF90_NOERR  .AND.  TRIM( mode ) == mode_parallel )  THEN
    421423         IF ( is_global )  THEN
    422             nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_INDEPENDENT )
     424            nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT )
    423425         ELSE
    424             nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_COLLECTIVE )
     426            nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE )
    425427         ENDIF
    426428      ENDIF
    427429#endif
    428430
    429       IF ( nc_stat /= NF90_NOERR)  THEN
     431      IF ( nc_stat /= NF90_NOERR )  THEN
    430432         return_value = 1
    431          CALL internal_message( 'error', routine_name //                                   &
    432                                          ': NetCDF error while initializing variable "' // &
    433                                          TRIM( var_name ) // '": ' // NF90_STRERROR( nc_stat ) )
     433         CALL internal_message( 'error', routine_name //                          &
     434                                ': NetCDF error while initializing variable "' // &
     435                                TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
    434436      ENDIF
    435437
    … …  
    440442#else
    441443   return_value = 1
    442    var_id = -1
     444   variable_id = -1
    443445#endif
    444446
    … …  
    450452!> Leave file definition state.
    451453!--------------------------------------------------------------------------------------------------!
    452 SUBROUTINE netcdf4_init_end( file_id, return_value )
    453 
    454    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_end'  !< name of this routine
    455 
    456    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    457    INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    458    INTEGER(iwp)              ::  old_mode      !< previous netcdf fill mode
    459    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     454SUBROUTINE netcdf4_stop_file_header_definition( file_id, return_value )
     455
     456   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_stop_file_header_definition'  !< name of this routine
     457
     458   INTEGER, INTENT(IN)  ::  file_id        !< file ID
     459   INTEGER              ::  nc_stat        !< netcdf return value
     460   INTEGER              ::  old_fill_mode  !< previous netcdf fill mode
     461   INTEGER, INTENT(OUT) ::  return_value   !< return value
    460462
    461463
    … …  
    464466
    465467   WRITE( temp_string, * ) file_id
    466    CALL internal_message( 'debug',        &
    467                           routine_name // &
     468   CALL internal_message( 'debug', routine_name // &
    468469                          ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
    469470
    470471   !-- Set general no fill, otherwise the performance drops significantly
    471    nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_mode )
     472   nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
    472473
    473474   IF ( nc_stat == NF90_NOERR )  THEN
    … …  
    477478   IF ( nc_stat /= NF90_NOERR )  THEN
    478479      return_value = 1
    479       CALL internal_message( 'error', routine_name // ': NetCDF error: ' // &
    480                                      NF90_STRERROR( nc_stat ) )
     480      CALL internal_message( 'error', routine_name // &
     481                             ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
    481482   ENDIF
    482483#else
    … …  
    484485#endif
    485486
    486 END SUBROUTINE netcdf4_init_end
     487END SUBROUTINE netcdf4_stop_file_header_definition
    487488
    488489!--------------------------------------------------------------------------------------------------!
    … …  
    491492!> Write variable of different kind into netcdf file.
    492493!--------------------------------------------------------------------------------------------------!
    493 SUBROUTINE netcdf4_write_variable(                                        &
    494               file_id, var_id, bounds_start, value_counts, bounds_origin, &
    495               is_global,                                                  &
    496               var_int8_0d,   var_int8_1d,   var_int8_2d,   var_int8_3d,   &
    497               var_int16_0d,  var_int16_1d,  var_int16_2d,  var_int16_3d,  &
    498               var_int32_0d,  var_int32_1d,  var_int32_2d,  var_int32_3d,  &
    499               var_intwp_0d,  var_intwp_1d,  var_intwp_2d,  var_intwp_3d,  &
    500               var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
    501               var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
    502               var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
     494SUBROUTINE netcdf4_write_variable(                                                    &
     495              file_id, variable_id, bounds_start, value_counts, bounds_origin,        &
     496              is_global,                                                              &
     497              values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
     498              values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     499              values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,  &
     500              values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,  &
     501              values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
     502              values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
     503              values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &
    503504              return_value )
    504505
    505506   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_variable'  !< name of this routine
    506507
    507    INTEGER(iwp)              ::  d             !< loop index
    508    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    509    INTEGER                   ::  my_rank       !< MPI rank of processor
    510    INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    511    INTEGER(iwp)              ::  ndim          !< number of dimensions of variable in file
    512    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    513    INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
    514 
    515    INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_origin  !< starting index of each dimension
    516    INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_start   !< starting index of variable
    517    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_ids        !< IDs of dimensions of variable in file
    518    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_lengths    !< length of dimensions of variable in file
    519    INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  value_counts   !< count of values along each dimension to be written
    520 
    521    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                               ::  var_int8_0d  !< output variable
    522    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int8_1d  !< output variable
    523    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int8_2d  !< output variable
    524    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int8_3d  !< output variable
    525 
    526    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                               ::  var_int16_0d  !< output variable
    527    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int16_1d  !< output variable
    528    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int16_2d  !< output variable
    529    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int16_3d  !< output variable
    530 
    531    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_int32_0d  !< output variable
    532    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int32_1d  !< output variable
    533    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int32_2d  !< output variable
    534    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int32_3d  !< output variable
    535 
    536    INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL                               ::  var_intwp_0d  !< output variable
    537    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_intwp_1d  !< output variable
    538    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_intwp_2d  !< output variable
    539    INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_intwp_3d  !< output variable
     508   INTEGER              ::  d             !< loop index
     509   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     510   INTEGER              ::  my_rank       !< MPI rank of processor
     511   INTEGER              ::  nc_stat       !< netcdf return value
     512   INTEGER              ::  ndims         !< number of dimensions of variable in file
     513   INTEGER, INTENT(OUT) ::  return_value  !< return value
     514   INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     515
     516   INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_origin      !< starting index of each dimension
     517   INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_start       !< starting index of variable
     518   INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_ids      !< IDs of dimensions of variable in file
     519   INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_lengths  !< length of dimensions of variable in file
     520   INTEGER, DIMENSION(:),              INTENT(IN)  ::  value_counts       !< count of values along each dimension to be written
     521
     522   INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
     523   INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
     524   INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
     525   INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
     526   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
     527   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
     528   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
     529   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
     530   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
     531   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
     532   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
     533   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
     534   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
     535   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
     536   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
     537   INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
    540538
    541539   LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)
    542540
    543    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_real32_0d  !< output variable
    544    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real32_1d  !< output variable
    545    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real32_2d  !< output variable
    546    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real32_3d  !< output variable
    547 
    548    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                               ::  var_real64_0d  !< output variable
    549    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real64_1d  !< output variable
    550    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real64_2d  !< output variable
    551    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real64_3d  !< output variable
    552 
    553    REAL(wp), POINTER, INTENT(IN), OPTIONAL                               ::  var_realwp_0d  !< output variable
    554    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_realwp_1d  !< output variable
    555    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_realwp_2d  !< output variable
    556    REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_realwp_3d  !< output variable
     541   REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
     542   REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
     543   REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
     544   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
     545   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
     546   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
     547   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
     548   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
     549   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
     550   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
     551   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
     552   REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
    557553
    558554
    … …  
    571567   IF ( return_value == 0  .AND.  ( .NOT. is_global  .OR.  my_rank == master_rank ) )  THEN
    572568
    573       WRITE( temp_string, * ) var_id
     569      WRITE( temp_string, * ) variable_id
    574570      CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
    575571
    576       ndim = SIZE( bounds_start )
     572      ndims = SIZE( bounds_start )
    577573
    578574      !-- 8bit integer output
    579       IF ( PRESENT( var_int8_0d ) )  THEN
    580          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int8_0d /),      &
    581                                  start = bounds_start - bounds_origin + 1, &
    582                                  count = value_counts )
    583       ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    584          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_1d,             &
    585                                  start = bounds_start - bounds_origin + 1, &
    586                                  count = value_counts )
    587       ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    588          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_2d,             &
    589                                  start = bounds_start - bounds_origin + 1, &
    590                                  count = value_counts )
    591       ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    592          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int8_3d,             &
     575      IF ( PRESENT( values_int8_0d ) )  THEN
     576         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), &
     577                                 start = bounds_start - bounds_origin + 1,   &
     578                                 count = value_counts )
     579      ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     580         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d,     &
     581                                 start = bounds_start - bounds_origin + 1, &
     582                                 count = value_counts )
     583      ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     584         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d,     &
     585                                 start = bounds_start - bounds_origin + 1, &
     586                                 count = value_counts )
     587      ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     588         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d,     &
    593589                                 start = bounds_start - bounds_origin + 1, &
    594590                                 count = value_counts )
    595591      !-- 16bit integer output
    596       ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    597          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int16_0d /),      &
    598                                  start = bounds_start - bounds_origin + 1, &
    599                                  count = value_counts )
    600       ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    601          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_1d,            &
    602                                  start = bounds_start - bounds_origin + 1, &
    603                                  count = value_counts )
    604       ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    605          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_2d,            &
    606                                  start = bounds_start - bounds_origin + 1, &
    607                                  count = value_counts )
    608       ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    609          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int16_3d,            &
     592      ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     593         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), &
     594                                 start = bounds_start - bounds_origin + 1,    &
     595                                 count = value_counts )
     596      ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     597         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d,    &
     598                                 start = bounds_start - bounds_origin + 1, &
     599                                 count = value_counts )
     600      ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     601         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d,    &
     602                                 start = bounds_start - bounds_origin + 1, &
     603                                 count = value_counts )
     604      ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     605         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d,    &
    610606                                 start = bounds_start - bounds_origin + 1, &
    611607                                 count = value_counts )
    612608      !-- 32bit integer output
    613       ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    614          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_int32_0d /),      &
    615                                  start = bounds_start - bounds_origin + 1, &
    616                                  count = value_counts )
    617       ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    618          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_1d,            &
    619                                  start = bounds_start - bounds_origin + 1, &
    620                                  count = value_counts )
    621       ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    622          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_2d,            &
    623                                  start = bounds_start - bounds_origin + 1, &
    624                                  count = value_counts )
    625       ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    626          nc_stat = NF90_PUT_VAR( file_id, var_id, var_int32_3d,            &
     609      ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     610         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /),  &
     611                                 start = bounds_start - bounds_origin + 1,     &
     612                                 count = value_counts )
     613      ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     614         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d,    &
     615                                 start = bounds_start - bounds_origin + 1, &
     616                                 count = value_counts )
     617      ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     618         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d,    &
     619                                 start = bounds_start - bounds_origin + 1, &
     620                                 count = value_counts )
     621      ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     622         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d,    &
    627623                                 start = bounds_start - bounds_origin + 1, &
    628624                                 count = value_counts )
    629625      !-- working-precision integer output
    630       ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    631          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_intwp_0d /),      &
    632                                  start = bounds_start - bounds_origin + 1, &
    633                                  count = value_counts )
    634       ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    635          nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_1d,            &
    636                                  start = bounds_start - bounds_origin + 1, &
    637                                  count = value_counts )
    638       ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    639          nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_2d,            &
    640                                  start = bounds_start - bounds_origin + 1, &
    641                                  count = value_counts )
    642       ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    643          nc_stat = NF90_PUT_VAR( file_id, var_id, var_intwp_3d,            &
     626      ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     627         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /),  &
     628                                 start = bounds_start - bounds_origin + 1,     &
     629                                 count = value_counts )
     630      ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     631         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d,    &
     632                                 start = bounds_start - bounds_origin + 1, &
     633                                 count = value_counts )
     634      ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     635         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d,    &
     636                                 start = bounds_start - bounds_origin + 1, &
     637                                 count = value_counts )
     638      ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     639         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d,    &
    644640                                 start = bounds_start - bounds_origin + 1, &
    645641                                 count = value_counts )
    646642      !-- 32bit real output
    647       ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    648          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real32_0d /),    &
    649                                  start = bounds_start - bounds_origin + 1, &
    650                                  count = value_counts )
    651       ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    652          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_1d,           &
    653                                  start = bounds_start - bounds_origin + 1, &
    654                                  count = value_counts )
    655       ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    656          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_2d,           &
    657                                  start = bounds_start - bounds_origin + 1, &
    658                                  count = value_counts )
    659       ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    660          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real32_3d,           &
     643      ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     644         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), &
     645                                 start = bounds_start - bounds_origin + 1,     &
     646                                 count = value_counts )
     647      ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     648         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d,   &
     649                                 start = bounds_start - bounds_origin + 1, &
     650                                 count = value_counts )
     651      ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     652         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d,   &
     653                                 start = bounds_start - bounds_origin + 1, &
     654                                 count = value_counts )
     655      ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     656         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d,   &
    661657                                 start = bounds_start - bounds_origin + 1, &
    662658                                 count = value_counts )
    663659      !-- 64bit real output
    664       ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    665          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_real64_0d /),    &
    666                                  start = bounds_start - bounds_origin + 1, &
    667                                  count = value_counts )
    668       ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    669          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_1d,           &
    670                                  start = bounds_start - bounds_origin + 1, &
    671                                  count = value_counts )
    672       ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    673          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_2d,           &
    674                                  start = bounds_start - bounds_origin + 1, &
    675                                  count = value_counts )
    676       ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    677          nc_stat = NF90_PUT_VAR( file_id, var_id, var_real64_3d,           &
     660      ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     661         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), &
     662                                 start = bounds_start - bounds_origin + 1,     &
     663                                 count = value_counts )
     664      ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     665         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d,   &
     666                                 start = bounds_start - bounds_origin + 1, &
     667                                 count = value_counts )
     668      ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     669         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d,   &
     670                                 start = bounds_start - bounds_origin + 1, &
     671                                 count = value_counts )
     672      ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     673         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d,   &
    678674                                 start = bounds_start - bounds_origin + 1, &
    679675                                 count = value_counts )
    680676      !-- working-precision real output
    681       ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    682          nc_stat = NF90_PUT_VAR( file_id, var_id, (/ var_realwp_0d /),    &
    683                                  start = bounds_start - bounds_origin + 1, &
    684                                  count = value_counts )
    685       ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    686          nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_1d,           &
    687                                  start = bounds_start - bounds_origin + 1, &
    688                                  count = value_counts )
    689       ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    690          nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_2d,           &
    691                                  start = bounds_start - bounds_origin + 1, &
    692                                  count = value_counts )
    693       ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    694          nc_stat = NF90_PUT_VAR( file_id, var_id, var_realwp_3d,           &
     677      ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     678         nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), &
     679                                 start = bounds_start - bounds_origin + 1,     &
     680                                 count = value_counts )
     681      ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     682         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d,   &
     683                                 start = bounds_start - bounds_origin + 1, &
     684                                 count = value_counts )
     685      ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     686         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d,   &
     687                                 start = bounds_start - bounds_origin + 1, &
     688                                 count = value_counts )
     689      ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     690         nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d,   &
    695691                                 start = bounds_start - bounds_origin + 1, &
    696692                                 count = value_counts )
    … …  
    698694         return_value = 1
    699695         nc_stat = NF90_NOERR
    700          WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
     696         WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id
    701697         CALL internal_message( 'error', routine_name // &
    702                                 TRIM( temp_string ) //   &
    703                                 ': no output values given' )
     698                                ': no output values given ' // TRIM( temp_string ) )
    704699      ENDIF
    705700
    … …  
    713708            WRITE( temp_string, * )  NF90_STRERROR( nc_stat )
    714709
    715             ALLOCATE( dim_ids(ndim) )
    716             ALLOCATE( dim_lengths(ndim) )
    717 
    718             nc_stat = NF90_INQUIRE_VARIABLE( file_id, var_id, dimids=dim_ids )
     710            ALLOCATE( dimension_ids(ndims) )
     711            ALLOCATE( dimension_lengths(ndims) )
     712
     713            nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids )
    719714
    720715            d = 1
    721             DO WHILE ( d <= ndim .AND. nc_stat == NF90_NOERR )
    722                nc_stat = NF90_INQUIRE_DIMENSION( file_id, dim_ids(d), len=dim_lengths(d) )
     716            DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR )
     717               nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), &
     718                                                 LEN=dimension_lengths(d) )
    723719               d = d + 1
    724720            ENDDO
    … …  
    728724                  'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
    729725               CALL internal_message( 'error', routine_name //     &
    730                                       ': error while writing: ' // &
    731                                       TRIM( temp_string ) )
     726                                      ': error while writing: ' // TRIM( temp_string ) )
    732727            ELSE
    733728               !-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
    734729               CALL internal_message( 'error', routine_name //            &
    735730                                      ': error while accessing file: ' // &
    736                                       NF90_STRERROR( nc_stat ) )
     731                                       NF90_STRERROR( nc_stat ) )
    737732            ENDIF
    738733
    … …  
    740735            !-- Other NetCDF error
    741736            CALL internal_message( 'error', routine_name //     &
    742                                    ': error while writing: ' // &
    743                                    NF90_STRERROR( nc_stat ) )
     737                                   ': error while writing: ' // NF90_STRERROR( nc_stat ) )
    744738         ENDIF
    745739      ENDIF
    … …  
    761755   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_finalize'  !< name of routine
    762756
    763    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    764    INTEGER(iwp)              ::  nc_stat       !< netcdf return value
    765    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
     757   INTEGER, INTENT(IN)  ::  file_id       !< file ID
     758   INTEGER              ::  nc_stat       !< netcdf return value
     759   INTEGER, INTENT(OUT) ::  return_value  !< return value
    766760
    767761
    … …  
    769763   WRITE( temp_string, * ) file_id
    770764   CALL internal_message( 'debug', routine_name // &
    771                                    ': close file (file_id=' // TRIM( temp_string ) // ')' )
     765                          ': close file (file_id=' // TRIM( temp_string ) // ')' )
    772766
    773767   nc_stat = NF90_CLOSE( file_id )
    … …  
    777771      return_value = 1
    778772      CALL internal_message( 'error', routine_name // &
    779                                       ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
     773                             ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
    780774   ENDIF
    781775#else
    … …  
    796790   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'get_netcdf_data_type'  !< name of this routine
    797791
    798    INTEGER(iwp) ::  return_value  !< netcdf data type
     792   INTEGER ::  return_value  !< netcdf data type
    799793
    800794
    … …  
    823817      CASE DEFAULT
    824818         CALL internal_message( 'error', routine_name // &
    825                                          ': data type unknown (' // TRIM( data_type ) // ')' )
    826          return_value = -1_iwp
     819                                ': data type unknown (' // TRIM( data_type ) // ')' )
     820         return_value = -1
    827821
    828822   END SELECT
    … …  
    860854!> Return the last created error message.
    861855!--------------------------------------------------------------------------------------------------!
    862 SUBROUTINE netcdf4_get_error_message( error_message )
    863 
    864    CHARACTER(LEN=800), INTENT(OUT) ::  error_message  !< return error message to main program
    865 
    866 
    867    error_message = internal_error_message
    868 
    869 END SUBROUTINE netcdf4_get_error_message
     856FUNCTION netcdf4_get_error_message() RESULT( error_message )
     857
     858   CHARACTER(LEN=800) ::  error_message  !< return error message to main program
     859
     860
     861   error_message = TRIM( internal_error_message )
     862
     863   internal_error_message = ''
     864
     865END FUNCTION netcdf4_get_error_message
    870866
    871867

  • palm/trunk/UTIL/binary_to_netcdf.f90

    r4123 r4141  
    4949
    5050   !-- Set kinds to be used as defaults
    51    INTEGER, PARAMETER ::   wp = 8  !< default real kind
    52    INTEGER, PARAMETER ::  iwp = 4  !< default integer kind
     51   INTEGER, PARAMETER ::  iwp = 4  !< default integer kind for output-variable values
     52   INTEGER, PARAMETER ::  wp  = 8  !< default real kind for output-variable values
    5353
    5454   INTEGER, PARAMETER ::  charlen_internal = 1000  !< length of strings within this program
    … …  
    5959      CHARACTER(LEN=charlen_internal) ::  name          !< name of attribute
    6060      CHARACTER(LEN=charlen_internal) ::  value_char    !< character value
    61       INTEGER(iwp)                    ::  var_id        !< id of variable to which the attribute belongs to
     61      INTEGER                         ::  variable_id   !< id of variable to which the attribute belongs to
    6262      INTEGER(KIND=1)                 ::  value_int8    !< 8bit integer value
    6363      INTEGER(KIND=2)                 ::  value_int16   !< 16bit integer value
    … …  
    7070      CHARACTER(LEN=charlen_internal) ::  data_type  !< data type of dimension
    7171      CHARACTER(LEN=charlen_internal) ::  name       !< dimension name
    72       INTEGER(iwp)                    ::  id         !< dimension id within file
    73       INTEGER(iwp)                    ::  length     !< length of dimension
     72      INTEGER                         ::  id         !< dimension id within file
     73      INTEGER                         ::  length     !< length of dimension
    7474   END TYPE dimension_type
    7575
    7676   TYPE variable_type
    77       CHARACTER(LEN=charlen_internal) ::  data_type  !< data type of variable
    78       CHARACTER(LEN=charlen_internal) ::  name       !< variable name
    79       INTEGER(iwp)                    ::  id         !< variable id within file
    80       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dimension_ids  !< list of dimension ids used by variable
     77      CHARACTER(LEN=charlen_internal)    ::  data_type      !< data type of variable
     78      CHARACTER(LEN=charlen_internal)    ::  name           !< variable name
     79      INTEGER                            ::  id             !< variable id within file
     80      INTEGER, DIMENSION(:), ALLOCATABLE ::  dimension_ids  !< list of dimension ids used by variable
    8181   END TYPE variable_type
    8282
    … …  
    9292      config_file_list_name = 'BINARY_CONFIG_LIST'  !< file containing list of binary config files of each output group
    9393
    94    INTEGER(iwp) ::  charlen            !< length of characters (strings) in binary file
    95    INTEGER(iwp) ::  dom_global_id      !< global ID within a single file defined by DOM
    96    INTEGER      ::  dom_master_rank    !< master MPI rank in DOM (rank which wrote additional information in DOM)
    97    INTEGER      ::  dom_nrank          !< number of MPI ranks used by DOM
    98    INTEGER(iwp) ::  file_index         !< loop index to loop over files
    99    INTEGER      ::  group              !< loop index to loop over groups
    100    INTEGER(iwp) ::  nc_file_id         !< ID of netcdf output file
    101    INTEGER(iwp) ::  nfiles             !< number of output files defined in config file
    102    INTEGER      ::  ngroup             !< number of output-file groups
    103    INTEGER      ::  return_value       !< return value
    104    INTEGER      ::  your_return_value  !< returned value of called routine
     94   INTEGER ::  charlen            !< length of characters (strings) in binary file
     95   INTEGER ::  dom_global_id      !< global ID within a single file defined by DOM
     96   INTEGER ::  dom_master_rank    !< master MPI rank in DOM (rank which wrote additional information in DOM)
     97   INTEGER ::  dom_nranks         !< number of MPI ranks used by DOM
     98   INTEGER ::  file_index         !< loop index to loop over files
     99   INTEGER ::  group              !< loop index to loop over groups
     100   INTEGER ::  nc_file_id         !< ID of netcdf output file
     101   INTEGER ::  nfiles             !< number of output files defined in config file
     102   INTEGER ::  ngroups            !< number of output-file groups
     103   INTEGER ::  return_value       !< return value
     104   INTEGER ::  your_return_value  !< returned value of called routine
    105105
    106106   INTEGER(KIND=1) ::  dummy_int8   !< dummy variable used for reading
    107107   INTEGER(KIND=2) ::  dummy_int16  !< dummy variable used for reading
    108108   INTEGER(KIND=4) ::  dummy_int32  !< dummy variable used for reading
    109    INTEGER(iwp)    ::  dummy_intwp  !< dummy variable used for reading
     109   INTEGER         ::  dummy_int    !< dummy variable used for reading
    110110
    111111   INTEGER, PARAMETER ::  bin_file_unit = 12          !< Fortran unit of binary file
    … …  
    113113   INTEGER, PARAMETER ::  config_file_list_unit = 10  !< Fortran unit of file containing config-file list
    114114
    115    INTEGER, DIMENSION(:), ALLOCATABLE ::  dim_id_netcdf  !< mapped dimension id within NetCDF file:
    116                                                          !> dimension_list(i)%id and dim_id_netcdf(dimension_list(i)%id)
     115   INTEGER, DIMENSION(:), ALLOCATABLE ::  dimension_id_netcdf  !< mapped dimension id within NetCDF file:
     116                                                         !> dimension_list(i)%id and dimension_id_netcdf(dimension_list(i)%id)
    117117                                                         !> reference the same dimension
    118    INTEGER, DIMENSION(:), ALLOCATABLE ::  var_id_netcdf  !< mapped variable id within NetCDF file:
    119                                                          !> variable_list(i)%id and var_id_netcdf(variable_list(i)%id)
     118   INTEGER, DIMENSION(:), ALLOCATABLE ::  variable_id_netcdf  !< mapped variable id within NetCDF file:
     119                                                         !> variable_list(i)%id and variable_id_netcdf(variable_list(i)%id)
    120120                                                         !> reference the same variable
    121121
    … …  
    139139
    140140      !-- Go through each group of output files (all marked by same file suffix)
    141       DO  group = 1, ngroup
     141      DO  group = 1, ngroups
    142142
    143143         CALL internal_message( 'info', 'Start converting ' // TRIM( group_names(group) ) // &
    … …  
    160160
    161161               IF ( your_return_value == 0 )  THEN
    162                   CALL convert_data_to_netcdf( TRIM( filename_list(file_index) ), your_return_value )
     162                  CALL convert_data_to_netcdf( TRIM( filename_list(file_index) ), &
     163                                               your_return_value )
    163164               ELSE
    164165                  return_value = your_return_value
    … …  
    228229
    229230      !-- Count the configuration files
    230       ngroup = 0
     231      ngroups = 0
    231232      DO WHILE ( io_stat == 0 )
    232233         READ( config_file_list_unit, '(A)', IOSTAT=io_stat )  file_name
    233          IF ( io_stat == 0 )  ngroup = ngroup + 1
     234         IF ( io_stat == 0 )  ngroups = ngroups + 1
    234235      ENDDO
    235236      REWIND( config_file_list_unit )
    236237
    237       IF ( ngroup /= 0 )  THEN
    238 
    239          ALLOCATE( group_names(ngroup) )
     238      IF ( ngroups /= 0 )  THEN
     239
     240         ALLOCATE( group_names(ngroups) )
    240241
    241242         !-- Extract the group names
    242          DO  i = 1, ngroup
     243         DO  i = 1, ngroups
    243244            READ( config_file_list_unit, '(A)', IOSTAT=io_stat )  file_name
    244245            IF ( INDEX( TRIM( file_name ), config_file_name_base ) == 1 )  THEN
    … …  
    284285   CHARACTER(LEN=charlen_internal), DIMENSION(:), ALLOCATABLE ::  filename_list_tmp  !< temporary list of file names
    285286
    286    INTEGER(iwp)         ::  filename_prefix_length  !< length of string containing the filname prefix
     287   INTEGER              ::  filename_prefix_length  !< length of string containing the filname prefix
    287288   INTEGER              ::  io_stat                 !< status of Fortran I/O operations
    288289   INTEGER, INTENT(OUT) ::  return_value            !< return value of routine
    … …  
    298299   IF ( io_stat /= 0 )  THEN
    299300      return_value = 1
    300       CALL internal_message( 'error', &
    301               routine_name // ': error while opening configuration file "' // &
    302               TRIM( config_file_name ) // '"' )
     301      CALL internal_message( 'error', routine_name // &
     302                            ': error while opening configuration file "' // &
     303                             TRIM( config_file_name ) // '"' )
    303304   ENDIF
    304305
    305306   IF ( return_value == 0 )  THEN
    306307
    307       READ( config_file_unit ) dom_nrank
    308 
    309       IF ( dom_nrank > 1000000 )  THEN
    310          dom_nrank = 1000000
     308      READ( config_file_unit ) dom_nranks
     309
     310      IF ( dom_nranks > 1000000 )  THEN
     311         dom_nranks = 1000000
    311312         CALL internal_message( 'info', routine_name // &
    312313                 ': number of MPI ranks used in PALM is greater than the maximum ' // &
    … …  
    357358            return_value = 1
    358359            CALL internal_message( 'error', routine_name // &
    359                                             ': error while reading file names from config' )
     360                                   ': error while reading file names from config' )
    360361            EXIT
    361362         ENDIF
    … …  
    377378
    378379   CHARACTER(LEN=2*charlen)             ::  bin_filename       !< name of binary file which to read
    379    CHARACTER(LEN=*        ), INTENT(IN) ::  bin_filename_body  !< body of binary filename which to read
     380   CHARACTER(LEN=*),        INTENT(IN) ::  bin_filename_body  !< body of binary filename which to read
    380381   CHARACTER(LEN=charlen  )             ::  read_string        !< string read from file
    381382
    … …  
    387388   INTEGER              ::  n_dimensions       !< number of dimensions in file
    388389   INTEGER              ::  n_variables        !< number of variables in file
    389    INTEGER(iwp)         ::  var_ndim           !< number of dimensions of a variable
     390   INTEGER              ::  variable_ndims     !< number of dimensions of a variable
    390391   INTEGER, INTENT(OUT) ::  return_value       !< return value
    391392
    … …  
    408409   IF ( io_stat == 0 )  THEN
    409410
    410       READ( bin_file_unit ) dummy_intwp
    411       READ( bin_file_unit ) dummy_intwp
    412       READ( bin_file_unit ) read_string
     411      READ( bin_file_unit ) dummy_int    ! charlen
     412      READ( bin_file_unit ) dummy_int    ! file_id
     413      READ( bin_file_unit ) read_string  ! filename
    413414
    414415   ELSE
    … …  
    475476            READ( bin_file_unit ) read_string
    476477            variable_list(n_variables)%data_type = read_string
    477             READ( bin_file_unit ) var_ndim
    478             ALLOCATE( variable_list(n_variables)%dimension_ids(1:var_ndim) )
    479             READ( bin_file_unit )  ( variable_list(n_variables)%dimension_ids(i), i = 1, var_ndim )
     478            READ( bin_file_unit ) variable_ndims
     479            ALLOCATE( variable_list(n_variables)%dimension_ids(1:variable_ndims) )
     480            READ( bin_file_unit ) &
     481               ( variable_list(n_variables)%dimension_ids(i), i = 1, variable_ndims )
    480482
    481483         CASE ( 'attribute' )
    … …  
    496498
    497499            !-- Read attribute
    498             READ( bin_file_unit ) attribute_list(n_attributes)%var_id
     500            READ( bin_file_unit ) attribute_list(n_attributes)%variable_id
    499501            READ( bin_file_unit ) read_string
    500502            attribute_list(n_attributes)%name = read_string
    … …  
    559561   CHARACTER(LEN=*), PARAMETER  ::  routine_name = 'define_netcdf_files'  !< routine name
    560562
    561    INTEGER              ::  i              !< loop index
    562    INTEGER              ::  j              !< loop index
    563    INTEGER              ::  nc_data_type   !< netcdf data type of output variable
    564    INTEGER              ::  nc_dim_length  !< length of dimension in netcdf file
    565    INTEGER              ::  nc_stat        !< return value of Netcdf calls
    566    INTEGER, INTENT(OUT) ::  return_value   !< return value
    567 
    568    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  var_dim_id  !< list of dimension ids of a variable
     563   INTEGER              ::  i                    !< loop index
     564   INTEGER              ::  j                    !< loop index
     565   INTEGER              ::  nc_data_type         !< netcdf data type of output variable
     566   INTEGER              ::  nc_dimension_length  !< length of dimension in netcdf file
     567   INTEGER              ::  nc_stat              !< return value of Netcdf calls
     568   INTEGER, INTENT(OUT) ::  return_value         !< return value
     569
     570   INTEGER, DIMENSION(:), ALLOCATABLE ::  dimension_ids  !< list of dimension ids of a variable
    569571
    570572
    … …  
    581583
    582584      !-- Define dimensions in NetCDF file
    583       ALLOCATE( dim_id_netcdf(1:MAXVAL(dimension_list(:)%id)) )
     585      ALLOCATE( dimension_id_netcdf(1:MAXVAL(dimension_list(:)%id)) )
    584586
    585587      DO  i = 1, SIZE( dimension_list )
    586588
    587589         IF ( dimension_list(i)%length < 0 )  THEN
    588             nc_dim_length = NF90_UNLIMITED
     590            nc_dimension_length = NF90_UNLIMITED
    589591         ELSE
    590             nc_dim_length = dimension_list(i)%length
     592            nc_dimension_length = dimension_list(i)%length
    591593         ENDIF
    592594
    593          nc_stat =  NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dim_length, &
    594                                   dim_id_netcdf(dimension_list(i)%id) )
     595         nc_stat =  NF90_DEF_DIM( nc_file_id, dimension_list(i)%name, nc_dimension_length, &
     596                                  dimension_id_netcdf(dimension_list(i)%id) )
    595597
    596598         IF ( nc_stat /= NF90_NOERR )  THEN
    … …  
    609611
    610612      !-- Create vector to map variable IDs from binary file to those within netcdf file
    611       ALLOCATE( var_id_netcdf(MIN( MINVAL(attribute_list(:)%var_id),   &
    612                                    MINVAL(variable_list(:)%id) )     : &
    613                               MAX( MAXVAL(attribute_list(:)%var_id),   &
    614                                    MAXVAL(variable_list(:)%id) )     ) )
     613      ALLOCATE( variable_id_netcdf(MIN( MINVAL( attribute_list(:)%variable_id ), &
     614                                        MINVAL( variable_list(:)%id ) )          &
     615                                   :                                             &
     616                                   MAX( MAXVAL( attribute_list(:)%variable_id ), &
     617                                        MAXVAL( variable_list(:)%id ) )     ) )
    615618
    616619      !-- Map global id from binary file to that of the netcdf file
    617       var_id_netcdf(dom_global_id) = NF90_GLOBAL
     620      variable_id_netcdf(dom_global_id) = NF90_GLOBAL
    618621
    619622      !-- Define variables in NetCDF file
    … …  
    651654         IF ( return_value == 0 )  THEN
    652655
    653             ALLOCATE( var_dim_id(1:SIZE( variable_list(i)%dimension_ids )) )
     656            ALLOCATE( dimension_ids(1:SIZE( variable_list(i)%dimension_ids )) )
    654657
    655658            DO  j = 1, SIZE( variable_list(i)%dimension_ids )
    656659
    657                var_dim_id(j) = dim_id_netcdf(variable_list(i)%dimension_ids(j))
     660               dimension_ids(j) = dimension_id_netcdf(variable_list(i)%dimension_ids(j))
    658661
    659662            ENDDO
    660663
    661664            nc_stat =  NF90_DEF_VAR( nc_file_id, variable_list(i)%name, nc_data_type, &
    662                                      var_dim_id, var_id_netcdf(variable_list(i)%id) )
     665                                     dimension_ids, variable_id_netcdf(variable_list(i)%id) )
    663666            IF ( nc_stat /= NF90_NOERR )  THEN
    664667               return_value = 1
    … …  
    668671            ENDIF
    669672
    670             DEALLOCATE( var_dim_id )
     673            DEALLOCATE( dimension_ids )
    671674
    672675         ENDIF
    … …  
    686689
    687690            CASE ( 'char' )
    688                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    689                                        var_id_netcdf(attribute_list(i)%var_id), &
    690                                        TRIM(attribute_list(i)%name),            &
     691               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     692                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     693                                       TRIM(attribute_list(i)%name),                      &
    691694                                       TRIM(attribute_list(i)%value_char) )
    692695
    693696            CASE ( 'int8' )
    694                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    695                                        var_id_netcdf(attribute_list(i)%var_id), &
    696                                        TRIM(attribute_list(i)%name),            &
     697               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     698                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     699                                       TRIM(attribute_list(i)%name),                      &
    697700                                       attribute_list(i)%value_int8 )
    698701
    699702            CASE ( 'int16' )
    700                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    701                                        var_id_netcdf(attribute_list(i)%var_id), &
    702                                        TRIM(attribute_list(i)%name),            &
     703               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     704                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     705                                       TRIM(attribute_list(i)%name),                      &
    703706                                       attribute_list(i)%value_int16 )
    704707
    705708            CASE ( 'int32' )
    706                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    707                                        var_id_netcdf(attribute_list(i)%var_id), &
    708                                        TRIM(attribute_list(i)%name),            &
     709               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     710                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     711                                       TRIM(attribute_list(i)%name),                      &
    709712                                       attribute_list(i)%value_int32 )
    710713
    711714            CASE ( 'real32' )
    712                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    713                                        var_id_netcdf(attribute_list(i)%var_id), &
    714                                        TRIM(attribute_list(i)%name),            &
     715               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     716                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     717                                       TRIM(attribute_list(i)%name),                      &
    715718                                       attribute_list(i)%value_real32 )
    716719
    717720            CASE ( 'real64' )
    718                nc_stat = NF90_PUT_ATT( nc_file_id,                              &
    719                                        var_id_netcdf(attribute_list(i)%var_id), &
    720                                        TRIM(attribute_list(i)%name),            &
     721               nc_stat = NF90_PUT_ATT( nc_file_id,                                        &
     722                                       variable_id_netcdf(attribute_list(i)%variable_id), &
     723                                       TRIM(attribute_list(i)%name),                      &
    721724                                       attribute_list(i)%value_real64 )
    722725
    723726            CASE DEFAULT
    724727               return_value = 1
    725                CALL internal_message( 'error', routine_name // &
     728               CALL internal_message( 'error', routine_name //                   &
    726729                       ': data type "' // TRIM( attribute_list(i)%data_type ) // &
    727730                       '" of attribute "' // TRIM( attribute_list(i)%name ) //   &
    … …  
    733736         IF ( nc_stat /= NF90_NOERR )  THEN
    734737            return_value = 1
    735             CALL internal_message( 'error', routine_name // &
    736                     ': attribute "' // TRIM( attribute_list(i)%name ) //   &
     738            CALL internal_message( 'error', routine_name //              &
     739                    ': attribute "' // TRIM( attribute_list(i)%name ) // &
    737740                    '": NF90_PUT_ATT error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
    738741            EXIT
    … …  
    750753      return_value = 1
    751754      CALL internal_message( 'error', routine_name // &
    752               ': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
     755                             ': NF90_ENDDEF error: ' // TRIM( NF90_STRERROR( nc_stat ) ) )
    753756   ENDIF
    754757
    … …  
    772775   INTEGER              ::  i             !< loop file_index
    773776   INTEGER              ::  io_stat       !< status of Fortran I/O operations
    774    INTEGER              ::  pe_id         !< loop index for loop over PE files
    775    INTEGER              ::  n_dim         !< number of dimensions of a variable
     777   INTEGER              ::  rank          !< loop index for loop over rank files
     778   INTEGER              ::  n_dimensions  !< number of dimensions of a variable
    776779   INTEGER              ::  nc_stat       !< return value of Netcdf calls
    777780   INTEGER, INTENT(OUT) ::  return_value  !< return value
    778    INTEGER(iwp)         ::  var_id        !< variable id read from binary file
    779 
    780    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  start_positions           !< start position of data per dimension
    781    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  data_count_per_dimension  !< data count of variable per dimension
    782    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  bounds_start              !< lower bounds of variable
    783    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  bounds_origin             !< lower bounds of dimensions in output file
     781   INTEGER              ::  variable_id   !< variable id read from binary file
     782
     783   INTEGER, DIMENSION(:), ALLOCATABLE ::  start_positions           !< start position of data per dimension
     784   INTEGER, DIMENSION(:), ALLOCATABLE ::  data_count_per_dimension  !< data count of variable per dimension
     785   INTEGER, DIMENSION(:), ALLOCATABLE ::  bounds_start              !< lower bounds of variable
     786   INTEGER, DIMENSION(:), ALLOCATABLE ::  bounds_origin             !< lower bounds of dimensions in output file
    784787
    785788   INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8   !< variable values
    … …  
    797800   return_value = 0
    798801
    799    !-- Open binary files of every possible PE
    800    DO  pe_id = 0, dom_nrank - 1
     802   !-- Open binary files of every possible MPI rank
     803   DO  rank = 0, dom_nranks - 1
    801804
    802805      WRITE( bin_filename, '(A, I6.6)' ) &
    803          TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', pe_id
     806         TRIM( filename_prefix ) // TRIM( bin_filename_body ) // '_', rank
    804807
    805808      INQUIRE( FILE=bin_filename, EXIST=file_exists )
    … …  
    846849         DO WHILE ( io_stat == 0  .AND.  return_value == 0 )
    847850
    848             READ( bin_file_unit, IOSTAT=io_stat ) var_id
     851            READ( bin_file_unit, IOSTAT=io_stat ) variable_id
    849852            IF ( io_stat < 0 )  EXIT  ! End-of-file
    850853
    851854            DO  i = LBOUND( variable_list, DIM=1 ), UBOUND( variable_list, DIM=1 )
    852                IF ( var_id == variable_list(i)%id )  THEN
    853                   n_dim = SIZE( variable_list(i)%dimension_ids )
     855               IF ( variable_id == variable_list(i)%id )  THEN
     856                  n_dimensions = SIZE( variable_list(i)%dimension_ids )
    854857                  variable_name = variable_list(i)%name
    855858
    856859                  CALL internal_message( 'debug', routine_name // ': read variable "' // &
    857860                                         TRIM( variable_name ) // '"' )
    858                   WRITE( temp_string, * ) n_dim
     861                  WRITE( temp_string, * ) n_dimensions
    859862                  CALL internal_message( 'debug', routine_name // &
    860                                          ':  n_dim = ' // TRIM( temp_string ) )
     863                                         ':  n_dimensions = ' // TRIM( temp_string ) )
    861864
    862865                  EXIT
    … …  
    864867            ENDDO
    865868
    866             ALLOCATE( bounds_start(1:n_dim) )
    867             ALLOCATE( bounds_origin(1:n_dim) )
    868             ALLOCATE( start_positions(1:n_dim) )
    869             ALLOCATE( data_count_per_dimension(1:n_dim) )
    870 
    871             READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dim )
    872             READ( bin_file_unit ) ( data_count_per_dimension(i), i = 1, n_dim )
    873             READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dim )
     869            ALLOCATE( bounds_start(1:n_dimensions) )
     870            ALLOCATE( bounds_origin(1:n_dimensions) )
     871            ALLOCATE( start_positions(1:n_dimensions) )
     872            ALLOCATE( data_count_per_dimension(1:n_dimensions) )
     873
     874            READ( bin_file_unit ) ( bounds_start(i), i = 1, n_dimensions )
     875            READ( bin_file_unit ) ( data_count_per_dimension(i), i = 1, n_dimensions )
     876            READ( bin_file_unit ) ( bounds_origin(i), i = 1, n_dimensions )
    874877
    875878            WRITE( temp_string, * ) bounds_start
    … …  
    885888            data_count = 1
    886889
    887             DO  i = 1, n_dim
     890            DO  i = 1, n_dimensions
    888891               data_count = data_count * data_count_per_dimension(i)
    889892               start_positions(i) = bounds_start(i) - bounds_origin(i) + 1
    … …  
    900903                  READ( bin_file_unit ) ( values_int8(i), i = 1, data_count )
    901904
    902                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int8, &
     905                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     906                               values_int8,                                            &
    903907                               start = start_positions, count = data_count_per_dimension )
    904908
    … …  
    910914                  READ( bin_file_unit ) ( values_int16(i), i = 1, data_count )
    911915
    912                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int16, &
     916                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     917                               values_int16,                                           &
    913918                               start = start_positions, count = data_count_per_dimension )
    914919
    … …  
    920925                  READ( bin_file_unit ) ( values_int32(i), i = 1, data_count )
    921926
    922                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_int32, &
     927                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     928                               values_int32,                                           &
    923929                               start = start_positions, count = data_count_per_dimension )
    924930
    … …  
    930936                  READ( bin_file_unit ) ( values_intwp(i), i = 1, data_count )
    931937
    932                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_intwp, &
     938                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     939                               values_intwp,                                          &
    933940                               start = start_positions, count = data_count_per_dimension )
    934941
    … …  
    940947                  READ( bin_file_unit ) ( values_real32(i), i = 1, data_count )
    941948
    942                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real32, &
     949                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     950                               values_real32,                                          &
    943951                               start = start_positions, count = data_count_per_dimension )
    944952
    … …  
    950958                  READ( bin_file_unit ) ( values_real64(i), i = 1, data_count )
    951959
    952                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_real64, &
     960                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     961                               values_real64,                                          &
    953962                               start = start_positions, count = data_count_per_dimension )
    954963
    … …  
    960969                  READ( bin_file_unit ) ( values_realwp(i), i = 1, data_count )
    961970
    962                   nc_stat = NF90_PUT_VAR( nc_file_id, var_id_netcdf(var_id), values_realwp, &
     971                  nc_stat = NF90_PUT_VAR( nc_file_id, variable_id_netcdf(variable_id), &
     972                               values_realwp,                                          &
    963973                               start = start_positions, count = data_count_per_dimension )
    964974
    … …  
    9971007
    9981008   !-- Deallocate fields for next file
    999    IF ( ALLOCATED( variable_list ) )  DEALLOCATE( variable_list )
    1000    IF ( ALLOCATED( dim_id_netcdf ) )  DEALLOCATE( dim_id_netcdf )
    1001    IF ( ALLOCATED( var_id_netcdf ) )  DEALLOCATE( var_id_netcdf )
     1009   IF ( ALLOCATED( variable_list       ) )  DEALLOCATE( variable_list )
     1010   IF ( ALLOCATED( dimension_id_netcdf ) )  DEALLOCATE( dimension_id_netcdf )
     1011   IF ( ALLOCATED( variable_id_netcdf  ) )  DEALLOCATE( variable_id_netcdf )
    10021012
    10031013END SUBROUTINE convert_data_to_netcdf
    … …  
    10101020SUBROUTINE internal_message( level, string )
    10111021
    1012    CHARACTER(LEN=*), INTENT(IN) :: level  !< message importance level
    1013    CHARACTER(LEN=*), INTENT(IN) :: string !< message string
     1022   CHARACTER(LEN=*), INTENT(IN) :: level   !< message importance level
     1023   CHARACTER(LEN=*), INTENT(IN) :: string  !< message string
    10141024
    10151025   IF ( TRIM( level ) == 'error' )  THEN
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |