!> @file data_output_binary_module.f90
!--------------------------------------------------------------------------------------------------!
! This file is part of the PALM model system.
!
! PALM is free software: you can redistribute it and/or modify it under the
! terms of the GNU General Public License as published by the Free Software
! Foundation, either version 3 of the License, or (at your option) any later
! version.
!
! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License along with
! PALM. If not, see <http://www.gnu.org/licenses/>.
!
! Copyright 2019-2019 Leibniz Universitaet Hannover
!--------------------------------------------------------------------------------------------------!
!
! Current revisions:
! ------------------
! 
! 
! Former revisions:
! -----------------
! $Id: data_output_binary_module.f90 4070 2019-07-03 13:51:40Z motisi $
! Initial revision
!
!
! Authors:
! --------
!> @author: Tobias Gronemeier
!
! Description:
! ------------
!> Binary output module to write output data into binary files.
!>
!> @todo Think of removing 'is_init' as its value can be derived from the return
!>       value of 'return_value'.
!> @todo Get return value of write statements.
!--------------------------------------------------------------------------------------------------!
MODULE data_output_binary_module

   USE kinds

#if defined( __parallel )
#if defined( __mpifh )
   INCLUDE "mpif.h"
#else
   USE MPI
#endif
#endif

   IMPLICIT NONE

   INTEGER(iwp), PARAMETER ::  charlen = 100_iwp  !< maximum length of character variables

   CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
   CHARACTER(LEN=*), PARAMETER ::  prefix = 'BIN_'                               !< file prefix for binary files

   CHARACTER(LEN=800)          ::  internal_error_message = ''  !< string containing the last error message
   CHARACTER(LEN=800)          ::  temp_string                  !< dummy string

   INTEGER(iwp) ::  binary_file_lowest_unit = 1000  !< lowest unit number of all binary files created by this module
   INTEGER(iwp) ::  config_file_unit                !< unit number of config file
   INTEGER(iwp) ::  debug_output_unit               !< Fortran Unit Number of the debug-output file
   INTEGER(iwp) ::  global_id_in_file = -1          !< value of global ID within a file
   INTEGER(iwp) ::  next_available_unit             !< next unit number available for new file

   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id  !< highest assigned ID of variable or dimension in a file

   LOGICAL ::  binary_open_file_first_call = .TRUE.  !< true if binary_open_file routine was not called yet
   LOGICAL ::  config_file_open = .FALSE.            !< true if config file is opened and not closed
   LOGICAL ::  print_debug_output = .FALSE.          !< if true, debug output is printed

   SAVE

   PRIVATE

   INTERFACE binary_init_module
      MODULE PROCEDURE binary_init_module
   END INTERFACE binary_init_module

   INTERFACE binary_open_file
      MODULE PROCEDURE binary_open_file
   END INTERFACE binary_open_file

   INTERFACE binary_init_dimension
      MODULE PROCEDURE binary_init_dimension
   END INTERFACE binary_init_dimension

   INTERFACE binary_init_variable
      MODULE PROCEDURE binary_init_variable
   END INTERFACE binary_init_variable

   INTERFACE binary_write_attribute
      MODULE PROCEDURE binary_write_attribute
   END INTERFACE binary_write_attribute

   INTERFACE binary_init_end
      MODULE PROCEDURE binary_init_end
   END INTERFACE binary_init_end

   INTERFACE binary_write_variable
      MODULE PROCEDURE binary_write_variable
   END INTERFACE binary_write_variable

   INTERFACE binary_finalize
      MODULE PROCEDURE binary_finalize
   END INTERFACE binary_finalize

   INTERFACE binary_get_error_message
      MODULE PROCEDURE binary_get_error_message
   END INTERFACE binary_get_error_message

   PUBLIC &
      binary_finalize, &
      binary_get_error_message, &
      binary_init_dimension, &
      binary_init_end, &
      binary_init_module, &
      binary_init_variable, &
      binary_open_file, &
      binary_write_attribute, &
      binary_write_variable


CONTAINS


!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Initialize data-output module.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_init_module( program_debug_output_unit, debug_output, dom_global_id )

   INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
   INTEGER(iwp), INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output

   LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed


   debug_output_unit = program_debug_output_unit

   print_debug_output = debug_output

   global_id_in_file = dom_global_id


END SUBROUTINE binary_init_module

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Open binary file.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_open_file( filename, file_id, return_value )

   CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
   CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
   CHARACTER(LEN=7)                   ::  myid_char          !< string containing value of myid with leading zeros

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine

   INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
   INTEGER(iwp)              ::  myid          !< id of local processor id (MPI rank)
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value

   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  files_highest_var_id_tmp  !< temporary list of given variable IDs in file

   LOGICAL ::  file_exists  !< true if file to be opened already exists


   return_value = 0

#if defined( __parallel )
   CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, return_value )
   IF ( return_value == 0 )  THEN
      WRITE( myid_char, '("_",I6.6)' )  myid
   ELSE
      CALL internal_message( 'debug', routine_name // 'MPI_COMM_RANK error' )
   ENDIF
#else
   myid = 0
   myid_char = '_' // REPEAT('0', 6)
#endif

   !-- Open binary config file for combining script
   IF ( return_value == 0  .AND.  binary_open_file_first_call )  THEN

      binary_open_file_first_call = .FALSE.
      config_file_unit = binary_file_lowest_unit

      IF ( myid == 0 )  THEN

         !-- Remove any pre-existing file
         INQUIRE( FILE=TRIM( config_file_name ), EXIST=file_exists )

         IF ( file_exists )  THEN
            CALL internal_message( 'debug', routine_name //              &
                                            ': Remove existing file ' // &
                                            TRIM( config_file_name ) )
            CALL SYSTEM( 'rm ' // TRIM( config_file_name ) )
         ENDIF

         OPEN( config_file_unit, FILE=TRIM( config_file_name ), &
               FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )

         IF ( return_value == 0 )  THEN

            config_file_open = .TRUE.

            !-- Write some general information to config file
            WRITE( config_file_unit )  LEN( prefix )
            WRITE( config_file_unit )  prefix
            WRITE( config_file_unit )  charlen
            WRITE( config_file_unit )  global_id_in_file

         ELSE

            return_value = 1
            CALL internal_message( 'error', routine_name // ': could not create config' )

         ENDIF

      ENDIF

      next_available_unit = binary_file_lowest_unit + 1

   ENDIF

   !-- Initialize output file: open, write header, initialize variable/dimension IDs
   IF ( return_value == 0 )  THEN

      bin_filename = prefix // TRIM( filename ) // myid_char

      !-- Remove any pre-existing file
      INQUIRE( FILE=TRIM( bin_filename ), EXIST=file_exists )

      IF ( file_exists )  THEN
         CALL internal_message( 'debug', routine_name // &
                                         ': remove existing file ' // TRIM( bin_filename ) )
         CALL SYSTEM( 'rm ' // TRIM( bin_filename ) )
      ENDIF

      !-- Open binary file
      CALL internal_message( 'debug', routine_name // ': open file ' // TRIM( bin_filename ) )
      OPEN ( next_available_unit, FILE=TRIM( bin_filename ), &
             FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value )

      IF ( return_value == 0 )  THEN

         !-- Add filename to config file
         IF ( myid == 0 )  THEN
            WRITE( config_file_unit )  filename
         ENDIF

         !-- Save file ID and increase next file unit number
         file_id = next_available_unit
         next_available_unit = next_available_unit + 1

         !-- Write some meta data to file
         WRITE ( file_id )  charlen
         WRITE ( file_id )  file_id
         WRITE ( file_id )  filename

         !-- Extend file-variable/dimension-ID list by 1 and set it to 0 for new file.
         IF ( ALLOCATED( files_highest_var_id ) )  THEN
            ALLOCATE( files_highest_var_id_tmp(SIZE( files_highest_var_id )) )
            files_highest_var_id_tmp = files_highest_var_id
            DEALLOCATE( files_highest_var_id )
            ALLOCATE( files_highest_var_id(binary_file_lowest_unit+1:file_id) )
            files_highest_var_id(:file_id-1) = files_highest_var_id_tmp
            DEALLOCATE( files_highest_var_id_tmp )
         ELSE
            ALLOCATE( files_highest_var_id(binary_file_lowest_unit+1:file_id) )
         ENDIF
         files_highest_var_id(file_id) = 0_iwp

      ELSE
         return_value = 1
         CALL internal_message( 'error', routine_name // &
                                         ': could not open file "' // TRIM( filename ) // '"')
      ENDIF

   ENDIF

END SUBROUTINE binary_open_file

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Write attribute to file.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_write_attribute( file_id, var_id, att_name, att_value_char, &
              att_value_int8, att_value_int16, att_value_int32,               &
              att_value_real32, att_value_real64, return_value )

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_attribute'  !< name of this routine

   CHARACTER(LEN=charlen), INTENT(IN)           ::  att_name        !< name of attribute
   CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL ::  att_value_char  !< value of attribute
   CHARACTER(LEN=charlen)                       ::  att_type        !< data type of attribute
   CHARACTER(LEN=charlen)                       ::  out_str         !< output string

   INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  att_value_int8   !< value of attribute
   INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  att_value_int16  !< value of attribute
   INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  att_value_int32  !< value of attribute

   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value

   REAL(KIND=4), INTENT(IN), OPTIONAL ::  att_value_real32  !< value of attribute
   REAL(KIND=8), INTENT(IN), OPTIONAL ::  att_value_real64  !< value of attribute


   return_value = 0

   CALL internal_message( 'debug', TRIM( routine_name ) // &
                                   ': write attribute ' // TRIM( att_name ) )

   !-- Write attribute to file
   out_str = 'attribute'
   WRITE( file_id )  out_str

   WRITE( file_id )  var_id
   WRITE( file_id )  att_name

   IF ( PRESENT( att_value_char ) )  THEN
      att_type = 'char'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_char
   ELSEIF ( PRESENT( att_value_int8 ) )  THEN
      att_type = 'int8'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_int8
   ELSEIF ( PRESENT( att_value_int16 ) )  THEN
      att_type = 'int16'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_int16
   ELSEIF ( PRESENT( att_value_int32 ) )  THEN
      att_type = 'int32'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_int32
   ELSEIF ( PRESENT( att_value_real32 ) )  THEN
      att_type = 'real32'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_real32
   ELSEIF ( PRESENT( att_value_real64 ) )  THEN
      att_type = 'real64'
      WRITE( file_id )  att_type
      WRITE( file_id )  att_value_real64
   ELSE
      return_value = 1
      CALL internal_message( 'error', TRIM( routine_name ) // &
                                      ': attribute "' // TRIM( att_name ) // '": no value given' )
   ENDIF

END SUBROUTINE binary_write_attribute

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Initialize dimension. Write information in file header and save dimension
!> values to be later written to file.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_init_dimension( file_id, dim_id, var_id, &
              dim_name, dim_type, dim_length, is_init, return_value )

   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_name  !< name of dimension
   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_type  !< data type of dimension
   CHARACTER(LEN=charlen)             ::  out_str   !< output string

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine

   INTEGER(iwp), INTENT(OUT) ::  dim_id        !< dimension ID
   INTEGER(iwp), INTENT(IN)  ::  dim_length    !< length of dimension
   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
   INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID

   LOGICAL, INTENT(OUT) ::  is_init  !< true if dimension is initialized


   return_value = 0

   CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dim_name ) )

   !-- Assign dimension ID
   dim_id = files_highest_var_id( file_id ) + 1
   files_highest_var_id( file_id ) = dim_id

   !-- Define dimension in file
   out_str = 'dimension'
   WRITE( file_id )  out_str
   WRITE( file_id )  dim_name
   WRITE( file_id )  dim_id
   WRITE( file_id )  dim_type
   WRITE( file_id )  dim_length

   !-- Define variable associated with dimension
   CALL binary_init_variable( file_id, var_id, dim_name, dim_type, &
                              (/dim_id/), is_init, .TRUE., return_value )
   IF ( return_value /= 0 )  THEN
      is_init = .FALSE.
      CALL internal_message( 'error', routine_name // &
                                      ': init dimension "' // TRIM( dim_name ) // '"' )
   ENDIF

END SUBROUTINE binary_init_dimension

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Initialize variable. Write information of variable into file header.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_init_variable( file_id, var_id, var_name, var_type, &
                                 var_dim_ids, is_init, is_global, return_value )

   CHARACTER(LEN=charlen)             ::  out_str   !< output string
   CHARACTER(LEN=charlen), INTENT(IN) ::  var_name  !< name of variable
   CHARACTER(LEN=charlen), INTENT(IN) ::  var_type  !< data type of variable

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine

   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value

   INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_ids  !< list of dimension IDs used by variable

   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
   LOGICAL, INTENT(OUT) ::  is_init    !< true if variable is initialized


   return_value = 0

   CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( var_name ) )

   IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning

   !-- Assign variable ID
   var_id = files_highest_var_id( file_id ) + 1
   files_highest_var_id( file_id ) = var_id

   !-- Write variable information in file
   out_str = 'variable'
   WRITE( file_id )  out_str
   WRITE( file_id )  var_name
   WRITE( file_id )  var_id
   WRITE( file_id )  var_type
   WRITE( file_id )  SIZE( var_dim_ids )
   WRITE( file_id )  var_dim_ids

   !-- Variable is initialised
   is_init = return_value == 0

END SUBROUTINE binary_init_variable

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Leave file definition state.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_init_end( file_id, return_value )

   CHARACTER(LEN=charlen) ::  out_str  !< output string

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_end'  !< name of this routine

   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value


   return_value = 0

   WRITE( temp_string, * ) file_id
   CALL internal_message( 'debug', &
                          routine_name // &
                          ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )

   out_str = '*** end file header ***'
   WRITE( file_id )  out_str

END SUBROUTINE binary_init_end

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Write variable to file.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_write_variable(                                         &
              file_id, var_id, bounds_start, bounds_end, bounds_origin,   &
              do_output, is_global,                                       &
              var_int8_0d,   var_int8_1d,   var_int8_2d,   var_int8_3d,   &
              var_int16_0d,  var_int16_1d,  var_int16_2d,  var_int16_3d,  &
              var_int32_0d,  var_int32_1d,  var_int32_2d,  var_int32_3d,  &
              var_intwp_0d,  var_intwp_1d,  var_intwp_2d,  var_intwp_3d,  &
              var_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &
              var_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &
              var_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &
              return_value )

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine

   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
   INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID

   INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds_origin  !< starting index of each dimension
   INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds_end     !< ending index of variable
   INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  bounds_start   !< starting index of variable

   INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL                               ::  var_int8_0d  !< output variable
   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int8_1d  !< output variable
   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int8_2d  !< output variable
   INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int8_3d  !< output variable

   INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL                               ::  var_int16_0d  !< output variable
   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int16_1d  !< output variable
   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int16_2d  !< output variable
   INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int16_3d  !< output variable

   INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_int32_0d  !< output variable
   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_int32_1d  !< output variable
   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_int32_2d  !< output variable
   INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_int32_3d  !< output variable

   INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL                               ::  var_intwp_0d  !< output variable
   INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_intwp_1d  !< output variable
   INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_intwp_2d  !< output variable
   INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_intwp_3d  !< output variable

   LOGICAL, INTENT(IN) ::  do_output  !< write output only if do_output = true
   LOGICAL, INTENT(IN) ::  is_global  !< true if variable is global (same on all PE)

   REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL                               ::  var_real32_0d  !< output variable
   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real32_1d  !< output variable
   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real32_2d  !< output variable
   REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real32_3d  !< output variable

   REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL                               ::  var_real64_0d  !< output variable
   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_real64_1d  !< output variable
   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_real64_2d  !< output variable
   REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_real64_3d  !< output variable

   REAL(wp), POINTER, INTENT(IN), OPTIONAL                               ::  var_realwp_0d  !< output variable
   REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  var_realwp_1d  !< output variable
   REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  var_realwp_2d  !< output variable
   REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  var_realwp_3d  !< output variable


   return_value = 0

   WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) var_id, file_id
   CALL internal_message( 'debug', routine_name // TRIM( temp_string ) )

   IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning

   IF ( do_output )  THEN
      WRITE( file_id )  var_id
      WRITE( file_id )  bounds_start
      WRITE( file_id )  bounds_end
      WRITE( file_id )  bounds_origin
      !-- 8bit integer output
      IF ( PRESENT( var_int8_0d ) )  THEN
         WRITE( file_id )  var_int8_0d
      ELSEIF ( PRESENT( var_int8_1d ) )  THEN
         WRITE( file_id )  var_int8_1d
      ELSEIF ( PRESENT( var_int8_2d ) )  THEN
         WRITE( file_id )  var_int8_2d
      ELSEIF ( PRESENT( var_int8_3d ) )  THEN
         WRITE( file_id )  var_int8_3d
      !-- 16bit integer output
      ELSEIF ( PRESENT( var_int16_0d ) )  THEN
         WRITE( file_id )  var_int16_0d
      ELSEIF ( PRESENT( var_int16_1d ) )  THEN
         WRITE( file_id )  var_int16_1d
      ELSEIF ( PRESENT( var_int16_2d ) )  THEN
         WRITE( file_id )  var_int16_2d
      ELSEIF ( PRESENT( var_int16_3d ) )  THEN
         WRITE( file_id )  var_int16_3d
      !-- 32bit integer output
      ELSEIF ( PRESENT( var_int32_0d ) )  THEN
         WRITE( file_id )  var_int32_0d
      ELSEIF ( PRESENT( var_int32_1d ) )  THEN
         WRITE( file_id )  var_int32_1d
      ELSEIF ( PRESENT( var_int32_2d ) )  THEN
         WRITE( file_id )  var_int32_2d
      ELSEIF ( PRESENT( var_int32_3d ) )  THEN
         WRITE( file_id )  var_int32_3d
      !-- working-precision integer output
      ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
         WRITE( file_id )  var_intwp_0d
      ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
         WRITE( file_id )  var_intwp_1d
      ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
         WRITE( file_id )  var_intwp_2d
      ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
         WRITE( file_id )  var_intwp_3d
      !-- 32bit real output
      ELSEIF ( PRESENT( var_real32_0d ) )  THEN
         WRITE( file_id )  var_real32_0d
      ELSEIF ( PRESENT( var_real32_1d ) )  THEN
         WRITE( file_id )  var_real32_1d
      ELSEIF ( PRESENT( var_real32_2d ) )  THEN
         WRITE( file_id )  var_real32_2d
      ELSEIF ( PRESENT( var_real32_3d ) )  THEN
         WRITE( file_id )  var_real32_3d
      !-- 64bit real output
      ELSEIF ( PRESENT( var_real64_0d ) )  THEN
         WRITE( file_id )  var_real64_0d
      ELSEIF ( PRESENT( var_real64_1d ) )  THEN
         WRITE( file_id )  var_real64_1d
      ELSEIF ( PRESENT( var_real64_2d ) )  THEN
         WRITE( file_id )  var_real64_2d
      ELSEIF ( PRESENT( var_real64_3d ) )  THEN
         WRITE( file_id )  var_real64_3d
      !-- working-precision real output
      ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
         WRITE( file_id )  var_realwp_0d
      ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
         WRITE( file_id )  var_realwp_1d
      ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
         WRITE( file_id )  var_realwp_2d
      ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
         WRITE( file_id )  var_realwp_3d
      ELSE
         return_value = 1
         WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
         CALL internal_message( 'error', routine_name // &
                                         TRIM( temp_string ) // ': no values given' )
      ENDIF

   ENDIF

END SUBROUTINE binary_write_variable

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Close opened files.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_finalize( file_id, return_value )

   CHARACTER(LEN=charlen) ::  out_str  !< output string

   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_finalize'  !< name of this routine

   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value


   IF ( config_file_open )  THEN

      out_str = '*** end config file ***'
      WRITE( config_file_unit )  out_str

      CLOSE( config_file_unit, IOSTAT=return_value )

      IF ( return_value /= 0 )  THEN
         CALL internal_message( 'error', routine_name // ': cannot close configuration file' )
      ELSE
         config_file_open = .FALSE.
      ENDIF

   ELSE

      return_value = 0

   ENDIF

   IF ( return_value == 0 )  THEN

      WRITE(temp_string,*) file_id
      CALL internal_message( 'debug', routine_name // &
                                      ': close file (file_id=' // TRIM( temp_string ) // ')' )

      CLOSE( file_id, IOSTAT=return_value )
      IF ( return_value /= 0 )  THEN
         WRITE(temp_string,*) file_id
         CALL internal_message( 'error',        &
                                routine_name // &
                                ': cannot close file (file_id=' // TRIM( temp_string ) // ')' )
      ENDIF

   ENDIF

END SUBROUTINE binary_finalize


!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Message routine writing debug information into the debug file
!> or creating the error message string.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE internal_message( level, string )

   CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
   CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string


   IF ( TRIM( level ) == 'error' )  THEN

      WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string

   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN

      WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
      FLUSH( debug_output_unit )

   ENDIF

END SUBROUTINE internal_message

!--------------------------------------------------------------------------------------------------!
! Description:
! ------------
!> Return the last created error message.
!--------------------------------------------------------------------------------------------------!
SUBROUTINE binary_get_error_message( error_message )

   CHARACTER(LEN=800), INTENT(OUT) ::  error_message  !< return error message to main program


   error_message = internal_error_message

END SUBROUTINE binary_get_error_message


END MODULE data_output_binary_module