Ignore:
Timestamp:
Jul 3, 2017 2:07:20 PM (7 years ago)
Author:
suehring
Message:

Reading of 3D topography using NetCDF data type NC_BYTE; bugfixes in reading 3D topography from file

File:
1 edited

Legend:

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

    r2274 r2302  
    2525! -----------------
    2626! $Id$
     27! Bugfixes in reading 3D topography from file
     28!
     29! 2274 2017-06-09 13:27:48Z Giersch
    2730! Changed error messages
    2831!
     
    338341    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  topo_height   !< input variable for topography height
    339342
     343    INTEGER( KIND=1 ), DIMENSION(:,:,:), ALLOCATABLE ::  topo_3d_read !< input variable for 3D topography
     344
    340345!
    341346!-- Calculation of horizontal array bounds including ghost layers
     
    903908                   ELSEIF ( lod == 2 )  THEN
    904909!
     910!--                   Allocate 1-byte integer dummy array to read 3D topography
     911                      ALLOCATE( topo_3d_read(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
     912!
    905913!--                   Read data PE-wise. Read yz-slices.
    906914                      DO  i = nxl, nxr
    907915                         DO  j = nys, nyn
    908916                            CALL netcdf_get_variable( id_topo, 'buildings_0',  &
    909                                                       i, j, topo_3d(:,j,i), 20 )  !Error number still need to be set properly
     917                                                      i, j, topo_3d_read(:,j,i), 20 )  !Error number still need to be set properly
    910918                         ENDDO
    911919                      ENDDO
     
    915923                      CALL message( 'init_grid', 'PA0457', 1, 2, 0, 6, 0 )
    916924                   ENDIF
     925!
     926!--                On file, 3D topography grid points is classified with 1,
     927!--                atmosphere is classified with 0, contrary to the internal
     928!--                treatment. Hence, conversion is required. Moreover, set
     929!--                topography array to zero at lowest grid level.
     930                   topo_3d = MERGE( 0, 1, topo_3d_read == 1 )
     931                   topo_3d(nzb,:,:) = 0
     932!
     933!--                Deallocate dummy array
     934                   DEALLOCATE( topo_3d_read )
    917935!
    918936!--                Close topography input file
Note: See TracChangeset for help on using the changeset viewer.