Changeset 4141 for palm/trunk/SOURCE/data_output_binary_module.f90
- Timestamp:
- Aug 5, 2019 12:24:51 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_binary_module.f90 (modified) (29 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_binary_module.f90
r4123 r4141 52 52 IMPLICIT NONE 53 53 54 INTEGER (iwp), PARAMETER :: charlen = 100_iwp!< maximum length of character variables54 INTEGER, PARAMETER :: charlen = 100 !< maximum length of character variables 55 55 56 56 CHARACTER(LEN=*), PARAMETER :: config_file_name = 'BINARY_TO_NETCDF_CONFIG' !< name of config file … … 62 62 CHARACTER(LEN=800) :: temp_string !< dummy string 63 63 64 INTEGER (iwp):: binary_file_lowest_unit = 1000 !< lowest unit number of all binary files created by this module65 INTEGER (iwp):: config_file_unit !< unit number of config file66 INTEGER (iwp):: debug_output_unit !< Fortran Unit Number of the debug-output file67 INTEGER (iwp):: global_id_in_file = -1 !< value of global ID within a file68 INTEGER 69 INTEGER (iwp):: next_available_unit !< next unit number available for new file70 INTEGER 71 72 INTEGER (iwp), DIMENSION(:), ALLOCATABLE :: files_highest_var_id !< highest assigned ID of variable or dimension in a file64 INTEGER :: binary_file_lowest_unit = 1000 !< lowest unit number of all binary files created by this module 65 INTEGER :: config_file_unit !< unit number of config file 66 INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file 67 INTEGER :: global_id_in_file = -1 !< value of global ID within a file 68 INTEGER :: master_rank !< master rank for tasks to be executed by single PE only 69 INTEGER :: next_available_unit !< next unit number available for new file 70 INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output 71 72 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id !< highest assigned ID of variable or dimension in a file 73 73 74 74 LOGICAL :: binary_open_file_first_call = .TRUE. !< true if binary_open_file routine was not called yet … … 100 100 END INTERFACE binary_write_attribute 101 101 102 INTERFACE binary_ init_end103 MODULE PROCEDURE binary_ init_end104 END INTERFACE binary_ init_end102 INTERFACE binary_stop_file_header_definition 103 MODULE PROCEDURE binary_stop_file_header_definition 104 END INTERFACE binary_stop_file_header_definition 105 105 106 106 INTERFACE binary_write_variable … … 120 120 binary_get_error_message, & 121 121 binary_init_dimension, & 122 binary_ init_end, &122 binary_stop_file_header_definition, & 123 123 binary_init_module, & 124 124 binary_init_variable, & … … 143 143 !> must be unique for each output group 144 144 145 INTEGER (iwp), INTENT(IN) :: dom_global_id !< global id within a file defined by DOM146 INTEGER, 147 INTEGER, 148 INTEGER (iwp), INTENT(IN) :: program_debug_output_unit !< file unit number for debug output145 INTEGER, INTENT(IN) :: dom_global_id !< global id within a file defined by DOM 146 INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be executed by a single PE 147 INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output 148 INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output 149 149 150 150 LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed … … 167 167 !> Open binary file. 168 168 !--------------------------------------------------------------------------------------------------! 169 SUBROUTINE binary_open_file( mode, file name, file_id, return_value )169 SUBROUTINE binary_open_file( mode, file_name, file_id, return_value ) 170 170 171 171 CHARACTER(LEN=charlen) :: bin_filename = '' !< actual name of binary file 172 CHARACTER(LEN=charlen), INTENT(IN) :: file name!< name of file172 CHARACTER(LEN=charlen), INTENT(IN) :: file_name !< name of file 173 173 CHARACTER(LEN=7) :: my_rank_char !< string containing value of my_rank with leading zeros 174 174 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode … … 176 176 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_open_file' !< name of this routine 177 177 178 INTEGER (iwp), INTENT(OUT) :: file_id !< file ID179 INTEGER 180 INTEGER :: nrank!< number of MPI ranks participating in output181 INTEGER (iwp), INTENT(OUT) :: return_value !< return value182 183 INTEGER (iwp), DIMENSION(:), ALLOCATABLE :: files_highest_var_id_tmp !< temporary list of given variable IDs in file178 INTEGER, INTENT(OUT) :: file_id !< file ID 179 INTEGER :: my_rank !< MPI rank of local processor 180 INTEGER :: nranks !< number of MPI ranks participating in output 181 INTEGER, INTENT(OUT) :: return_value !< return value 182 183 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id_tmp !< temporary list of given variable IDs in file 184 184 185 185 LOGICAL :: file_exists !< true if file to be opened already exists … … 189 189 190 190 #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 ) 192 192 IF ( return_value == 0 ) CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value ) 193 193 IF ( return_value == 0 ) THEN … … 197 197 ENDIF 198 198 #else 199 nrank = 1199 nranks = 1 200 200 my_rank = master_rank 201 201 WRITE( my_rank_char, '("_",I6.6)' ) my_rank … … 237 237 238 238 !-- Write some general information to config file 239 WRITE( config_file_unit ) nrank 239 WRITE( config_file_unit ) nranks 240 240 WRITE( config_file_unit ) master_rank 241 241 WRITE( config_file_unit ) LEN( file_prefix ) … … 260 260 IF ( return_value == 0 ) THEN 261 261 262 bin_filename = file_prefix // TRIM( file name ) // TRIM( file_suffix ) // my_rank_char262 bin_filename = file_prefix // TRIM( file_name ) // TRIM( file_suffix ) // my_rank_char 263 263 264 264 !-- Remove any pre-existing file … … 267 267 IF ( file_exists ) THEN 268 268 CALL internal_message( 'debug', routine_name // & 269 269 ': remove existing file ' // TRIM( bin_filename ) ) 270 270 !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by 271 271 !> PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used … … 282 282 IF ( return_value == 0 ) THEN 283 283 284 !-- Add file name to config file284 !-- Add file_name to config file 285 285 IF ( my_rank == master_rank ) THEN 286 WRITE( config_file_unit ) file name286 WRITE( config_file_unit ) file_name 287 287 ENDIF 288 288 … … 294 294 WRITE ( file_id ) charlen 295 295 WRITE ( file_id ) file_id 296 WRITE ( file_id ) file name296 WRITE ( file_id ) file_name 297 297 298 298 !-- Extend file-variable/dimension-ID list by 1 and set it to 0 for new file. 299 IF ( ALLOCATED( files_highest_var _id ) ) THEN300 ALLOCATE( files_highest_var _id_tmp(SIZE( files_highest_var_id )) )301 files_highest_var _id_tmp = files_highest_var_id302 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_tmp305 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 ) 306 306 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) ) 308 308 ENDIF 309 files_highest_var _id(file_id) = 0_iwp309 files_highest_variable_id(file_id) = 0 310 310 311 311 ELSE 312 312 return_value = 1 313 313 CALL internal_message( 'error', routine_name // & 314 ': could not open file "' // TRIM( filename ) // '"')314 ': could not open file "' // TRIM( file_name ) // '"') 315 315 ENDIF 316 316 … … 324 324 !> Write attribute to file. 325 325 !--------------------------------------------------------------------------------------------------! 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 )326 SUBROUTINE binary_write_attribute( file_id, variable_id, attribute_name, & 327 value_char, value_int8, value_int16, value_int32, & 328 value_real32, value_real64, return_value ) 329 329 330 330 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_attribute' !< name of this routine 331 331 332 CHARACTER(LEN=charlen), INTENT(IN) :: att _name !< name of attribute333 CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL :: att_value_char !< value of attribute334 CHARACTER(LEN=charlen) :: att _type !< data type of attribute335 CHARACTER(LEN=charlen) :: out _str!< output string336 337 INTEGER(KIND=1), INTENT(IN), OPTIONAL :: att_value_int8 !< value of attribute338 INTEGER(KIND=2), INTENT(IN), OPTIONAL :: att_value_int16 !< value of attribute339 INTEGER(KIND=4), INTENT(IN), OPTIONAL :: att_value_int32 !< value of attribute340 341 INTEGER (iwp), INTENT(IN) :: file_id !< file ID342 INTEGER (iwp), INTENT(IN) :: var_id!< variable ID343 INTEGER (iwp), INTENT(OUT) :: return_value !< return value344 345 REAL(KIND=4), INTENT(IN), OPTIONAL :: att_value_real32 !< value of attribute346 REAL(KIND=8), INTENT(IN), OPTIONAL :: att_value_real64 !< value of attribute332 CHARACTER(LEN=charlen), INTENT(IN) :: attribute_name !< name of attribute 333 CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL :: value_char !< value of attribute 334 CHARACTER(LEN=charlen) :: attribute_type !< data type of attribute 335 CHARACTER(LEN=charlen) :: output_string !< output string 336 337 INTEGER(KIND=1), INTENT(IN), OPTIONAL :: value_int8 !< value of attribute 338 INTEGER(KIND=2), INTENT(IN), OPTIONAL :: value_int16 !< value of attribute 339 INTEGER(KIND=4), INTENT(IN), OPTIONAL :: value_int32 !< value of attribute 340 341 INTEGER, INTENT(IN) :: file_id !< file ID 342 INTEGER, INTENT(IN) :: variable_id !< variable ID 343 INTEGER, INTENT(OUT) :: return_value !< return value 344 345 REAL(KIND=4), INTENT(IN), OPTIONAL :: value_real32 !< value of attribute 346 REAL(KIND=8), INTENT(IN), OPTIONAL :: value_real64 !< value of attribute 347 347 348 348 … … 350 350 351 351 CALL internal_message( 'debug', TRIM( routine_name ) // & 352 ': write attribute ' // TRIM( att_name ) )352 ': write attribute ' // TRIM( attribute_name ) ) 353 353 354 354 !-- Write attribute to file 355 out _str= 'attribute'356 WRITE( file_id ) out _str357 358 WRITE( file_id ) var _id359 WRITE( file_id ) att _name360 361 IF ( PRESENT( att_value_char ) ) THEN362 att _type = 'char'363 WRITE( file_id ) att _type364 WRITE( file_id ) att_value_char365 ELSEIF ( PRESENT( att_value_int8 ) ) THEN366 att _type = 'int8'367 WRITE( file_id ) att _type368 WRITE( file_id ) att_value_int8369 ELSEIF ( PRESENT( att_value_int16 ) ) THEN370 att _type = 'int16'371 WRITE( file_id ) att _type372 WRITE( file_id ) att_value_int16373 ELSEIF ( PRESENT( att_value_int32 ) ) THEN374 att _type = 'int32'375 WRITE( file_id ) att _type376 WRITE( file_id ) att_value_int32377 ELSEIF ( PRESENT( att_value_real32 ) ) THEN378 att _type = 'real32'379 WRITE( file_id ) att _type380 WRITE( file_id ) att_value_real32381 ELSEIF ( PRESENT( att_value_real64 ) ) THEN382 att _type = 'real64'383 WRITE( file_id ) att _type384 WRITE( file_id ) att_value_real64355 output_string = 'attribute' 356 WRITE( file_id ) output_string 357 358 WRITE( file_id ) variable_id 359 WRITE( file_id ) attribute_name 360 361 IF ( PRESENT( value_char ) ) THEN 362 attribute_type = 'char' 363 WRITE( file_id ) attribute_type 364 WRITE( file_id ) value_char 365 ELSEIF ( PRESENT( value_int8 ) ) THEN 366 attribute_type = 'int8' 367 WRITE( file_id ) attribute_type 368 WRITE( file_id ) value_int8 369 ELSEIF ( PRESENT( value_int16 ) ) THEN 370 attribute_type = 'int16' 371 WRITE( file_id ) attribute_type 372 WRITE( file_id ) value_int16 373 ELSEIF ( PRESENT( value_int32 ) ) THEN 374 attribute_type = 'int32' 375 WRITE( file_id ) attribute_type 376 WRITE( file_id ) value_int32 377 ELSEIF ( PRESENT( value_real32 ) ) THEN 378 attribute_type = 'real32' 379 WRITE( file_id ) attribute_type 380 WRITE( file_id ) value_real32 381 ELSEIF ( PRESENT( value_real64 ) ) THEN 382 attribute_type = 'real64' 383 WRITE( file_id ) attribute_type 384 WRITE( file_id ) value_real64 385 385 ELSE 386 386 return_value = 1 387 387 CALL internal_message( 'error', TRIM( routine_name ) // & 388 ': attribute "' // TRIM( att_name ) // '": no value given' )388 ': no value given for attribute "' // TRIM( attribute_name ) // '"' ) 389 389 ENDIF 390 390 … … 394 394 ! Description: 395 395 ! ------------ 396 !> Initialize dimension. Write information in file header and save dimension397 !> 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 dimension403 CHARACTER(LEN=charlen), INTENT(IN) :: dim _type !< data type of dimension404 CHARACTER(LEN=charlen) :: out _str!< output string405 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode396 !> Initialize dimension. Write information in file header 397 !> and save dimension values to be later written to file. 398 !--------------------------------------------------------------------------------------------------! 399 SUBROUTINE binary_init_dimension( mode, file_id, dimension_id, variable_id, & 400 dimension_name, dimension_type, dimension_length, return_value ) 401 402 CHARACTER(LEN=charlen), INTENT(IN) :: dimension_name !< name of dimension 403 CHARACTER(LEN=charlen), INTENT(IN) :: dimension_type !< data type of dimension 404 CHARACTER(LEN=charlen) :: output_string !< output string 405 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode 406 406 407 407 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_dimension' !< name of this routine 408 408 409 INTEGER (iwp), INTENT(OUT) :: dim_id!< dimension ID410 INTEGER (iwp), INTENT(IN) :: dim_length!< length of dimension411 INTEGER (iwp), INTENT(IN) :: file_id!< file ID412 INTEGER (iwp), INTENT(OUT) :: return_value!< return value413 INTEGER (iwp), INTENT(OUT) :: var_id!< variable ID409 INTEGER, INTENT(OUT) :: dimension_id !< dimension ID 410 INTEGER, INTENT(IN) :: dimension_length !< length of dimension 411 INTEGER, INTENT(IN) :: file_id !< file ID 412 INTEGER, INTENT(OUT) :: return_value !< return value 413 INTEGER, INTENT(OUT) :: variable_id !< variable ID 414 414 415 415 416 416 return_value = 0 417 417 418 CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dim _name ) )418 CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) ) 419 419 420 420 !-- Check mode (not required, added for compatibility reasons only) … … 422 422 423 423 !-- Assign dimension ID 424 dim _id = files_highest_var_id( file_id ) + 1425 files_highest_var _id( file_id ) = dim_id424 dimension_id = files_highest_variable_id( file_id ) + 1 425 files_highest_variable_id( file_id ) = dimension_id 426 426 427 427 !-- Define dimension in file 428 out _str= 'dimension'429 WRITE( file_id ) out _str430 WRITE( file_id ) dim _name431 WRITE( file_id ) dim _id432 WRITE( file_id ) dim _type433 WRITE( file_id ) dim _length428 output_string = 'dimension' 429 WRITE( file_id ) output_string 430 WRITE( file_id ) dimension_name 431 WRITE( file_id ) dimension_id 432 WRITE( file_id ) dimension_type 433 WRITE( file_id ) dimension_length 434 434 435 435 !-- 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 ) 438 438 IF ( return_value /= 0 ) THEN 439 439 CALL internal_message( 'error', routine_name // & 440 ': init dimension "' // TRIM( dim_name ) // '"' )440 ': init dimension "' // TRIM( dimension_name ) // '"' ) 441 441 ENDIF 442 442 … … 448 448 !> Initialize variable. Write information of variable into file header. 449 449 !--------------------------------------------------------------------------------------------------! 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 string454 CHARACTER(LEN=charlen), INTENT(IN) :: var _name!< name of variable455 CHARACTER(LEN=charlen), INTENT(IN) :: var _type!< data type of variable456 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode450 SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 451 dimension_ids, is_global, return_value ) 452 453 CHARACTER(LEN=charlen) :: output_string !< output string 454 CHARACTER(LEN=charlen), INTENT(IN) :: variable_name !< name of variable 455 CHARACTER(LEN=charlen), INTENT(IN) :: variable_type !< data type of variable 456 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode 457 457 458 458 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_variable' !< name of this routine 459 459 460 INTEGER (iwp), INTENT(IN) :: file_id !< file ID461 INTEGER (iwp), INTENT(OUT) :: var_id!< variable ID462 INTEGER (iwp), INTENT(OUT) :: return_value !< return value463 464 INTEGER (iwp), DIMENSION(:), INTENT(IN) :: var_dim_ids !< list of dimension IDs used by variable460 INTEGER, INTENT(IN) :: file_id !< file ID 461 INTEGER, INTENT(OUT) :: variable_id !< variable ID 462 INTEGER, INTENT(OUT) :: return_value !< return value 463 464 INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable 465 465 466 466 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE) … … 469 469 return_value = 0 470 470 471 CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( var _name ) )471 CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) ) 472 472 473 473 !-- Check mode (not required, added for compatibility reasons only) … … 478 478 479 479 !-- Assign variable ID 480 var _id = files_highest_var_id( file_id ) + 1481 files_highest_var _id( file_id ) = var_id480 variable_id = files_highest_variable_id( file_id ) + 1 481 files_highest_variable_id( file_id ) = variable_id 482 482 483 483 !-- Write variable information in file 484 out _str= 'variable'485 WRITE( file_id ) out _str486 WRITE( file_id ) var _name487 WRITE( file_id ) var _id488 WRITE( file_id ) var _type489 WRITE( file_id ) SIZE( var_dim_ids )490 WRITE( file_id ) var_dim_ids484 output_string = 'variable' 485 WRITE( file_id ) output_string 486 WRITE( file_id ) variable_name 487 WRITE( file_id ) variable_id 488 WRITE( file_id ) variable_type 489 WRITE( file_id ) SIZE( dimension_ids ) 490 WRITE( file_id ) dimension_ids 491 491 492 492 END SUBROUTINE binary_init_variable … … 497 497 !> Leave file definition state. 498 498 !--------------------------------------------------------------------------------------------------! 499 SUBROUTINE binary_ init_end( file_id, return_value )500 501 CHARACTER(LEN=charlen) :: out _str!< output string502 503 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_ init_end' !< name of this routine504 505 INTEGER (iwp), INTENT(IN) :: file_id !< file ID506 INTEGER (iwp), INTENT(OUT) :: return_value !< return value499 SUBROUTINE binary_stop_file_header_definition( file_id, return_value ) 500 501 CHARACTER(LEN=charlen) :: output_string !< output string 502 503 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_stop_file_header_definition' !< name of this routine 504 505 INTEGER, INTENT(IN) :: file_id !< file ID 506 INTEGER, INTENT(OUT) :: return_value !< return value 507 507 508 508 … … 510 510 511 511 WRITE( temp_string, * ) file_id 512 CALL internal_message( 'debug', & 513 routine_name // & 512 CALL internal_message( 'debug', routine_name // & 514 513 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 515 514 516 out _str= '*** end file header ***'517 WRITE( file_id ) out _str518 519 END SUBROUTINE binary_ init_end515 output_string = '*** end file header ***' 516 WRITE( file_id ) output_string 517 518 END SUBROUTINE binary_stop_file_header_definition 520 519 521 520 !--------------------------------------------------------------------------------------------------! … … 524 523 !> Write variable to file. 525 524 !--------------------------------------------------------------------------------------------------! 526 SUBROUTINE binary_write_variable( &527 file_id, var _id, bounds_start, value_counts, bounds_origin,&528 is_global, &529 va r_int8_0d, var_int8_1d, var_int8_2d, var_int8_3d, &530 va r_int16_0d, var_int16_1d, var_int16_2d, var_int16_3d, &531 va r_int32_0d, var_int32_1d, var_int32_2d, var_int32_3d, &532 va r_intwp_0d, var_intwp_1d, var_intwp_2d, var_intwp_3d, &533 va r_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &534 va r_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &535 va r_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &525 SUBROUTINE binary_write_variable( & 526 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 527 is_global, & 528 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 529 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 530 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 531 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 532 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 533 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 534 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, & 536 535 return_value ) 537 536 538 CHARACTER(LEN=charlen) :: out _str!< output string537 CHARACTER(LEN=charlen) :: output_string !< output string 539 538 540 539 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_variable' !< name of this routine 541 540 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 569 565 570 566 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE) 571 567 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 586 580 587 581 588 582 return_value = 0 589 583 590 WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) var _id, file_id584 WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id 591 585 CALL internal_message( 'debug', routine_name // TRIM( temp_string ) ) 592 586 … … 594 588 595 589 IF ( .NOT. ANY( value_counts == 0 ) ) THEN 596 WRITE( file_id ) var _id590 WRITE( file_id ) variable_id 597 591 WRITE( file_id ) bounds_start 598 592 WRITE( file_id ) value_counts 599 593 WRITE( file_id ) bounds_origin 600 594 !-- 8bit integer output 601 IF ( PRESENT( va r_int8_0d ) ) THEN602 out _str= 'int8'603 WRITE( file_id ) out _str604 WRITE( file_id ) va r_int8_0d605 ELSEIF ( PRESENT( va r_int8_1d ) ) THEN606 out _str= 'int8'607 WRITE( file_id ) out _str608 WRITE( file_id ) va r_int8_1d609 ELSEIF ( PRESENT( va r_int8_2d ) ) THEN610 out _str= 'int8'611 WRITE( file_id ) out _str612 WRITE( file_id ) va r_int8_2d613 ELSEIF ( PRESENT( va r_int8_3d ) ) THEN614 out _str= 'int8'615 WRITE( file_id ) out _str616 WRITE( file_id ) va r_int8_3d595 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 617 611 !-- 16bit integer output 618 ELSEIF ( PRESENT( va r_int16_0d ) ) THEN619 out _str= 'int16'620 WRITE( file_id ) out _str621 WRITE( file_id ) va r_int16_0d622 ELSEIF ( PRESENT( va r_int16_1d ) ) THEN623 out _str= 'int16'624 WRITE( file_id ) out _str625 WRITE( file_id ) va r_int16_1d626 ELSEIF ( PRESENT( va r_int16_2d ) ) THEN627 out _str= 'int16'628 WRITE( file_id ) out _str629 WRITE( file_id ) va r_int16_2d630 ELSEIF ( PRESENT( va r_int16_3d ) ) THEN631 out _str= 'int16'632 WRITE( file_id ) out _str633 WRITE( file_id ) va r_int16_3d612 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 634 628 !-- 32bit integer output 635 ELSEIF ( PRESENT( va r_int32_0d ) ) THEN636 out _str= 'int32'637 WRITE( file_id ) out _str638 WRITE( file_id ) va r_int32_0d639 ELSEIF ( PRESENT( va r_int32_1d ) ) THEN640 out _str= 'int32'641 WRITE( file_id ) out _str642 WRITE( file_id ) va r_int32_1d643 ELSEIF ( PRESENT( va r_int32_2d ) ) THEN644 out _str= 'int32'645 WRITE( file_id ) out _str646 WRITE( file_id ) va r_int32_2d647 ELSEIF ( PRESENT( va r_int32_3d ) ) THEN648 out _str= 'int32'649 WRITE( file_id ) out _str650 WRITE( file_id ) va r_int32_3d629 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 651 645 !-- working-precision integer output 652 ELSEIF ( PRESENT( va r_intwp_0d ) ) THEN653 out _str= 'intwp'654 WRITE( file_id ) out _str655 WRITE( file_id ) va r_intwp_0d656 ELSEIF ( PRESENT( va r_intwp_1d ) ) THEN657 out _str= 'intwp'658 WRITE( file_id ) out _str659 WRITE( file_id ) va r_intwp_1d660 ELSEIF ( PRESENT( va r_intwp_2d ) ) THEN661 out _str= 'intwp'662 WRITE( file_id ) out _str663 WRITE( file_id ) va r_intwp_2d664 ELSEIF ( PRESENT( va r_intwp_3d ) ) THEN665 out _str= 'intwp'666 WRITE( file_id ) out _str667 WRITE( file_id ) va r_intwp_3d646 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 668 662 !-- 32bit real output 669 ELSEIF ( PRESENT( va r_real32_0d ) ) THEN670 out _str= 'real32'671 WRITE( file_id ) out _str672 WRITE( file_id ) va r_real32_0d673 ELSEIF ( PRESENT( va r_real32_1d ) ) THEN674 out _str= 'real32'675 WRITE( file_id ) out _str676 WRITE( file_id ) va r_real32_1d677 ELSEIF ( PRESENT( va r_real32_2d ) ) THEN678 out _str= 'real32'679 WRITE( file_id ) out _str680 WRITE( file_id ) va r_real32_2d681 ELSEIF ( PRESENT( va r_real32_3d ) ) THEN682 out _str= 'real32'683 WRITE( file_id ) out _str684 WRITE( file_id ) va r_real32_3d663 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 685 679 !-- 64bit real output 686 ELSEIF ( PRESENT( va r_real64_0d ) ) THEN687 out _str= 'real64'688 WRITE( file_id ) out _str689 WRITE( file_id ) va r_real64_0d690 ELSEIF ( PRESENT( va r_real64_1d ) ) THEN691 out _str= 'real64'692 WRITE( file_id ) out _str693 WRITE( file_id ) va r_real64_1d694 ELSEIF ( PRESENT( va r_real64_2d ) ) THEN695 out _str= 'real64'696 WRITE( file_id ) out _str697 WRITE( file_id ) va r_real64_2d698 ELSEIF ( PRESENT( va r_real64_3d ) ) THEN699 out _str= 'real64'700 WRITE( file_id ) out _str701 WRITE( file_id ) va r_real64_3d680 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 702 696 !-- working-precision real output 703 ELSEIF ( PRESENT( va r_realwp_0d ) ) THEN704 out _str= 'realwp'705 WRITE( file_id ) out _str706 WRITE( file_id ) va r_realwp_0d707 ELSEIF ( PRESENT( va r_realwp_1d ) ) THEN708 out _str= 'realwp'709 WRITE( file_id ) out _str710 WRITE( file_id ) va r_realwp_1d711 ELSEIF ( PRESENT( va r_realwp_2d ) ) THEN712 out _str= 'realwp'713 WRITE( file_id ) out _str714 WRITE( file_id ) va r_realwp_2d715 ELSEIF ( PRESENT( va r_realwp_3d ) ) THEN716 out _str= 'realwp'717 WRITE( file_id ) out _str718 WRITE( file_id ) va r_realwp_3d697 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 719 713 ELSE 720 714 return_value = 1 … … 733 727 SUBROUTINE binary_finalize( file_id, return_value ) 734 728 735 CHARACTER(LEN=charlen) :: out _str!< output string729 CHARACTER(LEN=charlen) :: output_string !< output string 736 730 737 731 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_finalize' !< name of this routine 738 732 739 INTEGER (iwp), INTENT(IN) :: file_id !< file ID740 INTEGER (iwp), INTENT(OUT) :: return_value !< return value733 INTEGER, INTENT(IN) :: file_id !< file ID 734 INTEGER, INTENT(OUT) :: return_value !< return value 741 735 742 736 743 737 IF ( config_file_open ) THEN 744 738 745 out _str= '*** end config file ***'746 WRITE( config_file_unit ) out _str739 output_string = '*** end config file ***' 740 WRITE( config_file_unit ) output_string 747 741 748 742 CLOSE( config_file_unit, IOSTAT=return_value ) … … 762 756 IF ( return_value == 0 ) THEN 763 757 764 WRITE( temp_string,*) file_id758 WRITE( temp_string, * ) file_id 765 759 CALL internal_message( 'debug', routine_name // & 766 760 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 767 761 768 762 CLOSE( file_id, IOSTAT=return_value ) 769 763 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 // & 773 766 ': cannot close file (file_id=' // TRIM( temp_string ) // ')' ) 774 767 ENDIF … … 778 771 END SUBROUTINE binary_finalize 779 772 780 781 773 !--------------------------------------------------------------------------------------------------! 782 774 ! Description: … … 809 801 !> Return the last created error message. 810 802 !--------------------------------------------------------------------------------------------------! 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 803 FUNCTION binary_get_error_message() RESULT( error_message ) 804 805 CHARACTER(LEN=800) :: error_message !< return error message to main program 806 807 808 error_message = TRIM( internal_error_message ) 809 810 internal_error_message = '' 811 812 END FUNCTION binary_get_error_message 820 813 821 814 END MODULE data_output_binary_module
Note: See TracChangeset
for help on using the changeset viewer.
