Changeset 4577 for palm/trunk/SOURCE/data_output_netcdf4_module.f90
- Timestamp:
- Jun 25, 2020 9:53:58 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_netcdf4_module.f90 (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4481 r4577 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 2019-2020 Leibniz Universitaet Hannover … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4481 2020-03-31 18:55:54Z maronga 27 29 ! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument 28 ! 30 ! 29 31 ! 4408 2020-02-14 10:04:39Z gronemeier 30 32 ! Enable character-array output … … 67 69 #endif 68 70 69 CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message70 CHARACTER(LEN=100) :: file_suffix = '' !< file suffix added to each file name71 CHARACTER(LEN=800) :: temp_string !< dummy string72 73 71 CHARACTER(LEN=*), PARAMETER :: mode_parallel = 'parallel' !< string selecting netcdf4 parallel mode 74 72 CHARACTER(LEN=*), PARAMETER :: mode_serial = 'serial' !< string selecting netcdf4 serial mode 73 74 CHARACTER(LEN=100) :: file_suffix = '' !< file suffix added to each file name 75 CHARACTER(LEN=800) :: internal_error_message = '' !< string containing the last error message 76 CHARACTER(LEN=800) :: temp_string !< dummy string 75 77 76 78 INTEGER :: debug_output_unit !< Fortran Unit Number of the debug-output file … … 121 123 END INTERFACE netcdf4_get_error_message 122 124 123 PUBLIC &124 netcdf4_finalize, &125 netcdf4_get_error_message, &126 netcdf4_init_dimension, &127 netcdf4_ stop_file_header_definition,&128 netcdf4_init_ module,&129 netcdf4_ init_variable,&130 netcdf4_ open_file,&131 netcdf4_write_attribute, &125 PUBLIC & 126 netcdf4_finalize, & 127 netcdf4_get_error_message, & 128 netcdf4_init_dimension, & 129 netcdf4_init_module, & 130 netcdf4_init_variable, & 131 netcdf4_open_file, & 132 netcdf4_stop_file_header_definition, & 133 netcdf4_write_attribute, & 132 134 netcdf4_write_variable 133 135 … … 141 143 !> Initialize data-output module. 142 144 !--------------------------------------------------------------------------------------------------! 143 SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, &144 master_output_rank, &145 SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group, & 146 master_output_rank, & 145 147 program_debug_output_unit, debug_output, dom_global_id ) 146 148 … … 174 176 SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value ) 175 177 178 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_open_file' !< name of this routine 179 176 180 CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file 177 181 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 178 179 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_open_file' !< name of this routine180 182 181 183 INTEGER, INTENT(OUT) :: file_id !< file ID … … 201 203 IF ( my_rank /= master_rank ) THEN 202 204 return_value = 1 203 CALL internal_message( 'error', routine_name // &204 ': trying to define a NetCDF file in serial mode by an MPI ' // &205 'rank other than the master output rank. Serial NetCDF ' // &205 CALL internal_message( 'error', routine_name // & 206 ': trying to define a NetCDF file in serial mode by an MPI ' // & 207 'rank other than the master output rank. Serial NetCDF ' // & 206 208 'files can only be defined by the master output rank!' ) 207 209 ENDIF … … 212 214 213 215 IF ( return_value == 0 ) & 214 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 215 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), & 216 file_id ) 216 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 217 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), file_id ) 217 218 #else 218 219 nc_stat = 0 219 220 return_value = 1 220 CALL internal_message( 'error', routine_name // &221 ': pre-processor directive "__netcdf4" not given. ' // &221 CALL internal_message( 'error', routine_name // & 222 ': pre-processor directive "__netcdf4" not given. ' // & 222 223 'Using NetCDF4 output not possible' ) 223 224 #endif … … 226 227 227 228 #if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel ) 228 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), &229 IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &229 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 230 IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), & 230 231 file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL ) 231 232 #else 232 233 nc_stat = 0 233 234 return_value = 1 234 CALL internal_message( 'error', routine_name // &235 ': pre-processor directives "__parallel" and/or ' // &236 '"__netcdf4" and/or "__netcdf4_parallel" not given. ' // &235 CALL internal_message( 'error', routine_name // & 236 ': pre-processor directives "__parallel" and/or ' // & 237 '"__netcdf4" and/or "__netcdf4_parallel" not given. ' // & 237 238 'Using parallel NetCDF4 output not possible' ) 238 239 #endif … … 241 242 nc_stat = 0 242 243 return_value = 1 243 CALL internal_message( 'error', routine_name // ': selected mode "' // &244 TRIM( mode ) // '" must be either "' // &244 CALL internal_message( 'error', routine_name // ': selected mode "' // & 245 TRIM( mode ) // '" must be either "' // & 245 246 mode_serial // '" or "' // mode_parallel // '"' ) 246 247 ENDIF … … 249 250 IF ( nc_stat /= NF90_NOERR .AND. return_value == 0 ) THEN 250 251 return_value = 1 251 CALL internal_message( 'error', routine_name // &252 ': NetCDF error while opening file "' // &252 CALL internal_message( 'error', routine_name // & 253 ': NetCDF error while opening file "' // & 253 254 TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 254 255 ENDIF … … 262 263 !> Write attribute to netcdf file. 263 264 !--------------------------------------------------------------------------------------------------! 264 SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name, & 265 value_char, value_int8, value_int16, value_int32, & 266 value_real32, value_real64, return_value ) 265 SUBROUTINE netcdf4_write_attribute( file_id, variable_id, attribute_name, & 266 value_char, value_int8, value_int16, value_int32, & 267 value_real32, value_real64, return_value ) 268 269 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine 267 270 268 271 CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute 269 272 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute 270 271 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_attribute' !< name of this routine272 273 273 274 INTEGER :: nc_stat !< netcdf return value … … 295 296 ENDIF 296 297 297 CALL internal_message( 'debug', routine_name // &298 CALL internal_message( 'debug', routine_name // & 298 299 ': write attribute "' // TRIM( attribute_name ) // '"' ) 299 300 … … 312 313 ELSE 313 314 return_value = 1 314 CALL internal_message( 'error', routine_name // &315 CALL internal_message( 'error', routine_name // & 315 316 ': no value given for attribute "' // TRIM( attribute_name ) // '"' ) 316 317 ENDIF … … 319 320 IF ( nc_stat /= NF90_NOERR ) THEN 320 321 return_value = 1 321 CALL internal_message( 'error', routine_name // &322 ': NetCDF error while writing attribute "' // &322 CALL internal_message( 'error', routine_name // & 323 ': NetCDF error while writing attribute "' // & 323 324 TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 324 325 ENDIF … … 337 338 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, & 338 339 dimension_name, dimension_type, dimension_length, return_value ) 340 341 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine 339 342 340 343 CHARACTER(LEN=*), INTENT(IN) :: dimension_name !< name of dimension 341 344 CHARACTER(LEN=*), INTENT(IN) :: dimension_type !< data type of dimension 342 345 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 343 344 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine345 346 346 347 INTEGER, INTENT(OUT) :: dimension_id !< dimension ID … … 357 358 variable_id = -1 358 359 359 CALL internal_message( 'debug', routine_name // &360 CALL internal_message( 'debug', routine_name // & 360 361 ': init dimension "' // TRIM( dimension_name ) // '"' ) 361 362 ! … … 378 379 ELSE 379 380 return_value = 1 380 CALL internal_message( 'error', routine_name // &381 ': NetCDF error while initializing dimension "' // &381 CALL internal_message( 'error', routine_name // & 382 ': NetCDF error while initializing dimension "' // & 382 383 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 383 384 ENDIF … … 395 396 !> Initialize variable. 396 397 !--------------------------------------------------------------------------------------------------! 397 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, &398 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 398 399 dimension_ids, is_global, return_value ) 400 401 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine 399 402 400 403 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode (either parallel or serial) 401 404 CHARACTER(LEN=*), INTENT(IN) :: variable_name !< name of variable 402 405 CHARACTER(LEN=*), INTENT(IN) :: variable_type !< data type of variable 403 404 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_variable' !< name of this routine405 406 406 407 INTEGER, INTENT(IN) :: file_id !< file ID … … 419 420 420 421 WRITE( temp_string, * ) is_global 421 CALL internal_message( 'debug', routine_name // &422 ': init variable "' // TRIM( variable_name ) // &422 CALL internal_message( 'debug', routine_name // & 423 ': init variable "' // TRIM( variable_name ) // & 423 424 '" ( is_global = ' // TRIM( temp_string ) // ')' ) 424 425 … … 446 447 IF ( nc_stat /= NF90_NOERR ) THEN 447 448 return_value = 1 448 CALL internal_message( 'error', routine_name // &449 ': NetCDF error while initializing variable "' // &449 CALL internal_message( 'error', routine_name // & 450 ': NetCDF error while initializing variable "' // & 450 451 TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) ) 451 452 ENDIF … … 507 508 !> Write variable of different kind into netcdf file. 508 509 !--------------------------------------------------------------------------------------------------! 509 SUBROUTINE netcdf4_write_variable( &510 file_id, variable_id, bounds_start, value_counts, bounds_origin, &511 is_global, &512 values_char_0d, values_char_1d, values_char_2d, values_char_3d, &513 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, &514 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, &515 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, &516 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, &517 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, &518 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, &519 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, &510 SUBROUTINE netcdf4_write_variable( & 511 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 512 is_global, & 513 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 514 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 515 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 516 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 517 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 518 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 519 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 520 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d, & 520 521 return_value ) 521 522 … … 586 587 #endif 587 588 588 IF ( return_value == 0 .AND. ( .NOT. is_global .OR.my_rank == master_rank ) ) THEN589 IF ( return_value == 0 .AND. ( .NOT. is_global .OR. my_rank == master_rank ) ) THEN 589 590 590 591 WRITE( temp_string, * ) variable_id … … 596 597 !-- character output 597 598 IF ( PRESENT( values_char_0d ) ) THEN 598 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), &599 start = bounds_start - bounds_origin + 1, &599 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), & 600 start = bounds_start - bounds_origin + 1, & 600 601 count = value_counts ) 601 602 ELSEIF ( PRESENT( values_char_1d ) ) THEN 602 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d, &603 start = bounds_start - bounds_origin + 1, &603 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d, & 604 start = bounds_start - bounds_origin + 1, & 604 605 count = value_counts ) 605 606 ELSEIF ( PRESENT( values_char_2d ) ) THEN 606 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d, &607 start = bounds_start - bounds_origin + 1, &607 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d, & 608 start = bounds_start - bounds_origin + 1, & 608 609 count = value_counts ) 609 610 ELSEIF ( PRESENT( values_char_3d ) ) THEN 610 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d, &611 start = bounds_start - bounds_origin + 1, &611 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d, & 612 start = bounds_start - bounds_origin + 1, & 612 613 count = value_counts ) 613 614 ! 614 615 !-- 8bit integer output 615 616 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 616 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), &617 start = bounds_start - bounds_origin + 1, &617 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), & 618 start = bounds_start - bounds_origin + 1, & 618 619 count = value_counts ) 619 620 ELSEIF ( PRESENT( values_int8_1d ) ) THEN 620 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d, &621 start = bounds_start - bounds_origin + 1, &621 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d, & 622 start = bounds_start - bounds_origin + 1, & 622 623 count = value_counts ) 623 624 ELSEIF ( PRESENT( values_int8_2d ) ) THEN 624 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d, &625 start = bounds_start - bounds_origin + 1, &625 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d, & 626 start = bounds_start - bounds_origin + 1, & 626 627 count = value_counts ) 627 628 ELSEIF ( PRESENT( values_int8_3d ) ) THEN 628 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d, &629 start = bounds_start - bounds_origin + 1, &629 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d, & 630 start = bounds_start - bounds_origin + 1, & 630 631 count = value_counts ) 631 632 ! 632 633 !-- 16bit integer output 633 634 ELSEIF ( PRESENT( values_int16_0d ) ) THEN 634 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), &635 start = bounds_start - bounds_origin + 1, &635 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /), & 636 start = bounds_start - bounds_origin + 1, & 636 637 count = value_counts ) 637 638 ELSEIF ( PRESENT( values_int16_1d ) ) THEN 638 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d, &639 start = bounds_start - bounds_origin + 1, &639 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d, & 640 start = bounds_start - bounds_origin + 1, & 640 641 count = value_counts ) 641 642 ELSEIF ( PRESENT( values_int16_2d ) ) THEN 642 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d, &643 start = bounds_start - bounds_origin + 1, &643 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d, & 644 start = bounds_start - bounds_origin + 1, & 644 645 count = value_counts ) 645 646 ELSEIF ( PRESENT( values_int16_3d ) ) THEN 646 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d, &647 start = bounds_start - bounds_origin + 1, &647 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d, & 648 start = bounds_start - bounds_origin + 1, & 648 649 count = value_counts ) 649 650 ! 650 651 !-- 32bit integer output 651 652 ELSEIF ( PRESENT( values_int32_0d ) ) THEN 652 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /), &653 start = bounds_start - bounds_origin + 1, &653 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /), & 654 start = bounds_start - bounds_origin + 1, & 654 655 count = value_counts ) 655 656 ELSEIF ( PRESENT( values_int32_1d ) ) THEN 656 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d, &657 start = bounds_start - bounds_origin + 1, &657 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d, & 658 start = bounds_start - bounds_origin + 1, & 658 659 count = value_counts ) 659 660 ELSEIF ( PRESENT( values_int32_2d ) ) THEN 660 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d, &661 start = bounds_start - bounds_origin + 1, &661 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d, & 662 start = bounds_start - bounds_origin + 1, & 662 663 count = value_counts ) 663 664 ELSEIF ( PRESENT( values_int32_3d ) ) THEN 664 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d, &665 start = bounds_start - bounds_origin + 1, &666 count = value_counts ) 667 ! 668 !-- working-precision integer output665 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d, & 666 start = bounds_start - bounds_origin + 1, & 667 count = value_counts ) 668 ! 669 !-- Working-precision integer output 669 670 ELSEIF ( PRESENT( values_intwp_0d ) ) THEN 670 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /), &671 start = bounds_start - bounds_origin + 1, &671 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /), & 672 start = bounds_start - bounds_origin + 1, & 672 673 count = value_counts ) 673 674 ELSEIF ( PRESENT( values_intwp_1d ) ) THEN 674 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d, &675 start = bounds_start - bounds_origin + 1, &675 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d, & 676 start = bounds_start - bounds_origin + 1, & 676 677 count = value_counts ) 677 678 ELSEIF ( PRESENT( values_intwp_2d ) ) THEN 678 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d, &679 start = bounds_start - bounds_origin + 1, &679 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d, & 680 start = bounds_start - bounds_origin + 1, & 680 681 count = value_counts ) 681 682 ELSEIF ( PRESENT( values_intwp_3d ) ) THEN 682 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d, &683 start = bounds_start - bounds_origin + 1, &683 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d, & 684 start = bounds_start - bounds_origin + 1, & 684 685 count = value_counts ) 685 686 ! 686 687 !-- 32bit real output 687 688 ELSEIF ( PRESENT( values_real32_0d ) ) THEN 688 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), &689 start = bounds_start - bounds_origin + 1, &689 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /), & 690 start = bounds_start - bounds_origin + 1, & 690 691 count = value_counts ) 691 692 ELSEIF ( PRESENT( values_real32_1d ) ) THEN 692 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d, &693 start = bounds_start - bounds_origin + 1, &693 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d, & 694 start = bounds_start - bounds_origin + 1, & 694 695 count = value_counts ) 695 696 ELSEIF ( PRESENT( values_real32_2d ) ) THEN 696 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d, &697 start = bounds_start - bounds_origin + 1, &697 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d, & 698 start = bounds_start - bounds_origin + 1, & 698 699 count = value_counts ) 699 700 ELSEIF ( PRESENT( values_real32_3d ) ) THEN 700 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d, &701 start = bounds_start - bounds_origin + 1, &701 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d, & 702 start = bounds_start - bounds_origin + 1, & 702 703 count = value_counts ) 703 704 ! 704 705 !-- 64bit real output 705 706 ELSEIF ( PRESENT( values_real64_0d ) ) THEN 706 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), &707 start = bounds_start - bounds_origin + 1, &707 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /), & 708 start = bounds_start - bounds_origin + 1, & 708 709 count = value_counts ) 709 710 ELSEIF ( PRESENT( values_real64_1d ) ) THEN 710 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d, &711 start = bounds_start - bounds_origin + 1, &711 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d, & 712 start = bounds_start - bounds_origin + 1, & 712 713 count = value_counts ) 713 714 ELSEIF ( PRESENT( values_real64_2d ) ) THEN 714 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d, &715 start = bounds_start - bounds_origin + 1, &715 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d, & 716 start = bounds_start - bounds_origin + 1, & 716 717 count = value_counts ) 717 718 ELSEIF ( PRESENT( values_real64_3d ) ) THEN 718 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d, &719 start = bounds_start - bounds_origin + 1, &719 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d, & 720 start = bounds_start - bounds_origin + 1, & 720 721 count = value_counts ) 721 722 ! 722 723 !-- working-precision real output 723 724 ELSEIF ( PRESENT( values_realwp_0d ) ) THEN 724 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), &725 start = bounds_start - bounds_origin + 1, &725 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /), & 726 start = bounds_start - bounds_origin + 1, & 726 727 count = value_counts ) 727 728 ELSEIF ( PRESENT( values_realwp_1d ) ) THEN 728 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d, &729 start = bounds_start - bounds_origin + 1, &729 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d, & 730 start = bounds_start - bounds_origin + 1, & 730 731 count = value_counts ) 731 732 ELSEIF ( PRESENT( values_realwp_2d ) ) THEN 732 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d, &733 start = bounds_start - bounds_origin + 1, &733 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d, & 734 start = bounds_start - bounds_origin + 1, & 734 735 count = value_counts ) 735 736 ELSEIF ( PRESENT( values_realwp_3d ) ) THEN 736 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d, &737 start = bounds_start - bounds_origin + 1, &737 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d, & 738 start = bounds_start - bounds_origin + 1, & 738 739 count = value_counts ) 739 740 ELSE … … 741 742 nc_stat = NF90_NOERR 742 743 WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id 743 CALL internal_message( 'error', routine_name // &744 CALL internal_message( 'error', routine_name // & 744 745 ': no output values given ' // TRIM( temp_string ) ) 745 746 ENDIF … … 761 762 d = 1 762 763 DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR ) 763 nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), &764 nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d), & 764 765 LEN=dimension_lengths(d) ) 765 766 d = d + 1 … … 767 768 768 769 IF ( nc_stat == NF90_NOERR ) THEN 769 WRITE( temp_string, * ) TRIM( temp_string ) // '; given variable bounds: ' // &770 WRITE( temp_string, * ) TRIM( temp_string ) // '; given variable bounds: ' // & 770 771 'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin 771 CALL internal_message( 'error', routine_name // &772 CALL internal_message( 'error', routine_name // & 772 773 ': error while writing: ' // TRIM( temp_string ) ) 773 774 ELSE 774 775 ! 775 776 !-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION 776 CALL internal_message( 'error', routine_name // &777 ': error while accessing file: ' // &777 CALL internal_message( 'error', routine_name // & 778 ': error while accessing file: ' // & 778 779 NF90_STRERROR( nc_stat ) ) 779 780 ENDIF … … 782 783 ! 783 784 !-- Other NetCDF error 784 CALL internal_message( 'error', routine_name // &785 CALL internal_message( 'error', routine_name // & 785 786 ': error while writing: ' // NF90_STRERROR( nc_stat ) ) 786 787 ENDIF … … 810 811 #if defined( __netcdf4 ) 811 812 WRITE( temp_string, * ) file_id 812 CALL internal_message( 'debug', routine_name // &813 CALL internal_message( 'debug', routine_name // & 813 814 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 814 815 … … 818 819 ELSE 819 820 return_value = 1 820 CALL internal_message( 'error', routine_name // &821 CALL internal_message( 'error', routine_name // & 821 822 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 822 823 ENDIF … … 834 835 FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value ) 835 836 837 CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine 838 836 839 CHARACTER(LEN=*), INTENT(IN) :: data_type !< requested data type 837 838 CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_netcdf_data_type' !< name of this routine839 840 840 841 INTEGER :: return_value !< netcdf data type … … 864 865 865 866 CASE DEFAULT 866 CALL internal_message( 'error', routine_name // &867 CALL internal_message( 'error', routine_name // & 867 868 ': data type unknown (' // TRIM( data_type ) // ')' ) 868 869 return_value = -1 … … 875 876 ! Description: 876 877 ! ------------ 877 !> Message routine writing debug information into the debug file 878 !> or creating the error messagestring.878 !> Message routine writing debug information into the debug file or creating the error message 879 !> string. 879 880 !--------------------------------------------------------------------------------------------------! 880 881 SUBROUTINE internal_message( level, string )
Note: See TracChangeset
for help on using the changeset viewer.
