Home


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

Ignore:
Timestamp:
Jul 19, 2019 8:54:42 AM (5 years ago)
Author:
gronemeier
Message:

combine new netcdf4 output modules into a single module; improvements of DOM error messages; check initialization state of file before defining/writing anything; improvements in binary output

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/data_output_binary_module.f90

    r4070 r4106  
    2020! Current revisions:
    2121! ------------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    … …  
    3636!> Binary output module to write output data into binary files.
    3737!>
    38 !> @todo Think of removing 'is_init' as its value can be derived from the return
    39 !>       value of 'return_value'.
    40 !> @todo Get return value of write statements.
     38!> @todo Get iostat value of write statements.
    4139!--------------------------------------------------------------------------------------------------!
    4240MODULE data_output_binary_module
    … …  
    5755
    5856   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
    5958   CHARACTER(LEN=*), PARAMETER ::  prefix = 'BIN_'                               !< file prefix for binary files
    6059
    … …  
    156155!> Open binary file.
    157156!--------------------------------------------------------------------------------------------------!
    158 SUBROUTINE binary_open_file( filename, file_id, return_value )
     157SUBROUTINE binary_open_file( mode, filename, file_id, return_value )
    159158
    160159   CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    161160   CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
    162161   CHARACTER(LEN=7)                   ::  myid_char          !< string containing value of myid with leading zeros
     162   CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
    163163
    164164   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
    … …  
    180180      WRITE( myid_char, '("_",I6.6)' )  myid
    181181   ELSE
    182       CALL internal_message( 'debug', routine_name // 'MPI_COMM_RANK error' )
     182      CALL internal_message( 'debug', routine_name // ': MPI_COMM_RANK error' )
    183183   ENDIF
    184184#else
    … …  
    186186   myid_char = '_' // REPEAT('0', 6)
    187187#endif
     188
     189   !-- Check mode (not required, added for compatibility reasons)
     190   IF ( TRIM( mode ) == mode_binary )  CONTINUE
    188191
    189192   !-- Open binary config file for combining script
    … …  
    356359      return_value = 1
    357360      CALL internal_message( 'error', TRIM( routine_name ) // &
    358                                       ': attribute "' // TRIM( att_name ) // '": no value given' )
     361                             ': attribute "' // TRIM( att_name ) // '": no value given' )
    359362   ENDIF
    360363
    … …  
    367370!> values to be later written to file.
    368371!--------------------------------------------------------------------------------------------------!
    369 SUBROUTINE binary_init_dimension( file_id, dim_id, var_id, &
    370               dim_name, dim_type, dim_length, is_init, return_value )
     372SUBROUTINE binary_init_dimension( mode, file_id, dim_id, var_id, &
     373              dim_name, dim_type, dim_length, return_value )
    371374
    372375   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_name  !< name of dimension
    373376   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_type  !< data type of dimension
    374377   CHARACTER(LEN=charlen)             ::  out_str   !< output string
     378   CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
    375379
    376380   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
    … …  
    382386   INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
    383387
    384    LOGICAL, INTENT(OUT) ::  is_init  !< true if dimension is initialized
    385 
    386388
    387389   return_value = 0
    388390
    389391   CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dim_name ) )
     392
     393   !-- Check mode (not required, added for compatibility reasons only)
     394   IF ( TRIM( mode ) == mode_binary )  CONTINUE
    390395
    391396   !-- Assign dimension ID
    … …  
    402407
    403408   !-- Define variable associated with dimension
    404    CALL binary_init_variable( file_id, var_id, dim_name, dim_type, &
    405                               (/dim_id/), is_init, .TRUE., return_value )
     409   CALL binary_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
     410                              is_global=.TRUE., return_value=return_value )
    406411   IF ( return_value /= 0 )  THEN
    407       is_init = .FALSE.
    408412      CALL internal_message( 'error', routine_name // &
    409413                                      ': init dimension "' // TRIM( dim_name ) // '"' )
    … …  
    417421!> Initialize variable. Write information of variable into file header.
    418422!--------------------------------------------------------------------------------------------------!
    419 SUBROUTINE binary_init_variable( file_id, var_id, var_name, var_type, &
    420                                  var_dim_ids, is_init, is_global, return_value )
     423SUBROUTINE binary_init_variable( mode, file_id, var_id, var_name, var_type, &
     424                                 var_dim_ids, is_global, return_value )
    421425
    422426   CHARACTER(LEN=charlen)             ::  out_str   !< output string
    423427   CHARACTER(LEN=charlen), INTENT(IN) ::  var_name  !< name of variable
    424428   CHARACTER(LEN=charlen), INTENT(IN) ::  var_type  !< data type of variable
     429   CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
    425430
    426431   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
    … …  
    433438
    434439   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    435    LOGICAL, INTENT(OUT) ::  is_init    !< true if variable is initialized
    436440
    437441
    … …  
    440444   CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( var_name ) )
    441445
    442    IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning
     446   !-- Check mode (not required, added for compatibility reasons only)
     447   IF ( TRIM( mode ) == mode_binary )  CONTINUE
     448
     449   !-- Check if variable is global (not required, added for compatibility reasons only)
     450   IF ( is_global )  CONTINUE
    443451
    444452   !-- Assign variable ID
    … …  
    454462   WRITE( file_id )  SIZE( var_dim_ids )
    455463   WRITE( file_id )  var_dim_ids
    456 
    457    !-- Variable is initialised
    458    is_init = return_value == 0
    459464
    460465END SUBROUTINE binary_init_variable
    … …  
    504509              return_value )
    505510
     511   CHARACTER(LEN=charlen) ::  out_str  !< output string
     512
    506513   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
    507514
    … …  
    567574      !-- 8bit integer output
    568575      IF ( PRESENT( var_int8_0d ) )  THEN
     576         out_str = 'int8'
     577         WRITE( file_id )  out_str
    569578         WRITE( file_id )  var_int8_0d
    570579      ELSEIF ( PRESENT( var_int8_1d ) )  THEN
     580         out_str = 'int8'
     581         WRITE( file_id )  out_str
    571582         WRITE( file_id )  var_int8_1d
    572583      ELSEIF ( PRESENT( var_int8_2d ) )  THEN
     584         out_str = 'int8'
     585         WRITE( file_id )  out_str
    573586         WRITE( file_id )  var_int8_2d
    574587      ELSEIF ( PRESENT( var_int8_3d ) )  THEN
     588         out_str = 'int8'
     589         WRITE( file_id )  out_str
    575590         WRITE( file_id )  var_int8_3d
    576591      !-- 16bit integer output
    577592      ELSEIF ( PRESENT( var_int16_0d ) )  THEN
     593         out_str = 'int16'
     594         WRITE( file_id )  out_str
    578595         WRITE( file_id )  var_int16_0d
    579596      ELSEIF ( PRESENT( var_int16_1d ) )  THEN
     597         out_str = 'int16'
     598         WRITE( file_id )  out_str
    580599         WRITE( file_id )  var_int16_1d
    581600      ELSEIF ( PRESENT( var_int16_2d ) )  THEN
     601         out_str = 'int16'
     602         WRITE( file_id )  out_str
    582603         WRITE( file_id )  var_int16_2d
    583604      ELSEIF ( PRESENT( var_int16_3d ) )  THEN
     605         out_str = 'int16'
     606         WRITE( file_id )  out_str
    584607         WRITE( file_id )  var_int16_3d
    585608      !-- 32bit integer output
    586609      ELSEIF ( PRESENT( var_int32_0d ) )  THEN
     610         out_str = 'int32'
     611         WRITE( file_id )  out_str
    587612         WRITE( file_id )  var_int32_0d
    588613      ELSEIF ( PRESENT( var_int32_1d ) )  THEN
     614         out_str = 'int32'
     615         WRITE( file_id )  out_str
    589616         WRITE( file_id )  var_int32_1d
    590617      ELSEIF ( PRESENT( var_int32_2d ) )  THEN
     618         out_str = 'int32'
     619         WRITE( file_id )  out_str
    591620         WRITE( file_id )  var_int32_2d
    592621      ELSEIF ( PRESENT( var_int32_3d ) )  THEN
     622         out_str = 'int32'
     623         WRITE( file_id )  out_str
    593624         WRITE( file_id )  var_int32_3d
    594625      !-- working-precision integer output
    595626      ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
     627         out_str = 'intwp'
     628         WRITE( file_id )  out_str
    596629         WRITE( file_id )  var_intwp_0d
    597630      ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
     631         out_str = 'intwp'
     632         WRITE( file_id )  out_str
    598633         WRITE( file_id )  var_intwp_1d
    599634      ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
     635         out_str = 'intwp'
     636         WRITE( file_id )  out_str
    600637         WRITE( file_id )  var_intwp_2d
    601638      ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
     639         out_str = 'intwp'
     640         WRITE( file_id )  out_str
    602641         WRITE( file_id )  var_intwp_3d
    603642      !-- 32bit real output
    604643      ELSEIF ( PRESENT( var_real32_0d ) )  THEN
     644         out_str = 'real32'
     645         WRITE( file_id )  out_str
    605646         WRITE( file_id )  var_real32_0d
    606647      ELSEIF ( PRESENT( var_real32_1d ) )  THEN
     648         out_str = 'real32'
     649         WRITE( file_id )  out_str
    607650         WRITE( file_id )  var_real32_1d
    608651      ELSEIF ( PRESENT( var_real32_2d ) )  THEN
     652         out_str = 'real32'
     653         WRITE( file_id )  out_str
    609654         WRITE( file_id )  var_real32_2d
    610655      ELSEIF ( PRESENT( var_real32_3d ) )  THEN
     656         out_str = 'real32'
     657         WRITE( file_id )  out_str
    611658         WRITE( file_id )  var_real32_3d
    612659      !-- 64bit real output
    613660      ELSEIF ( PRESENT( var_real64_0d ) )  THEN
     661         out_str = 'real64'
     662         WRITE( file_id )  out_str
    614663         WRITE( file_id )  var_real64_0d
    615664      ELSEIF ( PRESENT( var_real64_1d ) )  THEN
     665         out_str = 'real64'
     666         WRITE( file_id )  out_str
    616667         WRITE( file_id )  var_real64_1d
    617668      ELSEIF ( PRESENT( var_real64_2d ) )  THEN
     669         out_str = 'real64'
     670         WRITE( file_id )  out_str
    618671         WRITE( file_id )  var_real64_2d
    619672      ELSEIF ( PRESENT( var_real64_3d ) )  THEN
     673         out_str = 'real64'
     674         WRITE( file_id )  out_str
    620675         WRITE( file_id )  var_real64_3d
    621676      !-- working-precision real output
    622677      ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
     678         out_str = 'realwp'
     679         WRITE( file_id )  out_str
    623680         WRITE( file_id )  var_realwp_0d
    624681      ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
     682         out_str = 'realwp'
     683         WRITE( file_id )  out_str
    625684         WRITE( file_id )  var_realwp_1d
    626685      ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
     686         out_str = 'realwp'
     687         WRITE( file_id )  out_str
    627688         WRITE( file_id )  var_realwp_2d
    628689      ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
     690         out_str = 'realwp'
     691         WRITE( file_id )  out_str
    629692         WRITE( file_id )  var_realwp_3d
    630693      ELSE
    631694         return_value = 1
    632          WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
    633          CALL internal_message( 'error', routine_name // &
    634                                          TRIM( temp_string ) // ': no values given' )
     695         CALL internal_message( 'error', routine_name // ': no values given' )
    635696      ENDIF
    636697
    … …  
    706767   IF ( TRIM( level ) == 'error' )  THEN
    707768
    708       WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
     769      WRITE( internal_error_message, '(A,A)' ) ': ', string
    709770
    710771   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |