- Timestamp:
- Jul 9, 2020 7:21:53 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 3 edited
-
data_output_binary_module.f90 (modified) (26 diffs)
-
data_output_module.f90 (modified) (57 diffs)
-
data_output_netcdf4_module.f90 (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_binary_module.f90
r4579 r4597 24 24 ! ----------------- 25 25 ! $Id$ 26 ! change: update argument list of routine binary_init_dimension due to changes in interface 27 ! 28 ! 4579 2020-06-25 20:05:07Z gronemeier 26 29 ! corrected formatting to follow PALM coding standard 27 30 ! … … 68 71 INCLUDE "mpif.h" 69 72 #endif 70 71 73 72 74 CHARACTER(LEN=*), PARAMETER :: config_file_name = 'BINARY_TO_NETCDF_CONFIG' !< name of config file … … 88 90 INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output 89 91 90 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id !< highest assigned ID of 91 !< variable or dimension in a file 92 93 LOGICAL :: binary_open_file_first_call = .TRUE. !< true if binary_open_file routine was not 94 !< called yet 95 LOGICAL :: config_file_open = .FALSE. !< true if config file is opened and not 96 !< closed 92 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id !< highest assigned ID of variable or dimension in a file 93 94 LOGICAL :: binary_open_file_first_call = .TRUE. !< true if binary_open_file routine was not called yet 95 LOGICAL :: config_file_open = .FALSE. !< true if config file is opened and not closed 97 96 LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed 98 97 … … 165 164 166 165 INTEGER, INTENT(IN) :: dom_global_id !< global id within a file defined by DOM 167 INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be 168 !< executed by a single PE 169 INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group 170 !< participating in output 166 INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be executed by a single PE 167 INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output 171 168 INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output 172 169 … … 174 171 175 172 176 file_suffix = file_suffix_of_output_group177 output_group_comm = mpi_comm_of_output_group178 master_rank = master_output_rank173 file_suffix = file_suffix_of_output_group 174 output_group_comm = mpi_comm_of_output_group 175 master_rank = master_output_rank 179 176 180 177 debug_output_unit = program_debug_output_unit 181 178 print_debug_output = debug_output 182 179 183 global_id_in_file = dom_global_id180 global_id_in_file = dom_global_id 184 181 185 182 END SUBROUTINE binary_init_module … … 204 201 INTEGER, INTENT(OUT) :: return_value !< return value 205 202 206 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id_tmp !< temporary list of given 207 !< variable IDs in file 203 INTEGER, DIMENSION(:), ALLOCATABLE :: files_highest_variable_id_tmp !< temporary list of given variable IDs in file 208 204 209 205 LOGICAL :: file_exists !< true if file to be opened already exists … … 238 234 ! 239 235 !-- Remove any pre-existing file 240 INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), EXIST =file_exists )236 INQUIRE( FILE=TRIM( config_file_name ) // TRIM( file_suffix ), EXIST=file_exists ) 241 237 242 238 IF ( file_exists ) THEN 243 CALL internal_message( 'debug', routine_name // ': Remove existing file ' // & 239 CALL internal_message( 'debug', routine_name // & 240 ': Remove existing file ' // & 244 241 TRIM( config_file_name ) // TRIM( file_suffix ) ) 245 242 !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by 246 243 !> PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used 247 ! CALL EXECUTE_COMMAND_LINE( 244 ! CALL EXECUTE_COMMAND_LINE( & 248 245 ! COMMAND='rm ' // TRIM( config_file_name ) // TRIM( file_suffix ), & 249 246 ! WAIT=.TRUE., EXITSTAT=return_value ) … … 288 285 289 286 IF ( file_exists ) THEN 290 CALL internal_message( 'debug', routine_name // ': remove existing file ' //&291 TRIM( bin_filename ) )287 CALL internal_message( 'debug', routine_name // & 288 ': remove existing file ' // TRIM( bin_filename ) ) 292 289 !> @note Fortran2008 feature 'EXECUTE_COMMAND_LINE' not yet supported by 293 290 !> PGI 18.10 compiler. Hence, non-standard 'SYSTEM' call must be used … … 320 317 !-- Extend file-variable/dimension-ID list by 1 and set it to 0 for new file. 321 318 IF ( ALLOCATED( files_highest_variable_id ) ) THEN 322 ALLOCATE( files_highest_variable_id_tmp( SIZE( files_highest_variable_id )) )319 ALLOCATE( files_highest_variable_id_tmp(SIZE( files_highest_variable_id )) ) 323 320 files_highest_variable_id_tmp = files_highest_variable_id 324 321 DEALLOCATE( files_highest_variable_id ) … … 333 330 ELSE 334 331 return_value = 1 335 CALL internal_message( 'error', routine_name // ': could not open file "' //&336 TRIM( file_name ) // '"')332 CALL internal_message( 'error', routine_name // & 333 ': could not open file "' // TRIM( file_name ) // '"') 337 334 ENDIF 338 335 … … 349 346 value_int16, value_int32, value_real32, value_real64, & 350 347 return_value ) 351 352 348 353 349 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_attribute' !< name of this routine … … 372 368 return_value = 0 373 369 374 CALL internal_message( 'debug', TRIM( routine_name ) // ': write attribute ' //&375 TRIM( attribute_name ) )370 CALL internal_message( 'debug', TRIM( routine_name ) // & 371 ': write attribute ' // TRIM( attribute_name ) ) 376 372 ! 377 373 !-- Write attribute to file … … 418 414 ! ------------ 419 415 !> Initialize dimension. Write information in file header and save dimension values to be later 420 ! <written to file.416 !> written to file. 421 417 !--------------------------------------------------------------------------------------------------! 422 418 SUBROUTINE binary_init_dimension( mode, file_id, dimension_id, variable_id, dimension_name, & 423 dimension_type, dimension_length, return_value ) 419 dimension_type, dimension_length, write_only_by_master_rank, & 420 return_value ) 424 421 425 422 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_dimension' !< name of this routine … … 436 433 INTEGER, INTENT(OUT) :: variable_id !< variable ID 437 434 435 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 436 438 437 439 438 return_value = 0 … … 441 440 CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dimension_name ) ) 442 441 ! 443 !-- Check mode (not required, added for compatibility reasons only)442 !-- Required for compatibility reasons 444 443 IF ( TRIM( mode ) == mode_binary ) CONTINUE 445 444 ! … … 458 457 !-- Define variable associated with dimension 459 458 CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 460 (/ dimension_id /), is_global=.TRUE., return_value=return_value ) 459 (/ dimension_id /), & 460 write_only_by_master_rank=write_only_by_master_rank, & 461 return_value=return_value ) 462 461 463 IF ( return_value /= 0 ) THEN 462 464 CALL internal_message( 'error', routine_name // & … … 472 474 !--------------------------------------------------------------------------------------------------! 473 475 SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 474 dimension_ids, is_global, return_value )476 dimension_ids, write_only_by_master_rank, return_value ) 475 477 476 478 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_variable' !< name of this routine 477 479 480 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode 478 481 CHARACTER(LEN=charlen) :: output_string !< output string 479 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode480 482 CHARACTER(LEN=charlen), INTENT(IN) :: variable_name !< name of variable 481 483 CHARACTER(LEN=charlen), INTENT(IN) :: variable_type !< data type of variable … … 487 489 INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable 488 490 489 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)491 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 490 492 491 493 … … 494 496 CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( variable_name ) ) 495 497 ! 496 !-- Check mode (not required, added for compatibility reasons only)498 !-- Required for compatibility reasons 497 499 IF ( TRIM( mode ) == mode_binary ) CONTINUE 498 ! 499 !-- Check if variable is global (not required, added for compatibility reasons only) 500 IF ( is_global ) CONTINUE 500 IF ( write_only_by_master_rank ) CONTINUE 501 501 ! 502 502 !-- Assign variable ID … … 533 533 534 534 WRITE( temp_string, * ) file_id 535 CALL internal_message( 'debug', routine_name // ': finalize file definition (file_id=' //&536 TRIM( temp_string ) // ')' )535 CALL internal_message( 'debug', routine_name // & 536 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 537 537 538 538 output_string = '*** end file header ***' … … 547 547 !--------------------------------------------------------------------------------------------------! 548 548 SUBROUTINE binary_write_variable( & 549 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 550 is_global, & 551 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 552 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 553 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 554 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 555 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 556 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 557 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 558 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, & 559 return_value ) 560 549 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 550 write_only_by_master_rank, & 551 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 552 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 553 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 554 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 555 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 556 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 557 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 558 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, & 559 return_value ) 561 560 562 561 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_variable' !< name of this routine … … 570 569 571 570 INTEGER, INTENT(IN) :: file_id !< file ID 571 INTEGER, INTENT(OUT) :: return_value !< return value 572 572 INTEGER, INTENT(IN) :: variable_id !< variable ID 573 INTEGER, INTENT(OUT) :: return_value !< return value574 573 575 574 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension … … 594 593 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable 595 594 596 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)595 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 597 596 598 597 REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable … … 614 613 WRITE( temp_string, '(": write variable ",I6," into file ",I6)' ) variable_id, file_id 615 614 CALL internal_message( 'debug', routine_name // TRIM( temp_string ) ) 616 617 IF ( is_global ) CONTINUE ! reqired to prevent compiler warning 615 ! 616 !-- Required for compatibility reasons 617 IF ( write_only_by_master_rank ) CONTINUE 618 618 619 619 IF ( .NOT. ANY( value_counts == 0 ) ) THEN … … 695 695 WRITE( file_id ) values_int32_3d 696 696 ! 697 !-- working-precision integer output697 !-- Working-precision integer output 698 698 ELSEIF ( PRESENT( values_intwp_0d ) ) THEN 699 699 output_string = 'intwp' … … 749 749 WRITE( file_id ) values_real64_3d 750 750 ! 751 !-- working-precision real output751 !-- Working-precision real output 752 752 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 753 753 output_string = 'realwp' -
palm/trunk/SOURCE/data_output_module.f90
r4579 r4597 24 24 ! ----------------- 25 25 ! $Id$ 26 ! bugfix: - write unlimited dimension in netcdf4-parallel mode 27 ! new : - added optional argument to dom_def_dim to allow that dimension variables can be written 28 ! by every PE 29 ! 30 ! 4579 2020-06-25 20:05:07Z gronemeier 26 31 ! corrected formatting to follow PALM coding standard 27 32 ! … … 116 121 117 122 TYPE variable_type 118 CHARACTER(LEN=charlen) :: data_type = ''!< data type119 CHARACTER(LEN=charlen) :: name!< variable name120 INTEGER :: id = no_id!< id within file121 LOGICAL :: is_global = .FALSE. !< true if globalvariable122 CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names 123 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids 124 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes 123 CHARACTER(LEN=charlen) :: data_type = '' !< data type 124 CHARACTER(LEN=charlen) :: name !< variable name 125 INTEGER :: id = no_id !< id within file 126 LOGICAL :: write_only_by_master_rank = .FALSE. !< true if only master rank shall write variable 127 CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names !< list of dimension names used by variable 128 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids used by variable 129 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes 125 130 END TYPE variable_type 126 131 127 132 TYPE dimension_type 128 CHARACTER(LEN=charlen) :: data_type = '' !< data type 129 CHARACTER(LEN=charlen) :: name !< dimension name 130 INTEGER :: id = no_id !< dimension id within file 131 INTEGER :: length !< length of dimension 132 INTEGER :: length_mask !< length of masked dimension 133 INTEGER :: variable_id = no_id !< associated variable id within file 134 LOGICAL :: is_masked = .FALSE. !< true if masked 133 CHARACTER(LEN=charlen) :: data_type = '' !< data type 134 CHARACTER(LEN=charlen) :: name !< dimension name 135 INTEGER :: id = no_id !< dimension id within file 136 INTEGER :: length !< length of dimension 137 INTEGER :: length_mask !< length of masked dimension 138 INTEGER :: variable_id = no_id !< associated variable id within file 139 LOGICAL :: is_masked = .FALSE. !< true if masked 140 LOGICAL :: write_only_by_master_rank = .FALSE. !< true if only master rank shall write variable 135 141 INTEGER, DIMENSION(2) :: bounds !< lower and upper bound of dimension 136 142 INTEGER, DIMENSION(:), ALLOCATABLE :: masked_indices !< list of masked indices of dimension … … 365 371 !> given which is then used to fill the entire dimension. 366 372 !> An optional mask can be given to mask limited dimensions. 373 !> Per default, a dimension is written to file only by the output master rank. However, this 374 !> behaviour can be changed via the optional parameter 'write_only_by_master_rank'. 367 375 !> Example call: 368 376 !> - fixed dimension with 100 entries (values known): … … 382 390 !> output_type='real32', bounds=(/1/), & 383 391 !> values_real32=(/fill_value/) ) 392 !> - dimension values must be written by all MPI ranks later 393 !> (e.g. the master output rank does not know all dimension values): 394 !> status = dom_def_dim( file_name='my_output_file_name', dimension_name='my_dimension', & 395 !> output_type='real32', bounds=(/1,100/), & 396 !> values_real32=(/fill_value/), write_only_by_master_rank = .FALSE. ) 384 397 !> 398 !> @note The optional argument 'write_only_by_master_rank' is set true by default to reduce the 399 !> number of file accesses. If dimension values must, however, be written by all MPI ranks 400 !> (e.g. each rank only knows parts of the values), 'write_only_by_master_rank' must be set 401 !> false to allow each rank to write values to the file for this dimension. 402 !> Values must be written after definition stage via calling dom_write_var. 385 403 !> @todo Convert given values into selected output_type. 386 404 !--------------------------------------------------------------------------------------------------! … … 388 406 values_int8, values_int16, values_int32, values_intwp, & 389 407 values_real32, values_real64, values_realwp, & 390 mask )&408 mask, write_only_by_master_rank ) & 391 409 RESULT( return_value ) 392 410 … … 401 419 INTEGER :: i !< loop index 402 420 INTEGER :: j !< loop index 403 INTEGER :: ndims = 0!< number of dimensions in file421 INTEGER :: ndims !< number of dimensions in file 404 422 INTEGER :: return_value !< return value 405 423 406 INTEGER, DIMENSION(:), INTENT(IN) :: bounds !< lower and upper bound of dimension variable 407 INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int8 !< values of dimension 408 INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int16 !< values of dimension 409 INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int32 !< values of dimension 410 INTEGER(iwp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_intwp !< values of dimension 411 412 LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: mask !< mask of dimesion 413 414 REAL(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real32 !< values of dimension 415 REAL(KIND=8), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real64 !< values of dimension 416 REAL(wp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_realwp !< values of dimension 424 INTEGER, DIMENSION(:), INTENT(IN) :: bounds !< lower and upper bound of dimension variable 425 INTEGER(KIND=1), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int8 !< values of dimension 426 INTEGER(KIND=2), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int16 !< values of dimension 427 INTEGER(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_int32 !< values of dimension 428 INTEGER(iwp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_intwp !< values of dimension 429 430 LOGICAL, INTENT(IN), OPTIONAL :: write_only_by_master_rank !< true if only master rank shall write this variable 431 432 LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: mask !< mask of dimesion 433 434 REAL(KIND=4), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real32 !< values of dimension 435 REAL(KIND=8), DIMENSION(:), INTENT(IN), OPTIONAL :: values_real64 !< values of dimension 436 REAL(wp), DIMENSION(:), INTENT(IN), OPTIONAL :: values_realwp !< values of dimension 417 437 418 438 TYPE(dimension_type) :: dimension !< new dimension … … 421 441 422 442 return_value = 0 443 ndims = 0 423 444 424 445 CALL internal_message( 'debug', routine_name // & … … 429 450 dimension%name = TRIM( dimension_name ) 430 451 dimension%data_type = TRIM( output_type ) 452 453 IF ( PRESENT( write_only_by_master_rank ) ) THEN 454 dimension%write_only_by_master_rank = write_only_by_master_rank 455 ELSE 456 dimension%write_only_by_master_rank = .TRUE. 457 ENDIF 431 458 ! 432 459 !-- Check dimension bounds and allocate dimension according to bounds … … 692 719 return_value = 1 693 720 CALL internal_message( 'error', routine_name // & 694 ': file already has a variable of this name defined. ' //&695 'Defining a dimension of the same name is not allowed ' //&696 '(dimension "' // TRIM( dimension_name ) //&697 721 ': file already has a variable of this name defined. ' // & 722 'Defining a dimension of the same name is not allowed ' // & 723 '(dimension "' // TRIM( dimension_name ) // & 724 '", file "' // TRIM( file_name ) // '")!' ) 698 725 EXIT 699 726 ENDIF … … 754 781 ! ------------ 755 782 !> Add variable to database. 756 !> If a variable is identical for each MPI rank, the optional argument 'is_global' should be set to757 !> .TRUE. This flags the variable to be a global variable and is later only written once by the758 !> master output rank.759 783 !> Example call: 760 784 !> dom_def_var( file_name = 'my_output_file_name', & … … 774 798 !> or 775 799 !> ALLOCATE( u(<z>,<y>,<x>) ) 776 !--------------------------------------------------------------------------------------------------! 777 FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, is_global ) & 800 !> @note The optional argument 'write_only_by_master_rank' can be used to reduce the number of file 801 !> accesses. If a variable is identical on each MPI rank, setting 'write_only_by_master_rank' 802 !> allows the underlying output modules to skip the write command if possible for MPI ranks 803 !> other than the master output rank. 804 !> As restrictions may apply for different output modules, it might be possible that this 805 !> option is ignored internally. Hence, all MPI ranks must still participate in the 806 !> dom_write_var calls in any case. 807 !--------------------------------------------------------------------------------------------------! 808 FUNCTION dom_def_var( file_name, variable_name, dimension_names, output_type, & 809 write_only_by_master_rank ) & 778 810 RESULT( return_value ) 779 811 … … 792 824 INTEGER :: return_value !< return value 793 825 794 LOGICAL :: found !< true if requested dimension is defined in file795 LOGICAL, INTENT(IN), OPTIONAL :: is_global !< true if variable is global (same on all PE)826 LOGICAL :: found !< true if requested dimension is defined in file 827 LOGICAL, INTENT(IN), OPTIONAL :: write_only_by_master_rank !< true if only master rank shall write this variable 796 828 797 829 TYPE(variable_type) :: variable !< new variable … … 815 847 variable%data_type = TRIM( output_type ) 816 848 817 IF ( PRESENT( is_global) ) THEN818 variable% is_global = is_global849 IF ( PRESENT( write_only_by_master_rank ) ) THEN 850 variable%write_only_by_master_rank = write_only_by_master_rank 819 851 ELSE 820 variable% is_global= .FALSE.852 variable%write_only_by_master_rank = .FALSE. 821 853 ENDIF 822 854 ! … … 830 862 return_value = 1 831 863 CALL internal_message( 'error', routine_name // & 832 ': file already initialized. No further variable definition allowed ' //&833 '(variable "' // TRIM( variable_name ) //&834 864 ': file already initialized. No further variable definition allowed ' // & 865 '(variable "' // TRIM( variable_name ) // & 866 '", file "' // TRIM( file_name ) // '")!' ) 835 867 EXIT 836 868 … … 842 874 return_value = 1 843 875 CALL internal_message( 'error', routine_name // & 844 ': file already has a dimension of this name defined. ' //&845 'Defining a variable of the same name is not allowed ' //&846 '(variable "' // TRIM( variable_name ) //&847 876 ': file already has a dimension of this name defined. ' // & 877 'Defining a variable of the same name is not allowed ' // & 878 '(variable "' // TRIM( variable_name ) // & 879 '", file "' // TRIM( file_name ) // '")!' ) 848 880 EXIT 849 881 ENDIF … … 863 895 return_value = 1 864 896 CALL internal_message( 'error', routine_name // & 865 ': required dimension "'// TRIM( variable%dimension_names(i) ) //&866 '" for variable is not defined ' //&867 '(variable "' // TRIM( variable_name ) //&868 897 ': required dimension "'// TRIM( variable%dimension_names(i) ) // & 898 '" for variable is not defined ' // & 899 '(variable "' // TRIM( variable_name ) // & 900 '", file "' // TRIM( file_name ) // '")!' ) 869 901 EXIT 870 902 ENDIF … … 976 1008 INTEGER :: return_value !< return value 977 1009 1010 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 978 1011 LOGICAL :: append_internal !< same as 'append' 979 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value980 1012 981 1013 TYPE(attribute_type) :: attribute !< new attribute … … 1039 1071 INTEGER :: return_value !< return value 1040 1072 1073 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 1041 1074 LOGICAL :: append_internal !< same as 'append' 1042 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value1043 1075 1044 1076 TYPE(attribute_type) :: attribute !< new attribute … … 1111 1143 INTEGER :: return_value !< return value 1112 1144 1145 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 1113 1146 LOGICAL :: append_internal !< same as 'append' 1114 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value1115 1147 1116 1148 TYPE(attribute_type) :: attribute !< new attribute … … 1174 1206 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_int32' !< name of routine 1175 1207 1176 1177 1208 CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute 1178 1209 CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file … … 1184 1215 INTEGER :: return_value !< return value 1185 1216 1217 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 1186 1218 LOGICAL :: append_internal !< same as 'append' 1187 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value1188 1219 1189 1220 TYPE(attribute_type) :: attribute !< new attribute … … 1254 1285 INTEGER :: return_value !< return value 1255 1286 1287 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 1256 1288 LOGICAL :: append_internal !< same as 'append' 1257 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value1258 1289 1259 1290 REAL(KIND=4), INTENT(IN) :: value !< attribute value … … 1326 1357 INTEGER :: return_value !< return value 1327 1358 1359 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value 1328 1360 LOGICAL :: append_internal !< same as 'append' 1329 LOGICAL, INTENT(IN), OPTIONAL :: append !< if true, append value to existing value1330 1361 1331 1362 REAL(KIND=8), INTENT(IN) :: value !< attribute value … … 1584 1615 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_end !< end index per dimension of variable 1585 1616 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< start index per dimension of variable 1586 1587 1617 INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_origin !< first index of each dimension 1588 1618 INTEGER, DIMENSION(:), ALLOCATABLE :: bounds_start_internal !< start index per dim. for output after masking … … 1590 1620 INTEGER, DIMENSION(:,:), ALLOCATABLE :: masked_indices !< list containing all output indices along a dimension 1591 1621 1592 LOGICAL :: do_output !< true if any data lies within given range of masked dimension1593 LOGICAL :: is_global !< true if variable is global1622 LOGICAL :: do_output !< true if any data lies within given range of masked dimension 1623 LOGICAL :: write_only_by_master_rank !< true if only master rank shall write variable 1594 1624 1595 1625 INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: values_int8_0d !< output variable … … 1687 1717 !-- Search for variable within file 1688 1718 CALL find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, & 1689 is_global, dimension_list, return_value=return_value )1719 write_only_by_master_rank, dimension_list, return_value=return_value ) 1690 1720 1691 1721 IF ( return_value == 0 ) THEN … … 1740 1770 ! 1741 1771 !-- Mask and resort variable 1742 !-- character output1772 !-- Character output 1743 1773 IF ( PRESENT( values_char_0d ) ) THEN 1744 1774 values_char_0d_pointer => values_char_0d … … 1845 1875 values_int8_3d_resorted(i,j,k) = values_int8_3d(masked_indices(3,k), & 1846 1876 masked_indices(2,j), & 1847 masked_indices(1,i) 1877 masked_indices(1,i)) 1848 1878 ENDDO 1849 1879 ENDDO … … 2225 2255 !-- Character output 2226 2256 IF ( PRESENT( values_char_0d ) ) THEN 2227 CALL binary_write_variable( file_id, variable_id, & 2228 bounds_start_internal, value_counts, bounds_origin, is_global, & 2229 values_char_0d=values_char_0d_pointer, return_value=output_return_value ) 2257 CALL binary_write_variable( file_id, variable_id, & 2258 bounds_start_internal, value_counts, bounds_origin, & 2259 write_only_by_master_rank, values_char_0d=values_char_0d_pointer, & 2260 return_value=output_return_value ) 2230 2261 ELSEIF ( PRESENT( values_char_1d ) ) THEN 2231 2262 CALL binary_write_variable( file_id, variable_id, & 2232 bounds_start_internal, value_counts, bounds_origin, is_global, & 2233 values_char_1d=values_char_1d_pointer, return_value=output_return_value ) 2263 bounds_start_internal, value_counts, bounds_origin, & 2264 write_only_by_master_rank, values_char_1d=values_char_1d_pointer, & 2265 return_value=output_return_value ) 2234 2266 ELSEIF ( PRESENT( values_char_2d ) ) THEN 2235 2267 CALL binary_write_variable( file_id, variable_id, & 2236 bounds_start_internal, value_counts, bounds_origin, is_global, & 2237 values_char_2d=values_char_2d_pointer, return_value=output_return_value ) 2268 bounds_start_internal, value_counts, bounds_origin, & 2269 write_only_by_master_rank, values_char_2d=values_char_2d_pointer, & 2270 return_value=output_return_value ) 2238 2271 ELSEIF ( PRESENT( values_char_3d ) ) THEN 2239 2272 CALL binary_write_variable( file_id, variable_id, & 2240 bounds_start_internal, value_counts, bounds_origin, is_global, & 2241 values_char_3d=values_char_3d_pointer, return_value=output_return_value ) 2273 bounds_start_internal, value_counts, bounds_origin, & 2274 write_only_by_master_rank, values_char_3d=values_char_3d_pointer, & 2275 return_value=output_return_value ) 2242 2276 ! 2243 2277 !-- 8bit integer output 2244 2278 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 2245 2279 CALL binary_write_variable( file_id, variable_id, & 2246 bounds_start_internal, value_counts, bounds_origin, is_global, & 2247 values_int8_0d=values_int8_0d_pointer, return_value=output_return_value ) 2280 bounds_start_internal, value_counts, bounds_origin, & 2281 write_only_by_master_rank, values_int8_0d=values_int8_0d_pointer, & 2282 return_value=output_return_value ) 2248 2283 ELSEIF ( PRESENT( values_int8_1d ) ) THEN 2249 2284 CALL binary_write_variable( file_id, variable_id, & 2250 bounds_start_internal, value_counts, bounds_origin, is_global, & 2251 values_int8_1d=values_int8_1d_pointer, return_value=output_return_value ) 2285 bounds_start_internal, value_counts, bounds_origin, & 2286 write_only_by_master_rank, values_int8_1d=values_int8_1d_pointer, & 2287 return_value=output_return_value ) 2252 2288 ELSEIF ( PRESENT( values_int8_2d ) ) THEN 2253 2289 CALL binary_write_variable( file_id, variable_id, & 2254 bounds_start_internal, value_counts, bounds_origin, is_global, & 2255 values_int8_2d=values_int8_2d_pointer, return_value=output_return_value ) 2290 bounds_start_internal, value_counts, bounds_origin, & 2291 write_only_by_master_rank, values_int8_2d=values_int8_2d_pointer, & 2292 return_value=output_return_value ) 2256 2293 ELSEIF ( PRESENT( values_int8_3d ) ) THEN 2257 2294 CALL binary_write_variable( file_id, variable_id, & 2258 bounds_start_internal, value_counts, bounds_origin, is_global, & 2259 values_int8_3d=values_int8_3d_pointer, return_value=output_return_value ) 2295 bounds_start_internal, value_counts, bounds_origin, & 2296 write_only_by_master_rank, values_int8_3d=values_int8_3d_pointer, & 2297 return_value=output_return_value ) 2260 2298 ! 2261 2299 !-- 16bit integer output 2262 2300 ELSEIF ( PRESENT( values_int16_0d ) ) THEN 2263 2301 CALL binary_write_variable( file_id, variable_id, & 2264 bounds_start_internal, value_counts, bounds_origin, is_global, & 2265 values_int16_0d=values_int16_0d_pointer, return_value=output_return_value ) 2302 bounds_start_internal, value_counts, bounds_origin, & 2303 write_only_by_master_rank, values_int16_0d=values_int16_0d_pointer, & 2304 return_value=output_return_value ) 2266 2305 ELSEIF ( PRESENT( values_int16_1d ) ) THEN 2267 2306 CALL binary_write_variable( file_id, variable_id, & 2268 bounds_start_internal, value_counts, bounds_origin, is_global, & 2269 values_int16_1d=values_int16_1d_pointer, return_value=output_return_value ) 2307 bounds_start_internal, value_counts, bounds_origin, & 2308 write_only_by_master_rank, values_int16_1d=values_int16_1d_pointer, & 2309 return_value=output_return_value ) 2270 2310 ELSEIF ( PRESENT( values_int16_2d ) ) THEN 2271 2311 CALL binary_write_variable( file_id, variable_id, & 2272 bounds_start_internal, value_counts, bounds_origin, is_global, & 2273 values_int16_2d=values_int16_2d_pointer, return_value=output_return_value ) 2312 bounds_start_internal, value_counts, bounds_origin, & 2313 write_only_by_master_rank, values_int16_2d=values_int16_2d_pointer, & 2314 return_value=output_return_value ) 2274 2315 ELSEIF ( PRESENT( values_int16_3d ) ) THEN 2275 2316 CALL binary_write_variable( file_id, variable_id, & 2276 bounds_start_internal, value_counts, bounds_origin, is_global, & 2277 values_int16_3d=values_int16_3d_pointer, return_value=output_return_value ) 2317 bounds_start_internal, value_counts, bounds_origin, & 2318 write_only_by_master_rank, values_int16_3d=values_int16_3d_pointer, & 2319 return_value=output_return_value ) 2278 2320 ! 2279 2321 !-- 32bit integer output 2280 2322 ELSEIF ( PRESENT( values_int32_0d ) ) THEN 2281 2323 CALL binary_write_variable( file_id, variable_id, & 2282 bounds_start_internal, value_counts, bounds_origin, is_global, & 2283 values_int32_0d=values_int32_0d_pointer, return_value=output_return_value ) 2324 bounds_start_internal, value_counts, bounds_origin, & 2325 write_only_by_master_rank, values_int32_0d=values_int32_0d_pointer, & 2326 return_value=output_return_value ) 2284 2327 ELSEIF ( PRESENT( values_int32_1d ) ) THEN 2285 2328 CALL binary_write_variable( file_id, variable_id, & 2286 bounds_start_internal, value_counts, bounds_origin, is_global, & 2287 values_int32_1d=values_int32_1d_pointer, return_value=output_return_value ) 2329 bounds_start_internal, value_counts, bounds_origin, & 2330 write_only_by_master_rank, values_int32_1d=values_int32_1d_pointer, & 2331 return_value=output_return_value ) 2288 2332 ELSEIF ( PRESENT( values_int32_2d ) ) THEN 2289 2333 CALL binary_write_variable( file_id, variable_id, & 2290 bounds_start_internal, value_counts, bounds_origin, is_global, & 2291 values_int32_2d=values_int32_2d_pointer, return_value=output_return_value ) 2334 bounds_start_internal, value_counts, bounds_origin, & 2335 write_only_by_master_rank, values_int32_2d=values_int32_2d_pointer, & 2336 return_value=output_return_value ) 2292 2337 ELSEIF ( PRESENT( values_int32_3d ) ) THEN 2293 2338 CALL binary_write_variable( file_id, variable_id, & 2294 bounds_start_internal, value_counts, bounds_origin, is_global, & 2295 values_int32_3d=values_int32_3d_pointer, return_value=output_return_value ) 2339 bounds_start_internal, value_counts, bounds_origin, & 2340 write_only_by_master_rank, values_int32_3d=values_int32_3d_pointer, & 2341 return_value=output_return_value ) 2296 2342 ! 2297 2343 !-- Working-precision integer output 2298 2344 ELSEIF ( PRESENT( values_intwp_0d ) ) THEN 2299 2345 CALL binary_write_variable( file_id, variable_id, & 2300 bounds_start_internal, value_counts, bounds_origin, is_global, & 2301 values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value ) 2346 bounds_start_internal, value_counts, bounds_origin, & 2347 write_only_by_master_rank, values_intwp_0d=values_intwp_0d_pointer, & 2348 return_value=output_return_value ) 2302 2349 ELSEIF ( PRESENT( values_intwp_1d ) ) THEN 2303 2350 CALL binary_write_variable( file_id, variable_id, & 2304 bounds_start_internal, value_counts, bounds_origin, is_global, & 2305 values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value ) 2351 bounds_start_internal, value_counts, bounds_origin, & 2352 write_only_by_master_rank, values_intwp_1d=values_intwp_1d_pointer, & 2353 return_value=output_return_value ) 2306 2354 ELSEIF ( PRESENT( values_intwp_2d ) ) THEN 2307 2355 CALL binary_write_variable( file_id, variable_id, & 2308 bounds_start_internal, value_counts, bounds_origin, is_global, & 2309 values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value ) 2356 bounds_start_internal, value_counts, bounds_origin, & 2357 write_only_by_master_rank, values_intwp_2d=values_intwp_2d_pointer, & 2358 return_value=output_return_value ) 2310 2359 ELSEIF ( PRESENT( values_intwp_3d ) ) THEN 2311 2360 CALL binary_write_variable( file_id, variable_id, & 2312 bounds_start_internal, value_counts, bounds_origin, is_global, & 2313 values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value ) 2361 bounds_start_internal, value_counts, bounds_origin, & 2362 write_only_by_master_rank, values_intwp_3d=values_intwp_3d_pointer, & 2363 return_value=output_return_value ) 2314 2364 ! 2315 2365 !-- 32bit real output 2316 2366 ELSEIF ( PRESENT( values_real32_0d ) ) THEN 2317 2367 CALL binary_write_variable( file_id, variable_id, & 2318 bounds_start_internal, value_counts, bounds_origin, is_global, & 2319 values_real32_0d=values_real32_0d_pointer, return_value=output_return_value ) 2368 bounds_start_internal, value_counts, bounds_origin, & 2369 write_only_by_master_rank, values_real32_0d=values_real32_0d_pointer, & 2370 return_value=output_return_value ) 2320 2371 ELSEIF ( PRESENT( values_real32_1d ) ) THEN 2321 2372 CALL binary_write_variable( file_id, variable_id, & 2322 bounds_start_internal, value_counts, bounds_origin, is_global, & 2323 values_real32_1d=values_real32_1d_pointer, return_value=output_return_value ) 2373 bounds_start_internal, value_counts, bounds_origin, & 2374 write_only_by_master_rank, values_real32_1d=values_real32_1d_pointer, & 2375 return_value=output_return_value ) 2324 2376 ELSEIF ( PRESENT( values_real32_2d ) ) THEN 2325 2377 CALL binary_write_variable( file_id, variable_id, & 2326 bounds_start_internal, value_counts, bounds_origin, is_global, & 2327 values_real32_2d=values_real32_2d_pointer, return_value=output_return_value ) 2378 bounds_start_internal, value_counts, bounds_origin, & 2379 write_only_by_master_rank, values_real32_2d=values_real32_2d_pointer, & 2380 return_value=output_return_value ) 2328 2381 ELSEIF ( PRESENT( values_real32_3d ) ) THEN 2329 2382 CALL binary_write_variable( file_id, variable_id, & 2330 bounds_start_internal, value_counts, bounds_origin, is_global, & 2331 values_real32_3d=values_real32_3d_pointer, return_value=output_return_value ) 2383 bounds_start_internal, value_counts, bounds_origin, & 2384 write_only_by_master_rank, values_real32_3d=values_real32_3d_pointer, & 2385 return_value=output_return_value ) 2332 2386 ! 2333 2387 !-- 64bit real output 2334 2388 ELSEIF ( PRESENT( values_real64_0d ) ) THEN 2335 2389 CALL binary_write_variable( file_id, variable_id, & 2336 bounds_start_internal, value_counts, bounds_origin, is_global, & 2337 values_real64_0d=values_real64_0d_pointer, return_value=output_return_value ) 2390 bounds_start_internal, value_counts, bounds_origin, & 2391 write_only_by_master_rank, values_real64_0d=values_real64_0d_pointer, & 2392 return_value=output_return_value ) 2338 2393 ELSEIF ( PRESENT( values_real64_1d ) ) THEN 2339 2394 CALL binary_write_variable( file_id, variable_id, & 2340 bounds_start_internal, value_counts, bounds_origin, is_global, & 2341 values_real64_1d=values_real64_1d_pointer, return_value=output_return_value ) 2395 bounds_start_internal, value_counts, bounds_origin, & 2396 write_only_by_master_rank, values_real64_1d=values_real64_1d_pointer, & 2397 return_value=output_return_value ) 2342 2398 ELSEIF ( PRESENT( values_real64_2d ) ) THEN 2343 2399 CALL binary_write_variable( file_id, variable_id, & 2344 bounds_start_internal, value_counts, bounds_origin, is_global, & 2345 values_real64_2d=values_real64_2d_pointer, return_value=output_return_value ) 2400 bounds_start_internal, value_counts, bounds_origin, & 2401 write_only_by_master_rank, values_real64_2d=values_real64_2d_pointer, & 2402 return_value=output_return_value ) 2346 2403 ELSEIF ( PRESENT( values_real64_3d ) ) THEN 2347 2404 CALL binary_write_variable( file_id, variable_id, & 2348 bounds_start_internal, value_counts, bounds_origin, is_global, & 2349 values_real64_3d=values_real64_3d_pointer, return_value=output_return_value ) 2350 ! 2351 !-- working-precision real output 2405 bounds_start_internal, value_counts, bounds_origin, & 2406 write_only_by_master_rank, values_real64_3d=values_real64_3d_pointer, & 2407 return_value=output_return_value ) 2408 ! 2409 !-- Working-precision real output 2352 2410 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 2353 2411 CALL binary_write_variable( file_id, variable_id, & 2354 bounds_start_internal, value_counts, bounds_origin, is_global, & 2355 values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value ) 2412 bounds_start_internal, value_counts, bounds_origin, & 2413 write_only_by_master_rank, values_realwp_0d=values_realwp_0d_pointer, & 2414 return_value=output_return_value ) 2356 2415 ELSEIF ( PRESENT( values_realwp_1d ) ) THEN 2357 2416 CALL binary_write_variable( file_id, variable_id, & 2358 bounds_start_internal, value_counts, bounds_origin, is_global, & 2359 values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value ) 2417 bounds_start_internal, value_counts, bounds_origin, & 2418 write_only_by_master_rank, values_realwp_1d=values_realwp_1d_pointer, & 2419 return_value=output_return_value ) 2360 2420 ELSEIF ( PRESENT( values_realwp_2d ) ) THEN 2361 2421 CALL binary_write_variable( file_id, variable_id, & 2362 bounds_start_internal, value_counts, bounds_origin, is_global, & 2363 values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value ) 2422 bounds_start_internal, value_counts, bounds_origin, & 2423 write_only_by_master_rank, values_realwp_2d=values_realwp_2d_pointer, & 2424 return_value=output_return_value ) 2364 2425 ELSEIF ( PRESENT( values_realwp_3d ) ) THEN 2365 2426 CALL binary_write_variable( file_id, variable_id, & 2366 bounds_start_internal, value_counts, bounds_origin, is_global, & 2367 values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value ) 2427 bounds_start_internal, value_counts, bounds_origin, & 2428 write_only_by_master_rank, values_realwp_3d=values_realwp_3d_pointer, & 2429 return_value=output_return_value ) 2368 2430 ELSE 2369 2431 return_value = 1 … … 2377 2439 CASE ( 'netcdf4-parallel', 'netcdf4-serial' ) 2378 2440 ! 2379 !-- Character output2441 !-- Character integer output 2380 2442 IF ( PRESENT( values_char_0d ) ) THEN 2381 CALL netcdf4_write_variable( file_id, variable_id, & 2382 bounds_start_internal, value_counts, bounds_origin, is_global, & 2383 values_char_0d=values_char_0d_pointer, return_value=output_return_value ) 2443 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2444 bounds_start_internal, value_counts, bounds_origin, & 2445 write_only_by_master_rank, values_char_0d=values_char_0d_pointer, & 2446 return_value=output_return_value ) 2384 2447 ELSEIF ( PRESENT( values_char_1d ) ) THEN 2385 CALL netcdf4_write_variable( file_id, variable_id, & 2386 bounds_start_internal, value_counts, bounds_origin, is_global, & 2387 values_char_1d=values_char_1d_pointer, return_value=output_return_value ) 2448 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2449 bounds_start_internal, value_counts, bounds_origin, & 2450 write_only_by_master_rank, values_char_1d=values_char_1d_pointer, & 2451 return_value=output_return_value ) 2388 2452 ELSEIF ( PRESENT( values_char_2d ) ) THEN 2389 CALL netcdf4_write_variable( file_id, variable_id, & 2390 bounds_start_internal, value_counts, bounds_origin, is_global, & 2391 values_char_2d=values_char_2d_pointer, return_value=output_return_value ) 2453 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2454 bounds_start_internal, value_counts, bounds_origin, & 2455 write_only_by_master_rank, values_char_2d=values_char_2d_pointer, & 2456 return_value=output_return_value ) 2392 2457 ELSEIF ( PRESENT( values_char_3d ) ) THEN 2393 CALL netcdf4_write_variable( file_id, variable_id, & 2394 bounds_start_internal, value_counts, bounds_origin, is_global, & 2395 values_char_3d=values_char_3d_pointer, return_value=output_return_value ) 2458 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2459 bounds_start_internal, value_counts, bounds_origin, & 2460 write_only_by_master_rank, values_char_3d=values_char_3d_pointer, & 2461 return_value=output_return_value ) 2396 2462 ! 2397 2463 !-- 8bit integer output 2398 2464 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 2399 CALL netcdf4_write_variable( file_id, variable_id, & 2400 bounds_start_internal, value_counts, bounds_origin, is_global, & 2401 values_int8_0d=values_int8_0d_pointer, return_value=output_return_value ) 2465 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2466 bounds_start_internal, value_counts, bounds_origin, & 2467 write_only_by_master_rank, values_int8_0d=values_int8_0d_pointer, & 2468 return_value=output_return_value ) 2402 2469 ELSEIF ( PRESENT( values_int8_1d ) ) THEN 2403 CALL netcdf4_write_variable( file_id, variable_id, & 2404 bounds_start_internal, value_counts, bounds_origin, is_global, & 2405 values_int8_1d=values_int8_1d_pointer, return_value=output_return_value ) 2470 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2471 bounds_start_internal, value_counts, bounds_origin, & 2472 write_only_by_master_rank, values_int8_1d=values_int8_1d_pointer, & 2473 return_value=output_return_value ) 2406 2474 ELSEIF ( PRESENT( values_int8_2d ) ) THEN 2407 CALL netcdf4_write_variable( file_id, variable_id, & 2408 bounds_start_internal, value_counts, bounds_origin, is_global, & 2409 values_int8_2d=values_int8_2d_pointer, return_value=output_return_value ) 2475 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2476 bounds_start_internal, value_counts, bounds_origin, & 2477 write_only_by_master_rank, values_int8_2d=values_int8_2d_pointer, & 2478 return_value=output_return_value ) 2410 2479 ELSEIF ( PRESENT( values_int8_3d ) ) THEN 2411 CALL netcdf4_write_variable( file_id, variable_id, & 2412 bounds_start_internal, value_counts, bounds_origin, is_global, & 2413 values_int8_3d=values_int8_3d_pointer, return_value=output_return_value ) 2480 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2481 bounds_start_internal, value_counts, bounds_origin, & 2482 write_only_by_master_rank, values_int8_3d=values_int8_3d_pointer, & 2483 return_value=output_return_value ) 2414 2484 ! 2415 2485 !-- 16bit integer output 2416 2486 ELSEIF ( PRESENT( values_int16_0d ) ) THEN 2417 CALL netcdf4_write_variable( file_id, variable_id, & 2418 bounds_start_internal, value_counts, bounds_origin, is_global, & 2419 values_int16_0d=values_int16_0d_pointer, return_value=output_return_value ) 2487 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2488 bounds_start_internal, value_counts, bounds_origin, & 2489 write_only_by_master_rank, values_int16_0d=values_int16_0d_pointer, & 2490 return_value=output_return_value ) 2420 2491 ELSEIF ( PRESENT( values_int16_1d ) ) THEN 2421 CALL netcdf4_write_variable( file_id, variable_id, & 2422 bounds_start_internal, value_counts, bounds_origin, is_global, & 2423 values_int16_1d=values_int16_1d_pointer, return_value=output_return_value ) 2492 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2493 bounds_start_internal, value_counts, bounds_origin, & 2494 write_only_by_master_rank, values_int16_1d=values_int16_1d_pointer, & 2495 return_value=output_return_value ) 2424 2496 ELSEIF ( PRESENT( values_int16_2d ) ) THEN 2425 CALL netcdf4_write_variable( file_id, variable_id, & 2426 bounds_start_internal, value_counts, bounds_origin, is_global, & 2427 values_int16_2d=values_int16_2d_pointer, return_value=output_return_value ) 2497 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2498 bounds_start_internal, value_counts, bounds_origin, & 2499 write_only_by_master_rank, values_int16_2d=values_int16_2d_pointer, & 2500 return_value=output_return_value ) 2428 2501 ELSEIF ( PRESENT( values_int16_3d ) ) THEN 2429 CALL netcdf4_write_variable( file_id, variable_id, & 2430 bounds_start_internal, value_counts, bounds_origin, is_global, & 2431 values_int16_3d=values_int16_3d_pointer, return_value=output_return_value ) 2502 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2503 bounds_start_internal, value_counts, bounds_origin, & 2504 write_only_by_master_rank, values_int16_3d=values_int16_3d_pointer, & 2505 return_value=output_return_value ) 2432 2506 ! 2433 2507 !-- 32bit integer output 2434 2508 ELSEIF ( PRESENT( values_int32_0d ) ) THEN 2435 CALL netcdf4_write_variable( file_id, variable_id, & 2436 bounds_start_internal, value_counts, bounds_origin, is_global, & 2437 values_int32_0d=values_int32_0d_pointer, return_value=output_return_value ) 2509 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2510 bounds_start_internal, value_counts, bounds_origin, & 2511 write_only_by_master_rank, values_int32_0d=values_int32_0d_pointer, & 2512 return_value=output_return_value ) 2438 2513 ELSEIF ( PRESENT( values_int32_1d ) ) THEN 2439 CALL netcdf4_write_variable( file_id, variable_id, & 2440 bounds_start_internal, value_counts, bounds_origin, is_global, & 2441 values_int32_1d=values_int32_1d_pointer, return_value=output_return_value ) 2514 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2515 bounds_start_internal, value_counts, bounds_origin, & 2516 write_only_by_master_rank, values_int32_1d=values_int32_1d_pointer, & 2517 return_value=output_return_value ) 2442 2518 ELSEIF ( PRESENT( values_int32_2d ) ) THEN 2443 CALL netcdf4_write_variable( file_id, variable_id, & 2444 bounds_start_internal, value_counts, bounds_origin, is_global, & 2445 values_int32_2d=values_int32_2d_pointer, return_value=output_return_value ) 2519 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2520 bounds_start_internal, value_counts, bounds_origin, & 2521 write_only_by_master_rank, values_int32_2d=values_int32_2d_pointer, & 2522 return_value=output_return_value ) 2446 2523 ELSEIF ( PRESENT( values_int32_3d ) ) THEN 2447 CALL netcdf4_write_variable( file_id, variable_id, & 2448 bounds_start_internal, value_counts, bounds_origin, is_global, & 2449 values_int32_3d=values_int32_3d_pointer, return_value=output_return_value ) 2524 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2525 bounds_start_internal, value_counts, bounds_origin, & 2526 write_only_by_master_rank, values_int32_3d=values_int32_3d_pointer, & 2527 return_value=output_return_value ) 2450 2528 ! 2451 2529 !-- Working-precision integer output 2452 2530 ELSEIF ( PRESENT( values_intwp_0d ) ) THEN 2453 CALL netcdf4_write_variable( file_id, variable_id, & 2454 bounds_start_internal, value_counts, bounds_origin, is_global, & 2455 values_intwp_0d=values_intwp_0d_pointer, return_value=output_return_value ) 2531 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2532 bounds_start_internal, value_counts, bounds_origin, & 2533 write_only_by_master_rank, values_intwp_0d=values_intwp_0d_pointer, & 2534 return_value=output_return_value ) 2456 2535 ELSEIF ( PRESENT( values_intwp_1d ) ) THEN 2457 CALL netcdf4_write_variable( file_id, variable_id, & 2458 bounds_start_internal, value_counts, bounds_origin, is_global, & 2459 values_intwp_1d=values_intwp_1d_pointer, return_value=output_return_value ) 2536 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2537 bounds_start_internal, value_counts, bounds_origin, & 2538 write_only_by_master_rank, values_intwp_1d=values_intwp_1d_pointer, & 2539 return_value=output_return_value ) 2460 2540 ELSEIF ( PRESENT( values_intwp_2d ) ) THEN 2461 CALL netcdf4_write_variable( file_id, variable_id, & 2462 bounds_start_internal, value_counts, bounds_origin, is_global, & 2463 values_intwp_2d=values_intwp_2d_pointer, return_value=output_return_value ) 2541 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2542 bounds_start_internal, value_counts, bounds_origin, & 2543 write_only_by_master_rank, values_intwp_2d=values_intwp_2d_pointer, & 2544 return_value=output_return_value ) 2464 2545 ELSEIF ( PRESENT( values_intwp_3d ) ) THEN 2465 CALL netcdf4_write_variable( file_id, variable_id, & 2466 bounds_start_internal, value_counts, bounds_origin, is_global, & 2467 values_intwp_3d=values_intwp_3d_pointer, return_value=output_return_value ) 2546 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2547 bounds_start_internal, value_counts, bounds_origin, & 2548 write_only_by_master_rank, values_intwp_3d=values_intwp_3d_pointer, & 2549 return_value=output_return_value ) 2468 2550 ! 2469 2551 !-- 32bit real output 2470 2552 ELSEIF ( PRESENT( values_real32_0d ) ) THEN 2471 CALL netcdf4_write_variable( file_id, variable_id, & 2472 bounds_start_internal, value_counts, bounds_origin, is_global, & 2473 values_real32_0d=values_real32_0d_pointer, return_value=output_return_value ) 2553 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2554 bounds_start_internal, value_counts, bounds_origin, & 2555 write_only_by_master_rank, values_real32_0d=values_real32_0d_pointer, & 2556 return_value=output_return_value ) 2474 2557 ELSEIF ( PRESENT( values_real32_1d ) ) THEN 2475 CALL netcdf4_write_variable( file_id, variable_id, & 2476 bounds_start_internal, value_counts, bounds_origin, is_global, & 2477 values_real32_1d=values_real32_1d_pointer, return_value=output_return_value ) 2558 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2559 bounds_start_internal, value_counts, bounds_origin, & 2560 write_only_by_master_rank, values_real32_1d=values_real32_1d_pointer, & 2561 return_value=output_return_value ) 2478 2562 ELSEIF ( PRESENT( values_real32_2d ) ) THEN 2479 CALL netcdf4_write_variable( file_id, variable_id, & 2480 bounds_start_internal, value_counts, bounds_origin, is_global, & 2481 values_real32_2d=values_real32_2d_pointer, return_value=output_return_value ) 2563 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2564 bounds_start_internal, value_counts, bounds_origin, & 2565 write_only_by_master_rank, values_real32_2d=values_real32_2d_pointer, & 2566 return_value=output_return_value ) 2482 2567 ELSEIF ( PRESENT( values_real32_3d ) ) THEN 2483 CALL netcdf4_write_variable( file_id, variable_id, & 2484 bounds_start_internal, value_counts, bounds_origin, is_global, & 2485 values_real32_3d=values_real32_3d_pointer, return_value=output_return_value ) 2568 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2569 bounds_start_internal, value_counts, bounds_origin, & 2570 write_only_by_master_rank, values_real32_3d=values_real32_3d_pointer, & 2571 return_value=output_return_value ) 2486 2572 ! 2487 2573 !-- 64bit real output 2488 2574 ELSEIF ( PRESENT( values_real64_0d ) ) THEN 2489 CALL netcdf4_write_variable( file_id, variable_id, & 2490 bounds_start_internal, value_counts, bounds_origin, is_global, & 2491 values_real64_0d=values_real64_0d_pointer, return_value=output_return_value ) 2575 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2576 bounds_start_internal, value_counts, bounds_origin, & 2577 write_only_by_master_rank, values_real64_0d=values_real64_0d_pointer, & 2578 return_value=output_return_value ) 2492 2579 ELSEIF ( PRESENT( values_real64_1d ) ) THEN 2493 CALL netcdf4_write_variable( file_id, variable_id, & 2494 bounds_start_internal, value_counts, bounds_origin, is_global, & 2495 values_real64_1d=values_real64_1d_pointer, return_value=output_return_value ) 2580 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2581 bounds_start_internal, value_counts, bounds_origin, & 2582 write_only_by_master_rank, values_real64_1d=values_real64_1d_pointer, & 2583 return_value=output_return_value ) 2496 2584 ELSEIF ( PRESENT( values_real64_2d ) ) THEN 2497 CALL netcdf4_write_variable( file_id, variable_id, & 2498 bounds_start_internal, value_counts, bounds_origin, is_global, & 2499 values_real64_2d=values_real64_2d_pointer, return_value=output_return_value ) 2585 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2586 bounds_start_internal, value_counts, bounds_origin, & 2587 write_only_by_master_rank, values_real64_2d=values_real64_2d_pointer, & 2588 return_value=output_return_value ) 2500 2589 ELSEIF ( PRESENT( values_real64_3d ) ) THEN 2501 CALL netcdf4_write_variable( file_id, variable_id, & 2502 bounds_start_internal, value_counts, bounds_origin, is_global, & 2503 values_real64_3d=values_real64_3d_pointer, return_value=output_return_value ) 2504 ! 2505 !-- working-precision real output 2590 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2591 bounds_start_internal, value_counts, bounds_origin, & 2592 write_only_by_master_rank, values_real64_3d=values_real64_3d_pointer, & 2593 return_value=output_return_value ) 2594 ! 2595 !-- Working-precision real output 2506 2596 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 2507 CALL netcdf4_write_variable( file_id, variable_id, & 2508 bounds_start_internal, value_counts, bounds_origin, is_global, & 2509 values_realwp_0d=values_realwp_0d_pointer, return_value=output_return_value ) 2597 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2598 bounds_start_internal, value_counts, bounds_origin, & 2599 write_only_by_master_rank, values_realwp_0d=values_realwp_0d_pointer, & 2600 return_value=output_return_value ) 2510 2601 ELSEIF ( PRESENT( values_realwp_1d ) ) THEN 2511 CALL netcdf4_write_variable( file_id, variable_id, & 2512 bounds_start_internal, value_counts, bounds_origin, is_global, & 2513 values_realwp_1d=values_realwp_1d_pointer, return_value=output_return_value ) 2602 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2603 bounds_start_internal, value_counts, bounds_origin, & 2604 write_only_by_master_rank, values_realwp_1d=values_realwp_1d_pointer, & 2605 return_value=output_return_value ) 2514 2606 ELSEIF ( PRESENT( values_realwp_2d ) ) THEN 2515 CALL netcdf4_write_variable( file_id, variable_id, & 2516 bounds_start_internal, value_counts, bounds_origin, is_global, & 2517 values_realwp_2d=values_realwp_2d_pointer, return_value=output_return_value ) 2607 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2608 bounds_start_internal, value_counts, bounds_origin, & 2609 write_only_by_master_rank, values_realwp_2d=values_realwp_2d_pointer, & 2610 return_value=output_return_value ) 2518 2611 ELSEIF ( PRESENT( values_realwp_3d ) ) THEN 2519 CALL netcdf4_write_variable( file_id, variable_id, & 2520 bounds_start_internal, value_counts, bounds_origin, is_global, & 2521 values_realwp_3d=values_realwp_3d_pointer, return_value=output_return_value ) 2612 CALL netcdf4_write_variable( TRIM( file_format(9:) ), file_id, variable_id, & 2613 bounds_start_internal, value_counts, bounds_origin, & 2614 write_only_by_master_rank, values_realwp_3d=values_realwp_3d_pointer, & 2615 return_value=output_return_value ) 2522 2616 ELSE 2523 2617 return_value = 1 … … 2585 2679 2586 2680 CASE ( 'netcdf4-parallel', 'netcdf4-serial' ) 2587 CALL netcdf4_finalize( files(f)%id, output_return_value ) 2681 CALL netcdf4_finalize( TRIM( files(f)%format(9:) ), files(f)%id, & 2682 output_return_value ) 2588 2683 2589 2684 CASE DEFAULT … … 2853 2948 return_value = 1 2854 2949 CALL internal_message( 'error', & 2855 routine_name //&2856 ': requested dimension/variable "' // TRIM( variable_name ) //&2857 '" for attribute "' // TRIM( attribute%name ) //&2858 2950 routine_name // & 2951 ': requested dimension/variable "' // TRIM( variable_name ) // & 2952 '" for attribute "' // TRIM( attribute%name ) // & 2953 '" does not exist in file "' // TRIM( file_name ) // '"' ) 2859 2954 ENDIF 2860 2955 … … 2948 3043 DO i = 1, nvars 2949 3044 dimension_is_used(d) = & 2950 3045 ANY( files(f)%dimensions(d)%name == files(f)%variables(i)%dimension_names ) 2951 3046 IF ( dimension_is_used(d) ) EXIT 2952 3047 ENDDO … … 3064 3159 file%dimensions(d)%id, file%dimensions(d)%name, & 3065 3160 file%dimensions(d)%data_type, file%dimensions(d)%length, & 3066 file%dimensions(d)%variable_id, return_value ) 3161 file%dimensions(d)%variable_id, & 3162 file%dimensions(d)%write_only_by_master_rank, return_value ) 3067 3163 3068 3164 ELSE … … 3070 3166 !-- Initialize masked dimension 3071 3167 CALL init_file_dimension( file%format, file%id, file%name, & 3072 file%dimensions(d)%id, file%dimensions(d)%name, & 3073 file%dimensions(d)%data_type, file%dimensions(d)%length_mask, & 3074 file%dimensions(d)%variable_id, return_value ) 3168 file%dimensions(d)%id, file%dimensions(d)%name, & 3169 file%dimensions(d)%data_type, file%dimensions(d)%length_mask, & 3170 file%dimensions(d)%variable_id, & 3171 file%dimensions(d)%write_only_by_master_rank, return_value ) 3075 3172 3076 3173 ENDIF … … 3104 3201 file%variables(d)%id, file%variables(d)%name, file%variables(d)%data_type, & 3105 3202 file%variables(d)%dimension_ids, & 3106 file%variables(d)% is_global, return_value )3203 file%variables(d)%write_only_by_master_rank, return_value ) 3107 3204 3108 3205 IF ( return_value == 0 .AND. ALLOCATED( file%variables(d)%attributes ) ) THEN … … 3134 3231 SUBROUTINE init_file_dimension( file_format, file_id, file_name, & 3135 3232 dimension_id, dimension_name, dimension_type, dimension_length, & 3136 variable_id, return_value )3233 variable_id, write_only_by_master_rank, return_value ) 3137 3234 3138 3235 CHARACTER(LEN=*), PARAMETER :: routine_name = 'init_file_dimension' !< file format chosen for file … … 3150 3247 INTEGER, INTENT(OUT) :: variable_id !< associated variable ID 3151 3248 3249 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 3250 3152 3251 3153 3252 return_value = 0 … … 3161 3260 CASE ( 'binary' ) 3162 3261 CALL binary_init_dimension( 'binary', file_id, dimension_id, variable_id, & 3163 dimension_name, dimension_type, dimension_length,&3164 3262 dimension_name, dimension_type, dimension_length, write_only_by_master_rank, & 3263 return_value=output_return_value ) 3165 3264 3166 3265 CASE ( 'netcdf4-serial' ) 3167 3266 CALL netcdf4_init_dimension( 'serial', file_id, dimension_id, variable_id, & 3168 dimension_name, dimension_type, dimension_length,&3169 3267 dimension_name, dimension_type, dimension_length, write_only_by_master_rank, & 3268 return_value=output_return_value ) 3170 3269 3171 3270 CASE ( 'netcdf4-parallel' ) 3172 3271 CALL netcdf4_init_dimension( 'parallel', file_id, dimension_id, variable_id, & 3173 dimension_name, dimension_type, dimension_length,&3174 3272 dimension_name, dimension_type, dimension_length, write_only_by_master_rank, & 3273 return_value=output_return_value ) 3175 3274 3176 3275 CASE DEFAULT … … 3197 3296 SUBROUTINE init_file_variable( file_format, file_id, file_name, & 3198 3297 variable_id, variable_name, variable_type, dimension_ids, & 3199 is_global, return_value )3298 write_only_by_master_rank, return_value ) 3200 3299 3201 3300 CHARACTER(LEN=*), PARAMETER :: routine_name = 'init_file_variable' !< file format chosen for file … … 3213 3312 INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable 3214 3313 3215 LOGICAL, INTENT(IN) :: is_global !< true if variable is global3314 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 3216 3315 3217 3316 … … 3226 3325 CASE ( 'binary' ) 3227 3326 CALL binary_init_variable( 'binary', file_id, variable_id, variable_name, & 3228 variable_type, dimension_ids, is_global, return_value=output_return_value ) 3327 variable_type, dimension_ids, write_only_by_master_rank, & 3328 return_value=output_return_value ) 3229 3329 3230 3330 CASE ( 'netcdf4-serial' ) 3231 3331 CALL netcdf4_init_variable( 'serial', file_id, variable_id, variable_name, & 3232 variable_type, dimension_ids, is_global, return_value=output_return_value ) 3332 variable_type, dimension_ids, write_only_by_master_rank, & 3333 return_value=output_return_value ) 3233 3334 3234 3335 CASE ( 'netcdf4-parallel' ) 3235 3336 CALL netcdf4_init_variable( 'parallel', file_id, variable_id, variable_name, & 3236 variable_type, dimension_ids, is_global, return_value=output_return_value ) 3337 variable_type, dimension_ids, write_only_by_master_rank, & 3338 return_value=output_return_value ) 3237 3339 3238 3340 CASE DEFAULT … … 3268 3370 3269 3371 INTEGER, INTENT(IN) :: file_id !< file ID 3372 INTEGER :: return_value !< return value 3270 3373 INTEGER :: output_return_value !< return value of a called output routine 3271 INTEGER :: return_value !< return value3272 3374 INTEGER, INTENT(IN) :: variable_id !< variable ID 3273 3375 … … 3335 3437 3336 3438 CASE( 'char' ) 3337 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3338 attribute_name=attribute%name, value_char=attribute%value_char,&3339 return_value=output_return_value )3439 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3440 variable_id=variable_id, attribute_name=attribute%name, & 3441 value_char=attribute%value_char, return_value=output_return_value ) 3340 3442 3341 3443 CASE( 'int8' ) 3342 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3343 attribute_name=attribute%name, value_int8=attribute%value_int8,&3344 return_value=output_return_value )3444 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3445 variable_id=variable_id, attribute_name=attribute%name, & 3446 value_int8=attribute%value_int8, return_value=output_return_value ) 3345 3447 3346 3448 CASE( 'int16' ) 3347 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3348 attribute_name=attribute%name, value_int16=attribute%value_int16,&3349 return_value=output_return_value )3449 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3450 variable_id=variable_id, attribute_name=attribute%name, & 3451 value_int16=attribute%value_int16, return_value=output_return_value ) 3350 3452 3351 3453 CASE( 'int32' ) 3352 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3353 attribute_name=attribute%name, value_int32=attribute%value_int32,&3354 return_value=output_return_value )3454 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3455 variable_id=variable_id, attribute_name=attribute%name, & 3456 value_int32=attribute%value_int32, return_value=output_return_value ) 3355 3457 3356 3458 CASE( 'real32' ) 3357 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3358 attribute_name=attribute%name, value_real32=attribute%value_real32,&3359 return_value=output_return_value )3459 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3460 variable_id=variable_id, attribute_name=attribute%name, & 3461 value_real32=attribute%value_real32, return_value=output_return_value ) 3360 3462 3361 3463 CASE( 'real64' ) 3362 CALL netcdf4_write_attribute( file_id=file_id, variable_id=variable_id,&3363 attribute_name=attribute%name, value_real64=attribute%value_real64,&3364 return_value=output_return_value )3464 CALL netcdf4_write_attribute( mode=file_format(9:), file_id=file_id, & 3465 variable_id=variable_id, attribute_name=attribute%name, & 3466 value_real64=attribute%value_real64, return_value=output_return_value ) 3365 3467 3366 3468 CASE DEFAULT … … 3408 3510 INTEGER, INTENT(OUT) :: return_value !< return value 3409 3511 3410 LOGICAL :: found = .FALSE.!< true if dimension required by variable was found in dimension list3512 LOGICAL :: found !< true if dimension required by variable was found in dimension list 3411 3513 3412 3514 TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< list of dimensions in file … … 3415 3517 3416 3518 3417 return_value = 0 3519 return_value = 0 3520 found = .FALSE. 3418 3521 ndims = SIZE( dimensions ) 3419 3522 nvars = SIZE( variables ) … … 3473 3576 3474 3577 CASE ( 'netcdf4-parallel', 'netcdf4-serial' ) 3475 CALL netcdf4_stop_file_header_definition( file_ id, output_return_value )3578 CALL netcdf4_stop_file_header_definition( file_format(9:), file_id, output_return_value ) 3476 3579 3477 3580 CASE DEFAULT … … 3500 3603 !--------------------------------------------------------------------------------------------------! 3501 3604 SUBROUTINE find_var_in_file( file_name, variable_name, file_format, file_id, variable_id, & 3502 is_global, dimensions, return_value )3605 write_only_by_master_rank, dimensions, return_value ) 3503 3606 3504 3607 CHARACTER(LEN=*), PARAMETER :: routine_name = 'find_var_in_file' !< name of routine … … 3517 3620 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension IDs used by variable 3518 3621 3519 LOGICAL :: found !< true if requested variable found in requested file3520 LOGICAL, INTENT(OUT) :: is_global !< true if variable is global3622 LOGICAL :: found !< true if requested variable found in requested file 3623 LOGICAL, INTENT(OUT) :: write_only_by_master_rank !< true if only master rank shall write variable 3521 3624 3522 3625 TYPE(dimension_type), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: dimensions !< list of dimensions used by variable … … 3546 3649 IF ( TRIM( variable_name ) == TRIM( files(f)%variables(d)%name ) ) THEN 3547 3650 3548 variable_id 3549 is_global = files(f)%variables(d)%is_global3651 variable_id = files(f)%variables(d)%id 3652 write_only_by_master_rank = files(f)%variables(d)%write_only_by_master_rank 3550 3653 3551 3654 ALLOCATE( dimension_ids(SIZE( files(f)%variables(d)%dimension_ids )) ) … … 3578 3681 IF ( TRIM( variable_name ) == TRIM( files(f)%dimensions(d)%name ) ) THEN 3579 3682 3580 variable_id 3581 is_global = .TRUE.3683 variable_id = files(f)%dimensions(d)%variable_id 3684 write_only_by_master_rank = files(f)%dimensions(d)%write_only_by_master_rank 3582 3685 3583 3686 ALLOCATE( dimensions(1) ) … … 3741 3844 3742 3845 INTEGER, PARAMETER :: indent_depth = 3 !< space per indentation 3743 INTEGER, PARAMETER :: max_keyname_length = 6!< length of longest key name3846 INTEGER, PARAMETER :: max_keyname_length = 8 !< length of longest key name 3744 3847 3745 3848 CHARACTER(LEN=50) :: write_format1 !< format for write statements … … 3805 3908 SUBROUTINE print_attributes( indent_level, attributes ) 3806 3909 3807 INTEGER, PARAMETER 3910 INTEGER, PARAMETER :: max_keyname_length = 6 !< length of longest key name 3808 3911 3809 3912 CHARACTER(LEN=50) :: write_format1 !< format for write statements … … 3865 3968 SUBROUTINE print_dimensions( indent_level, dimensions ) 3866 3969 3867 INTEGER, PARAMETER :: max_keyname_length = 15!< length of longest key name3970 INTEGER, PARAMETER :: max_keyname_length = 26 !< length of longest key name 3868 3971 3869 3972 CHARACTER(LEN=50) :: write_format1 !< format for write statements … … 3900 4003 WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) & 3901 4004 'id', dimensions(i)%id 4005 WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) & 4006 'write only by master rank', dimensions(i)%write_only_by_master_rank 3902 4007 WRITE( debug_output_unit, TRIM( write_format2 ) // ',I7)' ) & 3903 4008 'length', dimensions(i)%length … … 4080 4185 SUBROUTINE print_variables( indent_level, variables ) 4081 4186 4082 INTEGER, PARAMETER :: max_keyname_length = 16 !< length of longest key name4187 INTEGER, PARAMETER :: max_keyname_length = 26 !< length of longest key name 4083 4188 4084 4189 CHARACTER(LEN=50) :: write_format1 !< format for write statements … … 4111 4216 'id', variables(i)%id 4112 4217 WRITE( debug_output_unit, TRIM( write_format2 ) // ',L1)' ) & 4113 ' is global', variables(i)%is_global4218 'write only by master rank', variables(i)%write_only_by_master_rank 4114 4219 4115 4220 WRITE( debug_output_unit, TRIM( write_format2 ) // ',A)', ADVANCE='no' ) & -
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4579 r4597 24 24 ! ----------------- 25 25 ! $Id$ 26 ! bugfix: - allow writing of unlimited dimensions in parallel mode 27 ! - prevent unused-variable warning if preprocessor directives are not given 28 ! change: - set parallel access mode to independent per default 29 ! new : - dimension variables can be written by every PE 30 ! 31 ! 4579 2020-06-25 20:05:07Z gronemeier 26 32 ! corrected formatting to follow PALM coding standard 27 33 ! … … 53 59 !> NetCDF output module to write data to NetCDF files. 54 60 !> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0. 61 !> 62 !> @bug 'mode' is not always checked. If a routine is called with an unknown mode (e.g. a typo), 63 !> this does not throw any error. 55 64 !--------------------------------------------------------------------------------------------------! 56 65 MODULE data_output_netcdf4_module … … 82 91 INTEGER :: global_id_in_file = -1 !< value of global ID within a file 83 92 INTEGER :: master_rank !< master rank for tasks to be executed by single PE only 93 INTEGER :: my_rank !< MPI rank of processor 84 94 INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output 85 95 … … 150 160 program_debug_output_unit, debug_output, dom_global_id ) 151 161 162 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_module' !< name of this routine 163 152 164 CHARACTER(LEN=*), INTENT(IN) :: file_suffix_of_output_group !> file-name suffix added to each file; 153 165 !> must be unique for each output group … … 157 169 INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output 158 170 INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output 171 INTEGER :: return_value !< return value 159 172 160 173 LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed … … 165 178 master_rank = master_output_rank 166 179 180 #if defined( __parallel ) 181 CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value ) 182 IF ( return_value /= 0 ) THEN 183 CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' ) 184 ENDIF 185 #else 186 my_rank = master_rank 187 return_value = 0 188 ! 189 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 190 IF ( .FALSE. ) CALL internal_message( 'debug', routine_name // ': dummy message' ) 191 #endif 192 167 193 debug_output_unit = program_debug_output_unit 168 194 print_debug_output = debug_output … … 185 211 186 212 INTEGER, INTENT(OUT) :: file_id !< file ID 187 INTEGER :: my_rank !< MPI rank of processor188 213 INTEGER :: nc_stat !< netcdf return value 189 214 INTEGER, INTENT(OUT) :: return_value !< return value … … 199 224 200 225 #if defined( __netcdf4 ) 201 #if defined( __parallel ) 202 CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value ) 203 IF ( return_value /= 0 ) THEN 204 CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' ) 205 ENDIF 206 IF ( my_rank /= master_rank ) THEN 207 return_value = 1 208 CALL internal_message( 'error', routine_name // & 209 ': trying to define a NetCDF file in serial mode by an MPI ' // & 210 'rank other than the master output rank. Serial NetCDF ' // & 211 'files can only be defined by the master output rank!' ) 212 ENDIF 213 #else 214 my_rank = master_rank 215 return_value = 0 216 #endif 217 218 IF ( return_value == 0 ) & 219 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 220 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), file_id ) 226 227 IF ( return_value == 0 ) THEN 228 IF ( my_rank == master_rank ) THEN 229 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 230 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), & 231 file_id ) 232 ELSE 233 nc_stat = 0 234 ENDIF 235 ENDIF 221 236 #else 222 237 nc_stat = 0 … … 245 260 nc_stat = 0 246 261 return_value = 1 247 CALL internal_message( 'error', routine_name // ': selected mode "' //&248 TRIM( mode ) // '" must be either "' //&249 262 CALL internal_message( 'error', routine_name // & 263 ': selected mode "' // TRIM( mode ) // '" must be either "' // & 264 mode_serial // '" or "' // mode_parallel // '"' ) 250 265 ENDIF 251 266 … … 266 281 !> Write attribute to netcdf file. 267 282 !--------------------------------------------------------------------------------------------------! 268 SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name,&283 SUBROUTINE netcdf4_write_attribute( mode, file_id, variable_id, attribute_name, & 269 284 value_char, value_int8, value_int16, value_int32, & 270 285 value_real32, value_real64, return_value ) … … 273 288 274 289 CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute 290 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 275 291 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute 276 292 … … 292 308 return_value = 0 293 309 294 IF ( variable_id == global_id_in_file ) THEN 295 target_id = NF90_GLOBAL 296 ELSE 297 target_id = variable_id 298 ENDIF 299 300 CALL internal_message( 'debug', routine_name // & 301 ': write attribute "' // TRIM( attribute_name ) // '"' ) 302 303 IF ( PRESENT( value_char ) ) THEN 304 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) ) 305 ELSEIF ( PRESENT( value_int8 ) ) THEN 306 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 ) 307 ELSEIF ( PRESENT( value_int16 ) ) THEN 308 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 ) 309 ELSEIF ( PRESENT( value_int32 ) ) THEN 310 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 ) 311 ELSEIF ( PRESENT( value_real32 ) ) THEN 312 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 ) 313 ELSEIF ( PRESENT( value_real64 ) ) THEN 314 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 ) 315 ELSE 316 return_value = 1 317 CALL internal_message( 'error', routine_name // & 318 ': no value given for attribute "' // TRIM( attribute_name ) // '"' ) 319 ENDIF 320 321 IF ( return_value == 0 ) THEN 322 IF ( nc_stat /= NF90_NOERR ) THEN 310 IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN 311 312 IF ( variable_id == global_id_in_file ) THEN 313 target_id = NF90_GLOBAL 314 ELSE 315 target_id = variable_id 316 ENDIF 317 318 CALL internal_message( 'debug', routine_name // & 319 ': write attribute "' // TRIM( attribute_name ) // '"' ) 320 321 IF ( PRESENT( value_char ) ) THEN 322 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) ) 323 ELSEIF ( PRESENT( value_int8 ) ) THEN 324 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 ) 325 ELSEIF ( PRESENT( value_int16 ) ) THEN 326 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 ) 327 ELSEIF ( PRESENT( value_int32 ) ) THEN 328 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 ) 329 ELSEIF ( PRESENT( value_real32 ) ) THEN 330 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 ) 331 ELSEIF ( PRESENT( value_real64 ) ) THEN 332 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 ) 333 ELSE 323 334 return_value = 1 324 335 CALL internal_message( 'error', routine_name // & 325 ': NetCDF error while writing attribute "' // & 326 TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 327 ENDIF 336 ': no value given for attribute "' // TRIM( attribute_name ) // & 337 '"' ) 338 ENDIF 339 340 IF ( return_value == 0 ) THEN 341 IF ( nc_stat /= NF90_NOERR ) THEN 342 return_value = 1 343 CALL internal_message( 'error', routine_name // & 344 ': NetCDF error while writing attribute "' // & 345 TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 346 ENDIF 347 ENDIF 348 328 349 ENDIF 329 350 #else 330 351 return_value = 1 352 ! 353 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 354 IF ( .FALSE. ) THEN 355 nc_stat = LEN( routine_name ) 356 target_id = 0 357 ENDIF 331 358 #endif 332 359 … … 339 366 !--------------------------------------------------------------------------------------------------! 340 367 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, & 341 dimension_name, dimension_type, dimension_length, return_value ) 368 dimension_name, dimension_type, dimension_length, & 369 write_only_by_master_rank, return_value ) 342 370 343 371 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine … … 355 383 INTEGER, INTENT(OUT) :: variable_id !< variable ID 356 384 385 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 386 357 387 358 388 #if defined( __netcdf4 ) 359 389 return_value = 0 360 390 variable_id = -1 361 362 CALL internal_message( 'debug', routine_name // & 363 ': init dimension "' // TRIM( dimension_name ) // '"' ) 364 ! 365 !-- Check if dimension is unlimited 366 IF ( dimension_length < 0 ) THEN 367 nc_dimension_length = NF90_UNLIMITED 368 ELSE 369 nc_dimension_length = dimension_length 370 ENDIF 371 ! 372 !-- Define dimension in file 373 nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id ) 374 375 IF ( nc_stat == NF90_NOERR ) THEN 376 ! 377 !-- Define variable holding dimension values in file 378 CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 379 (/ dimension_id /), is_global=.TRUE., return_value=return_value ) 380 381 ELSE 382 return_value = 1 383 CALL internal_message( 'error', routine_name // & 384 ': NetCDF error while initializing dimension "' // & 385 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 391 dimension_id = -1 392 393 IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN 394 395 CALL internal_message( 'debug', routine_name // & 396 ': init dimension "' // TRIM( dimension_name ) // '"' ) 397 ! 398 !-- Check if dimension is unlimited 399 IF ( dimension_length < 0 ) THEN 400 nc_dimension_length = NF90_UNLIMITED 401 ELSE 402 nc_dimension_length = dimension_length 403 ENDIF 404 ! 405 !-- Define dimension in file 406 nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id ) 407 408 IF ( nc_stat == NF90_NOERR ) THEN 409 ! 410 !-- Define variable holding dimension values in file 411 CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 412 (/ dimension_id /), & 413 write_only_by_master_rank=write_only_by_master_rank, & 414 return_value=return_value ) 415 416 ELSE 417 return_value = 1 418 CALL internal_message( 'error', routine_name // & 419 ': NetCDF error while initializing dimension "' // & 420 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 421 ENDIF 422 386 423 ENDIF 387 424 #else … … 389 426 variable_id = -1 390 427 dimension_id = -1 428 ! 429 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 430 IF ( .FALSE. ) THEN 431 nc_stat = LEN( routine_name ) 432 nc_dimension_length = 0 433 ENDIF 391 434 #endif 392 435 … … 399 442 !--------------------------------------------------------------------------------------------------! 400 443 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 401 dimension_ids, is_global, return_value )444 dimension_ids, write_only_by_master_rank, return_value ) 402 445 403 446 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine … … 407 450 CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable 408 451 409 INTEGER, INTENT(IN) :: file_id !< file ID 410 INTEGER :: nc_stat !< netcdf return value 411 INTEGER :: nc_variable_type !< netcdf data type 412 INTEGER, INTENT(OUT) :: return_value !< return value 413 INTEGER, INTENT(OUT) :: variable_id !< variable ID 414 452 INTEGER, INTENT(IN) :: file_id !< file ID 453 INTEGER :: nc_stat !< netcdf return value 454 INTEGER :: nc_variable_type !< netcdf data type 455 INTEGER, INTENT(OUT) :: return_value !< return value 456 INTEGER, INTENT(OUT) :: variable_id !< variable ID 457 #if defined( __netcdf4_parallel ) 458 INTEGER :: parallel_access_mode !< either NF90_INDEPENDENT or NF90_COLLECTIVE 459 INTEGER :: unlimited_dimension_id !< ID of unlimited dimension in file 460 #endif 415 461 INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable 416 462 417 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE)463 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 418 464 419 465 420 466 #if defined( __netcdf4 ) 421 467 return_value = 0 422 423 WRITE( temp_string, * ) is_global 424 CALL internal_message( 'debug', routine_name // & 425 ': init variable "' // TRIM( variable_name ) // & 426 '" ( is_global = ' // TRIM( temp_string ) // ')' ) 427 428 nc_variable_type = get_netcdf_data_type( variable_type ) 429 430 IF ( nc_variable_type /= -1 ) THEN 431 ! 432 !-- Define variable in file 433 nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id ) 434 435 ! 436 !-- Define how variable can be accessed by PEs in parallel netcdf file 437 IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN 468 variable_id = -1 469 470 IF ( ( TRIM( mode ) == mode_serial .AND. my_rank == master_rank ) & 471 .OR. TRIM( mode ) == mode_parallel ) THEN 472 473 WRITE( temp_string, * ) write_only_by_master_rank 474 CALL internal_message( 'debug', routine_name // & 475 ': init variable "' // TRIM( variable_name ) // & 476 '" ( write_only_by_master_rank = ' // TRIM( temp_string ) // ')' ) 477 478 nc_variable_type = get_netcdf_data_type( variable_type ) 479 480 IF ( nc_variable_type /= -1 ) THEN 481 ! 482 !-- Define variable in file 483 nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, & 484 dimension_ids, variable_id ) 485 438 486 #if defined( __netcdf4_parallel ) 439 IF ( is_global ) THEN 440 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT ) 441 ELSE 442 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE ) 487 ! 488 !-- Define how variable can be accessed by PEs in parallel netcdf file 489 IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN 490 ! 491 !-- If the variable uses an unlimited dimension, its access mode must be 'collective', 492 !-- otherwise it can be set to independent. 493 !-- Hence, get ID of unlimited dimension in file (if any) and check if it is used by 494 !-- the variable. 495 nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id ) 496 497 IF ( nc_stat == NF90_NOERR ) THEN 498 IF ( ANY( dimension_ids == unlimited_dimension_id ) ) THEN 499 parallel_access_mode = NF90_COLLECTIVE 500 ELSE 501 parallel_access_mode = NF90_INDEPENDENT 502 ENDIF 503 504 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, parallel_access_mode ) 505 ENDIF 443 506 ENDIF 444 #else 445 CONTINUE 446 #endif 447 ENDIF 448 449 IF ( nc_stat /= NF90_NOERR ) THEN 507 #endif 508 509 IF ( nc_stat /= NF90_NOERR ) THEN 510 return_value = 1 511 CALL internal_message( 'error', routine_name // & 512 ': NetCDF error while initializing variable "' // & 513 TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 514 ENDIF 515 516 ELSE 450 517 return_value = 1 451 CALL internal_message( 'error', routine_name // & 452 ': NetCDF error while initializing variable "' // & 453 TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 454 ENDIF 455 456 ELSE 518 ENDIF 519 520 ELSEIF ( TRIM( mode ) /= mode_serial .AND. TRIM( mode ) /= mode_parallel ) THEN 457 521 return_value = 1 522 CALL internal_message( 'error', routine_name // & 523 ': selected mode "' // TRIM( mode ) // '" must be either "' // & 524 mode_serial // '" or "' // mode_parallel // '"' ) 458 525 ENDIF 459 526 … … 461 528 return_value = 1 462 529 variable_id = -1 530 ! 531 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 532 IF ( .FALSE. ) THEN 533 nc_stat = LEN( routine_name ) 534 nc_variable_type = get_netcdf_data_type( '' ) 535 ENDIF 463 536 #endif 464 537 … … 470 543 !> Leave file definition state. 471 544 !--------------------------------------------------------------------------------------------------! 472 SUBROUTINE netcdf4_stop_file_header_definition( file_id, return_value )545 SUBROUTINE netcdf4_stop_file_header_definition( mode, file_id, return_value ) 473 546 474 547 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_stop_file_header_definition' !< name of this routine 548 549 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 475 550 476 551 INTEGER, INTENT(IN) :: file_id !< file ID … … 483 558 return_value = 0 484 559 485 WRITE( temp_string, * ) file_id 486 CALL internal_message( 'debug', routine_name // & 487 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 488 ! 489 !-- Set general no fill, otherwise the performance drops significantly 490 nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode ) 491 492 IF ( nc_stat == NF90_NOERR ) THEN 493 nc_stat = NF90_ENDDEF( file_id ) 494 ENDIF 495 496 IF ( nc_stat /= NF90_NOERR ) THEN 497 return_value = 1 498 CALL internal_message( 'error', routine_name // & 499 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 560 IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN 561 562 WRITE( temp_string, * ) file_id 563 CALL internal_message( 'debug', routine_name // & 564 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 565 ! 566 !-- Set general no fill, otherwise the performance drops significantly 567 nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode ) 568 569 IF ( nc_stat == NF90_NOERR ) THEN 570 nc_stat = NF90_ENDDEF( file_id ) 571 ENDIF 572 573 IF ( nc_stat /= NF90_NOERR ) THEN 574 return_value = 1 575 CALL internal_message( 'error', routine_name // & 576 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 577 ENDIF 578 500 579 ENDIF 501 580 #else 502 581 return_value = 1 582 ! 583 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 584 IF ( .FALSE. ) THEN 585 nc_stat = LEN( routine_name ) 586 old_fill_mode = 0 587 ENDIF 503 588 #endif 504 589 … … 511 596 !--------------------------------------------------------------------------------------------------! 512 597 SUBROUTINE netcdf4_write_variable( & 513 file_id, variable_id, bounds_start, value_counts, bounds_origin,&514 is_global,&598 mode, file_id, variable_id, bounds_start, value_counts, bounds_origin, & 599 write_only_by_master_rank, & 515 600 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 516 601 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & … … 525 610 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine 526 611 612 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 613 527 614 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable 528 615 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable … … 530 617 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable 531 618 532 INTEGER :: d !< loop index533 INTEGER, INTENT(IN) :: file_id !< file ID534 INTEGER :: my_rank !< MPI rank of processor535 INTEGER :: n c_stat !< netcdf return value536 INTEGER :: ndims !< number of dimensions of variable in file537 INTEGER , INTENT(OUT) :: return_value !< return value538 INTEGER, INTENT(IN) :: variable_id !< variable ID619 INTEGER :: d !< loop index 620 INTEGER, INTENT(IN) :: file_id !< file ID 621 INTEGER :: nc_stat !< netcdf return value 622 INTEGER :: ndims !< number of dimensions of variable in file 623 INTEGER, INTENT(OUT) :: return_value !< return value 624 INTEGER :: unlimited_dimension_id !< ID of unlimited dimension in file 625 INTEGER, INTENT(IN) :: variable_id !< variable ID 539 626 540 627 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension … … 561 648 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable 562 649 563 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE) 650 LOGICAL, INTENT(IN) :: write_only_by_master_rank !< true if only master rank shall write variable 651 LOGICAL :: write_data !< true if variable shall be written to file 564 652 565 653 REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable … … 578 666 579 667 #if defined( __netcdf4 ) 580 581 #if defined( __parallel )582 CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )583 IF ( return_value /= 0 ) THEN584 CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )585 ENDIF586 #else587 my_rank = master_rank588 668 return_value = 0 589 #endif 590 591 IF ( return_value == 0 .AND. ( .NOT. is_global .OR. my_rank == master_rank ) ) THEN 669 write_data = .FALSE. 670 ! 671 !-- Check whether this PE write any data to file 672 IF ( TRIM( mode ) == mode_serial ) THEN 673 674 IF ( my_rank == master_rank ) write_data = .TRUE. 675 676 ELSEIF ( TRIM( mode ) == mode_parallel ) THEN 677 ! 678 !-- Check for collective access mode. 679 !-- This cannot be checked directly but indirect via the presence of any unlimited dimensions 680 !-- If any dimension is unlimited, variable access must be collective and all PEs must 681 !-- participate in writing 682 ndims = SIZE( bounds_start ) 683 ALLOCATE( dimension_ids(ndims) ) 684 685 nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, DIMIDS=dimension_ids ) 686 nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id ) 687 688 IF ( ANY( dimension_ids == unlimited_dimension_id ) ) THEN 689 write_data = .TRUE. 690 ! 691 !-- If access is independent, check if only master rank shall write 692 ELSEIF ( write_only_by_master_rank ) THEN 693 IF ( my_rank == master_rank ) write_data = .TRUE. 694 ! 695 !-- If all PEs can write, check if there are any data to be written 696 ELSEIF ( ALL( value_counts > 0, DIM=1 ) ) THEN 697 write_data = .TRUE. 698 ENDIF 699 700 ELSE 701 return_value = 1 702 CALL internal_message( 'error', routine_name // & 703 ': selected mode "' // TRIM( mode ) // '" must be either "' // & 704 mode_serial // '" or "' // mode_parallel // '"' ) 705 ENDIF 706 707 IF ( write_data ) THEN 592 708 593 709 WRITE( temp_string, * ) variable_id … … 595 711 596 712 ndims = SIZE( bounds_start ) 597 598 ! 599 !-- character output 713 ! 714 !-- Character output 600 715 IF ( PRESENT( values_char_0d ) ) THEN 601 716 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), & … … 723 838 count = value_counts ) 724 839 ! 725 !-- working-precision real output840 !-- Working-precision real output 726 841 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 727 842 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), & … … 757 872 WRITE( temp_string, * ) NF90_STRERROR( nc_stat ) 758 873 759 ALLOCATE( dimension_ids(ndims) )874 IF ( .NOT. ALLOCATED( dimension_ids ) ) ALLOCATE( dimension_ids(ndims) ) 760 875 ALLOCATE( dimension_lengths(ndims) ) 761 876 … … 793 908 #else 794 909 return_value = 1 910 ! 911 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 912 IF ( .FALSE. ) THEN 913 nc_stat = LEN( routine_name ) 914 IF ( write_data ) unlimited_dimension_id = 0 915 IF ( ALLOCATED( dimension_ids ) ) d = 0 916 IF ( ALLOCATED( dimension_lengths ) ) ndims = 0 917 ENDIF 795 918 #endif 796 919 … … 802 925 !> Close netcdf file. 803 926 !--------------------------------------------------------------------------------------------------! 804 SUBROUTINE netcdf4_finalize( file_id, return_value )927 SUBROUTINE netcdf4_finalize( mode, file_id, return_value ) 805 928 806 929 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_finalize' !< name of routine 930 931 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 807 932 808 933 INTEGER, INTENT(IN) :: file_id !< file ID … … 812 937 813 938 #if defined( __netcdf4 ) 814 WRITE( temp_string, * ) file_id 815 CALL internal_message( 'debug', routine_name // & 816 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 817 818 nc_stat = NF90_CLOSE( file_id ) 819 IF ( nc_stat == NF90_NOERR ) THEN 820 return_value = 0 821 ELSE 822 return_value = 1 823 CALL internal_message( 'error', routine_name // & 824 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 939 return_value = 0 940 941 IF ( .NOT. ( TRIM( mode ) == mode_serial .AND. my_rank /= master_rank ) ) THEN 942 943 WRITE( temp_string, * ) file_id 944 CALL internal_message( 'debug', routine_name // & 945 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 946 947 nc_stat = NF90_CLOSE( file_id ) 948 IF ( nc_stat == NF90_NOERR ) THEN 949 return_value = 0 950 ELSE 951 return_value = 1 952 CALL internal_message( 'error', routine_name // & 953 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 954 ENDIF 955 825 956 ENDIF 826 957 #else 827 958 return_value = 1 959 ! 960 !-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set 961 IF ( .FALSE. ) THEN 962 nc_stat = 0 963 temp_string = routine_name 964 ENDIF 828 965 #endif 829 966
Note: See TracChangeset
for help on using the changeset viewer.
