Changeset 4408
- Timestamp:
- Feb 14, 2020 10:04:39 AM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
data_output_binary_module.f90 (modified) (4 diffs)
-
data_output_module.f90 (modified) (6 diffs)
-
data_output_netcdf4_module.f90 (modified) (4 diffs)
-
virtual_measurement_mod.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_binary_module.f90
r4232 r4408 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable character-array output 28 ! 29 ! 4232 2019-09-20 09:34:22Z knoop 27 30 ! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement 28 31 ! … … 532 535 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 533 536 is_global, & 537 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 534 538 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 535 539 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & … … 544 548 545 549 CHARACTER(LEN=*), PARAMETER :: routine_name = 'binary_write_variable' !< name of this routine 550 551 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable 552 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable 553 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable 554 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable 546 555 547 556 INTEGER, INTENT(IN) :: file_id !< file ID … … 599 608 WRITE( file_id ) bounds_origin 600 609 ! 610 !-- character output 611 IF ( PRESENT( values_char_0d ) ) THEN 612 output_string = 'char' 613 WRITE( file_id ) output_string 614 WRITE( file_id ) values_char_0d 615 ELSEIF ( PRESENT( values_char_1d ) ) THEN 616 output_string = 'char' 617 WRITE( file_id ) output_string 618 WRITE( file_id ) values_char_1d 619 ELSEIF ( PRESENT( values_char_2d ) ) THEN 620 output_string = 'char' 621 WRITE( file_id ) output_string 622 WRITE( file_id ) values_char_2d 623 ELSEIF ( PRESENT( values_char_3d ) ) THEN 624 output_string = 'char' 625 WRITE( file_id ) output_string 626 WRITE( file_id ) values_char_3d 627 ! 601 628 !-- 8bit integer output 602 IF ( PRESENT( values_int8_0d ) ) THEN629 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 603 630 output_string = 'int8' 604 631 WRITE( file_id ) output_string -
palm/trunk/SOURCE/data_output_module.f90
r4147 r4408 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable character-array output 28 ! 29 ! 4147 2019-08-07 09:42:31Z gronemeier 27 30 ! corrected indentation according to coding standard 28 31 ! … … 1533 1536 !--------------------------------------------------------------------------------------------------! 1534 1537 FUNCTION dom_write_var( file_name, variable_name, bounds_start, bounds_end, & 1538 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 1535 1539 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 1536 1540 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & … … 1547 1551 1548 1552 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_write_var' !< name of routine 1553 1554 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable 1555 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable 1556 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable 1557 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable 1558 1559 CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:) :: values_char_1d_resorted !< resorted output variable 1560 CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:) :: values_char_2d_resorted !< resorted output variable 1561 CHARACTER(LEN=1), TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: values_char_3d_resorted !< resorted output variable 1562 1563 CHARACTER(LEN=1), POINTER :: values_char_0d_pointer !< pointer to resortet array 1564 CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:) :: values_char_1d_pointer !< pointer to resortet array 1565 CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:) :: values_char_2d_pointer !< pointer to resortet array 1566 CHARACTER(LEN=1), POINTER, CONTIGUOUS, DIMENSION(:,:,:) :: values_char_3d_pointer !< pointer to resortet array 1549 1567 1550 1568 INTEGER :: file_id !< file ID … … 1714 1732 ! 1715 1733 !-- Mask and resort variable 1734 !-- character output 1735 IF ( PRESENT( values_char_0d ) ) THEN 1736 values_char_0d_pointer => values_char_0d 1737 ELSEIF ( PRESENT( values_char_1d ) ) THEN 1738 IF ( do_output ) THEN 1739 ALLOCATE( values_char_1d_resorted(0:value_counts(1)-1) ) 1740 !$OMP PARALLEL PRIVATE (i) 1741 !$OMP DO 1742 DO i = 0, value_counts(1) - 1 1743 values_char_1d_resorted(i) = values_char_1d(masked_indices(1,i)) 1744 ENDDO 1745 !$OMP END PARALLEL 1746 ELSE 1747 ALLOCATE( values_char_1d_resorted(1) ) 1748 values_char_1d_resorted = ' ' 1749 ENDIF 1750 values_char_1d_pointer => values_char_1d_resorted 1751 ELSEIF ( PRESENT( values_char_2d ) ) THEN 1752 IF ( do_output ) THEN 1753 ALLOCATE( values_char_2d_resorted(0:value_counts(1)-1, & 1754 0:value_counts(2)-1) ) 1755 !$OMP PARALLEL PRIVATE (i,j) 1756 !$OMP DO 1757 DO i = 0, value_counts(1) - 1 1758 DO j = 0, value_counts(2) - 1 1759 values_char_2d_resorted(i,j) = values_char_2d(masked_indices(2,j), & 1760 masked_indices(1,i) ) 1761 ENDDO 1762 ENDDO 1763 !$OMP END PARALLEL 1764 ELSE 1765 ALLOCATE( values_char_2d_resorted(1,1) ) 1766 values_char_2d_resorted = ' ' 1767 ENDIF 1768 values_char_2d_pointer => values_char_2d_resorted 1769 ELSEIF ( PRESENT( values_char_3d ) ) THEN 1770 IF ( do_output ) THEN 1771 ALLOCATE( values_char_3d_resorted(0:value_counts(1)-1, & 1772 0:value_counts(2)-1, & 1773 0:value_counts(3)-1) ) 1774 !$OMP PARALLEL PRIVATE (i,j,k) 1775 !$OMP DO 1776 DO i = 0, value_counts(1) - 1 1777 DO j = 0, value_counts(2) - 1 1778 DO k = 0, value_counts(3) - 1 1779 values_char_3d_resorted(i,j,k) = values_char_3d(masked_indices(3,k), & 1780 masked_indices(2,j), & 1781 masked_indices(1,i) ) 1782 ENDDO 1783 ENDDO 1784 ENDDO 1785 !$OMP END PARALLEL 1786 ELSE 1787 ALLOCATE( values_char_3d_resorted(1,1,1) ) 1788 values_char_3d_resorted = ' ' 1789 ENDIF 1790 values_char_3d_pointer => values_char_3d_resorted 1791 ! 1716 1792 !-- 8bit integer output 1717 IF ( PRESENT( values_int8_0d ) ) THEN1793 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 1718 1794 values_int8_0d_pointer => values_int8_0d 1719 1795 ELSEIF ( PRESENT( values_int8_1d ) ) THEN … … 2139 2215 CASE ( 'binary' ) 2140 2216 ! 2217 !-- character output 2218 IF ( PRESENT( values_char_0d ) ) THEN 2219 CALL binary_write_variable( file_id, variable_id, & 2220 bounds_start_internal, value_counts, bounds_origin, is_global, & 2221 values_char_0d=values_char_0d_pointer, return_value=output_return_value ) 2222 ELSEIF ( PRESENT( values_char_1d ) ) THEN 2223 CALL binary_write_variable( file_id, variable_id, & 2224 bounds_start_internal, value_counts, bounds_origin, is_global, & 2225 values_char_1d=values_char_1d_pointer, return_value=output_return_value ) 2226 ELSEIF ( PRESENT( values_char_2d ) ) THEN 2227 CALL binary_write_variable( file_id, variable_id, & 2228 bounds_start_internal, value_counts, bounds_origin, is_global, & 2229 values_char_2d=values_char_2d_pointer, return_value=output_return_value ) 2230 ELSEIF ( PRESENT( values_char_3d ) ) THEN 2231 CALL binary_write_variable( file_id, variable_id, & 2232 bounds_start_internal, value_counts, bounds_origin, is_global, & 2233 values_char_3d=values_char_3d_pointer, return_value=output_return_value ) 2234 ! 2141 2235 !-- 8bit integer output 2142 IF ( PRESENT( values_int8_0d ) ) THEN2236 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 2143 2237 CALL binary_write_variable( file_id, variable_id, & 2144 2238 bounds_start_internal, value_counts, bounds_origin, is_global, & … … 2275 2369 CASE ( 'netcdf4-parallel', 'netcdf4-serial' ) 2276 2370 ! 2371 !-- character output 2372 IF ( PRESENT( values_char_0d ) ) THEN 2373 CALL netcdf4_write_variable( file_id, variable_id, & 2374 bounds_start_internal, value_counts, bounds_origin, is_global, & 2375 values_char_0d=values_char_0d_pointer, return_value=output_return_value ) 2376 ELSEIF ( PRESENT( values_char_1d ) ) THEN 2377 CALL netcdf4_write_variable( file_id, variable_id, & 2378 bounds_start_internal, value_counts, bounds_origin, is_global, & 2379 values_char_1d=values_char_1d_pointer, return_value=output_return_value ) 2380 ELSEIF ( PRESENT( values_char_2d ) ) THEN 2381 CALL netcdf4_write_variable( file_id, variable_id, & 2382 bounds_start_internal, value_counts, bounds_origin, is_global, & 2383 values_char_2d=values_char_2d_pointer, return_value=output_return_value ) 2384 ELSEIF ( PRESENT( values_char_3d ) ) THEN 2385 CALL netcdf4_write_variable( file_id, variable_id, & 2386 bounds_start_internal, value_counts, bounds_origin, is_global, & 2387 values_char_3d=values_char_3d_pointer, return_value=output_return_value ) 2388 ! 2277 2389 !-- 8bit integer output 2278 IF ( PRESENT( values_int8_0d ) ) THEN2390 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 2279 2391 CALL netcdf4_write_variable( file_id, variable_id, & 2280 2392 bounds_start_internal, value_counts, bounds_origin, is_global, & -
palm/trunk/SOURCE/data_output_netcdf4_module.f90
r4232 r4408 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Enable character-array output 28 ! 29 ! 4232 2019-09-20 09:34:22Z knoop 27 30 ! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement 28 31 ! … … 502 505 file_id, variable_id, bounds_start, value_counts, bounds_origin, & 503 506 is_global, & 507 values_char_0d, values_char_1d, values_char_2d, values_char_3d, & 504 508 values_int8_0d, values_int8_1d, values_int8_2d, values_int8_3d, & 505 509 values_int16_0d, values_int16_1d, values_int16_2d, values_int16_3d, & … … 512 516 513 517 CHARACTER(LEN=*), PARAMETER :: routine_name = 'netcdf4_write_variable' !< name of this routine 518 519 CHARACTER(LEN=1), POINTER, INTENT(IN), OPTIONAL :: values_char_0d !< output variable 520 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:) :: values_char_1d !< output variable 521 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:) :: values_char_2d !< output variable 522 CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) :: values_char_3d !< output variable 514 523 515 524 INTEGER :: d !< loop index … … 578 587 579 588 ndims = SIZE( bounds_start ) 589 590 ! 591 !-- character output 592 IF ( PRESENT( values_char_0d ) ) THEN 593 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /), & 594 start = bounds_start - bounds_origin + 1, & 595 count = value_counts ) 596 ELSEIF ( PRESENT( values_char_1d ) ) THEN 597 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d, & 598 start = bounds_start - bounds_origin + 1, & 599 count = value_counts ) 600 ELSEIF ( PRESENT( values_char_2d ) ) THEN 601 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d, & 602 start = bounds_start - bounds_origin + 1, & 603 count = value_counts ) 604 ELSEIF ( PRESENT( values_char_3d ) ) THEN 605 nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d, & 606 start = bounds_start - bounds_origin + 1, & 607 count = value_counts ) 580 608 ! 581 609 !-- 8bit integer output 582 IF ( PRESENT( values_int8_0d ) ) THEN610 ELSEIF ( PRESENT( values_int8_0d ) ) THEN 583 611 nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), & 584 612 start = bounds_start - bounds_origin + 1, & -
palm/trunk/SOURCE/virtual_measurement_mod.f90
r4406 r4408 25 25 ! ----------------- 26 26 ! $Id$ 27 ! write fill_value attribute 28 ! 29 ! 4406 2020-02-13 20:06:29Z knoop 27 30 ! Bugix: removed oro_rel wrong loop bounds and removed unnecessary restart method 28 ! 31 ! 29 32 ! 4400 2020-02-10 20:32:41Z suehring 30 33 ! Revision of the module: … … 268 271 INTEGER(iwp) :: start_coord_s = 0 !< start coordinate in NetCDF file for local soil observations 269 272 270 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_t !< number observations individual for each trajectory 273 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: dim_t !< number observations individual for each trajectory 271 274 !< or station that are no _FillValues 272 275 … … 287 290 REAL(wp) :: fill_nutm !< fill value for UTM coordinates in case of missing values 288 291 REAL(wp) :: fill_zar !< fill value for heigth coordinates in case of missing values 289 REAL(wp) :: fillout = -9999.0 !< fill value for output in case a observation is taken 292 REAL(wp) :: fillout = -9999.0 !< fill value for output in case a observation is taken 290 293 !< e.g. from inside a building 291 294 REAL(wp) :: origin_x_obs !< origin of the observation in UTM coordiates in x-direction … … 306 309 307 310 ! This need to be generalized 308 ! CHARACTER(LEN=10) :: char_fill = '_FillValue' 311 CHARACTER(LEN=10) :: char_fill = '_FillValue' !< attribute name for fill value 309 312 CHARACTER(LEN=9) :: char_long = 'long_name' !< attribute name for long_name 310 313 CHARACTER(LEN=13) :: char_standard = 'standard_name' !< attribute name for standard_name … … 462 465 463 466 END SUBROUTINE vm_check_parameters 464 467 465 468 !------------------------------------------------------------------------------! 466 469 ! Description: … … 893 896 ! 894 897 !-- Allocate flag array. This dummy array is used to identify grid points 895 !-- where virtual measurements should be taken. Please note, in order to 898 !-- where virtual measurements should be taken. Please note, in order to 896 899 !-- include also the surrounding grid points of the original coordinate 897 900 !-- ghost points are required. … … 1000 1003 ALLOCATE( vmea(l)%var_atts(1:vmea(l)%nmeas) ) 1001 1004 ! 1002 !-- Store the variable names in a data structures, which assigns further 1003 !-- attributes to this name. Further, for data output reasons, create a 1005 !-- Store the variable names in a data structures, which assigns further 1006 !-- attributes to this name. Further, for data output reasons, create a 1004 1007 !-- string of output variables, which will be written into the attribute 1005 1008 !-- data_content. … … 1014 1017 !-- define the grid-index space on each subdomain where virtual measurements 1015 1018 !-- should be taken. Note, the entire coordinate array (on the entire model 1016 !-- domain) won't be stored as this would exceed memory requirements, 1019 !-- domain) won't be stored as this would exceed memory requirements, 1017 1020 !-- particularly for trajectories. 1018 1021 IF ( vmea(l)%nmeas > 0 ) THEN … … 1344 1347 DEALLOCATE( meas_flag ) 1345 1348 ! 1346 !-- Close input file for virtual measurements. 1349 !-- Close input file for virtual measurements. 1347 1350 CALL close_input_file( pids_id ) 1348 1351 ! … … 1398 1401 !-- Note, start coordinates are initialized with zero for sake of simplicity 1399 1402 !-- in summation. However, in NetCDF the start coordinates must be >= 1, 1400 !-- so that a one needs to be added at the end. 1403 !-- so that a one needs to be added at the end. 1401 1404 DO l = 1, vmea_general%nvm 1402 1405 DO n = 0, myid - 1 … … 2237 2240 value = TRIM( vmea(l)%var_atts(n)%coordinates ) ) 2238 2241 2239 !return_value = dom_def_att( vmea(l)%nc_filename, &2240 !variable_name = variable_name, &2241 !attribute_name = char_fill, &2242 ! value = vmea(l)%var_atts(n)%fill_value)2242 return_value = dom_def_att( vmea(l)%nc_filename, & 2243 variable_name = variable_name, & 2244 attribute_name = char_fill, & 2245 value = REAL( vmea(l)%var_atts(n)%fill_value, KIND=4 ) ) 2243 2246 2244 2247 ENDDO ! loop over variables per site … … 2345 2348 DEALLOCATE( output_values_1d_target ) 2346 2349 ! 2347 !-- In case of sampled soil quantities, output also the respective 2350 !-- In case of sampled soil quantities, output also the respective 2348 2351 !-- coordinate arrays. 2349 2352 IF ( vmea(l)%soil_sampling ) THEN … … 2412 2415 ! 2413 2416 !-- Write the stations name 2414 2417 2415 2418 ENDIF 2416 2419 … … 2910 2913 ! i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl ) 2911 2914 ! i = MERGE( i , nxr, i < nxr ) 2912 ! 2915 ! 2913 2916 ! DO mm = surf_lsm_h%start_index(j,i), & 2914 2917 ! surf_lsm_h%end_index(j,i)
Note: See TracChangeset
for help on using the changeset viewer.
