Changeset 4579 for palm/trunk/SOURCE
- Timestamp:
- Jun 25, 2020 8:05:07 PM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 3 edited
-
data_output_binary_module.f90 (modified) (9 diffs)
-
data_output_module.f90 (modified) (33 diffs)
-
data_output_netcdf4_module.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_binary_module.f90
r4577 r4579 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 22 ! 21 ! 22 ! 23 23 ! Former revisions: 24 24 ! ----------------- 25 25 ! $Id$ 26 ! corrected formatting to follow PALM coding standard 27 ! 28 ! 4577 2020-06-25 09:53:58Z raasch 26 29 ! further re-formatting to follow the PALM coding standard 27 30 ! … … 192 195 193 196 CHARACTER(LEN=charlen) :: bin_filename = '' !< actual name of binary file 194 CHARACTER(LEN=7) :: my_rank_char !< string containing value of my_rank with leading zeros195 196 197 CHARACTER(LEN=charlen), INTENT(IN) :: file_name !< name of file 197 198 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode 198 199 CHARACTER(LEN=7) :: my_rank_char !< string containing value of my_rank with leading zeros 200 201 INTEGER, INTENT(OUT) :: file_id !< file ID 199 202 INTEGER :: my_rank !< MPI rank of local processor 200 203 INTEGER :: nranks !< number of MPI ranks participating in output 201 202 INTEGER, INTENT(OUT) :: file_id !< file ID203 204 INTEGER, INTENT(OUT) :: return_value !< return value 204 205 … … 250 251 ENDIF 251 252 252 OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), &253 OPEN( config_file_unit, FILE=TRIM( config_file_name ) // TRIM( file_suffix ), & 253 254 FORM='UNFORMATTED', STATUS='NEW', IOSTAT=return_value ) 254 255 … … 352 353 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_attribute' !< name of this routine 353 354 354 CHARACTER(LEN=charlen) :: attribute_type !< data type of attribute 355 CHARACTER(LEN=charlen) :: output_string !< output string 356 357 CHARACTER(LEN=charlen), INTENT(IN) :: attribute_name !< name of attribute 358 CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL :: value_char !< value of attribute 359 355 CHARACTER(LEN=charlen), INTENT(IN) :: attribute_name !< name of attribute 356 CHARACTER(LEN=charlen) :: attribute_type !< data type of attribute 357 CHARACTER(LEN=charlen) :: output_string !< output string 358 CHARACTER(LEN=charlen), INTENT(IN), OPTIONAL :: value_char !< value of attribute 360 359 361 360 INTEGER, INTENT(IN) :: file_id !< file ID 361 INTEGER, INTENT(OUT) :: return_value !< return value 362 362 INTEGER, INTENT(IN) :: variable_id !< variable ID 363 364 INTEGER, INTENT(OUT) :: return_value !< return value365 363 366 364 INTEGER(KIND=1), INTENT(IN), OPTIONAL :: value_int8 !< value of attribute … … 427 425 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_dimension' !< name of this routine 428 426 429 CHARACTER(LEN=charlen) :: output_string !< output string430 431 427 CHARACTER(LEN=charlen), INTENT(IN) :: dimension_name !< name of dimension 432 428 CHARACTER(LEN=charlen), INTENT(IN) :: dimension_type !< data type of dimension 433 429 CHARACTER(LEN=*), INTENT(IN) :: mode !< operation mode 434 430 CHARACTER(LEN=charlen) :: output_string !< output string 431 432 INTEGER, INTENT(OUT) :: dimension_id !< dimension ID 435 433 INTEGER, INTENT(IN) :: dimension_length !< length of dimension 436 434 INTEGER, INTENT(IN) :: file_id !< file ID 437 438 INTEGER, INTENT(OUT) :: dimension_id !< dimension ID439 435 INTEGER, INTENT(OUT) :: return_value !< return value 440 436 INTEGER, INTENT(OUT) :: variable_id !< variable ID … … 461 457 ! 462 458 !-- Define variable associated with dimension 463 CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &464 459 CALL binary_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 460 (/ dimension_id /), is_global=.TRUE., return_value=return_value ) 465 461 IF ( return_value /= 0 ) THEN 466 462 CALL internal_message( 'error', routine_name // & … … 477 473 SUBROUTINE binary_init_variable( mode, file_id, variable_id, variable_name, variable_type, & 478 474 dimension_ids, is_global, return_value ) 475 479 476 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_init_variable' !< name of this routine 480 477 … … 815 812 816 813 WRITE( temp_string, * ) file_id 817 CALL internal_message( 'debug', routine_name // &814 CALL internal_message( 'debug', routine_name // & 818 815 ': close file (file_id=' // TRIM( temp_string ) // ')' ) 819 816 … … 821 818 IF ( return_value /= 0 ) THEN 822 819 WRITE( temp_string, * ) file_id 823 CALL internal_message( 'error', routine_name // &820 CALL internal_message( 'error', routine_name // & 824 821 ': cannot close file (file_id=' // TRIM( temp_string ) // ')' ) 825 822 ENDIF -
palm/trunk/SOURCE/data_output_module.f90
r4577 r4579 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 22 ! 21 ! 22 ! 23 23 ! Former revisions: 24 24 ! ----------------- 25 25 ! $Id$ 26 ! corrected formatting to follow PALM coding standard 27 ! 28 ! 4577 2020-06-25 09:53:58Z raasch 26 29 ! file re-formatted to follow the PALM coding standard 27 30 ! … … 115 118 CHARACTER(LEN=charlen) :: data_type = '' !< data type 116 119 CHARACTER(LEN=charlen) :: name !< variable name 117 CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names !< list of118 !< dimension names used by variable119 120 INTEGER :: id = no_id !< id within file 120 LOGICAL :: is_global = .FALSE. !< true if global 121 !< variable 122 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of 123 !< dimension ids used by variable 124 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of 125 !< attributes 121 LOGICAL :: is_global = .FALSE. !< true if global variable 122 CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names !< list of dimension names used by variable 123 INTEGER, DIMENSION(:), ALLOCATABLE :: dimension_ids !< list of dimension ids used by variable 124 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes 126 125 END TYPE variable_type 127 126 … … 129 128 CHARACTER(LEN=charlen) :: data_type = '' !< data type 130 129 CHARACTER(LEN=charlen) :: name !< dimension name 131 INTEGER :: id = no_id !< dimension id within 132 !< file 130 INTEGER :: id = no_id !< dimension id within file 133 131 INTEGER :: length !< length of dimension 134 INTEGER :: length_mask !< length of masked 135 !< dimension 136 INTEGER :: variable_id = no_id !< associated variable 137 !< id within file 132 INTEGER :: length_mask !< length of masked dimension 133 INTEGER :: variable_id = no_id !< associated variable id within file 138 134 LOGICAL :: is_masked = .FALSE. !< true if masked 139 INTEGER, DIMENSION(2) :: bounds !< lower and upper bound 140 !< of dimension 141 INTEGER, DIMENSION(:), ALLOCATABLE :: masked_indices !< list of masked 142 !< indices of dimension 143 INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: masked_values_int8 !< masked dimension 144 !< values if 16bit integer 145 INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: masked_values_int16 !< masked dimension 146 !< values if 16bit integer 147 INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_int32 !< masked dimension 148 !< values if 32bit integer 149 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: masked_values_intwp !< masked dimension 150 !< values if working-precision int 151 INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< dimension values if 152 !< 16bit integer 153 INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< dimension values if 154 !< 16bit integer 155 INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< dimension values if 156 !< 32bit integer 157 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< dimension values if 158 !< working-precision integer 135 INTEGER, DIMENSION(2) :: bounds !< lower and upper bound of dimension 136 INTEGER, DIMENSION(:), ALLOCATABLE :: masked_indices !< list of masked indices of dimension 137 INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: masked_values_int8 !< masked dimension values if 16bit integer 138 INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: masked_values_int16 !< masked dimension values if 16bit integer 139 INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_int32 !< masked dimension values if 32bit integer 140 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: masked_values_intwp !< masked dimension values if working-precision int 141 INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE :: values_int8 !< dimension values if 16bit integer 142 INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE :: values_int16 !< dimension values if 16bit integer 143 INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE :: values_int32 !< dimension values if 32bit integer 144 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: values_intwp !< dimension values if working-precision integer 159 145 LOGICAL, DIMENSION(:), ALLOCATABLE :: mask !< mask 160 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_real32 !< masked dimension 161 !< values if 32bit real 162 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: masked_values_real64 !< masked dimension 163 !< values if 64bit real 164 REAL(wp), DIMENSION(:), ALLOCATABLE :: masked_values_realwp !< masked dimension 165 !< values if working-precision real 166 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< dimension values if 167 !< 32bit real 168 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< dimension values if 169 !< 64bit real 170 REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< dimension values if 171 !< working-precision real 146 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: masked_values_real32 !< masked dimension values if 32bit real 147 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: masked_values_real64 !< masked dimension values if 64bit real 148 REAL(wp), DIMENSION(:), ALLOCATABLE :: masked_values_realwp !< masked dimension values if working-precision real 149 REAL(KIND=4), DIMENSION(:), ALLOCATABLE :: values_real32 !< dimension values if 32bit real 150 REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: values_real64 !< dimension values if 64bit real 151 REAL(wp), DIMENSION(:), ALLOCATABLE :: values_realwp !< dimension values if working-precision real 172 152 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes 173 153 END TYPE dimension_type … … 256 236 END INTERFACE dom_database_debug_output 257 237 258 PUBLIC &259 dom_ init,&260 dom_def_ file,&261 dom_def_dim, &262 dom_def_ var,&263 dom_def_ att,&264 dom_def_ end,&265 dom_ write_var,&266 dom_ finalize_output,&267 dom_ get_error_message,&268 dom_ database_debug_output238 PUBLIC & 239 dom_database_debug_output, & 240 dom_def_att, & 241 dom_def_dim, & 242 dom_def_end, & 243 dom_def_file, & 244 dom_def_var, & 245 dom_finalize_output, & 246 dom_get_error_message, & 247 dom_init, & 248 dom_write_var 269 249 270 250 CONTAINS … … 281 261 !> prevents that multiple groups try to open and write to the same output file. 282 262 !--------------------------------------------------------------------------------------------------! 283 SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, &263 SUBROUTINE dom_init( file_suffix_of_output_group, mpi_comm_of_output_group, master_output_rank, & 284 264 program_debug_output_unit, debug_output ) 285 265 … … 304 284 print_debug_output = debug_output 305 285 306 CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, &286 CALL binary_init_module( output_file_suffix, output_group_comm, master_rank, & 307 287 debug_output_unit, debug_output, no_id ) 308 288 309 CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, &289 CALL netcdf4_init_module( output_file_suffix, output_group_comm, master_rank, & 310 290 debug_output_unit, debug_output, no_id ) 311 291 … … 350 330 IF ( files(f)%name == TRIM( file_name ) ) THEN 351 331 return_value = 1 352 CALL internal_message( 'error', routine_name // &353 ': file "' // TRIM( file_name ) // '" already exists' )332 CALL internal_message( 'error', routine_name // & 333 ': file "' // TRIM( file_name ) // '" already exists' ) 354 334 EXIT 355 335 ENDIF … … 405 385 !> @todo Convert given values into selected output_type. 406 386 !--------------------------------------------------------------------------------------------------! 407 FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds, & 408 values_int8, values_int16, values_int32, values_intwp, & 409 values_real32, values_real64, values_realwp, & 410 mask ) RESULT( return_value ) 387 FUNCTION dom_def_dim( file_name, dimension_name, output_type, bounds, & 388 values_int8, values_int16, values_int32, values_intwp, & 389 values_real32, values_real64, values_realwp, & 390 mask ) & 391 RESULT( return_value ) 411 392 412 393 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_dim' !< name of this routine … … 982 963 !> value=' and this part was appended', append=.TRUE. ) 983 964 !--------------------------------------------------------------------------------------------------! 984 FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append ) &965 FUNCTION dom_def_att_char( file_name, variable_name, attribute_name, value, append ) & 985 966 RESULT( return_value ) 967 968 ! CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_char' !< name of routine 986 969 987 970 CHARACTER(LEN=*), INTENT(IN) :: attribute_name !< name of attribute … … 990 973 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: variable_name !< name of variable 991 974 CHARACTER(LEN=charlen) :: variable_name_internal !< internal copy of variable_name 992 993 ! CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_def_att_char' !< name of routine994 975 995 976 INTEGER :: return_value !< return value … … 1563 1544 !--------------------------------------------------------------------------------------------------! 1564 1545 FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end, & 1565 values_char_0d, values_char_1d, values_char_2d, values_char_3d,&1566 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d,&1567 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d,&1568 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d,&1569 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d,&1570 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d,&1571 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d,&1572 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d&1573 )RESULT( return_value )1546 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 1547 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 1548 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & 1549 values_int32_0d, values_int32_1d, values_int32_2d, values_int32_3d, & 1550 values_intwp_0d, values_intwp_1d, values_intwp_2d, values_intwp_3d, & 1551 values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d, & 1552 values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d, & 1553 values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d ) & 1554 RESULT( return_value ) 1574 1555 1575 1556 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_write_var' !< name of routine … … 1778 1759 ELSEIF ( PRESENT( values_char_2d ) ) THEN 1779 1760 IF ( do_output ) THEN 1780 ALLOCATE( values_char_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 1761 ALLOCATE( values_char_2d_resorted(0:value_counts(1)-1, & 1762 0:value_counts(2)-1) ) 1781 1763 !$OMP PARALLEL PRIVATE (i,j) 1782 1764 !$OMP DO … … 1835 1817 ELSEIF ( PRESENT( values_int8_2d ) ) THEN 1836 1818 IF ( do_output ) THEN 1837 ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 1819 ALLOCATE( values_int8_2d_resorted(0:value_counts(1)-1, & 1820 0:value_counts(2)-1) ) 1838 1821 !$OMP PARALLEL PRIVATE (i,j) 1839 1822 !$OMP DO … … 1892 1875 ELSEIF ( PRESENT( values_int16_2d ) ) THEN 1893 1876 IF ( do_output ) THEN 1894 ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 1877 ALLOCATE( values_int16_2d_resorted(0:value_counts(1)-1, & 1878 0:value_counts(2)-1) ) 1895 1879 !$OMP PARALLEL PRIVATE (i,j) 1896 1880 !$OMP DO … … 1949 1933 ELSEIF ( PRESENT( values_int32_2d ) ) THEN 1950 1934 IF ( do_output ) THEN 1951 ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 1935 ALLOCATE( values_int32_2d_resorted(0:value_counts(1)-1, & 1936 0:value_counts(2)-1) ) 1952 1937 !$OMP PARALLEL PRIVATE (i,j) 1953 1938 !$OMP DO … … 2006 1991 ELSEIF ( PRESENT( values_intwp_2d ) ) THEN 2007 1992 IF ( do_output ) THEN 2008 ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 1993 ALLOCATE( values_intwp_2d_resorted(0:value_counts(1)-1, & 1994 0:value_counts(2)-1) ) 2009 1995 !$OMP PARALLEL PRIVATE (i,j) 2010 1996 !$OMP DO … … 2063 2049 ELSEIF ( PRESENT( values_real32_2d ) ) THEN 2064 2050 IF ( do_output ) THEN 2065 ALLOCATE( values_real32_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 2051 ALLOCATE( values_real32_2d_resorted(0:value_counts(1)-1, & 2052 0:value_counts(2)-1) ) 2066 2053 !$OMP PARALLEL PRIVATE (i,j) 2067 2054 !$OMP DO … … 2120 2107 ELSEIF ( PRESENT( values_real64_2d ) ) THEN 2121 2108 IF ( do_output ) THEN 2122 ALLOCATE( values_real64_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 2109 ALLOCATE( values_real64_2d_resorted(0:value_counts(1)-1, & 2110 0:value_counts(2)-1) ) 2123 2111 !$OMP PARALLEL PRIVATE (i,j) 2124 2112 !$OMP DO … … 2177 2165 ELSEIF ( PRESENT( values_realwp_2d ) ) THEN 2178 2166 IF ( do_output ) THEN 2179 ALLOCATE( values_realwp_2d_resorted(0:value_counts(1)-1,0:value_counts(2)-1) ) 2167 ALLOCATE( values_realwp_2d_resorted(0:value_counts(1)-1, & 2168 0:value_counts(2)-1) ) 2180 2169 !$OMP PARALLEL PRIVATE (i,j) 2181 2170 !$OMP DO … … 2649 2638 !> @todo Try to combine similar code parts and shorten routine. 2650 2639 !--------------------------------------------------------------------------------------------------! 2651 FUNCTION save_attribute_in_database( file_name, variable_name, attribute, append ) &2640 FUNCTION save_attribute_in_database( file_name, variable_name, attribute, append ) & 2652 2641 RESULT( return_value ) 2653 2642 … … 2707 2696 !-- Append existing string attribute 2708 2697 files(f)%attributes(a)%value_char = & 2709 TRIM( files(f)%attributes(a)%value_char ) //&2710 2698 TRIM( files(f)%attributes(a)%value_char ) // & 2699 TRIM( attribute%value_char ) 2711 2700 ELSE 2712 2701 files(f)%attributes(a) = attribute … … 2756 2745 !-- Check if attribute already exists 2757 2746 DO a = 1, natts 2758 IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name ) &2747 IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name ) & 2759 2748 THEN 2760 2749 IF ( append ) THEN … … 3081 3070 !-- Initialize masked dimension 3082 3071 CALL init_file_dimension( file%format, file%id, file%name, & 3083 file%dimensions(d)%id, file%dimensions(d)%name,&3084 file%dimensions(d)%data_type, file%dimensions(d)%length_mask,&3085 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 ) 3086 3075 3087 3076 ENDIF … … 3105 3094 !-- Save dimension IDs for variables wihtin database 3106 3095 IF ( return_value == 0 ) & 3107 CALL collect_dimesion_ids_for_variables( file%name, file%variables, file%dimensions, &3096 CALL collect_dimesion_ids_for_variables( file%name, file%variables, file%dimensions, & 3108 3097 return_value ) 3109 3098 ! … … 3230 3219 output_return_value = 0 3231 3220 3232 temp_string = '(file "' // TRIM( file_name ) // &3221 temp_string = '(file "' // TRIM( file_name ) // & 3233 3222 '", variable "' // TRIM( variable_name ) // '")' 3234 3223 … … 3257 3246 IF ( output_return_value /= 0 ) THEN 3258 3247 return_value = output_return_value 3259 CALL internal_message( 'error', routine_name // &3248 CALL internal_message( 'error', routine_name // & 3260 3249 ': error while defining variable ' // TRIM( temp_string ) ) 3261 3250 ENDIF … … 3268 3257 !> Write attribute to file. 3269 3258 !--------------------------------------------------------------------------------------------------! 3270 FUNCTION write_attribute( file_format, file_id, file_name, variable_id, variable_name, attribute )& 3271 RESULT( return_value ) 3259 FUNCTION write_attribute( file_format, file_id, file_name, & 3260 variable_id, variable_name, attribute ) & 3261 RESULT( return_value ) 3272 3262 3273 3263 CHARACTER(LEN=*), PARAMETER :: routine_name = 'write_attribute' !< file format chosen for file … … 3409 3399 CHARACTER(LEN=*), PARAMETER :: routine_name = 'collect_dimesion_ids_for_variables' !< file format chosen for file 3410 3400 3411 CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file3401 CHARACTER(LEN=*), INTENT(IN) :: file_name !< name of file 3412 3402 3413 3403 INTEGER :: d !< loop index … … 3418 3408 INTEGER, INTENT(OUT) :: return_value !< return value 3419 3409 3420 LOGICAL :: found = .FALSE. !< true if dimension required by variable was found in dimension list3410 LOGICAL :: found = .FALSE. !< true if dimension required by variable was found in dimension list 3421 3411 3422 3412 TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< list of dimensions in file … … 3747 3737 SUBROUTINE dom_database_debug_output 3748 3738 3739 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_database_debug_output' !< name of this routine 3749 3740 CHARACTER(LEN=*), PARAMETER :: separation_string = '---' !< string separating blocks in output 3750 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_database_debug_output' !< name of this routine3751 3741 3752 3742 INTEGER, PARAMETER :: indent_depth = 3 !< space per indentation 3753 3743 INTEGER, PARAMETER :: max_keyname_length = 6 !< length of longest key name 3754 3744 3755 CHARACTER(LEN=50) :: write_format1!< format for write statements3756 3757 INTEGER :: f!< loop index3758 INTEGER :: indent_level!< indentation level3759 INTEGER :: natts!< number of attributes3760 INTEGER :: ndims!< number of dimensions3761 INTEGER :: nvars!< number of variables3745 CHARACTER(LEN=50) :: write_format1 !< format for write statements 3746 3747 INTEGER :: f !< loop index 3748 INTEGER :: indent_level !< indentation level 3749 INTEGER :: natts !< number of attributes 3750 INTEGER :: ndims !< number of dimensions 3751 INTEGER :: nvars !< number of variables 3762 3752 3763 3753 … … 3820 3810 CHARACTER(LEN=50) :: write_format2 !< format for write statements 3821 3811 3822 INTEGER :: i 3823 INTEGER, INTENT(IN) :: indent_level 3824 INTEGER :: nelement 3812 INTEGER :: i !< loop index 3813 INTEGER, INTENT(IN) :: indent_level !< indentation level 3814 INTEGER :: nelement !< number of elements to print 3825 3815 3826 3816 TYPE(attribute_type), DIMENSION(:), INTENT(IN) :: attributes !< list of attributes … … 3880 3870 CHARACTER(LEN=50) :: write_format2 !< format for write statements 3881 3871 3882 INTEGER :: i 3883 INTEGER, INTENT(IN) :: indent_level 3884 INTEGER :: j 3885 INTEGER :: nelement 3872 INTEGER :: i !< loop index 3873 INTEGER, INTENT(IN) :: indent_level !< indentation level 3874 INTEGER :: j !< loop index 3875 INTEGER :: nelement !< number of elements to print 3886 3876 3887 3877 LOGICAL :: is_masked !< true if dimension is masked … … 4095 4085 CHARACTER(LEN=50) :: write_format2 !< format for write statements 4096 4086 4097 INTEGER :: i 4098 INTEGER, INTENT(IN) :: indent_level 4099 INTEGER :: j 4100 INTEGER :: nelement 4087 INTEGER :: i !< loop index 4088 INTEGER, INTENT(IN) :: indent_level !< indentation level 4089 INTEGER :: j !< loop index 4090 INTEGER :: nelement !< number of elements to print 4101 4091 4102 4092 TYPE(variable_type), DIMENSION(:), INTENT(IN) :: variables !< list of variables -
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4577 r4579 19 19 ! Current revisions: 20 20 ! ------------------ 21 ! 22 ! 21 ! 22 ! 23 23 ! Former revisions: 24 24 ! ----------------- 25 25 ! $Id$ 26 ! corrected formatting to follow PALM coding standard 27 ! 28 ! 4577 2020-06-25 09:53:58Z raasch 26 29 ! file re-formatted to follow the PALM coding standard 27 30 ! … … 213 216 #endif 214 217 215 IF ( return_value == 0 ) &218 IF ( return_value == 0 ) & 216 219 nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ), & 217 220 IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), file_id ) … … 272 275 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: value_char !< value of attribute 273 276 274 INTEGER :: nc_stat !< netcdf return value275 INTEGER :: target_id !< ID of target which gets attribute (either global or variable_id)276 277 277 INTEGER, INTENT(IN) :: file_id !< file ID 278 INTEGER :: nc_stat !< netcdf return value 278 279 INTEGER, INTENT(OUT) :: return_value !< return value 280 INTEGER :: target_id !< ID of target which gets attribute (either global or variable_id) 279 281 INTEGER, INTENT(IN) :: variable_id !< variable ID 280 282 … … 336 338 !> Initialize dimension. 337 339 !--------------------------------------------------------------------------------------------------! 338 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, &339 dimension_name, dimension_type, dimension_length, return_value )340 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id, & 341 dimension_name, dimension_type, dimension_length, return_value ) 340 342 341 343 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_init_dimension' !< name of this routine … … 374 376 ! 375 377 !-- Define variable holding dimension values in file 376 CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, &378 CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type, & 377 379 (/ dimension_id /), is_global=.TRUE., return_value=return_value ) 378 380 … … 482 484 483 485 WRITE( temp_string, * ) file_id 484 CALL internal_message( 'debug', routine_name // &486 CALL internal_message( 'debug', routine_name // & 485 487 ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' ) 486 488 ! … … 494 496 IF ( nc_stat /= NF90_NOERR ) THEN 495 497 return_value = 1 496 CALL internal_message( 'error', routine_name // &498 CALL internal_message( 'error', routine_name // & 497 499 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) ) 498 500 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
