Changeset 4147 for palm/trunk


Ignore:
Timestamp:
Aug 7, 2019 9:42:31 AM (2 years ago)
Author:
gronemeier
Message:

corrected indentation according to coding standard

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r4141 r4147  
    2525! -----------------
    2626! $Id$
     27! corrected indentation according to coding standard
     28!
     29! 4141 2019-08-05 12:24:51Z gronemeier
    2730! Initial revision
    2831!
     
    3841!> @todo Get iostat value of write statements.
    3942!--------------------------------------------------------------------------------------------------!
    40 MODULE data_output_binary_module
    41 
    42    USE kinds
     43 MODULE data_output_binary_module
     44
     45    USE kinds
    4346
    4447#if defined( __parallel )
    4548#if defined( __mpifh )
    46    INCLUDE "mpif.h"
     49    INCLUDE "mpif.h"
    4750#else
    48    USE MPI
     51    USE MPI
    4952#endif
    5053#endif
    5154
    52    IMPLICIT NONE
    53 
    54    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
    55 
    56    CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
    57    CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
    58    CHARACTER(LEN=*), PARAMETER ::  file_prefix = 'BIN_'                          !< file prefix for binary files
    59 
    60    CHARACTER(LEN=charlen)      ::  file_suffix = ''             !< file suffix added to each file name
    61    CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
    62    CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
    63 
    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
    73 
    74    LOGICAL ::  binary_open_file_first_call = .TRUE.  !< true if binary_open_file routine was not called yet
    75    LOGICAL ::  config_file_open = .FALSE.            !< true if config file is opened and not closed
    76    LOGICAL ::  print_debug_output = .FALSE.          !< if true, debug output is printed
    77 
    78    SAVE
    79 
    80    PRIVATE
    81 
    82    INTERFACE binary_init_module
    83       MODULE PROCEDURE binary_init_module
    84    END INTERFACE binary_init_module
    85 
    86    INTERFACE binary_open_file
    87       MODULE PROCEDURE binary_open_file
    88    END INTERFACE binary_open_file
    89 
    90    INTERFACE binary_init_dimension
    91       MODULE PROCEDURE binary_init_dimension
    92    END INTERFACE binary_init_dimension
    93 
    94    INTERFACE binary_init_variable
    95       MODULE PROCEDURE binary_init_variable
    96    END INTERFACE binary_init_variable
    97 
    98    INTERFACE binary_write_attribute
    99       MODULE PROCEDURE binary_write_attribute
    100    END INTERFACE binary_write_attribute
    101 
    102    INTERFACE binary_stop_file_header_definition
    103       MODULE PROCEDURE binary_stop_file_header_definition
    104    END INTERFACE binary_stop_file_header_definition
    105 
    106    INTERFACE binary_write_variable
    107       MODULE PROCEDURE binary_write_variable
    108    END INTERFACE binary_write_variable
    109 
    110    INTERFACE binary_finalize
    111       MODULE PROCEDURE binary_finalize
    112    END INTERFACE binary_finalize
    113 
    114    INTERFACE binary_get_error_message
    115       MODULE PROCEDURE binary_get_error_message
    116    END INTERFACE binary_get_error_message
    117 
    118    PUBLIC &
    119       binary_finalize, &
    120       binary_get_error_message, &
    121       binary_init_dimension, &
    122       binary_stop_file_header_definition, &
    123       binary_init_module, &
    124       binary_init_variable, &
    125       binary_open_file, &
    126       binary_write_attribute, &
    127       binary_write_variable
    128 
    129 
    130 CONTAINS
     55    IMPLICIT NONE
     56
     57    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
     58
     59    CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
     60    CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
     61    CHARACTER(LEN=*), PARAMETER ::  file_prefix = 'BIN_'                          !< file prefix for binary files
     62
     63    CHARACTER(LEN=charlen)      ::  file_suffix = ''             !< file suffix added to each file name
     64    CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
     65    CHARACTER(LEN=800)          ::  temp_string                  !< dummy string
     66
     67    INTEGER ::  binary_file_lowest_unit = 1000  !< lowest unit number of all binary files created by this module
     68    INTEGER ::  config_file_unit                !< unit number of config file
     69    INTEGER ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
     70    INTEGER ::  global_id_in_file = -1          !< value of global ID within a file
     71    INTEGER ::  master_rank                     !< master rank for tasks to be executed by single PE only
     72    INTEGER ::  next_available_unit             !< next unit number available for new file
     73    INTEGER ::  output_group_comm               !< MPI communicator addressing all MPI ranks which participate in output
     74
     75    INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id  !< highest assigned ID of variable or dimension in a file
     76
     77    LOGICAL ::  binary_open_file_first_call = .TRUE.  !< true if binary_open_file routine was not called yet
     78    LOGICAL ::  config_file_open = .FALSE.            !< true if config file is opened and not closed
     79    LOGICAL ::  print_debug_output = .FALSE.          !< if true, debug output is printed
     80
     81    SAVE
     82
     83    PRIVATE
     84
     85    INTERFACE binary_init_module
     86       MODULE PROCEDURE binary_init_module
     87    END INTERFACE binary_init_module
     88
     89    INTERFACE binary_open_file
     90       MODULE PROCEDURE binary_open_file
     91    END INTERFACE binary_open_file
     92
     93    INTERFACE binary_init_dimension
     94       MODULE PROCEDURE binary_init_dimension
     95    END INTERFACE binary_init_dimension
     96
     97    INTERFACE binary_init_variable
     98       MODULE PROCEDURE binary_init_variable
     99    END INTERFACE binary_init_variable
     100
     101    INTERFACE binary_write_attribute
     102       MODULE PROCEDURE binary_write_attribute
     103    END INTERFACE binary_write_attribute
     104
     105    INTERFACE binary_stop_file_header_definition
     106       MODULE PROCEDURE binary_stop_file_header_definition
     107    END INTERFACE binary_stop_file_header_definition
     108
     109    INTERFACE binary_write_variable
     110       MODULE PROCEDURE binary_write_variable
     111    END INTERFACE binary_write_variable
     112
     113    INTERFACE binary_finalize
     114       MODULE PROCEDURE binary_finalize
     115    END INTERFACE binary_finalize
     116
     117    INTERFACE binary_get_error_message
     118       MODULE PROCEDURE binary_get_error_message
     119    END INTERFACE binary_get_error_message
     120
     121    PUBLIC &
     122       binary_finalize, &
     123       binary_get_error_message, &
     124       binary_init_dimension, &
     125       binary_stop_file_header_definition, &
     126       binary_init_module, &
     127       binary_init_variable, &
     128       binary_open_file, &
     129       binary_write_attribute, &
     130       binary_write_variable
     131
     132
     133 CONTAINS
    131134
    132135
     
    136139!> Initialize data-output module.
    137140!--------------------------------------------------------------------------------------------------!
    138 SUBROUTINE binary_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
    139                                master_output_rank,                                    &
    140                                program_debug_output_unit, debug_output, dom_global_id )
    141 
    142    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
    143                                                                  !> must be unique for each output group
    144 
    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
    149 
    150    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
    151 
    152 
    153    file_suffix = file_suffix_of_output_group
    154    output_group_comm = mpi_comm_of_output_group
    155    master_rank = master_output_rank
    156 
    157    debug_output_unit = program_debug_output_unit
    158    print_debug_output = debug_output
    159 
    160    global_id_in_file = dom_global_id
    161 
    162 END SUBROUTINE binary_init_module
     141 SUBROUTINE binary_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &
     142                                master_output_rank,                                    &
     143                                program_debug_output_unit, debug_output, dom_global_id )
     144
     145    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
     146                                                                  !> must be unique for each output group
     147
     148    INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
     149    INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
     150    INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
     151    INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
     152
     153    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
     154
     155
     156    file_suffix = file_suffix_of_output_group
     157    output_group_comm = mpi_comm_of_output_group
     158    master_rank = master_output_rank
     159
     160    debug_output_unit = program_debug_output_unit
     161    print_debug_output = debug_output
     162
     163    global_id_in_file = dom_global_id
     164
     165 END SUBROUTINE binary_init_module
    163166
    164167!--------------------------------------------------------------------------------------------------!
     
    167170!> Open binary file.
    168171!--------------------------------------------------------------------------------------------------!
    169 SUBROUTINE binary_open_file( mode, file_name, file_id, return_value )
    170 
    171    CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    172    CHARACTER(LEN=charlen), INTENT(IN) ::  file_name          !< name of file
    173    CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
    174    CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
    175 
    176    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
    177 
    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
    184 
    185    LOGICAL ::  file_exists  !< true if file to be opened already exists
    186 
    187 
    188    return_value = 0
     172 SUBROUTINE binary_open_file( mode, file_name, file_id, return_value )
     173
     174    CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
     175    CHARACTER(LEN=charlen), INTENT(IN) ::  file_name          !< name of file
     176    CHARACTER(LEN=7)                   ::  my_rank_char       !< string containing value of my_rank with leading zeros
     177    CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
     178
     179    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
     180
     181    INTEGER, INTENT(OUT) ::  file_id       !< file ID
     182    INTEGER              ::  my_rank       !< MPI rank of local processor
     183    INTEGER              ::  nranks        !< number of MPI ranks participating in output
     184    INTEGER, INTENT(OUT) ::  return_value  !< return value
     185
     186    INTEGER, DIMENSION(:), ALLOCATABLE ::  files_highest_variable_id_tmp  !< temporary list of given variable IDs in file
     187
     188    LOGICAL ::  file_exists  !< true if file to be opened already exists
     189
     190
     191    return_value = 0
    189192
    190193#if defined( __parallel )
    191    CALL MPI_COMM_SIZE( output_group_comm, nranks, return_value )
    192    IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
    193    IF ( return_value == 0 )  THEN
    194       WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    195    ELSE
    196       CALL internal_message( 'error', routine_name // ': MPI error' )
    197    ENDIF
     194    CALL MPI_COMM_SIZE( output_group_comm, nranks, return_value )
     195    IF ( return_value == 0 )  CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
     196    IF ( return_value == 0 )  THEN
     197       WRITE( my_rank_char, '("_",I6.6)' )  my_rank
     198    ELSE
     199       CALL internal_message( 'error', routine_name // ': MPI error' )
     200    ENDIF
    198201#else
    199    nranks = 1
    200    my_rank = master_rank
    201    WRITE( my_rank_char, '("_",I6.6)' )  my_rank
     202    nranks = 1
     203    my_rank = master_rank
     204    WRITE( my_rank_char, '("_",I6.6)' )  my_rank
    202205#endif
    203 
    204    !-- Check mode (not required, added for compatibility reasons)
    205    IF ( TRIM( mode ) == mode_binary )  CONTINUE
    206 
    207    !-- Open binary config file for combining script
    208    IF ( return_value == 0  .AND.  binary_open_file_first_call )  THEN
    209 
    210       binary_open_file_first_call = .FALSE.
    211       config_file_unit = binary_file_lowest_unit
    212 
    213       IF ( my_rank == master_rank )  THEN
    214 
    215          !-- Remove any pre-existing file
    216          INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
    217                   EXIST=file_exists )
    218 
    219          IF ( file_exists )  THEN
    220             CALL internal_message( 'debug', routine_name //     &
    221                                    ': Remove existing file ' // &
    222                                    TRIM( config_file_name ) // TRIM( file_suffix ) )
    223             !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
    224             !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
    225             ! CALL EXECUTE_COMMAND_LINE(                                                &
    226             !         COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), &
    227             !         WAIT=.TRUE., EXITSTAT=return_value )
    228             CALL SYSTEM( 'rm ' // TRIM( config_file_name ) // TRIM( file_suffix ) )
    229          ENDIF
    230 
    231          OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
    232                FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
    233 
    234          IF ( return_value == 0 )  THEN
    235 
    236             config_file_open = .TRUE.
    237 
    238             !-- Write some general information to config file
    239             WRITE( config_file_unit )  nranks
    240             WRITE( config_file_unit )  master_rank
    241             WRITE( config_file_unit )  LEN( file_prefix )
    242             WRITE( config_file_unit )  file_prefix
    243             WRITE( config_file_unit )  charlen
    244             WRITE( config_file_unit )  global_id_in_file
    245 
    246          ELSE
    247 
    248             return_value = 1
    249             CALL internal_message( 'error', routine_name // ': could not create config' )
    250 
    251          ENDIF
    252 
    253       ENDIF
    254 
    255       next_available_unit = binary_file_lowest_unit + 1
    256 
    257    ENDIF
    258 
    259    !-- Initialize output file: open, write header, initialize variable/dimension IDs
    260    IF ( return_value == 0 )  THEN
    261 
    262       bin_filename = file_prefix // TRIM( file_name ) // TRIM( file_suffix ) // my_rank_char
    263 
    264       !-- Remove any pre-existing file
    265       INQUIRE( FILE=TRIM( bin_filename ), EXIST=file_exists )
    266 
    267       IF ( file_exists )  THEN
    268          CALL internal_message( 'debug', routine_name // &
    269                                 ': remove existing file ' // TRIM( bin_filename ) )
    270          !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
    271          !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
    272          ! CALL EXECUTE_COMMAND_LINE( COMMAND='rm ' // TRIM( bin_filename ), &
    273          !                            WAIT=.TRUE., EXITSTAT=return_value )
    274          CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
    275       ENDIF
    276 
    277       !-- Open binary file
    278       CALL internal_message( 'debug', routine_name // ': open file ' // TRIM( bin_filename ) )
    279       OPEN ( next_available_unit, FILE=TRIM( bin_filename ), &
    280              FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
    281 
    282       IF ( return_value == 0 )  THEN
    283 
    284          !-- Add file_name to config file
    285          IF ( my_rank == master_rank )  THEN
    286             WRITE( config_file_unit )  file_name
    287          ENDIF
    288 
    289          !-- Save file ID and increase next file unit number
    290          file_id = next_available_unit
    291          next_available_unit = next_available_unit + 1
    292 
    293          !-- Write some meta data to file
    294          WRITE ( file_id )  charlen
    295          WRITE ( file_id )  file_id
    296          WRITE ( file_id )  file_name
    297 
    298          !-- Extend file-variable/dimension-ID list by 1 and set it to 0 for new file.
    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 )
    306          ELSE
    307             ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
    308          ENDIF
    309          files_highest_variable_id(file_id) = 0
    310 
    311       ELSE
    312          return_value = 1
    313          CALL internal_message( 'error', routine_name // &
    314                                 ': could not open file "' // TRIM( file_name ) // '"')
    315       ENDIF
    316 
    317    ENDIF
    318 
    319 END SUBROUTINE binary_open_file
     206!
     207!-- Check mode (not required, added for compatibility reasons)
     208    IF ( TRIM( mode ) == mode_binary )  CONTINUE
     209!
     210!-- Open binary config file for combining script
     211    IF ( return_value == 0  .AND.  binary_open_file_first_call )  THEN
     212
     213       binary_open_file_first_call = .FALSE.
     214       config_file_unit = binary_file_lowest_unit
     215
     216       IF ( my_rank == master_rank )  THEN
     217!
     218!--      Remove any pre-existing file
     219          INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
     220                   EXIST=file_exists )
     221
     222          IF ( file_exists )  THEN
     223             CALL internal_message( 'debug', routine_name //     &
     224                                    ': Remove existing file ' // &
     225                                    TRIM( config_file_name ) // TRIM( file_suffix ) )
     226             !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
     227             !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
     228             ! CALL EXECUTE_COMMAND_LINE(                                                &
     229             !         COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), &
     230             !         WAIT=.TRUE., EXITSTAT=return_value )
     231             CALL SYSTEM( 'rm ' // TRIM( config_file_name ) // TRIM( file_suffix ) )
     232          ENDIF
     233
     234          OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &
     235                FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
     236
     237          IF ( return_value == 0 )  THEN
     238
     239             config_file_open = .TRUE.
     240!
     241!--          Write some general information to config file
     242             WRITE( config_file_unit )  nranks
     243             WRITE( config_file_unit )  master_rank
     244             WRITE( config_file_unit )  LEN( file_prefix )
     245             WRITE( config_file_unit )  file_prefix
     246             WRITE( config_file_unit )  charlen
     247             WRITE( config_file_unit )  global_id_in_file
     248
     249          ELSE
     250
     251             return_value = 1
     252             CALL internal_message( 'error', routine_name // ': could not create config' )
     253
     254          ENDIF
     255
     256       ENDIF
     257
     258       next_available_unit = binary_file_lowest_unit + 1
     259
     260    ENDIF
     261!
     262!-- Initialize output file: open, write header, initialize variable/dimension IDs
     263    IF ( return_value == 0 )  THEN
     264
     265       bin_filename = file_prefix // TRIM( file_name ) // TRIM( file_suffix ) // my_rank_char
     266!
     267!--    Remove any pre-existing file
     268       INQUIRE( FILE=TRIM( bin_filename ), EXIST=file_exists )
     269
     270       IF ( file_exists )  THEN
     271          CALL internal_message( 'debug', routine_name // &
     272                                 ': remove existing file ' // TRIM( bin_filename ) )
     273          !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by
     274          !>       PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used
     275          ! CALL EXECUTE_COMMAND_LINE( COMMAND='rm ' // TRIM( bin_filename ), &
     276          !                            WAIT=.TRUE., EXITSTAT=return_value )
     277          CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
     278       ENDIF
     279!
     280!--    Open binary file
     281       CALL internal_message( 'debug', routine_name // ': open file ' // TRIM( bin_filename ) )
     282       OPEN ( next_available_unit, FILE=TRIM( bin_filename ), &
     283              FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )
     284
     285       IF ( return_value == 0 )  THEN
     286!
     287!--      Add file_name to config file
     288          IF ( my_rank == master_rank )  THEN
     289             WRITE( config_file_unit )  file_name
     290          ENDIF
     291!
     292!--      Save file ID and increase next file unit number
     293          file_id = next_available_unit
     294          next_available_unit = next_available_unit + 1
     295!
     296!--      Write some meta data to file
     297          WRITE ( file_id )  charlen
     298          WRITE ( file_id )  file_id
     299          WRITE ( file_id )  file_name
     300!
     301!--      Extend file-variable/dimension-ID list by 1 and set it to 0 for new file.
     302          IF ( ALLOCATED( files_highest_variable_id ) )  THEN
     303             ALLOCATE( files_highest_variable_id_tmp(SIZE( files_highest_variable_id )) )
     304             files_highest_variable_id_tmp = files_highest_variable_id
     305             DEALLOCATE( files_highest_variable_id )
     306             ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
     307             files_highest_variable_id(:file_id-1) = files_highest_variable_id_tmp
     308             DEALLOCATE( files_highest_variable_id_tmp )
     309          ELSE
     310             ALLOCATE( files_highest_variable_id(binary_file_lowest_unit+1:file_id) )
     311          ENDIF
     312          files_highest_variable_id(file_id) = 0
     313
     314       ELSE
     315          return_value = 1
     316          CALL internal_message( 'error', routine_name // &
     317                                 ': could not open file "' // TRIM( file_name ) // '"')
     318       ENDIF
     319
     320    ENDIF
     321
     322 END SUBROUTINE binary_open_file
    320323
    321324!--------------------------------------------------------------------------------------------------!
     
    324327!> Write attribute to file.
    325328!--------------------------------------------------------------------------------------------------!
    326 SUBROUTINE 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 )
    329 
    330    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_attribute'  !< name of this routine
    331 
    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
    347 
    348 
    349    return_value = 0
    350 
    351    CALL internal_message( 'debug', TRIM( routine_name ) // &
    352                           ': write attribute ' // TRIM( attribute_name ) )
    353 
    354    !-- Write attribute to file
    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
    385    ELSE
    386       return_value = 1
    387       CALL internal_message( 'error', TRIM( routine_name ) // &
    388                              ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
    389    ENDIF
    390 
    391 END SUBROUTINE binary_write_attribute
     329 SUBROUTINE binary_write_attribute( file_id, variable_id, attribute_name, &
     330               value_char, value_int8, value_int16, value_int32,          &
     331               value_real32, value_real64, return_value )
     332
     333    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_attribute'  !< name of this routine
     334
     335    CHARACTER(LEN=charlen), INTENT(IN)           ::  attribute_name        !< name of attribute
     336    CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL ::  value_char  !< value of attribute
     337    CHARACTER(LEN=charlen)                       ::  attribute_type        !< data type of attribute
     338    CHARACTER(LEN=charlen)                       ::  output_string         !< output string
     339
     340    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
     341    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
     342    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
     343
     344    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     345    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     346    INTEGER, INTENT(OUT) ::  return_value  !< return value
     347
     348    REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
     349    REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
     350
     351
     352    return_value = 0
     353
     354    CALL internal_message( 'debug', TRIM( routine_name ) // &
     355                           ': write attribute ' // TRIM( attribute_name ) )
     356!
     357!-- Write attribute to file
     358    output_string = 'attribute'
     359    WRITE( file_id )  output_string
     360
     361    WRITE( file_id )  variable_id
     362    WRITE( file_id )  attribute_name
     363
     364    IF ( PRESENT( value_char ) )  THEN
     365       attribute_type = 'char'
     366       WRITE( file_id )  attribute_type
     367       WRITE( file_id )  value_char
     368    ELSEIF ( PRESENT( value_int8 ) )  THEN
     369       attribute_type = 'int8'
     370       WRITE( file_id )  attribute_type
     371       WRITE( file_id )  value_int8
     372    ELSEIF ( PRESENT( value_int16 ) )  THEN
     373       attribute_type = 'int16'
     374       WRITE( file_id )  attribute_type
     375       WRITE( file_id )  value_int16
     376    ELSEIF ( PRESENT( value_int32 ) )  THEN
     377       attribute_type = 'int32'
     378       WRITE( file_id )  attribute_type
     379       WRITE( file_id )  value_int32
     380    ELSEIF ( PRESENT( value_real32 ) )  THEN
     381       attribute_type = 'real32'
     382       WRITE( file_id )  attribute_type
     383       WRITE( file_id )  value_real32
     384    ELSEIF ( PRESENT( value_real64 ) )  THEN
     385       attribute_type = 'real64'
     386       WRITE( file_id )  attribute_type
     387       WRITE( file_id )  value_real64
     388    ELSE
     389       return_value = 1
     390       CALL internal_message( 'error', TRIM( routine_name ) // &
     391                              ': no value given for attribute "' // TRIM( attribute_name ) // '"' )
     392    ENDIF
     393
     394 END SUBROUTINE binary_write_attribute
    392395
    393396!--------------------------------------------------------------------------------------------------!
     
    397400!> and save dimension values to be later written to file.
    398401!--------------------------------------------------------------------------------------------------!
    399 SUBROUTINE 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
    406 
    407    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
    408 
    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
    414 
    415 
    416    return_value = 0
    417 
    418    CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) )
    419 
    420    !-- Check mode (not required, added for compatibility reasons only)
    421    IF ( TRIM( mode ) == mode_binary )  CONTINUE
    422 
    423    !-- Assign dimension ID
    424    dimension_id = files_highest_variable_id( file_id ) + 1
    425    files_highest_variable_id( file_id ) = dimension_id
    426 
    427    !-- Define dimension in file
    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
    434 
    435    !-- Define variable associated with dimension
    436    CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
    437                               (/ dimension_id /), is_global=.TRUE., return_value=return_value )
    438    IF ( return_value /= 0 )  THEN
    439       CALL internal_message( 'error', routine_name // &
    440                              ': init dimension "' // TRIM( dimension_name ) // '"' )
    441    ENDIF
    442 
    443 END SUBROUTINE binary_init_dimension
     402 SUBROUTINE binary_init_dimension( mode, file_id, dimension_id, variable_id, &
     403               dimension_name, dimension_type, dimension_length, return_value )
     404
     405    CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_name  !< name of dimension
     406    CHARACTER(LEN=charlen), INTENT(IN) ::  dimension_type  !< data type of dimension
     407    CHARACTER(LEN=charlen)             ::  output_string   !< output string
     408    CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
     409
     410    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
     411
     412    INTEGER, INTENT(OUT) ::  dimension_id      !< dimension ID
     413    INTEGER, INTENT(IN)  ::  dimension_length  !< length of dimension
     414    INTEGER, INTENT(IN)  ::  file_id           !< file ID
     415    INTEGER, INTENT(OUT) ::  return_value      !< return value
     416    INTEGER, INTENT(OUT) ::  variable_id       !< variable ID
     417
     418
     419    return_value = 0
     420
     421    CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) )
     422!
     423!-- Check mode (not required, added for compatibility reasons only)
     424    IF ( TRIM( mode ) == mode_binary )  CONTINUE
     425!
     426!-- Assign dimension ID
     427    dimension_id = files_highest_variable_id( file_id ) + 1
     428    files_highest_variable_id( file_id ) = dimension_id
     429!
     430!-- Define dimension in file
     431    output_string = 'dimension'
     432    WRITE( file_id )  output_string
     433    WRITE( file_id )  dimension_name
     434    WRITE( file_id )  dimension_id
     435    WRITE( file_id )  dimension_type
     436    WRITE( file_id )  dimension_length
     437!
     438!-- Define variable associated with dimension
     439    CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &
     440                               (/ dimension_id /), is_global=.TRUE., return_value=return_value )
     441    IF ( return_value /= 0 )  THEN
     442       CALL internal_message( 'error', routine_name // &
     443                              ': init dimension "' // TRIM( dimension_name ) // '"' )
     444    ENDIF
     445
     446 END SUBROUTINE binary_init_dimension
    444447
    445448!--------------------------------------------------------------------------------------------------!
     
    448451!> Initialize variable. Write information of variable into file header.
    449452!--------------------------------------------------------------------------------------------------!
    450 SUBROUTINE 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
    457 
    458    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
    459 
    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
    465 
    466    LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    467 
    468 
    469    return_value = 0
    470 
    471    CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) )
    472 
    473    !-- Check mode (not required, added for compatibility reasons only)
    474    IF ( TRIM( mode ) == mode_binary )  CONTINUE
    475 
    476    !-- Check if variable is global (not required, added for compatibility reasons only)
    477    IF ( is_global )  CONTINUE
    478 
    479    !-- Assign variable ID
    480    variable_id = files_highest_variable_id( file_id ) + 1
    481    files_highest_variable_id( file_id ) = variable_id
    482 
    483    !-- Write variable information in file
    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
    491 
    492 END SUBROUTINE binary_init_variable
     453 SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type, &
     454                                  dimension_ids, is_global, return_value )
     455
     456    CHARACTER(LEN=charlen)             ::  output_string   !< output string
     457    CHARACTER(LEN=charlen), INTENT(IN) ::  variable_name   !< name of variable
     458    CHARACTER(LEN=charlen), INTENT(IN) ::  variable_type   !< data type of variable
     459    CHARACTER(LEN=*),       INTENT(IN) ::  mode            !< operation mode
     460
     461    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
     462
     463    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     464    INTEGER, INTENT(OUT) ::  variable_id   !< variable ID
     465    INTEGER, INTENT(OUT) ::  return_value  !< return value
     466
     467    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
     468
     469    LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
     470
     471
     472    return_value = 0
     473
     474    CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) )
     475!
     476!-- Check mode (not required, added for compatibility reasons only)
     477    IF ( TRIM( mode ) == mode_binary )  CONTINUE
     478!
     479!-- Check if variable is global (not required, added for compatibility reasons only)
     480    IF ( is_global )  CONTINUE
     481!
     482!-- Assign variable ID
     483    variable_id = files_highest_variable_id( file_id ) + 1
     484    files_highest_variable_id( file_id ) = variable_id
     485!
     486!-- Write variable information in file
     487    output_string = 'variable'
     488    WRITE( file_id )  output_string
     489    WRITE( file_id )  variable_name
     490    WRITE( file_id )  variable_id
     491    WRITE( file_id )  variable_type
     492    WRITE( file_id )  SIZE( dimension_ids )
     493    WRITE( file_id )  dimension_ids
     494
     495 END SUBROUTINE binary_init_variable
    493496
    494497!--------------------------------------------------------------------------------------------------!
     
    497500!> Leave file definition state.
    498501!--------------------------------------------------------------------------------------------------!
    499 SUBROUTINE 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
    507 
    508 
    509    return_value = 0
    510 
    511    WRITE( temp_string, * ) file_id
    512    CALL internal_message( 'debug', routine_name // &
    513                           ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
    514 
    515    output_string = '*** end file header ***'
    516    WRITE( file_id )  output_string
    517 
    518 END SUBROUTINE binary_stop_file_header_definition
     502 SUBROUTINE binary_stop_file_header_definition( file_id, return_value )
     503
     504    CHARACTER(LEN=charlen) ::  output_string  !< output string
     505
     506    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_stop_file_header_definition'  !< name of this routine
     507
     508    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     509    INTEGER, INTENT(OUT) ::  return_value  !< return value
     510
     511
     512    return_value = 0
     513
     514    WRITE( temp_string, * ) file_id
     515    CALL internal_message( 'debug', routine_name // &
     516                           ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
     517
     518    output_string = '*** end file header ***'
     519    WRITE( file_id )  output_string
     520
     521 END SUBROUTINE binary_stop_file_header_definition
    519522
    520523!--------------------------------------------------------------------------------------------------!
     
    523526!> Write variable to file.
    524527!--------------------------------------------------------------------------------------------------!
    525 SUBROUTINE 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, &
    535               return_value )
    536 
    537    CHARACTER(LEN=charlen) ::  output_string  !< output string
    538 
    539    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
    540 
    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
    565 
    566    LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)
    567 
    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
    580 
    581 
    582    return_value = 0
    583 
    584    WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id
    585    CALL internal_message( 'debug', routine_name // TRIM( temp_string ) )
    586 
    587    IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning
    588 
    589    IF ( .NOT. ANY( value_counts == 0 ) )  THEN
    590       WRITE( file_id )  variable_id
    591       WRITE( file_id )  bounds_start
    592       WRITE( file_id )  value_counts
    593       WRITE( file_id )  bounds_origin
    594       !-- 8bit integer output
    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
    611       !-- 16bit integer output
    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
    628       !-- 32bit integer output
    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
    645       !-- working-precision integer output
    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
    662       !-- 32bit real output
    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
    679       !-- 64bit real output
    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
    696       !-- working-precision real output
    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
    713       ELSE
    714          return_value = 1
    715          CALL internal_message( 'error', routine_name // ': no values given' )
    716       ENDIF
    717 
    718    ENDIF
    719 
    720 END SUBROUTINE binary_write_variable
     528 SUBROUTINE binary_write_variable(                                                     &
     529               file_id, variable_id, bounds_start, value_counts, bounds_origin,        &
     530               is_global,                                                              &
     531               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
     532               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     533               values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,  &
     534               values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,  &
     535               values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
     536               values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
     537               values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &
     538               return_value )
     539
     540    CHARACTER(LEN=charlen) ::  output_string  !< output string
     541
     542    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
     543
     544    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     545    INTEGER, INTENT(OUT) ::  return_value  !< return value
     546    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
     547
     548    INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_origin  !< starting index of each dimension
     549    INTEGER, DIMENSION(:), INTENT(IN) ::  bounds_start   !< starting index of variable
     550    INTEGER, DIMENSION(:), INTENT(IN) ::  value_counts   !< count of values along each dimension to be written
     551
     552    INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
     553    INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
     554    INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
     555    INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
     556    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
     557    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
     558    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
     559    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
     560    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
     561    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
     562    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
     563    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
     564    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
     565    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
     566    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
     567    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
     568
     569    LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)
     570
     571    REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
     572    REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
     573    REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
     574    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
     575    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
     576    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
     577    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
     578    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
     579    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
     580    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
     581    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
     582    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
     583
     584
     585    return_value = 0
     586
     587    WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id
     588    CALL internal_message( 'debug', routine_name // TRIM( temp_string ) )
     589
     590    IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning
     591
     592    IF ( .NOT. ANY( value_counts == 0 ) )  THEN
     593       WRITE( file_id )  variable_id
     594       WRITE( file_id )  bounds_start
     595       WRITE( file_id )  value_counts
     596       WRITE( file_id )  bounds_origin
     597!
     598!--    8bit integer output
     599       IF ( PRESENT( values_int8_0d ) )  THEN
     600          output_string = 'int8'
     601          WRITE( file_id )  output_string
     602          WRITE( file_id )  values_int8_0d
     603       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     604          output_string = 'int8'
     605          WRITE( file_id )  output_string
     606          WRITE( file_id )  values_int8_1d
     607       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     608          output_string = 'int8'
     609          WRITE( file_id )  output_string
     610          WRITE( file_id )  values_int8_2d
     611       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     612          output_string = 'int8'
     613          WRITE( file_id )  output_string
     614          WRITE( file_id )  values_int8_3d
     615!
     616!--    16bit integer output
     617       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     618          output_string = 'int16'
     619          WRITE( file_id )  output_string
     620          WRITE( file_id )  values_int16_0d
     621       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     622          output_string = 'int16'
     623          WRITE( file_id )  output_string
     624          WRITE( file_id )  values_int16_1d
     625       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     626          output_string = 'int16'
     627          WRITE( file_id )  output_string
     628          WRITE( file_id )  values_int16_2d
     629       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     630          output_string = 'int16'
     631          WRITE( file_id )  output_string
     632          WRITE( file_id )  values_int16_3d
     633!
     634!--    32bit integer output
     635       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     636          output_string = 'int32'
     637          WRITE( file_id )  output_string
     638          WRITE( file_id )  values_int32_0d
     639       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     640          output_string = 'int32'
     641          WRITE( file_id )  output_string
     642          WRITE( file_id )  values_int32_1d
     643       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     644          output_string = 'int32'
     645          WRITE( file_id )  output_string
     646          WRITE( file_id )  values_int32_2d
     647       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     648          output_string = 'int32'
     649          WRITE( file_id )  output_string
     650          WRITE( file_id )  values_int32_3d
     651!
     652!--    working-precision integer output
     653       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     654          output_string = 'intwp'
     655          WRITE( file_id )  output_string
     656          WRITE( file_id )  values_intwp_0d
     657       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     658          output_string = 'intwp'
     659          WRITE( file_id )  output_string
     660          WRITE( file_id )  values_intwp_1d
     661       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     662          output_string = 'intwp'
     663          WRITE( file_id )  output_string
     664          WRITE( file_id )  values_intwp_2d
     665       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     666          output_string = 'intwp'
     667          WRITE( file_id )  output_string
     668          WRITE( file_id )  values_intwp_3d
     669!
     670!--    32bit real output
     671       ELSEIF ( PRESENT( values_real32_0d ) )  THEN
     672          output_string = 'real32'
     673          WRITE( file_id )  output_string
     674          WRITE( file_id )  values_real32_0d
     675       ELSEIF ( PRESENT( values_real32_1d ) )  THEN
     676          output_string = 'real32'
     677          WRITE( file_id )  output_string
     678          WRITE( file_id )  values_real32_1d
     679       ELSEIF ( PRESENT( values_real32_2d ) )  THEN
     680          output_string = 'real32'
     681          WRITE( file_id )  output_string
     682          WRITE( file_id )  values_real32_2d
     683       ELSEIF ( PRESENT( values_real32_3d ) )  THEN
     684          output_string = 'real32'
     685          WRITE( file_id )  output_string
     686          WRITE( file_id )  values_real32_3d
     687!
     688!--    64bit real output
     689       ELSEIF ( PRESENT( values_real64_0d ) )  THEN
     690          output_string = 'real64'
     691          WRITE( file_id )  output_string
     692          WRITE( file_id )  values_real64_0d
     693       ELSEIF ( PRESENT( values_real64_1d ) )  THEN
     694          output_string = 'real64'
     695          WRITE( file_id )  output_string
     696          WRITE( file_id )  values_real64_1d
     697       ELSEIF ( PRESENT( values_real64_2d ) )  THEN
     698          output_string = 'real64'
     699          WRITE( file_id )  output_string
     700          WRITE( file_id )  values_real64_2d
     701       ELSEIF ( PRESENT( values_real64_3d ) )  THEN
     702          output_string = 'real64'
     703          WRITE( file_id )  output_string
     704          WRITE( file_id )  values_real64_3d
     705!
     706!--    working-precision real output
     707       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
     708          output_string = 'realwp'
     709          WRITE( file_id )  output_string
     710          WRITE( file_id )  values_realwp_0d
     711       ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
     712          output_string = 'realwp'
     713          WRITE( file_id )  output_string
     714          WRITE( file_id )  values_realwp_1d
     715       ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
     716          output_string = 'realwp'
     717          WRITE( file_id )  output_string
     718          WRITE( file_id )  values_realwp_2d
     719       ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
     720          output_string = 'realwp'
     721          WRITE( file_id )  output_string
     722          WRITE( file_id )  values_realwp_3d
     723       ELSE
     724          return_value = 1
     725          CALL internal_message( 'error', routine_name // ': no values given' )
     726       ENDIF
     727
     728    ENDIF
     729
     730 END SUBROUTINE binary_write_variable
    721731
    722732!--------------------------------------------------------------------------------------------------!
     
    725735!> Close opened files.
    726736!--------------------------------------------------------------------------------------------------!
    727 SUBROUTINE binary_finalize( file_id, return_value )
    728 
    729    CHARACTER(LEN=charlen) ::  output_string  !< output string
    730 
    731    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_finalize'  !< name of this routine
    732 
    733    INTEGER, INTENT(IN)  ::  file_id       !< file ID
    734    INTEGER, INTENT(OUT) ::  return_value  !< return value
    735 
    736 
    737    IF ( config_file_open )  THEN
    738 
    739       output_string = '*** end config file ***'
    740       WRITE( config_file_unit )  output_string
    741 
    742       CLOSE( config_file_unit, IOSTAT=return_value )
    743 
    744       IF ( return_value /= 0 )  THEN
    745          CALL internal_message( 'error', routine_name // ': cannot close configuration file' )
    746       ELSE
    747          config_file_open = .FALSE.
    748       ENDIF
    749 
    750    ELSE
    751 
    752       return_value = 0
    753 
    754    ENDIF
    755 
    756    IF ( return_value == 0 )  THEN
    757 
    758       WRITE( temp_string, * ) file_id
    759       CALL internal_message( 'debug', routine_name // &
    760                              ': close file (file_id=' // TRIM( temp_string ) // ')' )
    761 
    762       CLOSE( file_id, IOSTAT=return_value )
    763       IF ( return_value /= 0 )  THEN
    764          WRITE( temp_string, * ) file_id
    765          CALL internal_message( 'error', routine_name // &
    766                                 ': cannot close file (file_id=' // TRIM( temp_string ) // ')' )
    767       ENDIF
    768 
    769    ENDIF
    770 
    771 END SUBROUTINE binary_finalize
     737 SUBROUTINE binary_finalize( file_id, return_value )
     738
     739    CHARACTER(LEN=charlen) ::  output_string  !< output string
     740
     741    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_finalize'  !< name of this routine
     742
     743    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     744    INTEGER, INTENT(OUT) ::  return_value  !< return value
     745
     746
     747    IF ( config_file_open )  THEN
     748
     749       output_string = '*** end config file ***'
     750       WRITE( config_file_unit )  output_string
     751
     752       CLOSE( config_file_unit, IOSTAT=return_value )
     753
     754       IF ( return_value /= 0 )  THEN
     755          CALL internal_message( 'error', routine_name // ': cannot close configuration file' )
     756       ELSE
     757          config_file_open = .FALSE.
     758       ENDIF
     759
     760    ELSE
     761
     762       return_value = 0
     763
     764    ENDIF
     765
     766    IF ( return_value == 0 )  THEN
     767
     768       WRITE( temp_string, * ) file_id
     769       CALL internal_message( 'debug', routine_name // &
     770                              ': close file (file_id=' // TRIM( temp_string ) // ')' )
     771
     772       CLOSE( file_id, IOSTAT=return_value )
     773       IF ( return_value /= 0 )  THEN
     774          WRITE( temp_string, * ) file_id
     775          CALL internal_message( 'error', routine_name // &
     776                                 ': cannot close file (file_id=' // TRIM( temp_string ) // ')' )
     777       ENDIF
     778
     779    ENDIF
     780
     781 END SUBROUTINE binary_finalize
    772782
    773783!--------------------------------------------------------------------------------------------------!
     
    777787!> or creating the error message string.
    778788!--------------------------------------------------------------------------------------------------!
    779 SUBROUTINE internal_message( level, string )
    780 
    781    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
    782    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
    783 
    784 
    785    IF ( TRIM( level ) == 'error' )  THEN
    786 
    787       WRITE( internal_error_message, '(A,A)' ) ': ', string
    788 
    789    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
    790 
    791       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
    792       FLUSH( debug_output_unit )
    793 
    794    ENDIF
    795 
    796 END SUBROUTINE internal_message
     789 SUBROUTINE internal_message( level, string )
     790
     791    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
     792    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
     793
     794
     795    IF ( TRIM( level ) == 'error' )  THEN
     796
     797       WRITE( internal_error_message, '(A,A)' ) ': ', string
     798
     799    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
     800
     801       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
     802       FLUSH( debug_output_unit )
     803
     804    ENDIF
     805
     806 END SUBROUTINE internal_message
    797807
    798808!--------------------------------------------------------------------------------------------------!
     
    801811!> Return the last created error message.
    802812!--------------------------------------------------------------------------------------------------!
    803 FUNCTION 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 
    812 END FUNCTION binary_get_error_message
    813 
    814 END MODULE data_output_binary_module
     813 FUNCTION binary_get_error_message() RESULT( error_message )
     814
     815    CHARACTER(LEN=800) ::  error_message  !< return error message to main program
     816
     817
     818    error_message = TRIM( internal_error_message )
     819
     820    internal_error_message = ''
     821
     822 END FUNCTION binary_get_error_message
     823
     824 END MODULE data_output_binary_module
  • palm/trunk/SOURCE/data_output_module.f90

    r4141 r4147  
    2525! -----------------
    2626! $Id$
     27! corrected indentation according to coding standard
     28!
     29! 4141 2019-08-05 12:24:51Z gronemeier
    2730! Initial revision
    2831!
     
    5962!> @todo Convert variable if type of given values do not fit specified type.
    6063!--------------------------------------------------------------------------------------------------!
    61 MODULE data_output_module
    62 
    63    USE kinds
    64 
    65    USE data_output_netcdf4_module, &
    66       ONLY: netcdf4_init_dimension, &
    67             netcdf4_get_error_message, &
    68             netcdf4_stop_file_header_definition, &
    69             netcdf4_init_module, &
    70             netcdf4_init_variable, &
    71             netcdf4_finalize, &
    72             netcdf4_open_file, &
    73             netcdf4_write_attribute, &
    74             netcdf4_write_variable
    75 
    76    USE data_output_binary_module, &
    77       ONLY: binary_finalize, &
    78             binary_get_error_message, &
    79             binary_init_dimension, &
    80             binary_stop_file_header_definition, &
    81             binary_init_module, &
    82             binary_init_variable, &
    83             binary_open_file, &
    84             binary_write_attribute, &
    85             binary_write_variable
    86 
    87    IMPLICIT NONE
    88 
    89    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
    90    INTEGER, PARAMETER ::  no_id = -1     !< default ID if no ID was assigned
    91 
    92    TYPE attribute_type
    93       CHARACTER(LEN=charlen) ::  data_type = ''  !< data type
    94       CHARACTER(LEN=charlen) ::  name            !< attribute name
    95       CHARACTER(LEN=charlen) ::  value_char      !< attribute value if character
    96       INTEGER(KIND=1)        ::  value_int8      !< attribute value if 8bit integer
    97       INTEGER(KIND=2)        ::  value_int16     !< attribute value if 16bit integer
    98       INTEGER(KIND=4)        ::  value_int32     !< attribute value if 32bit integer
    99       REAL(KIND=4)           ::  value_real32    !< attribute value if 32bit real
    100       REAL(KIND=8)           ::  value_real64    !< attribute value if 64bit real
    101    END TYPE attribute_type
    102 
    103    TYPE variable_type
    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
    111    END TYPE variable_type
    112 
    113    TYPE dimension_type
    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
    123       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  masked_values_int8    !< masked dimension values if 16bit integer
    124       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  masked_values_int16   !< masked dimension values if 16bit integer
    125       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  masked_values_int32   !< masked dimension values if 32bit integer
    126       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_values_intwp   !< masked dimension values if working-precision int
    127       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8           !< dimension values if 16bit integer
    128       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  values_int16          !< dimension values if 16bit integer
    129       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  values_int32          !< dimension values if 32bit integer
    130       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  values_intwp          !< dimension values if working-precision integer
    131       LOGICAL,         DIMENSION(:), ALLOCATABLE ::  mask                  !< mask
    132       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  masked_values_real32  !< masked dimension values if 32bit real
    133       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  masked_values_real64  !< masked dimension values if 64bit real
    134       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  masked_values_realwp  !< masked dimension values if working-precision real
    135       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  values_real32         !< dimension values if 32bit real
    136       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  values_real64         !< dimension values if 64bit real
    137       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  values_realwp         !< dimension values if working-precision real
    138       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes       !< list of attributes
    139    END TYPE dimension_type
    140 
    141    TYPE file_type
    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
    149    END TYPE file_type
    150 
    151 
    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
    160 
    161    LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
    162 
    163    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files  !< file list
    164 
    165    SAVE
    166 
    167    PRIVATE
    168 
    169    !> Initialize the data-output module
    170    INTERFACE dom_init
    171       MODULE PROCEDURE dom_init
    172    END INTERFACE dom_init
    173 
    174    !> Add files to database
    175    INTERFACE dom_def_file
    176       MODULE PROCEDURE dom_def_file
    177    END INTERFACE dom_def_file
    178 
    179    !> Add dimensions to database
    180    INTERFACE dom_def_dim
    181       MODULE PROCEDURE dom_def_dim
    182    END INTERFACE dom_def_dim
    183 
    184    !> Add variables to database
    185    INTERFACE dom_def_var
    186       MODULE PROCEDURE dom_def_var
    187    END INTERFACE dom_def_var
    188 
    189    !> Add attributes to database
    190    INTERFACE dom_def_att
    191       MODULE PROCEDURE dom_def_att_char
    192       MODULE PROCEDURE dom_def_att_int8
    193       MODULE PROCEDURE dom_def_att_int16
    194       MODULE PROCEDURE dom_def_att_int32
    195       MODULE PROCEDURE dom_def_att_real32
    196       MODULE PROCEDURE dom_def_att_real64
    197    END INTERFACE dom_def_att
    198 
    199    !> Prepare for output: evaluate database and create files
    200    INTERFACE dom_def_end
    201       MODULE PROCEDURE dom_def_end
    202    END INTERFACE dom_def_end
    203 
    204    !> Write variables to file
    205    INTERFACE dom_write_var
    206       MODULE PROCEDURE dom_write_var
    207    END INTERFACE dom_write_var
    208 
    209    !> Last actions required for output befor termination
    210    INTERFACE dom_finalize_output
    211       MODULE PROCEDURE dom_finalize_output
    212    END INTERFACE dom_finalize_output
    213 
    214    !> Return error message
    215    INTERFACE dom_get_error_message
    216       MODULE PROCEDURE dom_get_error_message
    217    END INTERFACE dom_get_error_message
    218 
    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 
    224    PUBLIC &
    225       dom_init, &
    226       dom_def_file, &
    227       dom_def_dim, &
    228       dom_def_var, &
    229       dom_def_att, &
    230       dom_def_end, &
    231       dom_write_var, &
    232       dom_finalize_output, &
    233       dom_get_error_message, &
    234       dom_database_debug_output
    235 
    236 CONTAINS
     64 MODULE data_output_module
     65
     66    USE kinds
     67
     68    USE data_output_netcdf4_module, &
     69       ONLY: netcdf4_init_dimension, &
     70             netcdf4_get_error_message, &
     71             netcdf4_stop_file_header_definition, &
     72             netcdf4_init_module, &
     73             netcdf4_init_variable, &
     74             netcdf4_finalize, &
     75             netcdf4_open_file, &
     76             netcdf4_write_attribute, &
     77             netcdf4_write_variable
     78
     79    USE data_output_binary_module, &
     80       ONLY: binary_finalize, &
     81             binary_get_error_message, &
     82             binary_init_dimension, &
     83             binary_stop_file_header_definition, &
     84             binary_init_module, &
     85             binary_init_variable, &
     86             binary_open_file, &
     87             binary_write_attribute, &
     88             binary_write_variable
     89
     90    IMPLICIT NONE
     91
     92    INTEGER, PARAMETER ::  charlen = 100  !< maximum length of character variables
     93    INTEGER, PARAMETER ::  no_id = -1     !< default ID if no ID was assigned
     94
     95    TYPE attribute_type
     96       CHARACTER(LEN=charlen) ::  data_type = ''  !< data type
     97       CHARACTER(LEN=charlen) ::  name            !< attribute name
     98       CHARACTER(LEN=charlen) ::  value_char      !< attribute value if character
     99       INTEGER(KIND=1)        ::  value_int8      !< attribute value if 8bit integer
     100       INTEGER(KIND=2)        ::  value_int16     !< attribute value if 16bit integer
     101       INTEGER(KIND=4)        ::  value_int32     !< attribute value if 32bit integer
     102       REAL(KIND=4)           ::  value_real32    !< attribute value if 32bit real
     103       REAL(KIND=8)           ::  value_real64    !< attribute value if 64bit real
     104    END TYPE attribute_type
     105
     106    TYPE variable_type
     107       CHARACTER(LEN=charlen)                            ::  data_type = ''       !< data type
     108       CHARACTER(LEN=charlen)                            ::  name                 !< variable name
     109       INTEGER                                           ::  id = no_id           !< id within file
     110       LOGICAL                                           ::  is_global = .FALSE.  !< true if global variable
     111       CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE ::  dimension_names      !< list of dimension names used by variable
     112       INTEGER,                DIMENSION(:), ALLOCATABLE ::  dimension_ids        !< list of dimension ids used by variable
     113       TYPE(attribute_type),   DIMENSION(:), ALLOCATABLE ::  attributes           !< list of attributes
     114    END TYPE variable_type
     115
     116    TYPE dimension_type
     117       CHARACTER(LEN=charlen)                     ::  data_type = ''        !< data type
     118       CHARACTER(LEN=charlen)                     ::  name                  !< dimension name
     119       INTEGER                                    ::  id = no_id            !< dimension id within file
     120       INTEGER                                    ::  length                !< length of dimension
     121       INTEGER                                    ::  length_mask           !< length of masked dimension
     122       INTEGER                                    ::  variable_id = no_id   !< associated variable id within file
     123       LOGICAL                                    ::  is_masked = .FALSE.   !< true if masked
     124       INTEGER,         DIMENSION(2)              ::  bounds                !< lower and upper bound of dimension
     125       INTEGER,         DIMENSION(:), ALLOCATABLE ::  masked_indices        !< list of masked indices of dimension
     126       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  masked_values_int8    !< masked dimension values if 16bit integer
     127       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  masked_values_int16   !< masked dimension values if 16bit integer
     128       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  masked_values_int32   !< masked dimension values if 32bit integer
     129       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_values_intwp   !< masked dimension values if working-precision int
     130       INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8           !< dimension values if 16bit integer
     131       INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  values_int16          !< dimension values if 16bit integer
     132       INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  values_int32          !< dimension values if 32bit integer
     133       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  values_intwp          !< dimension values if working-precision integer
     134       LOGICAL,         DIMENSION(:), ALLOCATABLE ::  mask                  !< mask
     135       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  masked_values_real32  !< masked dimension values if 32bit real
     136       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  masked_values_real64  !< masked dimension values if 64bit real
     137       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  masked_values_realwp  !< masked dimension values if working-precision real
     138       REAL(KIND=4),    DIMENSION(:), ALLOCATABLE ::  values_real32         !< dimension values if 32bit real
     139       REAL(KIND=8),    DIMENSION(:), ALLOCATABLE ::  values_real64         !< dimension values if 64bit real
     140       REAL(wp),        DIMENSION(:), ALLOCATABLE ::  values_realwp         !< dimension values if working-precision real
     141       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes       !< list of attributes
     142    END TYPE dimension_type
     143
     144    TYPE file_type
     145       CHARACTER(LEN=charlen)                          ::  format = ''        !< file format
     146       CHARACTER(LEN=charlen)                          ::  name = ''          !< file name
     147       INTEGER                                         ::  id = no_id         !< id of file
     148       LOGICAL                                         ::  is_init = .FALSE.  !< true if initialized
     149       TYPE(attribute_type), DIMENSION(:), ALLOCATABLE ::  attributes         !< list of attributes
     150       TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions         !< list of dimensions
     151       TYPE(variable_type),  DIMENSION(:), ALLOCATABLE ::  variables          !< list of variables
     152    END TYPE file_type
     153
     154
     155    CHARACTER(LEN=charlen) ::  output_file_suffix = ''      !< file suffix added to each file name
     156    CHARACTER(LEN=800)     ::  internal_error_message = ''  !< string containing the last error message
     157    CHARACTER(LEN=800)     ::  temp_string                  !< dummy string
     158
     159    INTEGER ::  debug_output_unit  !< Fortran Unit Number of the debug-output file
     160    INTEGER ::  nfiles = 0         !< number of files
     161    INTEGER ::  master_rank = 0    !< master rank for tasks to be executed by single PE only
     162    INTEGER ::  output_group_comm  !< MPI communicator addressing all MPI ranks which participate in output
     163
     164    LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
     165
     166    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files  !< file list
     167
     168    SAVE
     169
     170    PRIVATE
     171
     172    !> Initialize the data-output module
     173    INTERFACE dom_init
     174       MODULE PROCEDURE dom_init
     175    END INTERFACE dom_init
     176
     177    !> Add files to database
     178    INTERFACE dom_def_file
     179       MODULE PROCEDURE dom_def_file
     180    END INTERFACE dom_def_file
     181
     182    !> Add dimensions to database
     183    INTERFACE dom_def_dim
     184       MODULE PROCEDURE dom_def_dim
     185    END INTERFACE dom_def_dim
     186
     187    !> Add variables to database
     188    INTERFACE dom_def_var
     189       MODULE PROCEDURE dom_def_var
     190    END INTERFACE dom_def_var
     191
     192    !> Add attributes to database
     193    INTERFACE dom_def_att
     194       MODULE PROCEDURE dom_def_att_char
     195       MODULE PROCEDURE dom_def_att_int8
     196       MODULE PROCEDURE dom_def_att_int16
     197       MODULE PROCEDURE dom_def_att_int32
     198       MODULE PROCEDURE dom_def_att_real32
     199       MODULE PROCEDURE dom_def_att_real64
     200    END INTERFACE dom_def_att
     201
     202    !> Prepare for output: evaluate database and create files
     203    INTERFACE dom_def_end
     204       MODULE PROCEDURE dom_def_end
     205    END INTERFACE dom_def_end
     206
     207    !> Write variables to file
     208    INTERFACE dom_write_var
     209       MODULE PROCEDURE dom_write_var
     210    END INTERFACE dom_write_var
     211
     212    !> Last actions required for output befor termination
     213    INTERFACE dom_finalize_output
     214       MODULE PROCEDURE dom_finalize_output
     215    END INTERFACE dom_finalize_output
     216
     217    !> Return error message
     218    INTERFACE dom_get_error_message
     219       MODULE PROCEDURE dom_get_error_message
     220    END INTERFACE dom_get_error_message
     221
     222    !> Write database to debug output
     223    INTERFACE dom_database_debug_output
     224       MODULE PROCEDURE dom_database_debug_output
     225    END INTERFACE dom_database_debug_output
     226
     227    PUBLIC &
     228       dom_init, &
     229       dom_def_file, &
     230       dom_def_dim, &
     231       dom_def_var, &
     232       dom_def_att, &
     233       dom_def_end, &
     234       dom_write_var, &
     235       dom_finalize_output, &
     236       dom_get_error_message, &
     237       dom_database_debug_output
     238
     239 CONTAINS
    237240
    238241
     
    247250!> prevents that multiple groups try to open and write to the same output file.
    248251!--------------------------------------------------------------------------------------------------!
    249 SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &
    250                      program_debug_output_unit, debug_output )
    251 
    252    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  file_suffix_of_output_group  !< file-name suffix added to each file;
    253                                                                            !> must be unique for each output group
    254 
    255    INTEGER, INTENT(IN), OPTIONAL ::  master_output_rank         !< MPI rank executing tasks which must
    256                                                                 !> be executed by a single PE only
    257    INTEGER, INTENT(IN)           ::  mpi_comm_of_output_group   !< MPI communicator specifying the MPI group
    258                                                                 !> which participate in the output
    259    INTEGER, INTENT(IN)           ::  program_debug_output_unit  !< file unit number for debug output
    260 
    261    LOGICAL, INTENT(IN)           ::  debug_output               !< if true, debug output is printed
    262 
    263 
    264    IF ( PRESENT( file_suffix_of_output_group ) )  output_file_suffix = file_suffix_of_output_group
    265    IF ( PRESENT( master_output_rank ) )  master_rank = master_output_rank
    266 
    267    output_group_comm = mpi_comm_of_output_group
    268 
    269    debug_output_unit = program_debug_output_unit
    270    print_debug_output = debug_output
    271 
    272    CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &
    273                             debug_output_unit, debug_output, no_id )
    274 
    275    CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &
    276                             debug_output_unit, debug_output, no_id )
    277 
    278 END SUBROUTINE dom_init
     252 SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &
     253                      program_debug_output_unit, debug_output )
     254
     255    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  file_suffix_of_output_group  !< file-name suffix added to each file;
     256                                                                            !> must be unique for each output group
     257
     258    INTEGER, INTENT(IN), OPTIONAL ::  master_output_rank         !< MPI rank executing tasks which must
     259                                                                 !> be executed by a single PE only
     260    INTEGER, INTENT(IN)           ::  mpi_comm_of_output_group   !< MPI communicator specifying the MPI group
     261                                                                 !> which participate in the output
     262    INTEGER, INTENT(IN)           ::  program_debug_output_unit  !< file unit number for debug output
     263
     264    LOGICAL, INTENT(IN)           ::  debug_output               !< if true, debug output is printed
     265
     266
     267    IF ( PRESENT( file_suffix_of_output_group ) )  output_file_suffix = file_suffix_of_output_group
     268    IF ( PRESENT( master_output_rank ) )  master_rank = master_output_rank
     269
     270    output_group_comm = mpi_comm_of_output_group
     271
     272    debug_output_unit = program_debug_output_unit
     273    print_debug_output = debug_output
     274
     275    CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &
     276                             debug_output_unit, debug_output, no_id )
     277
     278    CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &
     279                             debug_output_unit, debug_output, no_id )
     280
     281 END SUBROUTINE dom_init
    279282
    280283!--------------------------------------------------------------------------------------------------!
     
    285288!>   status = dom_def_file( 'my_output_file_name', 'binary' )
    286289!--------------------------------------------------------------------------------------------------!
    287 FUNCTION 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
    291 
    292    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_file'  !< name of this routine
    293 
    294    INTEGER ::  f             !< loop index
    295    INTEGER ::  return_value  !< return value
    296 
    297    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files_tmp  !< temporary file list
    298 
    299 
    300    return_value = 0
    301 
    302    CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( file_name ) // '"' )
    303 
    304    !-- Allocate file list or extend it by 1
    305    IF ( .NOT. ALLOCATED( files ) ) THEN
    306 
    307       nfiles = 1
    308       ALLOCATE( files(nfiles) )
    309 
    310    ELSE
    311 
    312       nfiles = SIZE( files )
    313       !-- Check if file already exists
    314       DO  f = 1, nfiles
    315          IF ( files(f)%name == TRIM( file_name ) )  THEN
    316             return_value = 1
    317             CALL internal_message( 'error', routine_name // &
    318                     ': file "' // TRIM( file_name ) // '" already exists' )
    319             EXIT
    320          ENDIF
    321       ENDDO
    322 
    323       !-- Extend file list
    324       IF ( return_value == 0 )  THEN
    325          ALLOCATE( files_tmp(nfiles) )
    326          files_tmp = files
    327          DEALLOCATE( files )
    328          nfiles = nfiles + 1
    329          ALLOCATE( files(nfiles) )
    330          files(:nfiles-1) = files_tmp
    331          DEALLOCATE( files_tmp )
    332       ENDIF
    333 
    334    ENDIF
    335 
    336    !-- Add new file to database
    337    IF ( return_value == 0 )  THEN
    338       files(nfiles)%name = TRIM( file_name )
    339       files(nfiles)%format = TRIM( file_format )
    340    ENDIF
    341 
    342 END FUNCTION dom_def_file
     290 FUNCTION dom_def_file( file_name, file_format ) RESULT( return_value )
     291
     292    CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file to be created
     293    CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< format of file to be created
     294
     295    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_file'  !< name of this routine
     296
     297    INTEGER ::  f             !< loop index
     298    INTEGER ::  return_value  !< return value
     299
     300    TYPE(file_type), DIMENSION(:), ALLOCATABLE ::  files_tmp  !< temporary file list
     301
     302
     303    return_value = 0
     304
     305    CALL internal_message( 'debug', routine_name // ': define file "' // TRIM( file_name ) // '"' )
     306!
     307!-- Allocate file list or extend it by 1
     308    IF ( .NOT. ALLOCATED( files ) ) THEN
     309
     310       nfiles = 1
     311       ALLOCATE( files(nfiles) )
     312
     313    ELSE
     314
     315       nfiles = SIZE( files )
     316!
     317!--    Check if file already exists
     318       DO  f = 1, nfiles
     319          IF ( files(f)%name == TRIM( file_name ) )  THEN
     320             return_value = 1
     321             CALL internal_message( 'error', routine_name // &
     322                     ': file "' // TRIM( file_name ) // '" already exists' )
     323             EXIT
     324          ENDIF
     325       ENDDO
     326!
     327!--    Extend file list
     328       IF ( return_value == 0 )  THEN
     329          ALLOCATE( files_tmp(nfiles) )
     330          files_tmp = files
     331          DEALLOCATE( files )
     332          nfiles = nfiles + 1
     333          ALLOCATE( files(nfiles) )
     334          files(:nfiles-1) = files_tmp
     335          DEALLOCATE( files_tmp )
     336       ENDIF
     337
     338    ENDIF
     339!
     340!-- Add new file to database
     341    IF ( return_value == 0 )  THEN
     342       files(nfiles)%name = TRIM( file_name )
     343       files(nfiles)%format = TRIM( file_format )
     344    ENDIF
     345
     346 END FUNCTION dom_def_file
    343347
    344348!--------------------------------------------------------------------------------------------------!
     
    370374!> @todo Convert given values into selected output_type.
    371375!--------------------------------------------------------------------------------------------------!
    372 FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds,        &
    373                       values_int8, values_int16, values_int32, values_intwp, &
    374                       values_real32, values_real64, values_realwp,           &
    375                       mask ) RESULT( return_value )
    376 
    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
    380 
    381    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_dim'  !< name of this routine
    382 
    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
    404 
    405 
    406    return_value = 0
    407 
    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 )
    414    dimension%data_type = TRIM( output_type )
    415 
    416    !-- Check dimension bounds and allocate dimension according to bounds
    417    IF ( SIZE( bounds ) == 1 )  THEN
    418 
    419       !-- Dimension has only lower bound, which means it changes its size
    420       !-- during simulation.
    421       !-- Set length to -1 as indicator.
    422       dimension%bounds(:) = bounds(1)
    423       dimension%length    = -1
    424 
    425       IF ( PRESENT( mask ) )  THEN
    426          return_value = 1
    427          CALL internal_message( 'error', routine_name //                      &
    428                                 ': unlimited dimensions cannot be masked ' // &
    429                                 '(dimension "' // TRIM( dimension_name ) //   &
    430                                 '", file "' // TRIM( file_name ) // '")!' )
    431       ENDIF
    432 
    433    ELSEIF ( SIZE( bounds ) == 2 )  THEN
    434 
    435       dimension%bounds = bounds
    436       dimension%length = bounds(2) - bounds(1) + 1
    437 
    438       !-- Save dimension values
    439       IF ( PRESENT( values_int8 ) )  THEN
    440          ALLOCATE( dimension%values_int8(dimension%bounds(1):dimension%bounds(2)) )
    441          IF ( SIZE( values_int8 ) == dimension%length )  THEN
    442             dimension%values_int8 = values_int8
    443          ELSEIF ( SIZE( values_int8 ) == 1 )  THEN
    444             dimension%values_int8(:) = values_int8(1)
    445          ELSE
    446             return_value = 2
    447          ENDIF
    448       ELSEIF( PRESENT( values_int16 ) )  THEN
    449          ALLOCATE( dimension%values_int16(dimension%bounds(1):dimension%bounds(2)) )
    450          IF ( SIZE( values_int16 ) == dimension%length )  THEN
    451             dimension%values_int16 = values_int16
    452          ELSEIF ( SIZE( values_int16 ) == 1 )  THEN
    453             dimension%values_int16(:) = values_int16(1)
    454          ELSE
    455             return_value = 2
    456          ENDIF
    457       ELSEIF( PRESENT( values_int32 ) )  THEN
    458          ALLOCATE( dimension%values_int32(dimension%bounds(1):dimension%bounds(2)) )
    459          IF ( SIZE( values_int32 ) == dimension%length )  THEN
    460             dimension%values_int32 = values_int32
    461          ELSEIF ( SIZE( values_int32 ) == 1 )  THEN
    462             dimension%values_int32(:) = values_int32(1)
    463          ELSE
    464             return_value = 2
    465          ENDIF
    466       ELSEIF( PRESENT( values_intwp ) )  THEN
    467          ALLOCATE( dimension%values_intwp(dimension%bounds(1):dimension%bounds(2)) )
    468          IF ( SIZE( values_intwp ) == dimension%length )  THEN
    469             dimension%values_intwp = values_intwp
    470          ELSEIF ( SIZE( values_intwp ) == 1 )  THEN
    471             dimension%values_intwp(:) = values_intwp(1)
    472          ELSE
    473             return_value = 2
    474          ENDIF
    475       ELSEIF( PRESENT( values_real32 ) )  THEN
    476          ALLOCATE( dimension%values_real32(dimension%bounds(1):dimension%bounds(2)) )
    477          IF ( SIZE( values_real32 ) == dimension%length )  THEN
    478             dimension%values_real32 = values_real32
    479          ELSEIF ( SIZE( values_real32 ) == 1 )  THEN
    480             dimension%values_real32(:) = values_real32(1)
    481          ELSE
    482             return_value = 2
    483          ENDIF
    484       ELSEIF( PRESENT( values_real64 ) )  THEN
    485          ALLOCATE( dimension%values_real64(dimension%bounds(1):dimension%bounds(2)) )
    486          IF ( SIZE( values_real64 ) == dimension%length )  THEN
    487             dimension%values_real64 = values_real64
    488          ELSEIF ( SIZE( values_real64 ) == 1 )  THEN
    489             dimension%values_real64(:) = values_real64(1)
    490          ELSE
    491             return_value = 2
    492          ENDIF
    493       ELSEIF( PRESENT( values_realwp ) )  THEN
    494          ALLOCATE( dimension%values_realwp(dimension%bounds(1):dimension%bounds(2)) )
    495          IF ( SIZE( values_realwp ) == dimension%length )  THEN
    496             dimension%values_realwp = values_realwp
    497          ELSEIF ( SIZE( values_realwp ) == 1 )  THEN
    498             dimension%values_realwp(:) = values_realwp(1)
    499          ELSE
    500             return_value = 2
    501          ENDIF
    502       ELSE
    503          return_value = 1
    504          CALL internal_message( 'error', routine_name //                    &
    505                                 ': no values given ' //                     &
    506                                 '(dimension "' // TRIM( dimension_name ) // &
    507                                 '", file "' // TRIM( file_name ) // '")!' )
    508       ENDIF
    509 
    510       IF ( return_value == 2 )  THEN
    511          return_value = 1
    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 ) // '")!' )
    516       ENDIF
    517 
    518       !-- Initialize mask
    519       IF ( PRESENT( mask )  .AND.  return_value == 0 )  THEN
    520 
    521          IF ( dimension%length == SIZE( mask ) )  THEN
    522 
    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
    628 
    629          ELSE
    630             return_value = 1
    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 ) // '")!' )
    635          ENDIF
    636 
    637       ENDIF
    638 
    639    ELSE
    640 
    641       return_value = 1
    642       CALL internal_message( 'error', routine_name //                                       &
    643                              ': at least one but no more than two bounds must be given ' // &
    644                              '(dimension "' // TRIM( dimension_name ) //                    &
    645                              '", file "' // TRIM( file_name ) // '")!' )
    646 
    647    ENDIF
    648 
    649    !-- Add dimension to database
    650    IF ( return_value == 0 )  THEN
    651 
    652       DO  f = 1, nfiles
    653 
    654          IF ( TRIM( file_name ) == files(f)%name )  THEN
    655 
    656             IF ( files(f)%is_init )  THEN
    657 
    658                return_value = 1
    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 ) // '")!' )
    664                EXIT
    665 
    666             ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
    667 
    668                ndims = 1
    669                ALLOCATE( files(f)%dimensions(ndims) )
    670 
    671             ELSE
    672 
    673                !-- Check if any variable of the same name as the new dimension is already defined
    674                IF ( ALLOCATED( files(f)%variables ) )  THEN
    675                   DO  i = 1, SIZE( files(f)%variables )
    676                      IF ( files(f)%variables(i)%name == dimension%name )  THEN
    677                         return_value = 1
    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 ) // '")!' )
    683                         EXIT
    684                      ENDIF
    685                   ENDDO
    686                ENDIF
    687 
    688                IF ( return_value == 0 )  THEN
    689                   !-- Check if dimension already exists in file
    690                   ndims = SIZE( files(f)%dimensions )
    691 
    692                   DO  d = 1, ndims
    693                      IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
    694                         return_value = 1
    695                         CALL internal_message( 'error', routine_name //     &
    696                                 ': dimension already exists in file ' //    &
    697                                 '(dimension "' // TRIM( dimension_name ) // &
    698                                 '", file "' // TRIM( file_name ) // '")!' )
    699                         EXIT
    700                      ENDIF
    701                   ENDDO
    702 
    703                   !-- Extend dimension list
    704                   IF ( return_value == 0 )  THEN
    705                      ALLOCATE( dimensions_tmp(ndims) )
    706                      dimensions_tmp = files(f)%dimensions
    707                      DEALLOCATE( files(f)%dimensions )
    708                      ndims = ndims + 1
    709                      ALLOCATE( files(f)%dimensions(ndims) )
    710                      files(f)%dimensions(:ndims-1) = dimensions_tmp
    711                      DEALLOCATE( dimensions_tmp )
    712                   ENDIF
    713                ENDIF
    714 
    715             ENDIF
    716 
    717             !-- Add new dimension to database
    718             IF ( return_value == 0 )  files(f)%dimensions(ndims) = dimension
    719 
    720             EXIT
    721 
    722          ENDIF
    723       ENDDO
    724 
    725       IF ( f > nfiles )  THEN
    726          return_value = 1
    727          CALL internal_message( 'error', routine_name //                                     &
    728                                 ': file not found (dimension "' // TRIM( dimension_name ) // &
    729                                 '", file "' // TRIM( file_name ) // '")!' )
    730       ENDIF
    731 
    732    ENDIF
    733 
    734 END FUNCTION dom_def_dim
     376 FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds,        &
     377                       values_int8, values_int16, values_int32, values_intwp, &
     378                       values_real32, values_real64, values_realwp,           &
     379                       mask ) RESULT( return_value )
     380
     381    CHARACTER(LEN=*), INTENT(IN) ::  file_name       !< name of file
     382    CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
     383    CHARACTER(LEN=*), INTENT(IN) ::  output_type     !< data type of dimension variable in output file
     384
     385    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_dim'  !< name of this routine
     386
     387    INTEGER ::  d             !< loop index
     388    INTEGER ::  f             !< loop index
     389    INTEGER ::  i             !< loop index
     390    INTEGER ::  j             !< loop index
     391    INTEGER ::  ndims         !< number of dimensions in file
     392    INTEGER ::  return_value  !< return value
     393
     394    INTEGER,         DIMENSION(:), INTENT(IN)           ::  bounds         !< lower and upper bound of dimension variable
     395    INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int8    !< values of dimension
     396    INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int16   !< values of dimension
     397    INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL ::  values_int32   !< values of dimension
     398    INTEGER(iwp),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_intwp   !< values of dimension
     399
     400    LOGICAL,         DIMENSION(:), INTENT(IN), OPTIONAL ::  mask           !< mask of dimesion
     401
     402    REAL(KIND=4),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real32  !< values of dimension
     403    REAL(KIND=8),    DIMENSION(:), INTENT(IN), OPTIONAL ::  values_real64  !< values of dimension
     404    REAL(wp),        DIMENSION(:), INTENT(IN), OPTIONAL ::  values_realwp  !< values of dimension
     405
     406    TYPE(dimension_type)                            ::  dimension       !< new dimension
     407    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimensions_tmp  !< temporary dimension list
     408
     409
     410    return_value = 0
     411
     412    CALL internal_message( 'debug', routine_name //                    &
     413                           ': define dimension ' //                    &
     414                           '(dimension "' // TRIM( dimension_name ) // &
     415                           '", file "' // TRIM( file_name ) // '")' )
     416
     417    dimension%name      = TRIM( dimension_name )
     418    dimension%data_type = TRIM( output_type )
     419!
     420!-- Check dimension bounds and allocate dimension according to bounds
     421    IF ( SIZE( bounds ) == 1 )  THEN
     422!
     423!--    Dimension has only lower bound, which means it changes its size
     424!--    during simulation.
     425!--    Set length to -1 as indicator.
     426       dimension%bounds(:) = bounds(1)
     427       dimension%length    = -1
     428
     429       IF ( PRESENT( mask ) )  THEN
     430          return_value = 1
     431          CALL internal_message( 'error', routine_name //                      &
     432                                 ': unlimited dimensions cannot be masked ' // &
     433                                 '(dimension "' // TRIM( dimension_name ) //   &
     434                                 '", file "' // TRIM( file_name ) // '")!' )
     435       ENDIF
     436
     437    ELSEIF ( SIZE( bounds ) == 2 )  THEN
     438
     439       dimension%bounds = bounds
     440       dimension%length = bounds(2) - bounds(1) + 1
     441!
     442!--    Save dimension values
     443       IF ( PRESENT( values_int8 ) )  THEN
     444          ALLOCATE( dimension%values_int8(dimension%bounds(1):dimension%bounds(2)) )
     445          IF ( SIZE( values_int8 ) == dimension%length )  THEN
     446             dimension%values_int8 = values_int8
     447          ELSEIF ( SIZE( values_int8 ) == 1 )  THEN
     448             dimension%values_int8(:) = values_int8(1)
     449          ELSE
     450             return_value = 2
     451          ENDIF
     452       ELSEIF( PRESENT( values_int16 ) )  THEN
     453          ALLOCATE( dimension%values_int16(dimension%bounds(1):dimension%bounds(2)) )
     454          IF ( SIZE( values_int16 ) == dimension%length )  THEN
     455             dimension%values_int16 = values_int16
     456          ELSEIF ( SIZE( values_int16 ) == 1 )  THEN
     457             dimension%values_int16(:) = values_int16(1)
     458          ELSE
     459             return_value = 2
     460          ENDIF
     461       ELSEIF( PRESENT( values_int32 ) )  THEN
     462          ALLOCATE( dimension%values_int32(dimension%bounds(1):dimension%bounds(2)) )
     463          IF ( SIZE( values_int32 ) == dimension%length )  THEN
     464             dimension%values_int32 = values_int32
     465          ELSEIF ( SIZE( values_int32 ) == 1 )  THEN
     466             dimension%values_int32(:) = values_int32(1)
     467          ELSE
     468             return_value = 2
     469          ENDIF
     470       ELSEIF( PRESENT( values_intwp ) )  THEN
     471          ALLOCATE( dimension%values_intwp(dimension%bounds(1):dimension%bounds(2)) )
     472          IF ( SIZE( values_intwp ) == dimension%length )  THEN
     473             dimension%values_intwp = values_intwp
     474          ELSEIF ( SIZE( values_intwp ) == 1 )  THEN
     475             dimension%values_intwp(:) = values_intwp(1)
     476          ELSE
     477             return_value = 2
     478          ENDIF
     479       ELSEIF( PRESENT( values_real32 ) )  THEN
     480          ALLOCATE( dimension%values_real32(dimension%bounds(1):dimension%bounds(2)) )
     481          IF ( SIZE( values_real32 ) == dimension%length )  THEN
     482             dimension%values_real32 = values_real32
     483          ELSEIF ( SIZE( values_real32 ) == 1 )  THEN
     484             dimension%values_real32(:) = values_real32(1)
     485          ELSE
     486             return_value = 2
     487          ENDIF
     488       ELSEIF( PRESENT( values_real64 ) )  THEN
     489          ALLOCATE( dimension%values_real64(dimension%bounds(1):dimension%bounds(2)) )
     490          IF ( SIZE( values_real64 ) == dimension%length )  THEN
     491             dimension%values_real64 = values_real64
     492          ELSEIF ( SIZE( values_real64 ) == 1 )  THEN
     493             dimension%values_real64(:) = values_real64(1)
     494          ELSE
     495             return_value = 2
     496          ENDIF
     497       ELSEIF( PRESENT( values_realwp ) )  THEN
     498          ALLOCATE( dimension%values_realwp(dimension%bounds(1):dimension%bounds(2)) )
     499          IF ( SIZE( values_realwp ) == dimension%length )  THEN
     500             dimension%values_realwp = values_realwp
     501          ELSEIF ( SIZE( values_realwp ) == 1 )  THEN
     502             dimension%values_realwp(:) = values_realwp(1)
     503          ELSE
     504             return_value = 2
     505          ENDIF
     506       ELSE
     507          return_value = 1
     508          CALL internal_message( 'error', routine_name //                    &
     509                                 ': no values given ' //                     &
     510                                 '(dimension "' // TRIM( dimension_name ) // &
     511                                 '", file "' // TRIM( file_name ) // '")!' )
     512       ENDIF
     513
     514       IF ( return_value == 2 )  THEN
     515          return_value = 1
     516          CALL internal_message( 'error', routine_name //                               &
     517                                 ': number of values and given bounds do not match ' // &
     518                                 '(dimension "' // TRIM( dimension_name ) //            &
     519                                 '", file "' // TRIM( file_name ) // '")!' )
     520       ENDIF
     521!
     522!--    Initialize mask
     523       IF ( PRESENT( mask )  .AND.  return_value == 0 )  THEN
     524
     525          IF ( dimension%length == SIZE( mask ) )  THEN
     526
     527             IF ( ALL( mask ) )  THEN
     528
     529                CALL internal_message( 'debug', routine_name //                              &
     530                                       ': mask contains only TRUE values. Ignoring mask ' // &
     531                                       '(dimension "' // TRIM( dimension_name ) //           &
     532                                       '", file "' // TRIM( file_name ) // '")!' )
     533
     534             ELSE
     535
     536                dimension%is_masked = .TRUE.
     537                dimension%length_mask = COUNT( mask )
     538
     539                ALLOCATE( dimension%mask(dimension%bounds(1):dimension%bounds(2)) )
     540                ALLOCATE( dimension%masked_indices(0:dimension%length_mask-1) )
     541
     542                dimension%mask = mask
     543!
     544!--             Save masked positions and masked values
     545                IF ( ALLOCATED( dimension%values_int8 ) )  THEN
     546
     547                   ALLOCATE( dimension%masked_values_int8(0:dimension%length_mask-1) )
     548                   j = 0
     549                   DO  i = dimension%bounds(1), dimension%bounds(2)
     550                      IF ( dimension%mask(i) )  THEN
     551                         dimension%masked_values_int8(j) = dimension%values_int8(i)
     552                         dimension%masked_indices(j) = i
     553                         j = j + 1
     554                      ENDIF
     555                   ENDDO
     556
     557                ELSEIF ( ALLOCATED( dimension%values_int16 ) )  THEN
     558
     559                   ALLOCATE( dimension%masked_values_int16(0:dimension%length_mask-1) )
     560                   j = 0
     561                   DO  i = dimension%bounds(1), dimension%bounds(2)
     562                      IF ( dimension%mask(i) )  THEN
     563                         dimension%masked_values_int16(j) = dimension%values_int16(i)
     564                         dimension%masked_indices(j) = i
     565                         j = j + 1
     566                      ENDIF
     567                   ENDDO
     568
     569                ELSEIF ( ALLOCATED( dimension%values_int32 ) )  THEN
     570
     571                   ALLOCATE( dimension%masked_values_int32(0:dimension%length_mask-1) )
     572                   j = 0
     573                   DO  i =dimension%bounds(1), dimension%bounds(2)
     574                      IF ( dimension%mask(i) )  THEN
     575                         dimension%masked_values_int32(j) = dimension%values_int32(i)
     576                         dimension%masked_indices(j) = i
     577                         j = j + 1
     578                      ENDIF
     579                   ENDDO
     580
     581                ELSEIF ( ALLOCATED( dimension%values_intwp ) )  THEN
     582
     583                   ALLOCATE( dimension%masked_values_intwp(0:dimension%length_mask-1) )
     584                   j = 0
     585                   DO  i = dimension%bounds(1), dimension%bounds(2)
     586                      IF ( dimension%mask(i) )  THEN
     587                         dimension%masked_values_intwp(j) = dimension%values_intwp(i)
     588                         dimension%masked_indices(j) = i
     589                         j = j + 1
     590                      ENDIF
     591                   ENDDO
     592
     593                ELSEIF ( ALLOCATED( dimension%values_real32 ) )  THEN
     594
     595                   ALLOCATE( dimension%masked_values_real32(0:dimension%length_mask-1) )
     596                   j = 0
     597                   DO  i = dimension%bounds(1), dimension%bounds(2)
     598                      IF ( dimension%mask(i) )  THEN
     599                         dimension%masked_values_real32(j) = dimension%values_real32(i)
     600                         dimension%masked_indices(j) = i
     601                         j = j + 1
     602                      ENDIF
     603                   ENDDO
     604
     605                ELSEIF ( ALLOCATED(dimension%values_real64) )  THEN
     606
     607                   ALLOCATE( dimension%masked_values_real64(0:dimension%length_mask-1) )
     608                   j = 0
     609                   DO  i = dimension%bounds(1), dimension%bounds(2)
     610                      IF ( dimension%mask(i) )  THEN
     611                         dimension%masked_values_real64(j) = dimension%values_real64(i)
     612                         dimension%masked_indices(j) = i
     613                         j = j + 1
     614                      ENDIF
     615                   ENDDO
     616
     617                ELSEIF ( ALLOCATED(dimension%values_realwp) )  THEN
     618
     619                   ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) )
     620                   j = 0
     621                   DO  i = dimension%bounds(1), dimension%bounds(2)
     622                      IF ( dimension%mask(i) )  THEN
     623                         dimension%masked_values_realwp(j) = dimension%values_realwp(i)
     624                         dimension%masked_indices(j) = i
     625                         j = j + 1
     626                      ENDIF
     627                   ENDDO
     628
     629                ENDIF
     630
     631             ENDIF  ! if not all mask = true
     632
     633          ELSE
     634             return_value = 1
     635             CALL internal_message( 'error', routine_name //                           &
     636                                    ': size of mask and given bounds do not match ' // &
     637                                    '(dimension "' // TRIM( dimension_name ) //        &
     638                                    '", file "' // TRIM( file_name ) // '")!' )
     639          ENDIF
     640
     641       ENDIF
     642
     643    ELSE
     644
     645       return_value = 1
     646       CALL internal_message( 'error', routine_name //                                       &
     647                              ': at least one but no more than two bounds must be given ' // &
     648                              '(dimension "' // TRIM( dimension_name ) //                    &
     649                              '", file "' // TRIM( file_name ) // '")!' )
     650
     651    ENDIF
     652!
     653!-- Add dimension to database
     654    IF ( return_value == 0 )  THEN
     655
     656       DO  f = 1, nfiles
     657
     658          IF ( TRIM( file_name ) == files(f)%name )  THEN
     659
     660             IF ( files(f)%is_init )  THEN
     661
     662                return_value = 1
     663                CALL internal_message( 'error', routine_name //                      &
     664                                       ': file already initialized. ' //             &
     665                                       'No further dimension definition allowed ' // &
     666                                       '(dimension "' // TRIM( dimension_name ) //   &
     667                                       '", file "' // TRIM( file_name ) // '")!' )
     668                EXIT
     669
     670             ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
     671
     672                ndims = 1
     673                ALLOCATE( files(f)%dimensions(ndims) )
     674
     675             ELSE
     676!
     677!--             Check if any variable of the same name as the new dimension is already defined
     678                IF ( ALLOCATED( files(f)%variables ) )  THEN
     679                   DO  i = 1, SIZE( files(f)%variables )
     680                      IF ( files(f)%variables(i)%name == dimension%name )  THEN
     681                         return_value = 1
     682                         CALL internal_message( 'error', routine_name //                    &
     683                                 ': file already has a variable of this name defined. ' //  &
     684                                 'Defining a dimension of the same name is not allowed ' // &
     685                                 '(dimension "' // TRIM( dimension_name ) //                &
     686                                 '", file "' // TRIM( file_name ) // '")!' )
     687                         EXIT
     688                      ENDIF
     689                   ENDDO
     690                ENDIF
     691
     692                IF ( return_value == 0 )  THEN
     693!
     694!--                Check if dimension already exists in file
     695                   ndims = SIZE( files(f)%dimensions )
     696
     697                   DO  d = 1, ndims
     698                      IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
     699                         return_value = 1
     700                         CALL internal_message( 'error', routine_name //     &
     701                                 ': dimension already exists in file ' //    &
     702                                 '(dimension "' // TRIM( dimension_name ) // &
     703                                 '", file "' // TRIM( file_name ) // '")!' )
     704                         EXIT
     705                      ENDIF
     706                   ENDDO
     707!
     708!--                Extend dimension list
     709                   IF ( return_value == 0 )  THEN
     710                      ALLOCATE( dimensions_tmp(ndims) )
     711                      dimensions_tmp = files(f)%dimensions
     712                      DEALLOCATE( files(f)%dimensions )
     713                      ndims = ndims + 1
     714                      ALLOCATE( files(f)%dimensions(ndims) )
     715                      files(f)%dimensions(:ndims-1) = dimensions_tmp
     716                      DEALLOCATE( dimensions_tmp )
     717                   ENDIF
     718                ENDIF
     719
     720             ENDIF
     721!
     722!--          Add new dimension to database
     723             IF ( return_value == 0 )  files(f)%dimensions(ndims) = dimension
     724
     725             EXIT
     726
     727          ENDIF
     728       ENDDO
     729
     730       IF ( f > nfiles )  THEN
     731          return_value = 1
     732          CALL internal_message( 'error', routine_name //                                     &
     733                                 ': file not found (dimension "' // TRIM( dimension_name ) // &
     734                                 '", file "' // TRIM( file_name ) // '")!' )
     735       ENDIF
     736
     737    ENDIF
     738
     739 END FUNCTION dom_def_dim
    735740
    736741!--------------------------------------------------------------------------------------------------!
     
    759764!>          ALLOCATE( u(<z>,<y>,<x>) )
    760765!--------------------------------------------------------------------------------------------------!
    761 FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, is_global ) &
    762             RESULT( return_value )
    763 
    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
    767 
    768    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_var'  !< name of this routine
    769 
    770    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) ::  dimension_names  !< list of dimension names
    771 
    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
    783 
    784 
    785    return_value = 0
    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 )
    793 
    794    ALLOCATE( variable%dimension_names(SIZE( dimension_names )) )
    795    ALLOCATE( variable%dimension_ids(SIZE( dimension_names )) )
    796 
    797    variable%dimension_names = dimension_names
    798    variable%dimension_ids = -1
    799    variable%data_type = TRIM( output_type )
    800 
    801    IF ( PRESENT( is_global ) )  THEN
    802       variable%is_global = is_global
    803    ELSE
    804       variable%is_global = .FALSE.
    805    ENDIF
    806 
    807    !-- Add variable to database
    808    DO  f = 1, nfiles
    809 
    810       IF ( TRIM( file_name ) == files(f)%name )  THEN
    811 
    812          IF ( files(f)%is_init )  THEN
    813 
    814             return_value = 1
    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 ) // '")!' )
    819             EXIT
    820 
    821          ELSEIF ( ALLOCATED( files(f)%dimensions ) )  THEN
    822 
    823             !-- Check if any dimension of the same name as the new variable is already defined
    824             DO  d = 1, SIZE( files(f)%dimensions )
    825                IF ( files(f)%dimensions(d)%name == variable%name )  THEN
    826                   return_value = 1
    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 ) // '")!' )
    832                   EXIT
    833                ENDIF
    834             ENDDO
    835 
    836             !-- Check if dimensions assigned to variable are defined within file
    837             IF ( return_value == 0 )  THEN
    838                DO  i = 1, SIZE( variable%dimension_names )
    839                   found = .FALSE.
    840                   DO  d = 1, SIZE( files(f)%dimensions )
    841                      IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) )  THEN
    842                         found = .TRUE.
    843                         EXIT
    844                      ENDIF
    845                   ENDDO
    846                   IF ( .NOT. found )  THEN
    847                      return_value = 1
    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 ) // '")!' )
    853                      EXIT
    854                   ENDIF
    855                ENDDO
    856             ENDIF
    857 
    858          ELSE
    859 
    860             return_value = 1
    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 ) // '")!' )
    865 
    866          ENDIF
    867 
    868          IF ( return_value == 0 )  THEN
    869 
    870             !-- Check if variable already exists
    871             IF ( .NOT. ALLOCATED( files(f)%variables ) )  THEN
    872 
    873                nvars = 1
    874                ALLOCATE( files(f)%variables(nvars) )
    875 
    876             ELSE
    877 
    878                nvars = SIZE( files(f)%variables )
    879                DO  i = 1, nvars
    880                   IF ( files(f)%variables(i)%name == variable%name )  THEN
    881                      return_value = 1
    882                      CALL internal_message( 'error', routine_name //   &
    883                              ': variable already exists '//            &
    884                              '(variable "' // TRIM( variable_name ) // &
    885                              '", file "' // TRIM( file_name ) // '")!' )
    886                      EXIT
    887                   ENDIF
    888                ENDDO
    889 
    890                IF ( return_value == 0 )  THEN
    891                   !-- Extend variable list
    892                   ALLOCATE( variables_tmp(nvars) )
    893                   variables_tmp = files(f)%variables
    894                   DEALLOCATE( files(f)%variables )
    895                   nvars = nvars + 1
    896                   ALLOCATE( files(f)%variables(nvars) )
    897                   files(f)%variables(:nvars-1) = variables_tmp
    898                   DEALLOCATE( variables_tmp )
    899                ENDIF
    900 
    901             ENDIF
    902 
    903             !-- Add new variable to database
    904             IF ( return_value == 0 )  files(f)%variables(nvars) = variable
    905 
    906          ENDIF
    907 
    908          EXIT
    909 
    910       ENDIF
    911 
    912    ENDDO
    913 
    914    IF ( f > nfiles )  THEN
    915       return_value = 1
    916       CALL internal_message( 'error', routine_name //                                   &
    917                              ': file not found (variable "' // TRIM( variable_name ) // &
    918                              '", file "' // TRIM( file_name ) // '")!' )
    919    ENDIF
    920 
    921 END FUNCTION dom_def_var
     766 FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, is_global ) &
     767             RESULT( return_value )
     768
     769    CHARACTER(LEN=*), INTENT(IN) ::  file_name      !< name of file
     770    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
     771    CHARACTER(LEN=*), INTENT(IN) ::  output_type    !< data type of variable
     772
     773    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_var'  !< name of this routine
     774
     775    CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) ::  dimension_names  !< list of dimension names
     776
     777    INTEGER ::  d             !< loop index
     778    INTEGER ::  f             !< loop index
     779    INTEGER ::  i             !< loop index
     780    INTEGER ::  nvars         !< number of variables in file
     781    INTEGER ::  return_value  !< return value
     782
     783    LOGICAL                       ::  found      !< true if requested dimension is defined in file
     784    LOGICAL, INTENT(IN), OPTIONAL ::  is_global  !< true if variable is global (same on all PE)
     785
     786    TYPE(variable_type)                            ::  variable       !< new variable
     787    TYPE(variable_type), DIMENSION(:), ALLOCATABLE ::  variables_tmp  !< temporary variable list
     788
     789
     790    return_value = 0
     791    found = .FALSE.
     792
     793    CALL internal_message( 'debug', routine_name //                                     &
     794                           ': define variable (variable "' // TRIM( variable_name ) //  &
     795                           '", file "' // TRIM( file_name ) // '")' )
     796
     797    variable%name = TRIM( variable_name )
     798
     799    ALLOCATE( variable%dimension_names(SIZE( dimension_names )) )
     800    ALLOCATE( variable%dimension_ids(SIZE( dimension_names )) )
     801
     802    variable%dimension_names = dimension_names
     803    variable%dimension_ids = -1
     804    variable%data_type = TRIM( output_type )
     805
     806    IF ( PRESENT( is_global ) )  THEN
     807       variable%is_global = is_global
     808    ELSE
     809       variable%is_global = .FALSE.
     810    ENDIF
     811!
     812!-- Add variable to database
     813    DO  f = 1, nfiles
     814
     815       IF ( TRIM( file_name ) == files(f)%name )  THEN
     816
     817          IF ( files(f)%is_init )  THEN
     818
     819             return_value = 1
     820             CALL internal_message( 'error', routine_name //                                  &
     821                     ': file already initialized. No further variable definition allowed ' // &
     822                     '(variable "' // TRIM( variable_name ) //                                &
     823                     '", file "' // TRIM( file_name ) // '")!' )
     824             EXIT
     825
     826          ELSEIF ( ALLOCATED( files(f)%dimensions ) )  THEN
     827!
     828!--          Check if any dimension of the same name as the new variable is already defined
     829             DO  d = 1, SIZE( files(f)%dimensions )
     830                IF ( files(f)%dimensions(d)%name == variable%name )  THEN
     831                   return_value = 1
     832                   CALL internal_message( 'error', routine_name //                    &
     833                           ': file already has a dimension of this name defined. ' // &
     834                           'Defining a variable of the same name is not allowed ' //  &
     835                           '(variable "' // TRIM( variable_name ) //                  &
     836                           '", file "' // TRIM( file_name ) // '")!' )
     837                   EXIT
     838                ENDIF
     839             ENDDO
     840!
     841!--          Check if dimensions assigned to variable are defined within file
     842             IF ( return_value == 0 )  THEN
     843                DO  i = 1, SIZE( variable%dimension_names )
     844                   found = .FALSE.
     845                   DO  d = 1, SIZE( files(f)%dimensions )
     846                      IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) )  THEN
     847                         found = .TRUE.
     848                         EXIT
     849                      ENDIF
     850                   ENDDO
     851                   IF ( .NOT. found )  THEN
     852                      return_value = 1
     853                      CALL internal_message( 'error', routine_name //                            &
     854                              ': required dimension "'//  TRIM( variable%dimension_names(i) ) // &
     855                              '" for variable is not defined ' //                                &
     856                              '(variable "' // TRIM( variable_name ) //                          &
     857                              '", file "' // TRIM( file_name ) // '")!' )
     858                      EXIT
     859                   ENDIF
     860                ENDDO
     861             ENDIF
     862
     863          ELSE
     864
     865             return_value = 1
     866             CALL internal_message( 'error', routine_name //                      &
     867                     ': no dimensions defined in file. Cannot define variable '// &
     868                     '(variable "' // TRIM( variable_name ) //                    &
     869                     '", file "' // TRIM( file_name ) // '")!' )
     870
     871          ENDIF
     872
     873          IF ( return_value == 0 )  THEN
     874!
     875!--          Check if variable already exists
     876             IF ( .NOT. ALLOCATED( files(f)%variables ) )  THEN
     877
     878                nvars = 1
     879                ALLOCATE( files(f)%variables(nvars) )
     880
     881             ELSE
     882
     883                nvars = SIZE( files(f)%variables )
     884                DO  i = 1, nvars
     885                   IF ( files(f)%variables(i)%name == variable%name )  THEN
     886                      return_value = 1
     887                      CALL internal_message( 'error', routine_name //   &
     888                              ': variable already exists '//            &
     889                              '(variable "' // TRIM( variable_name ) // &
     890                              '", file "' // TRIM( file_name ) // '")!' )
     891                      EXIT
     892                   ENDIF
     893                ENDDO
     894
     895                IF ( return_value == 0 )  THEN
     896!
     897!--                Extend variable list
     898                   ALLOCATE( variables_tmp(nvars) )
     899                   variables_tmp = files(f)%variables
     900                   DEALLOCATE( files(f)%variables )
     901                   nvars = nvars + 1
     902                   ALLOCATE( files(f)%variables(nvars) )
     903                   files(f)%variables(:nvars-1) = variables_tmp
     904                   DEALLOCATE( variables_tmp )
     905                ENDIF
     906
     907             ENDIF
     908!
     909!--          Add new variable to database
     910             IF ( return_value == 0 )  files(f)%variables(nvars) = variable
     911
     912          ENDIF
     913
     914          EXIT
     915
     916       ENDIF
     917
     918    ENDDO
     919
     920    IF ( f > nfiles )  THEN
     921       return_value = 1
     922       CALL internal_message( 'error', routine_name //                                   &
     923                              ': file not found (variable "' // TRIM( variable_name ) // &
     924                              '", file "' // TRIM( file_name ) // '")!' )
     925    ENDIF
     926
     927 END FUNCTION dom_def_var
    922928
    923929!--------------------------------------------------------------------------------------------------!
     
    946952!>                   value=' and this part was appended', append=.TRUE. )
    947953!--------------------------------------------------------------------------------------------------!
    948 FUNCTION 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
    956 
    957    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_char'  !< name of routine
    958 
    959    INTEGER ::  return_value  !< return value
    960 
    961    LOGICAL                       ::  append_internal  !< same as 'append'
    962    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    963 
    964    TYPE(attribute_type) ::  attribute  !< new attribute
    965 
    966 
    967    return_value = 0
    968 
    969    IF ( PRESENT( append ) )  THEN
    970       append_internal = append
    971    ELSE
    972       append_internal = .FALSE.
    973    ENDIF
    974 
    975    attribute%name       = TRIM( attribute_name )
    976    attribute%data_type  = 'char'
    977    attribute%value_char = TRIM( value )
    978 
    979    IF ( PRESENT( variable_name ) )  THEN
    980       variable_name_internal = TRIM( variable_name )
    981    ELSE
    982       variable_name_internal = ''
    983    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 )
    988 
    989 END FUNCTION dom_def_att_char
     954 FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append ) &
     955             RESULT( return_value )
     956
     957    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     958    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     959    CHARACTER(LEN=*),      INTENT(IN)           ::  value                   !< attribute value
     960    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     961    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     962
     963    ! CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_char'  !< name of routine
     964
     965    INTEGER ::  return_value  !< return value
     966
     967    LOGICAL                       ::  append_internal  !< same as 'append'
     968    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     969
     970    TYPE(attribute_type) ::  attribute  !< new attribute
     971
     972
     973    return_value = 0
     974
     975    IF ( PRESENT( append ) )  THEN
     976       append_internal = append
     977    ELSE
     978       append_internal = .FALSE.
     979    ENDIF
     980
     981    attribute%name       = TRIM( attribute_name )
     982    attribute%data_type  = 'char'
     983    attribute%value_char = TRIM( value )
     984
     985    IF ( PRESENT( variable_name ) )  THEN
     986       variable_name_internal = TRIM( variable_name )
     987    ELSE
     988       variable_name_internal = ''
     989    ENDIF
     990
     991    return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     992                      variable_name=TRIM( variable_name_internal ),         &
     993                      attribute=attribute, append=append_internal )
     994
     995 END FUNCTION dom_def_att_char
    990996
    991997!--------------------------------------------------------------------------------------------------!
     
    10081014!>                   value=1_1 )
    10091015!--------------------------------------------------------------------------------------------------!
    1010 FUNCTION 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
    1017 
    1018    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int8'  !< name of routine
    1019 
    1020    INTEGER(KIND=1), INTENT(IN) ::  value  !< attribute value
    1021 
    1022    INTEGER ::  return_value  !< return value
    1023 
    1024    LOGICAL                       ::  append_internal  !< same as 'append'
    1025    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    1026 
    1027    TYPE(attribute_type) ::  attribute  !< new attribute
    1028 
    1029 
    1030    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
    1037 
    1038    IF ( PRESENT( append ) )  THEN
    1039       IF ( append )  THEN
    1040          return_value = 1
    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 ) // '")!' )
    1046       ENDIF
    1047    ENDIF
    1048 
    1049    IF ( return_value == 0 )  THEN
    1050       append_internal = .FALSE.
    1051 
    1052       attribute%name       = TRIM( attribute_name )
    1053       attribute%data_type  = 'int8'
    1054       attribute%value_int8 = value
    1055 
    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 )
    1059    ENDIF
    1060 
    1061 END FUNCTION dom_def_att_int8
     1016 FUNCTION dom_def_att_int8( file_name, variable_name, attribute_name, value, append ) &
     1017             RESULT( return_value )
     1018
     1019    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1020    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1021    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1022    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     1023
     1024    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int8'  !< name of routine
     1025
     1026    INTEGER(KIND=1), INTENT(IN) ::  value  !< attribute value
     1027
     1028    INTEGER ::  return_value  !< return value
     1029
     1030    LOGICAL                       ::  append_internal  !< same as 'append'
     1031    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     1032
     1033    TYPE(attribute_type) ::  attribute  !< new attribute
     1034
     1035
     1036    return_value = 0
     1037
     1038    IF ( PRESENT( variable_name ) )  THEN
     1039       variable_name_internal = TRIM( variable_name )
     1040    ELSE
     1041       variable_name_internal = ''
     1042    ENDIF
     1043
     1044    IF ( PRESENT( append ) )  THEN
     1045       IF ( append )  THEN
     1046          return_value = 1
     1047          CALL internal_message( 'error', routine_name //                             &
     1048                                 ': numeric attribute cannot be appended ' //         &
     1049                                 '(attribute "' // TRIM( attribute_name ) //          &
     1050                                 '", variable "' // TRIM( variable_name_internal ) // &
     1051                                 '", file "' // TRIM( file_name ) // '")!' )
     1052       ENDIF
     1053    ENDIF
     1054
     1055    IF ( return_value == 0 )  THEN
     1056       append_internal = .FALSE.
     1057
     1058       attribute%name       = TRIM( attribute_name )
     1059       attribute%data_type  = 'int8'
     1060       attribute%value_int8 = value
     1061
     1062       return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1063                         variable_name=TRIM( variable_name_internal ),         &
     1064                         attribute=attribute, append=append_internal )
     1065    ENDIF
     1066
     1067 END FUNCTION dom_def_att_int8
    10621068
    10631069!--------------------------------------------------------------------------------------------------!
     
    10801086!>                   value=1_2 )
    10811087!--------------------------------------------------------------------------------------------------!
    1082 FUNCTION 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
    1089 
    1090    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int16'  !< name of routine
    1091 
    1092    INTEGER(KIND=2), INTENT(IN) ::  value  !< attribute value
    1093 
    1094    INTEGER ::  return_value  !< return value
    1095 
    1096    LOGICAL                       ::  append_internal  !< same as 'append'
    1097    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    1098 
    1099    TYPE(attribute_type) ::  attribute  !< new attribute
    1100 
    1101 
    1102    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
    1109 
    1110    IF ( PRESENT( append ) )  THEN
    1111       IF ( append )  THEN
    1112          return_value = 1
    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 ) // '")!' )
    1118       ENDIF
    1119    ENDIF
    1120 
    1121    IF ( return_value == 0 )  THEN
    1122       append_internal = .FALSE.
    1123 
    1124       attribute%name        = TRIM( attribute_name )
    1125       attribute%data_type   = 'int16'
    1126       attribute%value_int16 = value
    1127 
    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 )
    1131    ENDIF
    1132 
    1133 END FUNCTION dom_def_att_int16
     1088 FUNCTION dom_def_att_int16( file_name, variable_name, attribute_name, value, append ) &
     1089             RESULT( return_value )
     1090
     1091    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1092    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1093    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1094    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     1095
     1096    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int16'  !< name of routine
     1097
     1098    INTEGER(KIND=2), INTENT(IN) ::  value  !< attribute value
     1099
     1100    INTEGER ::  return_value  !< return value
     1101
     1102    LOGICAL                       ::  append_internal  !< same as 'append'
     1103    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     1104
     1105    TYPE(attribute_type) ::  attribute  !< new attribute
     1106
     1107
     1108    return_value = 0
     1109
     1110    IF ( PRESENT( variable_name ) )  THEN
     1111       variable_name_internal = TRIM( variable_name )
     1112    ELSE
     1113       variable_name_internal = ''
     1114    ENDIF
     1115
     1116    IF ( PRESENT( append ) )  THEN
     1117       IF ( append )  THEN
     1118          return_value = 1
     1119          CALL internal_message( 'error', routine_name //                             &
     1120                                 ': numeric attribute cannot be appended ' //         &
     1121                                 '(attribute "' // TRIM( attribute_name ) //          &
     1122                                 '", variable "' // TRIM( variable_name_internal ) // &
     1123                                 '", file "' // TRIM( file_name ) // '")!' )
     1124       ENDIF
     1125    ENDIF
     1126
     1127    IF ( return_value == 0 )  THEN
     1128       append_internal = .FALSE.
     1129
     1130       attribute%name        = TRIM( attribute_name )
     1131       attribute%data_type   = 'int16'
     1132       attribute%value_int16 = value
     1133
     1134       return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1135                         variable_name=TRIM( variable_name_internal ),         &
     1136                         attribute=attribute, append=append_internal )
     1137    ENDIF
     1138
     1139 END FUNCTION dom_def_att_int16
    11341140
    11351141!--------------------------------------------------------------------------------------------------!
     
    11521158!>                   value=1_4 )
    11531159!--------------------------------------------------------------------------------------------------!
    1154 FUNCTION 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
    1161 
    1162    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int32'  !< name of routine
    1163 
    1164    INTEGER(KIND=4), INTENT(IN) ::  value  !< attribute value
    1165 
    1166    INTEGER ::  return_value  !< return value
    1167 
    1168    LOGICAL                       ::  append_internal  !< same as 'append'
    1169    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    1170 
    1171    TYPE(attribute_type) ::  attribute  !< new attribute
    1172 
    1173 
    1174    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
    1181 
    1182    IF ( PRESENT( append ) )  THEN
    1183       IF ( append )  THEN
    1184          return_value = 1
    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 ) // '")!' )
    1190       ENDIF
    1191    ENDIF
    1192 
    1193    IF ( return_value == 0 )  THEN
    1194       append_internal = .FALSE.
    1195 
    1196       attribute%name        = TRIM( attribute_name )
    1197       attribute%data_type   = 'int32'
    1198       attribute%value_int32 = value
    1199 
    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 )
    1203    ENDIF
    1204 
    1205 END FUNCTION dom_def_att_int32
     1160 FUNCTION dom_def_att_int32( file_name, variable_name, attribute_name, value, append ) &
     1161             RESULT( return_value )
     1162
     1163    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1164    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1165    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1166    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     1167
     1168    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_int32'  !< name of routine
     1169
     1170    INTEGER(KIND=4), INTENT(IN) ::  value  !< attribute value
     1171
     1172    INTEGER ::  return_value  !< return value
     1173
     1174    LOGICAL                       ::  append_internal  !< same as 'append'
     1175    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     1176
     1177    TYPE(attribute_type) ::  attribute  !< new attribute
     1178
     1179
     1180    return_value = 0
     1181
     1182    IF ( PRESENT( variable_name ) )  THEN
     1183       variable_name_internal = TRIM( variable_name )
     1184    ELSE
     1185       variable_name_internal = ''
     1186    ENDIF
     1187
     1188    IF ( PRESENT( append ) )  THEN
     1189       IF ( append )  THEN
     1190          return_value = 1
     1191          CALL internal_message( 'error', routine_name //                             &
     1192                                 ': numeric attribute cannot be appended ' //         &
     1193                                 '(attribute "' // TRIM( attribute_name ) //          &
     1194                                 '", variable "' // TRIM( variable_name_internal ) // &
     1195                                 '", file "' // TRIM( file_name ) // '")!' )
     1196       ENDIF
     1197    ENDIF
     1198
     1199    IF ( return_value == 0 )  THEN
     1200       append_internal = .FALSE.
     1201
     1202       attribute%name        = TRIM( attribute_name )
     1203       attribute%data_type   = 'int32'
     1204       attribute%value_int32 = value
     1205
     1206       return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1207                         variable_name=TRIM( variable_name_internal ),         &
     1208                         attribute=attribute, append=append_internal )
     1209    ENDIF
     1210
     1211 END FUNCTION dom_def_att_int32
    12061212
    12071213!--------------------------------------------------------------------------------------------------!
     
    12241230!>                   value=1.0_4 )
    12251231!--------------------------------------------------------------------------------------------------!
    1226 FUNCTION 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
    1233 
    1234    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real32'  !< name of routine
    1235 
    1236    INTEGER ::  return_value  !< return value
    1237 
    1238    LOGICAL                       ::  append_internal  !< same as 'append'
    1239    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    1240 
    1241    REAL(KIND=4), INTENT(IN) ::  value  !< attribute value
    1242 
    1243    TYPE(attribute_type) ::  attribute  !< new attribute
    1244 
    1245 
    1246    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
    1253 
    1254    IF ( PRESENT( append ) )  THEN
    1255       IF ( append )  THEN
    1256          return_value = 1
    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 ) // '")!' )
    1262       ENDIF
    1263    ENDIF
    1264 
    1265    IF ( return_value == 0 )  THEN
    1266       append_internal = .FALSE.
    1267 
    1268       attribute%name         = TRIM( attribute_name )
    1269       attribute%data_type    = 'real32'
    1270       attribute%value_real32 = value
    1271 
    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 )
    1275    ENDIF
    1276 
    1277 END FUNCTION dom_def_att_real32
     1232 FUNCTION dom_def_att_real32( file_name, variable_name, attribute_name, value, append ) &
     1233             RESULT( return_value )
     1234
     1235    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1236    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1237    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1238    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     1239
     1240    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real32'  !< name of routine
     1241
     1242    INTEGER ::  return_value  !< return value
     1243
     1244    LOGICAL                       ::  append_internal  !< same as 'append'
     1245    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     1246
     1247    REAL(KIND=4), INTENT(IN) ::  value  !< attribute value
     1248
     1249    TYPE(attribute_type) ::  attribute  !< new attribute
     1250
     1251
     1252    return_value = 0
     1253
     1254    IF ( PRESENT( variable_name ) )  THEN
     1255       variable_name_internal = TRIM( variable_name )
     1256    ELSE
     1257       variable_name_internal = ''
     1258    ENDIF
     1259
     1260    IF ( PRESENT( append ) )  THEN
     1261       IF ( append )  THEN
     1262          return_value = 1
     1263          CALL internal_message( 'error', routine_name //                             &
     1264                                 ': numeric attribute cannot be appended ' //         &
     1265                                 '(attribute "' // TRIM( attribute_name ) //          &
     1266                                 '", variable "' // TRIM( variable_name_internal ) // &
     1267                                 '", file "' // TRIM( file_name ) // '")!' )
     1268       ENDIF
     1269    ENDIF
     1270
     1271    IF ( return_value == 0 )  THEN
     1272       append_internal = .FALSE.
     1273
     1274       attribute%name         = TRIM( attribute_name )
     1275       attribute%data_type    = 'real32'
     1276       attribute%value_real32 = value
     1277
     1278       return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1279                         variable_name=TRIM( variable_name_internal ),         &
     1280                         attribute=attribute, append=append_internal )
     1281    ENDIF
     1282
     1283 END FUNCTION dom_def_att_real32
    12781284
    12791285!--------------------------------------------------------------------------------------------------!
     
    12961302!>                   value=1.0_8 )
    12971303!--------------------------------------------------------------------------------------------------!
    1298 FUNCTION 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
    1305 
    1306    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real64'  !< name of routine
    1307 
    1308    INTEGER ::  return_value  !< return value
    1309 
    1310    LOGICAL                       ::  append_internal  !< same as 'append'
    1311    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
    1312 
    1313    REAL(KIND=8), INTENT(IN) ::  value  !< attribute value
    1314 
    1315    TYPE(attribute_type) ::  attribute  !< new attribute
    1316 
    1317 
    1318    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
    1325 
    1326    IF ( PRESENT( append ) )  THEN
    1327       IF ( append )  THEN
    1328          return_value = 1
    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 ) // '")!' )
    1334       ENDIF
    1335    ENDIF
    1336 
    1337    IF ( return_value == 0 )  THEN
    1338       append_internal = .FALSE.
    1339 
    1340       attribute%name         = TRIM( attribute_name )
    1341       attribute%data_type    = 'real64'
    1342       attribute%value_real64 = value
    1343 
    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 
    1349 END FUNCTION dom_def_att_real64
     1304 FUNCTION dom_def_att_real64( file_name, variable_name, attribute_name, value, append ) &
     1305             RESULT( return_value )
     1306
     1307    CHARACTER(LEN=*),      INTENT(IN)           ::  file_name               !< name of file
     1308    CHARACTER(LEN=*),      INTENT(IN)           ::  attribute_name          !< name of attribute
     1309    CHARACTER(LEN=*),      INTENT(IN), OPTIONAL ::  variable_name           !< name of variable
     1310    CHARACTER(LEN=charlen)                      ::  variable_name_internal  !< internal copy of variable_name
     1311
     1312    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_att_real64'  !< name of routine
     1313
     1314    INTEGER ::  return_value  !< return value
     1315
     1316    LOGICAL                       ::  append_internal  !< same as 'append'
     1317    LOGICAL, INTENT(IN), OPTIONAL ::  append           !< if true, append value to existing value
     1318
     1319    REAL(KIND=8), INTENT(IN) ::  value  !< attribute value
     1320
     1321    TYPE(attribute_type) ::  attribute  !< new attribute
     1322
     1323
     1324    return_value = 0
     1325
     1326    IF ( PRESENT( variable_name ) )  THEN
     1327       variable_name_internal = TRIM( variable_name )
     1328    ELSE
     1329       variable_name_internal = ''
     1330    ENDIF
     1331
     1332    IF ( PRESENT( append ) )  THEN
     1333       IF ( append )  THEN
     1334          return_value = 1
     1335          CALL internal_message( 'error', routine_name //                             &
     1336                                 ': numeric attribute cannot be appended ' //         &
     1337                                 '(attribute "' // TRIM( attribute_name ) //          &
     1338                                 '", variable "' // TRIM( variable_name_internal ) // &
     1339                                 '", file "' // TRIM( file_name ) // '")!' )
     1340       ENDIF
     1341    ENDIF
     1342
     1343    IF ( return_value == 0 )  THEN
     1344       append_internal = .FALSE.
     1345
     1346       attribute%name         = TRIM( attribute_name )
     1347       attribute%data_type    = 'real64'
     1348       attribute%value_real64 = value
     1349
     1350       return_value = save_attribute_in_database( file_name=TRIM( file_name ), &
     1351                         variable_name=TRIM( variable_name_internal ),         &
     1352                         attribute=attribute, append=append_internal )
     1353    ENDIF
     1354
     1355 END FUNCTION dom_def_att_real64
    13501356
    13511357!--------------------------------------------------------------------------------------------------!
     
    13571363!> to the files.
    13581364!--------------------------------------------------------------------------------------------------!
    1359 FUNCTION 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): &
     1365 FUNCTION dom_def_end() RESULT( return_value )
     1366
     1367    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_def_end'  !< name of routine
     1368
     1369    INTEGER ::  d             !< loop index
     1370    INTEGER ::  f             !< loop index
     1371    INTEGER ::  return_value  !< return value
     1372
     1373    INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int8           !< target array for dimension values
     1374    INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int16          !< target array for dimension values
     1375    INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_int32          !< target array for dimension values
     1376    INTEGER(iwp),    DIMENSION(:), ALLOCATABLE, TARGET ::  values_intwp          !< target array for dimension values
     1377
     1378    INTEGER(KIND=1), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int8_pointer   !< pointer to target array
     1379    INTEGER(KIND=2), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int16_pointer  !< pointer to target array
     1380    INTEGER(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_int32_pointer  !< pointer to target array
     1381    INTEGER(iwp),    DIMENSION(:), POINTER, CONTIGUOUS ::  values_intwp_pointer  !< pointer to target array
     1382
     1383    REAL(KIND=4), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real32            !< target array for dimension values
     1384    REAL(KIND=8), DIMENSION(:), ALLOCATABLE, TARGET ::  values_real64            !< target array for dimension values
     1385    REAL(wp),     DIMENSION(:), ALLOCATABLE, TARGET ::  values_realwp            !< target array for dimension values
     1386
     1387    REAL(KIND=4), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real32_pointer    !< pointer to target array
     1388    REAL(KIND=8), DIMENSION(:), POINTER, CONTIGUOUS ::  values_real64_pointer    !< pointer to target array
     1389    REAL(wp),     DIMENSION(:), POINTER, CONTIGUOUS ::  values_realwp_pointer    !< pointer to target array
     1390
     1391
     1392    return_value = 0
     1393    CALL internal_message( 'debug', routine_name // ': start' )
     1394!
     1395!-- Clear database from empty files and unused dimensions
     1396    IF ( nfiles > 0 )  return_value = cleanup_database()
     1397
     1398    IF ( return_value == 0 )  THEN
     1399       DO  f = 1, nfiles
     1400!
     1401!--       Skip initialization if file is already initialized
     1402          IF ( files(f)%is_init )  CYCLE
     1403
     1404          CALL internal_message( 'debug', routine_name // ': initialize file "' // &
     1405                                 TRIM( files(f)%name ) // '"' )
     1406!
     1407!--       Open file
     1408          CALL open_output_file( files(f)%format, files(f)%name, files(f)%id, &
     1409                                 return_value=return_value )
     1410!
     1411!--       Initialize file header:
     1412!--       define dimensions and variables and write attributes
     1413          IF ( return_value == 0 )  &
     1414             CALL init_file_header( files(f), return_value=return_value )
     1415!
     1416!--       End file definition
     1417          IF ( return_value == 0 )  &
     1418             CALL stop_file_header_definition( files(f)%format, files(f)%id, &
     1419                                               files(f)%name, return_value )
     1420
     1421          IF ( return_value == 0 )  THEN
     1422!
     1423!--          Flag file as initialized
     1424             files(f)%is_init = .TRUE.
     1425!
     1426!--          Write dimension values into file
     1427             DO  d = 1, SIZE( files(f)%dimensions )
     1428                IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) )  THEN
     1429                   ALLOCATE( values_int8(files(f)%dimensions(d)%bounds(1): &
    14341430                                         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): &
     1431                   values_int8 = files(f)%dimensions(d)%values_int8
     1432                   values_int8_pointer => values_int8
     1433                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1434                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1435                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1436                                     values_int8_1d=values_int8_pointer )
     1437                   DEALLOCATE( values_int8 )
     1438                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int16 ) )  THEN
     1439                   ALLOCATE( values_int16(files(f)%dimensions(d)%bounds(1): &
    14641440                                          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): &
     1441                   values_int16 = files(f)%dimensions(d)%values_int16
     1442                   values_int16_pointer => values_int16
     1443                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1444                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1445                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1446                                     values_int16_1d=values_int16_pointer )
     1447                   DEALLOCATE( values_int16 )
     1448                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_int32 ) )  THEN
     1449                   ALLOCATE( values_int32(files(f)%dimensions(d)%bounds(1): &
    14741450                                          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): &
     1451                   values_int32 = files(f)%dimensions(d)%values_int32
     1452                   values_int32_pointer => values_int32
     1453                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1454                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1455                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1456                                     values_int32_1d=values_int32_pointer )
     1457                   DEALLOCATE( values_int32 )
     1458                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_intwp ) )  THEN
     1459                   ALLOCATE( values_intwp(files(f)%dimensions(d)%bounds(1): &
    14841460                                          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 
    1505 END FUNCTION dom_def_end
     1461                   values_intwp = files(f)%dimensions(d)%values_intwp
     1462                   values_intwp_pointer => values_intwp
     1463                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1464                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1465                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1466                                     values_intwp_1d=values_intwp_pointer )
     1467                   DEALLOCATE( values_intwp )
     1468                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real32 ) )  THEN
     1469                   ALLOCATE( values_real32(files(f)%dimensions(d)%bounds(1): &
     1470                                           files(f)%dimensions(d)%bounds(2)) )
     1471                   values_real32 = files(f)%dimensions(d)%values_real32
     1472                   values_real32_pointer => values_real32
     1473                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1474                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1475                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1476                                     values_real32_1d=values_real32_pointer )
     1477                   DEALLOCATE( values_real32 )
     1478                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_real64 ) )  THEN
     1479                   ALLOCATE( values_real64(files(f)%dimensions(d)%bounds(1): &
     1480                                           files(f)%dimensions(d)%bounds(2)) )
     1481                   values_real64 = files(f)%dimensions(d)%values_real64
     1482                   values_real64_pointer => values_real64
     1483                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1484                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1485                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1486                                     values_real64_1d=values_real64_pointer )
     1487                   DEALLOCATE( values_real64 )
     1488                ELSEIF ( ALLOCATED( files(f)%dimensions(d)%values_realwp ) )  THEN
     1489                   ALLOCATE( values_realwp(files(f)%dimensions(d)%bounds(1): &
     1490                                           files(f)%dimensions(d)%bounds(2)) )
     1491                   values_realwp = files(f)%dimensions(d)%values_realwp
     1492                   values_realwp_pointer => values_realwp
     1493                   return_value = dom_write_var( files(f)%name, files(f)%dimensions(d)%name, &
     1494                                     bounds_start=(/ files(f)%dimensions(d)%bounds(1) /),    &
     1495                                     bounds_end  =(/ files(f)%dimensions(d)%bounds(2) /),    &
     1496                                     values_realwp_1d=values_realwp_pointer )
     1497                   DEALLOCATE( values_realwp )
     1498                ENDIF
     1499                IF ( return_value /= 0 )  EXIT
     1500             ENDDO
     1501
     1502          ENDIF
     1503
     1504          IF ( return_value /= 0 )  EXIT
     1505
     1506       ENDDO
     1507    ENDIF
     1508
     1509    CALL internal_message( 'debug', routine_name // ': finished' )
     1510
     1511 END FUNCTION dom_def_end
    15061512
    15071513!--------------------------------------------------------------------------------------------------!
     
    15261532!>       chosen, the values are written to file as given in the 'dom_write_var' call.
    15271533!--------------------------------------------------------------------------------------------------!
    1528 FUNCTION 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, &
     1534 FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end,         &
     1535             values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
     1536             values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     1537             values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,  &
     1538             values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,  &
     1539             values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &
     1540             values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &
     1541             values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d  &
     1542             ) RESULT( return_value )
     1543
     1544    CHARACTER(LEN=charlen)            ::  file_format    !< file format chosen for file
     1545    CHARACTER(LEN=*),      INTENT(IN) ::  file_name      !< name of file
     1546    CHARACTER(LEN=*),      INTENT(IN) ::  variable_name  !< name of variable
     1547
     1548    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
     1549
     1550    INTEGER ::  file_id              !< file ID
     1551    INTEGER ::  i                    !< loop index
     1552    INTEGER ::  j                    !< loop index
     1553    INTEGER ::  k                    !< loop index
     1554    INTEGER ::  output_return_value  !< return value of a called output routine
     1555    INTEGER ::  return_value         !< return value
     1556    INTEGER ::  variable_id          !< variable ID
     1557
     1558    INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_end             !< end index per dimension of variable
     1559    INTEGER, DIMENSION(:),   INTENT(IN)  ::  bounds_start           !< start index per dimension of variable
     1560    INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_origin          !< first index of each dimension
     1561    INTEGER, DIMENSION(:),   ALLOCATABLE ::  bounds_start_internal  !< start index per dim. for output after masking
     1562    INTEGER, DIMENSION(:),   ALLOCATABLE ::  value_counts           !< count of indices to be written per dimension
     1563    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  masked_indices         !< list containing all output indices along a dimension
     1564
     1565    LOGICAL ::  do_output  !< true if any data lies within given range of masked dimension
     1566    LOGICAL ::  is_global  !< true if variable is global
     1567
     1568    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                   ::  values_int8_0d             !< output variable
     1569    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                   ::  values_int16_0d            !< output variable
     1570    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                   ::  values_int32_0d            !< output variable
     1571    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL                   ::  values_intwp_0d            !< output variable
     1572    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d             !< output variable
     1573    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d            !< output variable
     1574    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d            !< output variable
     1575    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d            !< output variable
     1576    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d             !< output variable
     1577    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d            !< output variable
     1578    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d            !< output variable
     1579    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d            !< output variable
     1580    INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d             !< output variable
     1581    INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d            !< output variable
     1582    INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d            !< output variable
     1583    INTEGER(iwp),    POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d            !< output variable
     1584
     1585    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int8_1d_resorted    !< resorted output variable
     1586    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int16_1d_resorted   !< resorted output variable
     1587    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_int32_1d_resorted   !< resorted output variable
     1588    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:)               ::  values_intwp_1d_resorted   !< resorted output variable
     1589    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int8_2d_resorted    !< resorted output variable
     1590    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int16_2d_resorted   !< resorted output variable
     1591    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_int32_2d_resorted   !< resorted output variable
     1592    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:)             ::  values_intwp_2d_resorted   !< resorted output variable
     1593    INTEGER(KIND=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int8_3d_resorted    !< resorted output variable
     1594    INTEGER(KIND=2), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int16_3d_resorted   !< resorted output variable
     1595    INTEGER(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_int32_3d_resorted   !< resorted output variable
     1596    INTEGER(iwp),    TARGET, ALLOCATABLE, DIMENSION(:,:,:)           ::  values_intwp_3d_resorted   !< resorted output variable
     1597
     1598    INTEGER(KIND=1), POINTER                                         ::  values_int8_0d_pointer     !< pointer to resortet array
     1599    INTEGER(KIND=2), POINTER                                         ::  values_int16_0d_pointer    !< pointer to resortet array
     1600    INTEGER(KIND=4), POINTER                                         ::  values_int32_0d_pointer    !< pointer to resortet array
     1601    INTEGER(iwp),    POINTER                                         ::  values_intwp_0d_pointer    !< pointer to resortet array
     1602    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int8_1d_pointer     !< pointer to resortet array
     1603    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int16_1d_pointer    !< pointer to resortet array
     1604    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_int32_1d_pointer    !< pointer to resortet array
     1605    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:)               ::  values_intwp_1d_pointer    !< pointer to resortet array
     1606    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int8_2d_pointer     !< pointer to resortet array
     1607    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int16_2d_pointer    !< pointer to resortet array
     1608    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_int32_2d_pointer    !< pointer to resortet array
     1609    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:)             ::  values_intwp_2d_pointer    !< pointer to resortet array
     1610    INTEGER(KIND=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int8_3d_pointer     !< pointer to resortet array
     1611    INTEGER(KIND=2), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int16_3d_pointer    !< pointer to resortet array
     1612    INTEGER(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_int32_3d_pointer    !< pointer to resortet array
     1613    INTEGER(iwp),    POINTER, CONTIGUOUS, DIMENSION(:,:,:)           ::  values_intwp_3d_pointer    !< pointer to resortet array
     1614
     1615    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                      ::  values_real32_0d           !< output variable
     1616    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                      ::  values_real64_0d           !< output variable
     1617    REAL(wp),     POINTER, INTENT(IN), OPTIONAL                      ::  values_realwp_0d           !< output variable
     1618    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real32_1d           !< output variable
     1619    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_real64_1d           !< output variable
     1620    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:)        ::  values_realwp_1d           !< output variable
     1621    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real32_2d           !< output variable
     1622    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_real64_2d           !< output variable
     1623    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:)      ::  values_realwp_2d           !< output variable
     1624    REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real32_3d           !< output variable
     1625    REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_real64_3d           !< output variable
     1626    REAL(wp),     POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:)    ::  values_realwp_3d           !< output variable
     1627
     1628    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real32_1d_resorted  !< resorted output variable
     1629    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_real64_1d_resorted  !< resorted output variable
     1630    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:)                  ::  values_realwp_1d_resorted  !< resorted output variable
     1631    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real32_2d_resorted  !< resorted output variable
     1632    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_real64_2d_resorted  !< resorted output variable
     1633    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:)                ::  values_realwp_2d_resorted  !< resorted output variable
     1634    REAL(KIND=4), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real32_3d_resorted  !< resorted output variable
     1635    REAL(KIND=8), TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_real64_3d_resorted  !< resorted output variable
     1636    REAL(wp),     TARGET, ALLOCATABLE, DIMENSION(:,:,:)              ::  values_realwp_3d_resorted  !< resorted output variable
     1637
     1638    REAL(KIND=4), POINTER                                            ::  values_real32_0d_pointer   !< pointer to resortet array
     1639    REAL(KIND=8), POINTER                                            ::  values_real64_0d_pointer   !< pointer to resortet array
     1640    REAL(wp),     POINTER                                            ::  values_realwp_0d_pointer   !< pointer to resortet array
     1641    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real32_1d_pointer   !< pointer to resortet array
     1642    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_real64_1d_pointer   !< pointer to resortet array
     1643    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:)                  ::  values_realwp_1d_pointer   !< pointer to resortet array
     1644    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real32_2d_pointer   !< pointer to resortet array
     1645    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_real64_2d_pointer   !< pointer to resortet array
     1646    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:)                ::  values_realwp_2d_pointer   !< pointer to resortet array
     1647    REAL(KIND=4), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real32_3d_pointer   !< pointer to resortet array
     1648    REAL(KIND=8), POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_real64_3d_pointer   !< pointer to resortet array
     1649    REAL(wp),     POINTER, CONTIGUOUS, DIMENSION(:,:,:)              ::  values_realwp_3d_pointer   !< pointer to resortet array
     1650
     1651    TYPE(dimension_type), DIMENSION(:), ALLOCATABLE ::  dimension_list  !< list of used dimensions of variable
     1652
     1653
     1654    return_value = 0
     1655    output_return_value = 0
     1656
     1657    CALL internal_message( 'debug', routine_name // ': write ' // TRIM( variable_name ) // &
     1658                           ' into file ' // TRIM( file_name ) )
     1659!
     1660!-- Search for variable within file
     1661    CALL find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, &
     1662                           is_global, dimension_list, return_value=return_value  )
     1663
     1664    IF ( return_value == 0 )  THEN
     1665!
     1666!--    Check if the correct amount of variable bounds were given
     1667       IF ( SIZE( bounds_start ) /= SIZE( dimension_list )  .OR.  &
     1668            SIZE( bounds_end ) /= SIZE( dimension_list ) )  THEN
     1669          return_value = 1
     1670          CALL internal_message( 'error', routine_name //                  &
     1671                                 ': number bounds do not match with ' //   &
     1672                                 'number of dimensions of variable ' //    &
     1673                                 '(variable "' // TRIM( variable_name ) // &
     1674                                 '", file "' // TRIM( file_name ) // '")!' )
     1675       ENDIF
     1676
     1677    ENDIF
     1678
     1679    IF ( return_value == 0 )  THEN
     1680!
     1681!--    Save starting index (lower bounds) of each dimension
     1682       ALLOCATE( bounds_origin(SIZE( dimension_list )) )
     1683       ALLOCATE( bounds_start_internal(SIZE( dimension_list )) )
     1684       ALLOCATE( value_counts(SIZE( dimension_list )) )
     1685
     1686       WRITE( temp_string, * ) bounds_start
     1687       CALL internal_message( 'debug', routine_name //                    &
     1688                              ': file "' // TRIM( file_name ) //          &
     1689                              '", variable "' // TRIM( variable_name ) // &
     1690                              '", bounds_start =' // TRIM( temp_string ) )
     1691       WRITE( temp_string, * ) bounds_end
     1692       CALL internal_message( 'debug', routine_name //                    &
     1693                              ': file "' // TRIM( file_name ) //          &
     1694                              '", variable "' // TRIM( variable_name ) // &
     1695                              '", bounds_end =' // TRIM( temp_string ) )
     1696!
     1697!--    Get bounds for masking
     1698       CALL get_masked_indices_and_masked_dimension_bounds( dimension_list,                  &
     1699               bounds_start, bounds_end, bounds_start_internal, value_counts, bounds_origin, &
     1700               masked_indices )
     1701
     1702       do_output = .NOT. ANY( value_counts == 0 )
     1703
     1704       WRITE( temp_string, * ) bounds_start_internal
     1705       CALL internal_message( 'debug', routine_name //                    &
     1706                              ': file "' // TRIM( file_name ) //          &
     1707                              '", variable "' // TRIM( variable_name ) // &
     1708                              '", bounds_start_internal =' // TRIM( temp_string ) )
     1709       WRITE( temp_string, * ) value_counts
     1710       CALL internal_message( 'debug', routine_name //                    &
     1711                              ': file "' // TRIM( file_name ) //          &
     1712                              '", variable "' // TRIM( variable_name ) // &
     1713                              '", value_counts =' // TRIM( temp_string ) )
     1714!
     1715!--    Mask and resort variable
     1716!--    8bit integer output
     1717       IF ( PRESENT( values_int8_0d ) )  THEN
     1718          values_int8_0d_pointer => values_int8_0d
     1719       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     1720          IF ( do_output ) THEN
     1721             ALLOCATE( values_int8_1d_resorted(0:value_counts(1)-1) )
     1722             !$OMP PARALLEL PRIVATE (i)
     1723             !$OMP DO
     1724             DO  i = 0, value_counts(1) - 1
     1725                values_int8_1d_resorted(i) = values_int8_1d(masked_indices(1,i))
     1726             ENDDO
     1727             !$OMP END PARALLEL
     1728          ELSE
     1729             ALLOCATE( values_int8_1d_resorted(1) )
     1730             values_int8_1d_resorted = 0_1
     1731          ENDIF
     1732          values_int8_1d_pointer => values_int8_1d_resorted
     1733       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
     1734          IF ( do_output ) THEN
     1735             ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1, &
    17881736                                               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, &
     1737             !$OMP PARALLEL PRIVATE (i,j)
     1738             !$OMP DO
     1739             DO  i = 0, value_counts(1) - 1
     1740                DO  j = 0, value_counts(2) - 1
     1741                   values_int8_2d_resorted(i,j) = values_int8_2d(masked_indices(2,j), &
     1742                                                                 masked_indices(1,i)  )
     1743                ENDDO
     1744             ENDDO
     1745             !$OMP END PARALLEL
     1746          ELSE
     1747             ALLOCATE( values_int8_2d_resorted(1,1) )
     1748             values_int8_2d_resorted = 0_1
     1749          ENDIF
     1750          values_int8_2d_pointer => values_int8_2d_resorted
     1751       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
     1752          IF ( do_output ) THEN
     1753             ALLOCATE( values_int8_3d_resorted(0:value_counts(1)-1, &
    18061754                                               0:value_counts(2)-1, &
    18071755                                               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, &
     1756             !$OMP PARALLEL PRIVATE (i,j,k)
     1757             !$OMP DO
     1758             DO  i = 0, value_counts(1) - 1
     1759                DO  j = 0, value_counts(2) - 1
     1760                   DO  k = 0, value_counts(3) - 1
     1761                      values_int8_3d_resorted(i,j,k) = values_int8_3d(masked_indices(3,k), &
     1762                                                                      masked_indices(2,j), &
     1763                                                                      masked_indices(1,i)  )
     1764                   ENDDO
     1765                ENDDO
     1766             ENDDO
     1767             !$OMP END PARALLEL
     1768          ELSE
     1769             ALLOCATE( values_int8_3d_resorted(1,1,1) )
     1770             values_int8_3d_resorted = 0_1
     1771          ENDIF
     1772          values_int8_3d_pointer => values_int8_3d_resorted
     1773!
     1774!--    16bit integer output
     1775       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
     1776          values_int16_0d_pointer => values_int16_0d
     1777       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
     1778          IF ( do_output ) THEN
     1779             ALLOCATE( values_int16_1d_resorted(0:value_counts(1)-1) )
     1780             !$OMP PARALLEL PRIVATE (i)
     1781             !$OMP DO
     1782             DO  i = 0, value_counts(1) - 1
     1783                values_int16_1d_resorted(i) = values_int16_1d(masked_indices(1,i))
     1784             ENDDO
     1785             !$OMP END PARALLEL
     1786          ELSE
     1787             ALLOCATE( values_int16_1d_resorted(1) )
     1788             values_int16_1d_resorted = 0_1
     1789          ENDIF
     1790          values_int16_1d_pointer => values_int16_1d_resorted
     1791       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
     1792          IF ( do_output ) THEN
     1793             ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1, &
    19621794                                                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, &
     1795             !$OMP PARALLEL PRIVATE (i,j)
     1796             !$OMP DO
     1797             DO  i = 0, value_counts(1) - 1
     1798                DO  j = 0, value_counts(2) - 1
     1799                   values_int16_2d_resorted(i,j) = values_int16_2d(masked_indices(2,j), &
     1800                                                                   masked_indices(1,i))
     1801                ENDDO
     1802             ENDDO
     1803             !$OMP END PARALLEL
     1804          ELSE
     1805             ALLOCATE( values_int16_2d_resorted(1,1) )
     1806             values_int16_2d_resorted = 0_1
     1807          ENDIF
     1808          values_int16_2d_pointer => values_int16_2d_resorted
     1809       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
     1810          IF ( do_output ) THEN
     1811             ALLOCATE( values_int16_3d_resorted(0:value_counts(1)-1, &
    19801812                                                0:value_counts(2)-1, &
    19811813                                                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, &
     1814             !$OMP PARALLEL PRIVATE (i,j,k)
     1815             !$OMP DO
     1816             DO  i = 0, value_counts(1) - 1
     1817                DO  j = 0, value_counts(2) - 1
     1818                   DO  k = 0, value_counts(3) - 1
     1819                      values_int16_3d_resorted(i,j,k) = values_int16_3d(masked_indices(3,k), &
     1820                                                                        masked_indices(2,j), &
     1821                                                                        masked_indices(1,i)  )
     1822                   ENDDO
     1823                ENDDO
     1824             ENDDO
     1825             !$OMP END PARALLEL
     1826          ELSE
     1827             ALLOCATE( values_int16_3d_resorted(1,1,1) )
     1828             values_int16_3d_resorted = 0_1
     1829          ENDIF
     1830          values_int16_3d_pointer => values_int16_3d_resorted
     1831!
     1832!--    32bit integer output
     1833       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
     1834          values_int32_0d_pointer => values_int32_0d
     1835       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
     1836          IF ( do_output ) THEN
     1837             ALLOCATE( values_int32_1d_resorted(0:value_counts(1)-1) )
     1838             !$OMP PARALLEL PRIVATE (i)
     1839             !$OMP DO
     1840             DO  i = 0, value_counts(1) - 1
     1841                values_int32_1d_resorted(i) = values_int32_1d(masked_indices(1,i))
     1842             ENDDO
     1843             !$OMP END PARALLEL
     1844          ELSE
     1845             ALLOCATE( values_int32_1d_resorted(1) )
     1846             values_int32_1d_resorted = 0_1
     1847          ENDIF
     1848          values_int32_1d_pointer => values_int32_1d_resorted
     1849       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
     1850          IF ( do_output ) THEN
     1851             ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1, &
    20201852                                                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, &
     1853             !$OMP PARALLEL PRIVATE (i,j)
     1854             !$OMP DO
     1855             DO  i = 0, value_counts(1) - 1
     1856                DO  j = 0, value_counts(2) - 1
     1857                   values_int32_2d_resorted(i,j) = values_int32_2d(masked_indices(2,j), &
     1858                                                                   masked_indices(1,i)  )
     1859                ENDDO
     1860             ENDDO
     1861             !$OMP END PARALLEL
     1862          ELSE
     1863             ALLOCATE( values_int32_2d_resorted(1,1) )
     1864             values_int32_2d_resorted = 0_1
     1865          ENDIF
     1866          values_int32_2d_pointer => values_int32_2d_resorted
     1867       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
     1868          IF ( do_output ) THEN
     1869             ALLOCATE( values_int32_3d_resorted(0:value_counts(1)-1, &
    20381870                                                0:value_counts(2)-1, &
    20391871                                                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, &
     1872             !$OMP PARALLEL PRIVATE (i,j,k)
     1873             !$OMP DO
     1874             DO  i = 0, value_counts(1) - 1
     1875                DO  j = 0, value_counts(2) - 1
     1876                   DO  k = 0, value_counts(3) - 1
     1877                      values_int32_3d_resorted(i,j,k) = values_int32_3d(masked_indices(3,k), &
     1878                                                                        masked_indices(2,j), &
     1879                                                                        masked_indices(1,i)  )
     1880                   ENDDO
     1881                ENDDO
     1882             ENDDO
     1883             !$OMP END PARALLEL
     1884          ELSE
     1885             ALLOCATE( values_int32_3d_resorted(1,1,1) )
     1886             values_int32_3d_resorted = 0_1
     1887          ENDIF
     1888          values_int32_3d_pointer => values_int32_3d_resorted
     1889!
     1890!--    working-precision integer output
     1891       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
     1892          values_intwp_0d_pointer => values_intwp_0d
     1893       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
     1894          IF ( do_output ) THEN
     1895             ALLOCATE( values_intwp_1d_resorted(0:value_counts(1)-1) )
     1896             !$OMP PARALLEL PRIVATE (i)
     1897             !$OMP DO
     1898             DO  i = 0, value_counts(1) - 1
     1899                values_intwp_1d_resorted(i) = values_intwp_1d(masked_indices(1,i))
     1900             ENDDO
     1901             !$OMP END PARALLEL
     1902          ELSE
     1903             ALLOCATE( values_intwp_1d_resorted(1) )
     1904             values_intwp_1d_resorted = 0_1
     1905          ENDIF
     1906          values_intwp_1d_pointer => values_intwp_1d_resorted
     1907       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
     1908          IF ( do_output ) THEN
     1909             ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1, &
    20781910                                                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, &
     1911             !$OMP PARALLEL PRIVATE (i,j)
     1912             !$OMP DO
     1913             DO  i = 0, value_counts(1) - 1
     1914                DO  j = 0, value_counts(2) - 1
     1915                   values_intwp_2d_resorted(i,j) = values_intwp_2d(masked_indices(2,j), &
     1916                                                                   masked_indices(1,i)  )
     1917                ENDDO
     1918             ENDDO
     1919             !$OMP END PARALLEL
     1920          ELSE
     1921             ALLOCATE( values_intwp_2d_resorted(1,1) )
     1922             values_intwp_2d_resorted = 0_1
     1923          ENDIF
     1924          values_intwp_2d_pointer => values_intwp_2d_resorted
     1925       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
     1926          IF ( do_output ) THEN
     1927             ALLOCATE( values_intwp_3d_resorted(0:value_counts(1)-1, &
    20961928                                                0:value_counts(2)-1, &
    20971929                                                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 
    2116       ELSE
    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 ) // '")!'  )
    2122       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                 &nb