Changeset 4408 for palm


Ignore:
Timestamp:
Feb 14, 2020 10:04:39 AM (11 months ago)
Author:
gronemeier
Message:

write fill_value attribute in virtual-measurements module; enable character-array output in data-output module

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/data_output_binary_module.f90

    r4232 r4408  
    2525! -----------------
    2626! $Id$
     27! Enable character-array output
     28!
     29! 4232 2019-09-20 09:34:22Z knoop
    2730! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
    2831!
     
    532535               file_id, variable_id, bounds_start, value_counts, bounds_origin,        &
    533536               is_global,                                                              &
     537               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,   &
    534538               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
    535539               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     
    544548
    545549    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
    546555
    547556    INTEGER, INTENT(IN)  ::  file_id       !< file ID
     
    599608       WRITE( file_id )  bounds_origin
    600609!
     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!
    601628!--    8bit integer output
    602        IF ( PRESENT( values_int8_0d ) )  THEN
     629       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
    603630          output_string = 'int8'
    604631          WRITE( file_id )  output_string
  • palm/trunk/SOURCE/data_output_module.f90

    r4147 r4408  
    2020! Current revisions:
    2121! ------------------
    22 !
    23 !
     22! 
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! Enable character-array output
     28!
     29! 4147 2019-08-07 09:42:31Z gronemeier
    2730! corrected indentation according to coding standard
    2831!
     
    15331536!--------------------------------------------------------------------------------------------------!
    15341537 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,   &
    15351539             values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
    15361540             values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     
    15471551
    15481552    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
    15491567
    15501568    INTEGER ::  file_id              !< file ID
     
    17141732!
    17151733!--    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!
    17161792!--    8bit integer output
    1717        IF ( PRESENT( values_int8_0d ) )  THEN
     1793       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
    17181794          values_int8_0d_pointer => values_int8_0d
    17191795       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
     
    21392215          CASE ( 'binary' )
    21402216!
     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!
    21412235!--          8bit integer output
    2142              IF ( PRESENT( values_int8_0d ) )  THEN
     2236             ELSEIF ( PRESENT( values_int8_0d ) )  THEN
    21432237                CALL binary_write_variable( file_id, variable_id,                      &
    21442238                        bounds_start_internal, value_counts, bounds_origin, is_global, &
     
    22752369          CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    22762370!
     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!
    22772389!--          8bit integer output
    2278              IF ( PRESENT( values_int8_0d ) )  THEN
     2390             ELSEIF ( PRESENT( values_int8_0d ) )  THEN
    22792391                CALL netcdf4_write_variable( file_id, variable_id,                     &
    22802392                        bounds_start_internal, value_counts, bounds_origin, is_global, &
  • palm/trunk/SOURCE/data_output_netcdf4_module.f90

    r4232 r4408  
    2525! -----------------
    2626! $Id$
     27! Enable character-array output
     28!
     29! 4232 2019-09-20 09:34:22Z knoop
    2730! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
    2831!
     
    502505               file_id, variable_id, bounds_start, value_counts, bounds_origin,        &
    503506               is_global,                                                              &
     507               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,   &
    504508               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,   &
    505509               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,  &
     
    512516
    513517    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
    514523
    515524    INTEGER              ::  d             !< loop index
     
    578587
    579588       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 )
    580608!
    581609!--    8bit integer output
    582        IF ( PRESENT( values_int8_0d ) )  THEN
     610       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
    583611          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /), &
    584612                                  start = bounds_start - bounds_origin + 1,   &
  • palm/trunk/SOURCE/virtual_measurement_mod.f90

    r4406 r4408  
    2525! -----------------
    2626! $Id$
     27! write fill_value attribute
     28!
     29! 4406 2020-02-13 20:06:29Z knoop
    2730! Bugix: removed oro_rel wrong loop bounds and removed unnecessary restart method
    28 ! 
     31!
    2932! 4400 2020-02-10 20:32:41Z suehring
    3033! Revision of the module:
     
    268271       INTEGER(iwp) ::  start_coord_s = 0   !< start coordinate in NetCDF file for local soil observations
    269272
    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
    271274                                                         !< or station that are no _FillValues
    272275
     
    287290       REAL(wp) ::  fill_nutm                            !< fill value for UTM coordinates in case of missing values
    288291       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
    290293                                                         !< e.g. from inside a building
    291294       REAL(wp) ::  origin_x_obs                         !< origin of the observation in UTM coordiates in x-direction
     
    306309
    307310    ! This need to be generalized
    308 !     CHARACTER(LEN=10) ::  char_fill = '_FillValue'
     311    CHARACTER(LEN=10) ::  char_fill = '_FillValue'                 !< attribute name for fill value
    309312    CHARACTER(LEN=9)  ::  char_long = 'long_name'                  !< attribute name for long_name
    310313    CHARACTER(LEN=13) ::  char_standard = 'standard_name'          !< attribute name for standard_name
     
    462465
    463466 END SUBROUTINE vm_check_parameters
    464  
     467
    465468!------------------------------------------------------------------------------!
    466469! Description:
     
    893896!
    894897!-- 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
    896899!-- include also the surrounding grid points of the original coordinate
    897900!-- ghost points are required.
     
    10001003       ALLOCATE( vmea(l)%var_atts(1:vmea(l)%nmeas) )
    10011004!
    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
    10041007!--    string of output variables, which will be written into the attribute
    10051008!--    data_content.
     
    10141017!--    define the grid-index space on each subdomain where virtual measurements
    10151018!--    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,
    10171020!--    particularly for trajectories.
    10181021       IF ( vmea(l)%nmeas > 0 )  THEN
     
    13441347    DEALLOCATE( meas_flag )
    13451348!
    1346 !-- Close input file for virtual measurements. 
     1349!-- Close input file for virtual measurements.
    13471350    CALL close_input_file( pids_id )
    13481351!
     
    13981401!-- Note, start coordinates are initialized with zero for sake of simplicity
    13991402!-- 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.
    14011404    DO  l = 1, vmea_general%nvm
    14021405       DO  n  = 0, myid - 1
     
    22372240                                      value = TRIM( vmea(l)%var_atts(n)%coordinates ) )
    22382241
    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 ) )
    22432246
    22442247       ENDDO  ! loop over variables per site
     
    23452348          DEALLOCATE( output_values_1d_target )
    23462349!
    2347 !--       In case of sampled soil quantities, output also the respective 
     2350!--       In case of sampled soil quantities, output also the respective
    23482351!--       coordinate arrays.
    23492352          IF ( vmea(l)%soil_sampling )  THEN
     
    24122415!
    24132416!--          Write the stations name
    2414              
     2417
    24152418          ENDIF
    24162419
     
    29102913!                     i = MERGE( vmea(l)%i(m), nxl, vmea(l)%i(m) > nxl )
    29112914!                     i = MERGE( i           , nxr, i            < nxr )
    2912 ! 
     2915!
    29132916!                     DO  mm = surf_lsm_h%start_index(j,i),                      &
    29142917!                              surf_lsm_h%end_index(j,i)
Note: See TracChangeset for help on using the changeset viewer.