Changeset 4141 for palm/trunk/SOURCE/data_output_netcdf4_module.f90
- Timestamp:
- Aug 5, 2019 12:24:51 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_netcdf4_module.f90 (modified) (34 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4123 r4141 62 62 CHARACTER(LEN=*), PARAMETER :: mode_serial = 'serial' !< string selecting netcdf4 serial mode 63 63 64 INTEGER (iwp):: debug_output_unit !< Fortran Unit Number of the debug-output file65 INTEGER (iwp):: global_id_in_file = -1 !< value of global ID within a file66 INTEGER 67 INTEGER 64 INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file 65 INTEGER :: global_id_in_file = -1 !< value of global ID within a file 66 INTEGER :: master_rank !< master rank for tasks to be executed by single PE only 67 INTEGER :: output_group_comm !< MPI communicator addressing all MPI ranks which participate in output 68 68 69 69 LOGICAL :: print_debug_output = .FALSE. !< if true, debug output is printed … … 93 93 END INTERFACE netcdf4_write_attribute 94 94 95 INTERFACE netcdf4_ init_end96 MODULE PROCEDURE netcdf4_ init_end97 END INTERFACE netcdf4_ init_end95 INTERFACE netcdf4_stop_file_header_definition 96 MODULE PROCEDURE netcdf4_stop_file_header_definition 97 END INTERFACE netcdf4_stop_file_header_definition 98 98 99 99 INTERFACE netcdf4_write_variable … … 113 113 netcdf4_get_error_message, & 114 114 netcdf4_init_dimension, & 115 netcdf4_ init_end, &115 netcdf4_stop_file_header_definition, & 116 116 netcdf4_init_module, & 117 117 netcdf4_init_variable, & … … 136 136 !> must be unique for each output group 137 137 138 INTEGER (iwp), INTENT(IN) :: dom_global_id !< global id within a file defined by DOM139 INTEGER, 140 INTEGER, 141 INTEGER (iwp), INTENT(IN) :: program_debug_output_unit !< file unit number for debug output138 INTEGER, INTENT(IN) :: dom_global_id !< global id within a file defined by DOM 139 INTEGER, INTENT(IN) :: master_output_rank !< MPI rank executing tasks which must be executed by a single PE 140 INTEGER, INTENT(IN) :: mpi_comm_of_output_group !< MPI communicator specifying the rank group participating in output 141 INTEGER, INTENT(IN) :: program_debug_output_unit !< file unit number for debug output 142 142 143 143 LOGICAL, INTENT(IN) :: debug_output !< if true, debug output is printed … … 160 160 !> Open netcdf file. 161 161 !--------------------------------------------------------------------------------------------------! 162 SUBROUTINE netcdf4_open_file( mode, file name, file_id, return_value )163 164 CHARACTER(LEN=*), INTENT(IN) :: file name !< name of file165 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)162 SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value ) 163 164 CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file 165 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 166 166 167 167 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_open_file' !< name of this routine 168 168 169 INTEGER (iwp), INTENT(OUT) :: file_id !< file ID170 INTEGER 171 INTEGER (iwp):: nc_stat !< netcdf return value172 INTEGER (iwp), INTENT(OUT) :: return_value !< return value169 INTEGER, INTENT(OUT) :: file_id !< file ID 170 INTEGER :: my_rank !< MPI rank of processor 171 INTEGER :: nc_stat !< netcdf return value 172 INTEGER, INTENT(OUT) :: return_value !< return value 173 173 174 174 … … 177 177 178 178 !-- Open new file 179 CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file name ) // '"' )179 CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' ) 180 180 181 181 IF ( TRIM( mode ) == mode_serial ) THEN … … 200 200 201 201 IF ( return_value == 0 ) & 202 nc_stat = NF90_CREATE( TRIM( file name ) // TRIM( file_suffix ), &203 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &202 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 203 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), & 204 204 file_id ) 205 205 #else … … 214 214 215 215 #if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel ) 216 nc_stat = NF90_CREATE( TRIM( file name ) // TRIM( file_suffix ),&216 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 217 217 IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), & 218 218 file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL ) … … 229 229 nc_stat = 0 230 230 return_value = 1 231 CALL internal_message( 'error', routine_name // ': selected mode "' // &231 CALL internal_message( 'error', routine_name // ': selected mode "' // & 232 232 TRIM( mode ) // '" must be either "' // & 233 233 mode_serial // '" or "' // mode_parallel // '"' ) … … 237 237 IF ( nc_stat /= NF90_NOERR .AND. return_value == 0 ) THEN 238 238 return_value = 1 239 CALL internal_message( 'error', routine_name // ': NetCDF error while opening file "' // & 240 TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) ) 239 CALL internal_message( 'error', routine_name // & 240 ': NetCDF error while opening file "' // & 241 TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 241 242 ENDIF 242 243 #endif … … 249 250 !> Write attribute to netcdf file. 250 251 !--------------------------------------------------------------------------------------------------! 251 SUBROUTINE netcdf4_write_attribute( file_id, var _id, att_name, att_value_char, &252 att_value_int8, att_value_int16, att_value_int32,&253 att_value_real32, att_value_real64, return_value )254 255 CHARACTER(LEN=*), INTENT(IN) :: att _name!< name of attribute256 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: att_value_char!< value of attribute252 SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name, & 253 value_char, value_int8, value_int16, value_int32, & 254 value_real32, value_real64, return_value ) 255 256 CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute 257 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute 257 258 258 259 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine 259 260 260 INTEGER (iwp):: nc_stat !< netcdf return value261 INTEGER (iwp) :: target_id !< ID of target which gets attribute (either global or var_id)262 263 INTEGER (iwp), INTENT(IN) :: file_id !< file ID264 INTEGER (iwp), INTENT(OUT) :: return_value !< return value265 INTEGER (iwp), INTENT(IN) :: var_id!< variable ID266 267 INTEGER(KIND=1), INTENT(IN), OPTIONAL :: att_value_int8 !< value of attribute268 INTEGER(KIND=2), INTENT(IN), OPTIONAL :: att_value_int16 !< value of attribute269 INTEGER(KIND=4), INTENT(IN), OPTIONAL :: att_value_int32 !< value of attribute270 271 REAL(KIND=4), INTENT(IN), OPTIONAL :: att_value_real32 !< value of attribute272 REAL(KIND=8), INTENT(IN), OPTIONAL :: att_value_real64 !< value of attribute261 INTEGER :: nc_stat !< netcdf return value 262 INTEGER :: target_id !< ID of target which gets attribute (either global or variable_id) 263 264 INTEGER, INTENT(IN) :: file_id !< file ID 265 INTEGER, INTENT(OUT) :: return_value !< return value 266 INTEGER, INTENT(IN) :: variable_id !< variable ID 267 268 INTEGER(KIND=1), INTENT(IN), OPTIONAL :: value_int8 !< value of attribute 269 INTEGER(KIND=2), INTENT(IN), OPTIONAL :: value_int16 !< value of attribute 270 INTEGER(KIND=4), INTENT(IN), OPTIONAL :: value_int32 !< value of attribute 271 272 REAL(KIND=4), INTENT(IN), OPTIONAL :: value_real32 !< value of attribute 273 REAL(KIND=8), INTENT(IN), OPTIONAL :: value_real64 !< value of attribute 273 274 274 275 … … 276 277 return_value = 0 277 278 278 IF ( var _id == global_id_in_file ) THEN279 IF ( variable_id == global_id_in_file ) THEN 279 280 target_id = NF90_GLOBAL 280 281 ELSE 281 target_id = var _id282 ENDIF 283 284 CALL internal_message( 'debug', &285 routine_name // ': write attribute "' // TRIM( att_name ) // '"' )286 287 IF ( PRESENT( att_value_char ) ) THEN288 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), TRIM( att_value_char ) )289 ELSEIF ( PRESENT( att_value_int8 ) ) THEN290 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), att_value_int8 )291 ELSEIF ( PRESENT( att_value_int16 ) ) THEN292 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), att_value_int16 )293 ELSEIF ( PRESENT( att_value_int32 ) ) THEN294 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), att_value_int32 )295 ELSEIF ( PRESENT( att_value_real32 ) ) THEN296 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), att_value_real32 )297 ELSEIF ( PRESENT( att_value_real64 ) ) THEN298 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( att _name ), att_value_real64 )282 target_id = variable_id 283 ENDIF 284 285 CALL internal_message( 'debug', routine_name // & 286 ': write attribute "' // TRIM( attribute_name ) // '"' ) 287 288 IF ( PRESENT( value_char ) ) THEN 289 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) ) 290 ELSEIF ( PRESENT( value_int8 ) ) THEN 291 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 ) 292 ELSEIF ( PRESENT( value_int16 ) ) THEN 293 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 ) 294 ELSEIF ( PRESENT( value_int32 ) ) THEN 295 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 ) 296 ELSEIF ( PRESENT( value_real32 ) ) THEN 297 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 ) 298 ELSEIF ( PRESENT( value_real64 ) ) THEN 299 nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 ) 299 300 ELSE 300 301 return_value = 1 301 CALL internal_message( 'error', TRIM( routine_name )// &302 ': attribute "' // TRIM( att_name ) // '": no value given' )302 CALL internal_message( 'error', routine_name // & 303 ': no value given for attribute "' // TRIM( attribute_name ) // '"' ) 303 304 ENDIF 304 305 … … 306 307 IF ( nc_stat /= NF90_NOERR ) THEN 307 308 return_value = 1 308 CALL internal_message( 'error', 309 routine_name //': NetCDF error while writing attribute "' // &310 TRIM( att_name ) // '": ' // NF90_STRERROR( nc_stat ) )309 CALL internal_message( 'error', routine_name // & 310 ': NetCDF error while writing attribute "' // & 311 TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 311 312 ENDIF 312 313 ENDIF … … 322 323 !> Initialize dimension. 323 324 !--------------------------------------------------------------------------------------------------! 324 SUBROUTINE netcdf4_init_dimension( mode, file_id, dim _id, var_id, &325 dim _name, dim_type, dim_length, return_value )326 327 CHARACTER(LEN=*), INTENT(IN) :: dim _name !< name of dimension328 CHARACTER(LEN=*), INTENT(IN) :: dim _type !< data type of dimension329 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)325 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, & 326 dimension_name, dimension_type, dimension_length, return_value ) 327 328 CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension 329 CHARACTER(LEN=*), INTENT(IN) :: dimension_type !< data type of dimension 330 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 330 331 331 332 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine 332 333 333 INTEGER (iwp), INTENT(OUT) :: dim_id !< dimension ID334 INTEGER (iwp), INTENT(IN) :: dim_length !< length of dimension335 INTEGER (iwp), INTENT(IN) :: file_id!< file ID336 INTEGER (iwp) :: nc_dim_length !< length of dimension337 INTEGER (iwp) :: nc_stat!< netcdf return value338 INTEGER (iwp), INTENT(OUT) :: return_value!< return value339 INTEGER (iwp), INTENT(OUT) :: var_id!< variable ID334 INTEGER, INTENT(OUT) :: dimension_id !< dimension ID 335 INTEGER, INTENT(IN) :: dimension_length !< length of dimension 336 INTEGER, INTENT(IN) :: file_id !< file ID 337 INTEGER :: nc_dimension_length !< length of dimension 338 INTEGER :: nc_stat !< netcdf return value 339 INTEGER, INTENT(OUT) :: return_value !< return value 340 INTEGER, INTENT(OUT) :: variable_id !< variable ID 340 341 341 342 342 343 #if defined( __netcdf4 ) 343 344 return_value = 0 344 var _id = -1345 346 CALL internal_message( 'debug', &347 routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )345 variable_id = -1 346 347 CALL internal_message( 'debug', routine_name // & 348 ': init dimension "' // TRIM( dimension_name ) // '"' ) 348 349 349 350 !-- Check if dimension is unlimited 350 IF ( dim _length < 0 ) THEN351 nc_dim _length = NF90_UNLIMITED351 IF ( dimension_length < 0 ) THEN 352 nc_dimension_length = NF90_UNLIMITED 352 353 ELSE 353 nc_dim _length = dim_length354 nc_dimension_length = dimension_length 354 355 ENDIF 355 356 356 357 !-- Define dimension in file 357 nc_stat = NF90_DEF_DIM( file_id, dim _name, nc_dim_length, dim_id )358 nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id ) 358 359 359 360 IF ( nc_stat == NF90_NOERR ) THEN 360 361 361 362 !-- Define variable holding dimension values in file 362 CALL netcdf4_init_variable( mode, file_id, var _id, dim_name, dim_type, (/dim_id/), &363 363 CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 364 (/ dimension_id /), is_global=.TRUE., return_value=return_value ) 364 365 365 366 ELSE 366 367 return_value = 1 367 CALL internal_message( 'error', routine_name // 368 369 TRIM( dim_name ) // '": ' // NF90_STRERROR( nc_stat ) )368 CALL internal_message( 'error', routine_name // & 369 ': NetCDF error while initializing dimension "' // & 370 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 370 371 ENDIF 371 372 #else 372 373 return_value = 1 373 var _id = -1374 dim _id = -1374 variable_id = -1 375 dimension_id = -1 375 376 #endif 376 377 … … 382 383 !> Initialize variable. 383 384 !--------------------------------------------------------------------------------------------------! 384 SUBROUTINE netcdf4_init_variable( mode, file_id, var _id, var_name, var_type, var_dim_ids, &385 is_global, return_value )386 387 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial)388 CHARACTER(LEN=*), INTENT(IN) :: var _name !< name of variable389 CHARACTER(LEN=*), INTENT(IN) :: var _type !< data type of variable385 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 386 dimension_ids, is_global, return_value ) 387 388 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 389 CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable 390 CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable 390 391 391 392 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine 392 393 393 INTEGER (iwp), INTENT(IN) :: file_id!< file ID394 INTEGER (iwp) :: nc_stat!< netcdf return value395 INTEGER (iwp) :: nc_var_type!< netcdf data type396 INTEGER (iwp), INTENT(OUT) :: return_value!< return value397 INTEGER (iwp), INTENT(OUT) :: var_id!< variable ID398 399 INTEGER (iwp), DIMENSION(:), INTENT(IN) :: var_dim_ids !< list of dimension IDs used by variable394 INTEGER, INTENT(IN) :: file_id !< file ID 395 INTEGER :: nc_stat !< netcdf return value 396 INTEGER :: nc_variable_type !< netcdf data type 397 INTEGER, INTENT(OUT) :: return_value !< return value 398 INTEGER, INTENT(OUT) :: variable_id !< variable ID 399 400 INTEGER, DIMENSION(:), INTENT(IN) :: dimension_ids !< list of dimension IDs used by variable 400 401 401 402 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE) … … 406 407 407 408 WRITE( temp_string, * ) is_global 408 CALL internal_message( 'debug', routine_name // ': init variable "' // TRIM( var_name ) // & 409 '" ( is_global = ' // TRIM( temp_string ) // ')' ) 410 411 nc_var_type = get_netcdf_data_type( var_type ) 412 413 IF ( nc_var_type /= -1_iwp ) THEN 409 CALL internal_message( 'debug', routine_name // & 410 ': init variable "' // TRIM( variable_name ) // & 411 '" ( is_global = ' // TRIM( temp_string ) // ')' ) 412 413 nc_variable_type = get_netcdf_data_type( variable_type ) 414 415 IF ( nc_variable_type /= -1 ) THEN 414 416 415 417 !-- Define variable in file 416 nc_stat = NF90_DEF_VAR( file_id, var _name, nc_var_type, var_dim_ids, var_id )418 nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type, dimension_ids, variable_id ) 417 419 418 420 #if defined( __netcdf4_parallel ) … … 420 422 IF ( nc_stat == NF90_NOERR .AND. TRIM( mode ) == mode_parallel ) THEN 421 423 IF ( is_global ) THEN 422 nc_stat = NF90_VAR_PAR_ACCESS( file_id, var _id, NF90_INDEPENDENT )424 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_INDEPENDENT ) 423 425 ELSE 424 nc_stat = NF90_VAR_PAR_ACCESS( file_id, var _id, NF90_COLLECTIVE )426 nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, NF90_COLLECTIVE ) 425 427 ENDIF 426 428 ENDIF 427 429 #endif 428 430 429 IF ( nc_stat /= NF90_NOERR ) THEN431 IF ( nc_stat /= NF90_NOERR ) THEN 430 432 return_value = 1 431 CALL internal_message( 'error', routine_name // 432 433 TRIM( var_name ) // '": ' // NF90_STRERROR( nc_stat ) )433 CALL internal_message( 'error', routine_name // & 434 ': NetCDF error while initializing variable "' // & 435 TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 434 436 ENDIF 435 437 … … 440 442 #else 441 443 return_value = 1 442 var _id = -1444 variable_id = -1 443 445 #endif 444 446 … … 450 452 !> Leave file definition state. 451 453 !--------------------------------------------------------------------------------------------------! 452 SUBROUTINE netcdf4_ init_end( file_id, return_value )453 454 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_ init_end' !< name of this routine455 456 INTEGER (iwp), INTENT(IN) :: file_id!< file ID457 INTEGER (iwp) :: nc_stat!< netcdf return value458 INTEGER (iwp) :: old_mode!< previous netcdf fill mode459 INTEGER (iwp), INTENT(OUT) :: return_value!< return value454 SUBROUTINE netcdf4_stop_file_header_definition( file_id, return_value ) 455 456 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_stop_file_header_definition' !< name of this routine 457 458 INTEGER, INTENT(IN) :: file_id !< file ID 459 INTEGER :: nc_stat !< netcdf return value 460 INTEGER :: old_fill_mode !< previous netcdf fill mode 461 INTEGER, INTENT(OUT) :: return_value !< return value 460 462 461 463 … … 464 466 465 467 WRITE( temp_string, * ) file_id 466 CALL internal_message( 'debug', & 467 routine_name // & 468 CALL internal_message( 'debug', routine_name // & 468 469 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 469 470 470 471 !-- Set general no fill, otherwise the performance drops significantly 471 nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_ mode )472 nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode ) 472 473 473 474 IF ( nc_stat == NF90_NOERR ) THEN … … 477 478 IF ( nc_stat /= NF90_NOERR ) THEN 478 479 return_value = 1 479 CALL internal_message( 'error', routine_name // ': NetCDF error: ' //&480 480 CALL internal_message( 'error', routine_name // & 481 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 481 482 ENDIF 482 483 #else … … 484 485 #endif 485 486 486 END SUBROUTINE netcdf4_ init_end487 END SUBROUTINE netcdf4_stop_file_header_definition 487 488 488 489 !--------------------------------------------------------------------------------------------------! … … 491 492 !> Write variable of different kind into netcdf file. 492 493 !--------------------------------------------------------------------------------------------------! 493 SUBROUTINE netcdf4_write_variable( &494 file_id, var _id, bounds_start, value_counts, bounds_origin,&495 is_global, &496 va r_int8_0d, var_int8_1d, var_int8_2d, var_int8_3d, &497 va r_int16_0d, var_int16_1d, var_int16_2d, var_int16_3d, &498 va r_int32_0d, var_int32_1d, var_int32_2d, var_int32_3d, &499 va r_intwp_0d, var_intwp_1d, var_intwp_2d, var_intwp_3d, &500 va r_real32_0d, var_real32_1d, var_real32_2d, var_real32_3d, &501 va r_real64_0d, var_real64_1d, var_real64_2d, var_real64_3d, &502 va r_realwp_0d, var_realwp_1d, var_realwp_2d, var_realwp_3d, &494 SUBROUTINE netcdf4_write_variable( & 495 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 496 is_global, & 497 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 498 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 499 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 500 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 501 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 502 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 503 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, & 503 504 return_value ) 504 505 505 506 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine 506 507 507 INTEGER(iwp) :: d !< loop index 508 INTEGER(iwp), INTENT(IN) :: file_id !< file ID 509 INTEGER :: my_rank !< MPI rank of processor 510 INTEGER(iwp) :: nc_stat !< netcdf return value 511 INTEGER(iwp) :: ndim !< number of dimensions of variable in file 512 INTEGER(iwp), INTENT(OUT) :: return_value !< return value 513 INTEGER(iwp), INTENT(IN) :: var_id !< variable ID 514 515 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension 516 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable 517 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_ids !< IDs of dimensions of variable in file 518 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_lengths !< length of dimensions of variable in file 519 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: value_counts !< count of values along each dimension to be written 520 521 INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: var_int8_0d !< output variable 522 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int8_1d !< output variable 523 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int8_2d !< output variable 524 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int8_3d !< output variable 525 526 INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: var_int16_0d !< output variable 527 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int16_1d !< output variable 528 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int16_2d !< output variable 529 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int16_3d !< output variable 530 531 INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_int32_0d !< output variable 532 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_int32_1d !< output variable 533 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_int32_2d !< output variable 534 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_int32_3d !< output variable 535 536 INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: var_intwp_0d !< output variable 537 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_intwp_1d !< output variable 538 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_intwp_2d !< output variable 539 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_intwp_3d !< output variable 508 INTEGER :: d !< loop index 509 INTEGER, INTENT(IN) :: file_id !< file ID 510 INTEGER :: my_rank !< MPI rank of processor 511 INTEGER :: nc_stat !< netcdf return value 512 INTEGER :: ndims !< number of dimensions of variable in file 513 INTEGER, INTENT(OUT) :: return_value !< return value 514 INTEGER, INTENT(IN) :: variable_id !< variable ID 515 516 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_origin !< starting index of each dimension 517 INTEGER, DIMENSION(:), INTENT(IN) :: bounds_start !< starting index of variable 518 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< IDs of dimensions of variable in file 519 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_lengths !< length of dimensions of variable in file 520 INTEGER, DIMENSION(:), INTENT(IN) :: value_counts !< count of values along each dimension to be written 521 522 INTEGER(KIND=1), POINTER, INTENT(IN), OPTIONAL :: values_int8_0d !< output variable 523 INTEGER(KIND=2), POINTER, INTENT(IN), OPTIONAL :: values_int16_0d !< output variable 524 INTEGER(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_int32_0d !< output variable 525 INTEGER(iwp), POINTER, INTENT(IN), OPTIONAL :: values_intwp_0d !< output variable 526 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int8_1d !< output variable 527 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int16_1d !< output variable 528 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_int32_1d !< output variable 529 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_intwp_1d !< output variable 530 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int8_2d !< output variable 531 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int16_2d !< output variable 532 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_int32_2d !< output variable 533 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_intwp_2d !< output variable 534 INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int8_3d !< output variable 535 INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int16_3d !< output variable 536 INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_int32_3d !< output variable 537 INTEGER(iwp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_intwp_3d !< output variable 540 538 541 539 LOGICAL, INTENT(IN) :: is_global !< true if variable is global (same on all PE) 542 540 543 REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: var_real32_0d !< output variable 544 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real32_1d !< output variable 545 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real32_2d !< output variable 546 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real32_3d !< output variable 547 548 REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: var_real64_0d !< output variable 549 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_real64_1d !< output variable 550 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_real64_2d !< output variable 551 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_real64_3d !< output variable 552 553 REAL(wp), POINTER, INTENT(IN), OPTIONAL :: var_realwp_0d !< output variable 554 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: var_realwp_1d !< output variable 555 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: var_realwp_2d !< output variable 556 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: var_realwp_3d !< output variable 541 REAL(KIND=4), POINTER, INTENT(IN), OPTIONAL :: values_real32_0d !< output variable 542 REAL(KIND=8), POINTER, INTENT(IN), OPTIONAL :: values_real64_0d !< output variable 543 REAL(wp), POINTER, INTENT(IN), OPTIONAL :: values_realwp_0d !< output variable 544 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real32_1d !< output variable 545 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_real64_1d !< output variable 546 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_realwp_1d !< output variable 547 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real32_2d !< output variable 548 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_real64_2d !< output variable 549 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_realwp_2d !< output variable 550 REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real32_3d !< output variable 551 REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_real64_3d !< output variable 552 REAL(wp), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_realwp_3d !< output variable 557 553 558 554 … … 571 567 IF ( return_value == 0 .AND. ( .NOT. is_global .OR. my_rank == master_rank ) ) THEN 572 568 573 WRITE( temp_string, * ) var _id569 WRITE( temp_string, * ) variable_id 574 570 CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) ) 575 571 576 ndim = SIZE( bounds_start )572 ndims = SIZE( bounds_start ) 577 573 578 574 !-- 8bit integer output 579 IF ( PRESENT( va r_int8_0d ) ) THEN580 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_int8_0d /),&581 start = bounds_start - bounds_origin + 1, &582 count = value_counts ) 583 ELSEIF ( PRESENT( va r_int8_1d ) ) THEN584 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int8_1d,&585 start = bounds_start - bounds_origin + 1, & 586 count = value_counts ) 587 ELSEIF ( PRESENT( va r_int8_2d ) ) THEN588 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int8_2d,&589 start = bounds_start - bounds_origin + 1, & 590 count = value_counts ) 591 ELSEIF ( PRESENT( va r_int8_3d ) ) THEN592 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int8_3d,&575 IF ( PRESENT( values_int8_0d ) ) THEN 576 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), & 577 start = bounds_start - bounds_origin + 1, & 578 count = value_counts ) 579 ELSEIF ( PRESENT( values_int8_1d ) ) THEN 580 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d, & 581 start = bounds_start - bounds_origin + 1, & 582 count = value_counts ) 583 ELSEIF ( PRESENT( values_int8_2d ) ) THEN 584 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d, & 585 start = bounds_start - bounds_origin + 1, & 586 count = value_counts ) 587 ELSEIF ( PRESENT( values_int8_3d ) ) THEN 588 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d, & 593 589 start = bounds_start - bounds_origin + 1, & 594 590 count = value_counts ) 595 591 !-- 16bit integer output 596 ELSEIF ( PRESENT( va r_int16_0d ) ) THEN597 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_int16_0d /),&598 start = bounds_start - bounds_origin + 1, &599 count = value_counts ) 600 ELSEIF ( PRESENT( va r_int16_1d ) ) THEN601 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int16_1d,&602 start = bounds_start - bounds_origin + 1, & 603 count = value_counts ) 604 ELSEIF ( PRESENT( va r_int16_2d ) ) THEN605 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int16_2d,&606 start = bounds_start - bounds_origin + 1, & 607 count = value_counts ) 608 ELSEIF ( PRESENT( va r_int16_3d ) ) THEN609 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int16_3d,&592 ELSEIF ( PRESENT( values_int16_0d ) ) THEN 593 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), & 594 start = bounds_start - bounds_origin + 1, & 595 count = value_counts ) 596 ELSEIF ( PRESENT( values_int16_1d ) ) THEN 597 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d, & 598 start = bounds_start - bounds_origin + 1, & 599 count = value_counts ) 600 ELSEIF ( PRESENT( values_int16_2d ) ) THEN 601 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d, & 602 start = bounds_start - bounds_origin + 1, & 603 count = value_counts ) 604 ELSEIF ( PRESENT( values_int16_3d ) ) THEN 605 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d, & 610 606 start = bounds_start - bounds_origin + 1, & 611 607 count = value_counts ) 612 608 !-- 32bit integer output 613 ELSEIF ( PRESENT( va r_int32_0d ) ) THEN614 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_int32_0d /),&615 start = bounds_start - bounds_origin + 1, &616 count = value_counts ) 617 ELSEIF ( PRESENT( va r_int32_1d ) ) THEN618 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int32_1d,&619 start = bounds_start - bounds_origin + 1, & 620 count = value_counts ) 621 ELSEIF ( PRESENT( va r_int32_2d ) ) THEN622 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int32_2d,&623 start = bounds_start - bounds_origin + 1, & 624 count = value_counts ) 625 ELSEIF ( PRESENT( va r_int32_3d ) ) THEN626 nc_stat = NF90_PUT_VAR( file_id, var _id, var_int32_3d,&609 ELSEIF ( PRESENT( values_int32_0d ) ) THEN 610 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /), & 611 start = bounds_start - bounds_origin + 1, & 612 count = value_counts ) 613 ELSEIF ( PRESENT( values_int32_1d ) ) THEN 614 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d, & 615 start = bounds_start - bounds_origin + 1, & 616 count = value_counts ) 617 ELSEIF ( PRESENT( values_int32_2d ) ) THEN 618 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d, & 619 start = bounds_start - bounds_origin + 1, & 620 count = value_counts ) 621 ELSEIF ( PRESENT( values_int32_3d ) ) THEN 622 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d, & 627 623 start = bounds_start - bounds_origin + 1, & 628 624 count = value_counts ) 629 625 !-- working-precision integer output 630 ELSEIF ( PRESENT( va r_intwp_0d ) ) THEN631 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_intwp_0d /),&632 start = bounds_start - bounds_origin + 1, &633 count = value_counts ) 634 ELSEIF ( PRESENT( va r_intwp_1d ) ) THEN635 nc_stat = NF90_PUT_VAR( file_id, var _id, var_intwp_1d,&636 start = bounds_start - bounds_origin + 1, & 637 count = value_counts ) 638 ELSEIF ( PRESENT( va r_intwp_2d ) ) THEN639 nc_stat = NF90_PUT_VAR( file_id, var _id, var_intwp_2d,&640 start = bounds_start - bounds_origin + 1, & 641 count = value_counts ) 642 ELSEIF ( PRESENT( va r_intwp_3d ) ) THEN643 nc_stat = NF90_PUT_VAR( file_id, var _id, var_intwp_3d,&626 ELSEIF ( PRESENT( values_intwp_0d ) ) THEN 627 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /), & 628 start = bounds_start - bounds_origin + 1, & 629 count = value_counts ) 630 ELSEIF ( PRESENT( values_intwp_1d ) ) THEN 631 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d, & 632 start = bounds_start - bounds_origin + 1, & 633 count = value_counts ) 634 ELSEIF ( PRESENT( values_intwp_2d ) ) THEN 635 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d, & 636 start = bounds_start - bounds_origin + 1, & 637 count = value_counts ) 638 ELSEIF ( PRESENT( values_intwp_3d ) ) THEN 639 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d, & 644 640 start = bounds_start - bounds_origin + 1, & 645 641 count = value_counts ) 646 642 !-- 32bit real output 647 ELSEIF ( PRESENT( va r_real32_0d ) ) THEN648 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_real32_0d /),&649 start = bounds_start - bounds_origin + 1, &650 count = value_counts ) 651 ELSEIF ( PRESENT( va r_real32_1d ) ) THEN652 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real32_1d,&653 start = bounds_start - bounds_origin + 1, & 654 count = value_counts ) 655 ELSEIF ( PRESENT( va r_real32_2d ) ) THEN656 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real32_2d,&657 start = bounds_start - bounds_origin + 1, & 658 count = value_counts ) 659 ELSEIF ( PRESENT( va r_real32_3d ) ) THEN660 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real32_3d,&643 ELSEIF ( PRESENT( values_real32_0d ) ) THEN 644 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), & 645 start = bounds_start - bounds_origin + 1, & 646 count = value_counts ) 647 ELSEIF ( PRESENT( values_real32_1d ) ) THEN 648 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d, & 649 start = bounds_start - bounds_origin + 1, & 650 count = value_counts ) 651 ELSEIF ( PRESENT( values_real32_2d ) ) THEN 652 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d, & 653 start = bounds_start - bounds_origin + 1, & 654 count = value_counts ) 655 ELSEIF ( PRESENT( values_real32_3d ) ) THEN 656 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d, & 661 657 start = bounds_start - bounds_origin + 1, & 662 658 count = value_counts ) 663 659 !-- 64bit real output 664 ELSEIF ( PRESENT( va r_real64_0d ) ) THEN665 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_real64_0d /),&666 start = bounds_start - bounds_origin + 1, &667 count = value_counts ) 668 ELSEIF ( PRESENT( va r_real64_1d ) ) THEN669 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real64_1d,&670 start = bounds_start - bounds_origin + 1, & 671 count = value_counts ) 672 ELSEIF ( PRESENT( va r_real64_2d ) ) THEN673 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real64_2d,&674 start = bounds_start - bounds_origin + 1, & 675 count = value_counts ) 676 ELSEIF ( PRESENT( va r_real64_3d ) ) THEN677 nc_stat = NF90_PUT_VAR( file_id, var _id, var_real64_3d,&660 ELSEIF ( PRESENT( values_real64_0d ) ) THEN 661 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), & 662 start = bounds_start - bounds_origin + 1, & 663 count = value_counts ) 664 ELSEIF ( PRESENT( values_real64_1d ) ) THEN 665 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d, & 666 start = bounds_start - bounds_origin + 1, & 667 count = value_counts ) 668 ELSEIF ( PRESENT( values_real64_2d ) ) THEN 669 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d, & 670 start = bounds_start - bounds_origin + 1, & 671 count = value_counts ) 672 ELSEIF ( PRESENT( values_real64_3d ) ) THEN 673 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d, & 678 674 start = bounds_start - bounds_origin + 1, & 679 675 count = value_counts ) 680 676 !-- working-precision real output 681 ELSEIF ( PRESENT( va r_realwp_0d ) ) THEN682 nc_stat = NF90_PUT_VAR( file_id, var _id, (/ var_realwp_0d /),&683 start = bounds_start - bounds_origin + 1, &684 count = value_counts ) 685 ELSEIF ( PRESENT( va r_realwp_1d ) ) THEN686 nc_stat = NF90_PUT_VAR( file_id, var _id, var_realwp_1d,&687 start = bounds_start - bounds_origin + 1, & 688 count = value_counts ) 689 ELSEIF ( PRESENT( va r_realwp_2d ) ) THEN690 nc_stat = NF90_PUT_VAR( file_id, var _id, var_realwp_2d,&691 start = bounds_start - bounds_origin + 1, & 692 count = value_counts ) 693 ELSEIF ( PRESENT( va r_realwp_3d ) ) THEN694 nc_stat = NF90_PUT_VAR( file_id, var _id, var_realwp_3d,&677 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 678 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), & 679 start = bounds_start - bounds_origin + 1, & 680 count = value_counts ) 681 ELSEIF ( PRESENT( values_realwp_1d ) ) THEN 682 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d, & 683 start = bounds_start - bounds_origin + 1, & 684 count = value_counts ) 685 ELSEIF ( PRESENT( values_realwp_2d ) ) THEN 686 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d, & 687 start = bounds_start - bounds_origin + 1, & 688 count = value_counts ) 689 ELSEIF ( PRESENT( values_realwp_3d ) ) THEN 690 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d, & 695 691 start = bounds_start - bounds_origin + 1, & 696 692 count = value_counts ) … … 698 694 return_value = 1 699 695 nc_stat = NF90_NOERR 700 WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var _id, file_id696 WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id 701 697 CALL internal_message( 'error', routine_name // & 702 TRIM( temp_string ) // & 703 ': no output values given' ) 698 ': no output values given ' // TRIM( temp_string ) ) 704 699 ENDIF 705 700 … … 713 708 WRITE( temp_string, * ) NF90_STRERROR( nc_stat ) 714 709 715 ALLOCATE( dim _ids(ndim) )716 ALLOCATE( dim _lengths(ndim) )717 718 nc_stat = NF90_INQUIRE_VARIABLE( file_id, var _id, dimids=dim_ids )710 ALLOCATE( dimension_ids(ndims) ) 711 ALLOCATE( dimension_lengths(ndims) ) 712 713 nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids ) 719 714 720 715 d = 1 721 DO WHILE ( d <= ndim .AND. nc_stat == NF90_NOERR ) 722 nc_stat = NF90_INQUIRE_DIMENSION( file_id, dim_ids(d), len=dim_lengths(d) ) 716 DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR ) 717 nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), & 718 LEN=dimension_lengths(d) ) 723 719 d = d + 1 724 720 ENDDO … … 728 724 'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin 729 725 CALL internal_message( 'error', routine_name // & 730 ': error while writing: ' // & 731 TRIM( temp_string ) ) 726 ': error while writing: ' // TRIM( temp_string ) ) 732 727 ELSE 733 728 !-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION 734 729 CALL internal_message( 'error', routine_name // & 735 730 ': error while accessing file: ' // & 736 NF90_STRERROR( nc_stat ) )731 NF90_STRERROR( nc_stat ) ) 737 732 ENDIF 738 733 … … 740 735 !-- Other NetCDF error 741 736 CALL internal_message( 'error', routine_name // & 742 ': error while writing: ' // & 743 NF90_STRERROR( nc_stat ) ) 737 ': error while writing: ' // NF90_STRERROR( nc_stat ) ) 744 738 ENDIF 745 739 ENDIF … … 761 755 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_finalize' !< name of routine 762 756 763 INTEGER (iwp), INTENT(IN) :: file_id !< file ID764 INTEGER (iwp):: nc_stat !< netcdf return value765 INTEGER (iwp), INTENT(OUT) :: return_value !< return value757 INTEGER, INTENT(IN) :: file_id !< file ID 758 INTEGER :: nc_stat !< netcdf return value 759 INTEGER, INTENT(OUT) :: return_value !< return value 766 760 767 761 … … 769 763 WRITE( temp_string, * ) file_id 770 764 CALL internal_message( 'debug', routine_name // & 771 765 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 772 766 773 767 nc_stat = NF90_CLOSE( file_id ) … … 777 771 return_value = 1 778 772 CALL internal_message( 'error', routine_name // & 779 773 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 780 774 ENDIF 781 775 #else … … 796 790 CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine 797 791 798 INTEGER (iwp):: return_value !< netcdf data type792 INTEGER :: return_value !< netcdf data type 799 793 800 794 … … 823 817 CASE DEFAULT 824 818 CALL internal_message( 'error', routine_name // & 825 826 return_value = -1 _iwp819 ': data type unknown (' // TRIM( data_type ) // ')' ) 820 return_value = -1 827 821 828 822 END SELECT … … 860 854 !> Return the last created error message. 861 855 !--------------------------------------------------------------------------------------------------! 862 SUBROUTINE netcdf4_get_error_message( error_message ) 863 864 CHARACTER(LEN=800), INTENT(OUT) :: error_message !< return error message to main program 865 866 867 error_message = internal_error_message 868 869 END SUBROUTINE netcdf4_get_error_message 856 FUNCTION netcdf4_get_error_message() RESULT( error_message ) 857 858 CHARACTER(LEN=800) :: error_message !< return error message to main program 859 860 861 error_message = TRIM( internal_error_message ) 862 863 internal_error_message = '' 864 865 END FUNCTION netcdf4_get_error_message 870 866 871 867
Note: See TracChangeset
for help on using the changeset viewer.
