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

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

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

Legend:

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

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