Changeset 4159 for palm/trunk/SOURCE


Ignore:
Timestamp:
Aug 15, 2019 1:31:35 PM (5 years ago)
Author:
suehring
Message:

Revision of topography processing to have a consistent treatment of 2D and 3D buildings (init_grid, surface_mod); Bugfix in indoor model in case of non grid-resolved buildings

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r4148 r4159  
    2626! -----------------
    2727! $Id: indoor_model_mod.f90
     28! Bugfix in case of non grid-resolved buildings. Further, vertical grid spacing
     29! is now considered at the correct level. 
     30!
     31!
    2832! - change calculation of a_m and c_m
    2933! - change calculation of u-values (use h_es in building array)
     
    449453    REAL(wp) ::  du_tmp                                    !< 1/u_tmp
    450454    REAL(wp) ::  du_win_tmp                                !< 1/building(nb)%u_value_win
     455    REAL(wp) ::  facade_area_v                             !< dummy to compute the total facade area from vertical walls
    451456
    452457    REAL(wp), DIMENSION(:), ALLOCATABLE ::  volume         !< total building volume at each discrete height level
     
    588593             nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ),    &
    589594                         DIM = 1 )
    590              DO  k = nzb+1, nzt+1
     595             DO  k = nzb, nzt+1
    591596!
    592597!--             Check if grid point belongs to a building.
     
    622627       DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
    623628          buildings(nb)%building_height = buildings(nb)%building_height        &
    624                                         + dzw(k)
     629                                        + dzw(k+1)
    625630       ENDDO
    626631    ENDDO
     
    650655                   DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
    651656                      IF ( building_id_f%var(j,i) /= building_id_f%fill )      &
    652                          volume_l(k) = volume_l(k) + dx * dy * dzw(k)
     657                         volume_l(k) = volume_l(k) + dx * dy * dzw(k+1)
    653658                   ENDDO
    654659                ENDDO
     
    720725!--    Determine building index and check whether building is on PE
    721726       nb = MINLOC( ABS( buildings(:)%id - building_id_f%var(j,i) ), DIM = 1 )
     727
    722728       IF ( buildings(nb)%on_pe )  THEN
    723729!
     
    846852       IF ( buildings(nb)%on_pe )  THEN
    847853         
     854          facade_area_v = 0.0_wp         
     855          DO  k = buildings(nb)%kb_min, buildings(nb)%kb_max
     856             facade_area_v = facade_area_v + buildings(nb)%num_facade_v(k)     &
     857                             * dzw(k+1) * dx
     858          ENDDO
     859         
    848860          buildings(nb)%vpf = buildings(nb)%vol_tot /                          &
    849                ( buildings(nb)%num_facades_per_building_h * dx * dy +          &
    850                  SUM( buildings(nb)%num_facade_v(buildings(nb)%kb_min:         &
    851                                                  buildings(nb)%kb_max)         &
    852                     * dzw(buildings(nb)%kb_min:buildings(nb)%kb_max) ) * dx )
     861                        ( buildings(nb)%num_facades_per_building_h * dx * dy + &
     862                          facade_area_v )
    853863       ENDIF
    854864    ENDDO
     
    11301140!--          Building geometries --> not time-dependent
    11311141             facade_element_area          = dx * dy                                                   !< [m2] surface area per facade element   
    1132              floor_area_per_facade        = buildings(nb)%vpf(kk) * ddzw(kk                        !< [m2/m2] floor area per facade area
     1142             floor_area_per_facade        = buildings(nb)%vpf(kk) * ddzw(kk+1)                        !< [m2/m2] floor area per facade area
    11331143             indoor_volume_per_facade     = buildings(nb)%vpf(kk)                                     !< [m3/m2] indoor air volume per facade area
    11341144             buildings(nb)%area_facade    = facade_element_area *                                   &
     
    13371347!--          EXCEPT facade_element_area, EVERYTHING IS CALCULATED EQUALLY)
    13381348!--          Building geometries  --> not time-dependent
    1339              IF ( l == 0  .OR. l == 1 ) facade_element_area = dx * dzw(kk                          !< [m2] surface area per facade element
    1340              IF ( l == 2  .OR. l == 3 ) facade_element_area = dy * dzw(kk                          !< [m2] surface area per facade element
    1341              floor_area_per_facade        = buildings(nb)%vpf(kk) * ddzw(kk                        !< [m2/m2] floor area per facade area
     1349             IF ( l == 0  .OR. l == 1 ) facade_element_area = dx * dzw(kk+1)                          !< [m2] surface area per facade element
     1350             IF ( l == 2  .OR. l == 3 ) facade_element_area = dy * dzw(kk+1)                          !< [m2] surface area per facade element
     1351             floor_area_per_facade        = buildings(nb)%vpf(kk) * ddzw(kk+1)                        !< [m2/m2] floor area per facade area
    13421352             indoor_volume_per_facade     = buildings(nb)%vpf(kk)                                     !< [m3/m2] indoor air volume per facade area
    13431353             buildings(nb)%area_facade    = facade_element_area *                                   &
  • palm/trunk/SOURCE/init_grid.f90

    r4144 r4159  
    2525! -----------------
    2626! $Id$
     27! Revision of topography processing. This was not consistent between 2D and 3D
     28! buildings.
     29!
     30! 4144 2019-08-06 09:11:47Z raasch
    2731! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
    2832!
     
    14081412!-- need to be remove to avoid steep edges at the child-domain boundaries.
    14091413    IF ( input_pids_static )  THEN
     1414   
    14101415#if defined( __parallel )
    14111416       CALL MPI_ALLREDUCE( MINVAL( terrain_height_f%var ), oro_min, 1,         &
     
    14141419       oro_min = MINVAL( terrain_height_f%var )
    14151420#endif
    1416 
    14171421       terrain_height_f%var = terrain_height_f%var - oro_min
    14181422!                           
     
    15751579
    15761580          DO  nr = 1, SIZE(build_ids_final)
    1577              oro_max_l(nr) = MAXVAL(                                              &
    1578                               MERGE( terrain_height_f%var, 0.0_wp,                &
    1579                                      building_id_f%var(nys:nyn,nxl:nxr) ==      &
     1581             oro_max_l(nr) = MAXVAL(                                           &
     1582                              MERGE( terrain_height_f%var(nys:nyn,nxl:nxr),    &
     1583                                     0.0_wp,                                   &
     1584                                     building_id_f%var(nys:nyn,nxl:nxr) ==     &
    15801585                                     build_ids_final(nr) ) )
    15811586          ENDDO
     
    15831588#if defined( __parallel )   
    15841589          IF ( SIZE(build_ids_final) >= 1 ) THEN
    1585              CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL,   &
     1590             CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL,&
    15861591                                 MPI_MAX, comm2d, ierr )
    15871592          ENDIF
     
    15911596!
    15921597!--       Finally, determine discrete grid height of maximum orography occupied
    1593 !--       by a building. Use all-or-nothing approach, i.e. a grid box is either
     1598!--       by a building. Use all-or-nothing approach, i.e. if terrain
     1599!--       exceeds the scalar level the grid box is fully terrain and the
     1600!--       maximum terrain is set to the zw level.
     1601!--       terrain or
    15941602          oro_max_l = 0.0
    15951603          DO  nr = 1, SIZE(build_ids_final)
     
    16251633!--             attributes will not be correct as given surface information
    16261634!--             will not be in accordance to the classified grid points.
    1627 !--             Hence, in this case, de-flag the grid point and give it
    1628 !--             urban type instead.
     1635!--             Hence, in this case, also a building flag.
    16291636                IF ( zu(k) - ocean_offset <= terrain_height_f%var(j,i) )  THEN
    16301637                    topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
     
    16361643!--             3D buildings require separate treatment.
    16371644                IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
    1638                    IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN       
    1639                       IF ( zu(k) - ocean_offset <=                             &
    1640                            oro_max(nr) + buildings_f%var_2d(j,i) )  THEN
     1645!
     1646!--                Fill-up the terrain to the level of maximum orography
     1647!--                within the building-covered area.
     1648                   IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
     1649!
     1650!--                   Note, oro_max is always on zw level                   
     1651                      IF ( zu(k) - ocean_offset < oro_max(nr) )  THEN
     1652                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
     1653                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
     1654                      ELSEIF ( zu(k) - ocean_offset <=                         &
     1655                               oro_max(nr) + buildings_f%var_2d(j,i) )  THEN
    16411656                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    16421657                         topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
    1643 !
    1644 !--                      De-flag grid point of type natural. See comment above.
    1645                          topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 1 )
    16461658                      ENDIF
    16471659                   ENDIF
    16481660                ENDIF
    16491661             ENDDO
     1662!
     1663!--          Special treatment for non grid-resolved buildings. This case,
     1664!--          the uppermost terrain grid point is flagged as building as well
     1665!--          well, even though no building exists at all. However, the
     1666!--          surface element will be identified as urban-surface and the
     1667!--          input data provided by the drivers is consistent to the surface
     1668!--          classification. Else, all non grid-resolved buildings would vanish
     1669!--          and identified as terrain grid points, which, however, won't be
     1670!--          consistent with the input data.
     1671             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
     1672                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
     1673                   DO  k = nzb, nzt
     1674                      IF( zw(k) - ocean_offset == oro_max(nr) )  THEN
     1675                         IF ( buildings_f%var_2d(j,i) <= zu(k+1) - zw(k) )  THEN
     1676                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
     1677                         ENDIF
     1678                      ENDIF
     1679                   ENDDO
     1680                ENDIF
     1681             ENDIF
    16501682!
    16511683!--          Map 3D buildings onto terrain height. 
     
    16691701                      IF ( building_type_f%var(j,i) /= 7 )  THEN
    16701702                         DO k = topo_top_index + 1, nzt + 1     
    1671                             IF ( zw(k) - ocean_offset <= oro_max(nr) )  THEN
     1703                            IF ( zu(k) - ocean_offset <= oro_max(nr) )  THEN
    16721704                               topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    1673                                topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
     1705                               topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 1 )
    16741706                            ENDIF
    16751707                         ENDDO       
     
    16781710!--                      lower start index where building starts.
    16791711                         DO  k = nzb, nzt
    1680                             IF ( zw(k) - ocean_offset <= oro_max(nr) )         &
     1712                            IF ( zu(k) - ocean_offset <= oro_max(nr) )         &
    16811713                               topo_top_index = k
    16821714                         ENDDO
     
    16901722                         IF ( buildings_f%var_3d(k2,j,i) == 1 )  THEN
    16911723                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
    1692                             topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 1 )
    16931724                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 2 )
    16941725                         ENDIF
     
    17091740    ELSE
    17101741       ocean_offset     = MERGE( zw(0), 0.0_wp, ocean_mode )
     1742!
     1743!--    Initialize topography bit 0 (indicates obstacle) everywhere to zero
     1744!--    and clear all grid points at nzb, where alway a surface is defined.
     1745!--    Further, set also bit 1 (indicates terrain) at nzb, which is further
     1746!--    used for masked data output and further processing. Note, in the
     1747!--    ASCII case no distinction is made between buildings and terrain,
     1748!--    so that setting of bit 1 and 2 at the same time has no effect.
    17111749       topo_3d          = IBSET( topo_3d, 0 )
    17121750       topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
     1751       topo_3d(nzb,:,:) = IBSET( topo_3d(nzb,:,:), 1 )
    17131752       DO  i = nxl, nxr
    17141753          DO  j = nys, nyn
  • palm/trunk/SOURCE/surface_mod.f90

    r4156 r4159  
    2626! -----------------
    2727! $Id$
     28! Surface classification revised and adjusted to changes in init_grid
     29!
     30! 4156 2019-08-14 09:18:14Z schwenkel
    2831! Bugfix in case of cloud microphysics morrison
    2932!
     
    939942       LOGICAL ::  building                       !< flag indicating building grid point
    940943       LOGICAL ::  terrain                        !< flag indicating natural terrain grid point
     944       LOGICAL ::  unresolved_building            !< flag indicating a grid point where actually a building is
     945                                                  !< defined but not resolved by the vertical grid
    941946
    942947       num_def_h = 0
     
    966971                   IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN
    967972!
    968 !--                   Determine flags indicating terrain or building.
     973!--                   Determine flags indicating a terrain surface, a building
     974!--                   surface,
    969975                      terrain  = BTEST( wall_flags_0(k-1,j,i), 5 )  .OR.       &
    970976                                 topo_no_distinct
     
    972978                                 topo_no_distinct
    973979!
     980!--                   unresolved_building indicates a surface with equal height
     981!--                   as terrain but with a non-grid resolved building on top.
     982!--                   These surfaces will be flagged as urban surfaces.
     983                      unresolved_building = BTEST( wall_flags_0(k-1,j,i), 5 )  &
     984                                     .AND.  BTEST( wall_flags_0(k-1,j,i), 6 )
     985!
    974986!--                   Land-surface type
    975                       IF ( land_surface  .AND.  terrain )  THEN
     987                      IF ( land_surface  .AND.  terrain  .AND.                 &
     988                           .NOT. unresolved_building )  THEN
    976989                         num_lsm_h    = num_lsm_h    + 1
    977990!
     
    10271040                      building = BTEST( wall_flags_0(k,j-1,i), 6 )   .OR.      &
    10281041                                 topo_no_distinct
    1029                       IF (  land_surface  .AND.  terrain )  THEN
     1042
     1043                      unresolved_building = BTEST( wall_flags_0(k,j-1,i), 5 )  &
     1044                                     .AND.  BTEST( wall_flags_0(k,j-1,i), 6 )
     1045                                     
     1046                      IF (  land_surface  .AND.  terrain  .AND.                &
     1047                           .NOT. unresolved_building )  THEN
    10301048                         num_lsm_v(0) = num_lsm_v(0) + 1
    10311049                      ELSEIF ( urban_surface  .AND.  building )  THEN
     
    10561074                      building = BTEST( wall_flags_0(k,j+1,i), 6 )  .OR.       &
    10571075                                 topo_no_distinct
    1058                       IF (  land_surface  .AND.  terrain )  THEN
     1076                                 
     1077                      unresolved_building = BTEST( wall_flags_0(k,j+1,i), 5 )  &
     1078                                     .AND.  BTEST( wall_flags_0(k,j+1,i), 6 )
     1079                               
     1080                      IF (  land_surface  .AND.  terrain  .AND.                &
     1081                           .NOT. unresolved_building )  THEN
    10591082                         num_lsm_v(1) = num_lsm_v(1) + 1
    10601083                      ELSEIF ( urban_surface  .AND.  building )  THEN
     
    10851108                      building = BTEST( wall_flags_0(k,j,i-1), 6 )  .OR.       &
    10861109                                 topo_no_distinct
    1087                       IF (  land_surface  .AND.  terrain )  THEN
     1110                                 
     1111                      unresolved_building = BTEST( wall_flags_0(k,j,i-1), 5 )  &
     1112                                     .AND.  BTEST( wall_flags_0(k,j,i-1), 6 )
     1113                                     
     1114                      IF (  land_surface  .AND.  terrain  .AND.                &
     1115                           .NOT. unresolved_building )  THEN
    10881116                         num_lsm_v(2) = num_lsm_v(2) + 1
    10891117                      ELSEIF ( urban_surface  .AND.  building )  THEN
     
    11141142                      building = BTEST( wall_flags_0(k,j,i+1), 6 )  .OR.       &
    11151143                                 topo_no_distinct
    1116                       IF (  land_surface  .AND.  terrain )  THEN
     1144                                 
     1145                      unresolved_building = BTEST( wall_flags_0(k,j,i+1), 5 )  &
     1146                                     .AND.  BTEST( wall_flags_0(k,j,i+1), 6 )
     1147                                 
     1148                      IF (  land_surface  .AND.  terrain  .AND.                &
     1149                           .NOT. unresolved_building )  THEN
    11171150                         num_lsm_v(3) = num_lsm_v(3) + 1
    11181151                      ELSEIF ( urban_surface  .AND.  building )  THEN
     
    22172250       INTEGER(iwp), DIMENSION(0:3) ::  start_index_usm_v !< dummy to determing local start index in surface type for given (j,i), for vertical urban surfaces
    22182251
    2219        LOGICAL ::  building     !< flag indicating building grid point
    2220        LOGICAL ::  terrain      !< flag indicating natural terrain grid point
    2221 
     2252       LOGICAL ::  building            !< flag indicating building grid point
     2253       LOGICAL ::  terrain             !< flag indicating natural terrain grid point
     2254       LOGICAL ::  unresolved_building !< flag indicating a grid point where actually a building is defined but not resolved by the vertical grid
    22222255!
    22232256!--    Set offset indices, i.e. index difference between surface element and
     
    23222355                      building = BTEST( wall_flags_0(k-1,j,i), 6 )  .OR.       &
    23232356                                 topo_no_distinct
     2357                                 
     2358!
     2359!--                   unresolved_building indicates a surface with equal height
     2360!--                   as terrain but with a non-grid resolved building on top.
     2361!--                   These surfaces will be flagged as urban surfaces.
     2362                      unresolved_building = BTEST( wall_flags_0(k-1,j,i), 5 )  &
     2363                                     .AND.  BTEST( wall_flags_0(k-1,j,i), 6 )
    23242364!
    23252365!--                   Natural surface type         
    2326                       IF ( land_surface  .AND.  terrain )  THEN
     2366                      IF ( land_surface  .AND.  terrain  .AND.                 &
     2367                           .NOT. unresolved_building )  THEN
    23272368                         CALL initialize_horizontal_surfaces( k, j, i,         &
    23282369                                                              surf_lsm_h,      &
     
    23752416                      building = BTEST( wall_flags_0(k,j-1,i), 6 )  .OR.       &
    23762417                                 topo_no_distinct
    2377                       IF ( urban_surface  .AND.  building )  THEN
     2418
     2419                      unresolved_building = BTEST( wall_flags_0(k,j-1,i), 5 )  &
     2420                                     .AND.  BTEST( wall_flags_0(k,j-1,i), 6 )
     2421                                     
     2422                      IF ( land_surface  .AND.  terrain  .AND.                 &
     2423                           .NOT. unresolved_building )  THEN
     2424                         CALL initialize_vertical_surfaces( k, j, i,           &
     2425                                                            surf_lsm_v(0),     &
     2426                                                            num_lsm_v(0),      &
     2427                                                            num_lsm_v_kji(0),  &
     2428                                                            .FALSE., .FALSE.,  &             
     2429                                                            .FALSE., .TRUE. )
     2430                      ELSEIF ( urban_surface  .AND.  building )  THEN
    23782431                         CALL initialize_vertical_surfaces( k, j, i,           &
    23792432                                                            surf_usm_v(0),     &
     
    23812434                                                            num_usm_v_kji(0),  &
    23822435                                                            .FALSE., .FALSE.,  &             
    2383                                                             .FALSE., .TRUE. )
    2384                       ELSEIF ( land_surface  .AND.  terrain )  THEN
    2385                          CALL initialize_vertical_surfaces( k, j, i,           &
    2386                                                             surf_lsm_v(0),     &
    2387                                                             num_lsm_v(0),      &
    2388                                                             num_lsm_v_kji(0),  &
    2389                                                             .FALSE., .FALSE.,  &             
    2390                                                             .FALSE., .TRUE. )
     2436                                                            .FALSE., .TRUE. )
    23912437                      ELSE
    23922438                         CALL initialize_vertical_surfaces( k, j, i,           &
     
    24072453                      building = BTEST( wall_flags_0(k,j+1,i), 6 )  .OR.       &
    24082454                                 topo_no_distinct
    2409                       IF ( urban_surface  .AND.  building )  THEN
     2455                                 
     2456                      unresolved_building = BTEST( wall_flags_0(k,j+1,i), 5 )  &
     2457                                     .AND.  BTEST( wall_flags_0(k,j+1,i), 6 )
     2458                                     
     2459                      IF ( land_surface  .AND.  terrain  .AND.                 &
     2460                           .NOT. unresolved_building )  THEN
     2461                         CALL initialize_vertical_surfaces( k, j, i,           &
     2462                                                            surf_lsm_v(1),     &
     2463                                                            num_lsm_v(1),      &
     2464                                                            num_lsm_v_kji(1),  &
     2465                                                            .FALSE., .FALSE.,  &
     2466                                                            .TRUE., .FALSE. )
     2467                      ELSEIF ( urban_surface  .AND.  building )  THEN
    24102468                         CALL initialize_vertical_surfaces( k, j, i,           &
    24112469                                                            surf_usm_v(1),     &
     
    24142472                                                            .FALSE., .FALSE.,  &
    24152473                                                            .TRUE., .FALSE. )
    2416                       ELSEIF ( land_surface  .AND.  terrain )  THEN
    2417                          CALL initialize_vertical_surfaces( k, j, i,           &
    2418                                                             surf_lsm_v(1),     &
    2419                                                             num_lsm_v(1),      &
    2420                                                             num_lsm_v_kji(1),  &
    2421                                                             .FALSE., .FALSE.,  &
    2422                                                             .TRUE., .FALSE. ) 
    24232474                      ELSE
    24242475                         CALL initialize_vertical_surfaces( k, j, i,           &
     
    24392490                      building = BTEST( wall_flags_0(k,j,i-1), 6 )  .OR.       &
    24402491                                 topo_no_distinct
    2441                       IF ( urban_surface  .AND.  building )  THEN
     2492                                 
     2493                      unresolved_building = BTEST( wall_flags_0(k,j,i-1), 5 )  &
     2494                                     .AND.  BTEST( wall_flags_0(k,j,i-1), 6 )
     2495                                 
     2496                      IF ( land_surface  .AND.  terrain  .AND.                 &
     2497                           .NOT. unresolved_building )  THEN
     2498                         CALL initialize_vertical_surfaces( k, j, i,           &
     2499                                                            surf_lsm_v(2),     &
     2500                                                            num_lsm_v(2),      &
     2501                                                            num_lsm_v_kji(2),  &
     2502                                                            .TRUE., .FALSE.,   &
     2503                                                            .FALSE., .FALSE. )
     2504                      ELSEIF ( urban_surface  .AND.  building )  THEN
    24422505                         CALL initialize_vertical_surfaces( k, j, i,           &
    24432506                                                            surf_usm_v(2),     &
     
    24452508                                                            num_usm_v_kji(2),  &
    24462509                                                            .TRUE., .FALSE.,   &
    2447                                                             .FALSE., .FALSE. )
    2448                       ELSEIF ( land_surface  .AND.  terrain )  THEN
    2449                          CALL initialize_vertical_surfaces( k, j, i,           &
    2450                                                             surf_lsm_v(2),     &
    2451                                                             num_lsm_v(2),      &
    2452                                                             num_lsm_v_kji(2),  &
    2453                                                             .TRUE., .FALSE.,   &
    2454                                                             .FALSE., .FALSE. )
     2510                                                            .FALSE., .FALSE. )
    24552511                      ELSE
    24562512                         CALL initialize_vertical_surfaces( k, j, i,           &
     
    24712527                      building = BTEST( wall_flags_0(k,j,i+1), 6 )  .OR.       &
    24722528                                 topo_no_distinct
    2473                       IF ( urban_surface  .AND.  building )  THEN
     2529                                 
     2530                      unresolved_building = BTEST( wall_flags_0(k,j,i+1), 5 )  &
     2531                                     .AND.  BTEST( wall_flags_0(k,j,i+1), 6 )
     2532                                 
     2533                      IF ( land_surface  .AND.  terrain  .AND.                 &
     2534                           .NOT. unresolved_building )  THEN
     2535                         CALL initialize_vertical_surfaces( k, j, i,           &
     2536                                                            surf_lsm_v(3),     &
     2537                                                            num_lsm_v(3),      &
     2538                                                            num_lsm_v_kji(3),  &
     2539                                                           .FALSE., .TRUE.,    &
     2540                                                           .FALSE., .FALSE. )
     2541                      ELSEIF ( urban_surface  .AND.  building )  THEN
    24742542                         CALL initialize_vertical_surfaces( k, j, i,           &
    24752543                                                            surf_usm_v(3),     &
     
    24772545                                                            num_usm_v_kji(3),  &
    24782546                                                           .FALSE., .TRUE.,    &
    2479                                                            .FALSE., .FALSE. )
    2480                       ELSEIF ( land_surface  .AND.  terrain )  THEN
    2481                          CALL initialize_vertical_surfaces( k, j, i,           &
    2482                                                             surf_lsm_v(3),     &
    2483                                                             num_lsm_v(3),      &
    2484                                                             num_lsm_v_kji(3),  &
    2485                                                            .FALSE., .TRUE.,    &
    2486                                                            .FALSE., .FALSE. )
     2547                                                           .FALSE., .FALSE. )
    24872548                      ELSE
    24882549                         CALL initialize_vertical_surfaces( k, j, i,           &
Note: See TracChangeset for help on using the changeset viewer.