Changeset 3254 for palm/trunk


Ignore:
Timestamp:
Sep 17, 2018 10:53:57 AM (6 years ago)
Author:
suehring
Message:

Additional checks for surface_fractions and building_id; Remove redundant subroutine argument in surface_mod

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r3241 r3254  
    2525! -----------------
    2626! $Id$
     27! Additional check for surface_fractions and and checks for building_id and
     28! building_type extended.
     29!
     30! 3241 2018-09-12 15:02:00Z raasch
    2731! unused variables removed
    2832!
     
    3741!
    3842! 3209 2018-08-27 16:58:37Z suehring
    39 ! Read zsoil dimension lenght only if soil variables are provided
     43! Read zsoil dimension length only if soil variables are provided
    4044!
    4145! 3183 2018-07-27 14:25:55Z suehring
     
    30403044       ENDIF
    30413045!
     3046!--    Check for correct dimension of surface_fractions, should run from 0-2.
     3047       IF ( surface_fraction_f%from_file )  THEN
     3048          IF ( surface_fraction_f%nf-1 > 2 )  THEN
     3049             message_string = 'nsurface_fraction must not be larger than 3.'
     3050             CALL message( 'netcdf_data_input_mod', 'PA0580', 1, 2, 0, 6, 0 )
     3051          ENDIF
     3052       ENDIF
     3053!
    30423054!--    Check orography for fill-values. For the moment, give an error message.
    30433055!--    More advanced methods, e.g. a nearest neighbor algorithm as used in GIS
     
    33983410                IF ( buildings_f%lod == 1 )  THEN
    33993411                   IF ( buildings_f%var_2d(j,i)  /= buildings_f%fill1  .AND.   &
    3400                         building_type_f%var(j,i) == building_type_f%fill )  THEN
    3401 
     3412                        building_type_f%var(j,i) == building_type_f%fill  .OR. &
     3413                        buildings_f%var_2d(j,i)  == buildings_f%fill1  .AND.   &
     3414                        building_type_f%var(j,i) /= building_type_f%fill )  THEN
    34023415                      WRITE( message_string, * ) 'Each location where a ' //   &
    34033416                                         'building is set requires a type ' // &
     
    34113424                IF ( buildings_f%lod == 2 )  THEN
    34123425                   IF ( ANY( buildings_f%var_3d(:,j,i) == 1 )  .AND.           &
    3413                         building_type_f%var(j,i) == building_type_f%fill )  THEN
     3426                        building_type_f%var(j,i) == building_type_f%fill  .OR. &
     3427                        .NOT. ANY( buildings_f%var_3d(:,j,i) == 1 )  .AND.     &
     3428                        building_type_f%var(j,i) /= building_type_f%fill)  THEN
    34143429                      WRITE( message_string, * ) 'Each location where a ' //   &
    34153430                                         'building is set requires a type ' // &
     
    34283443                IF ( buildings_f%lod == 1 )  THEN
    34293444                   IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1  .AND.    &
    3430                         building_id_f%var(j,i)  == building_id_f%fill )  THEN
     3445                        building_id_f%var(j,i)  == building_id_f%fill  .OR.    &
     3446                        buildings_f%var_2d(j,i) == buildings_f%fill1  .AND.    &
     3447                        building_id_f%var(j,i)  /= building_id_f%fill )  THEN
    34313448                      WRITE( message_string, * ) 'Each location where a ' //   &
    34323449                                         'building is set requires an ID ' //  &
     
    34373454                ELSEIF ( buildings_f%lod == 2 )  THEN
    34383455                   IF ( ANY( buildings_f%var_3d(:,j,i) == 1 )  .AND.           &
    3439                         building_id_f%var(j,i) == building_id_f%fill )  THEN
     3456                        building_id_f%var(j,i) == building_id_f%fill  .OR.     &
     3457                        .NOT. ANY( buildings_f%var_3d(:,j,i) == 1 )  .AND.     &
     3458                        building_id_f%var(j,i) /= building_id_f%fill )  THEN
    34403459                      WRITE( message_string, * ) 'Each location where a ' //   &
    34413460                                         'building is set requires an ID ' //  &
     
    34473466             ENDIF
    34483467!
    3449 !--          Check if at each location where a building ID or a -type is set
    3450 !--          also a bulding is defined.
     3468!--          Check if building ID is set where a bulding is defined.
    34513469             IF ( buildings_f%from_file )  THEN
    34523470                IF ( buildings_f%lod == 1 )  THEN
    3453                    IF ( buildings_f%var_2d(j,i)  /= buildings_f%fill1  .AND.   &
    3454                         building_id_f%var(j,i) == building_id_f%fill )  THEN
     3471                   IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1  .AND.   &
     3472                        building_id_f%var(j,i)  == building_id_f%fill )  THEN
    34553473                      WRITE( message_string, * ) 'Each building grid point '// &
    34563474                                                 'requires an ID.', i, j
     
    34593477                   ENDIF
    34603478                ELSEIF ( buildings_f%lod == 2 )  THEN
    3461                    IF ( ANY( buildings_f%var_3d(:,j,i) == 1 )                  &
    3462                   .AND. building_id_f%var(j,i) == building_id_f%fill )  THEN
     3479                   IF ( ANY( buildings_f%var_3d(:,j,i) == 1 )  .AND.           &
     3480                        building_id_f%var(j,i) == building_id_f%fill )  THEN
    34633481                      WRITE( message_string, * ) 'Each building grid point '// &
    34643482                                                 'requires an ID.', i, j
  • palm/trunk/SOURCE/surface_mod.f90

    r3253 r3254  
    2626! -----------------
    2727! $Id$
     28! Remove redundant subroutine argument
     29!
     30! 3253 2018-09-17 08:39:12Z suehring
    2831! Bugfix, missing deallocation of q_surface
    2932!
     
    18151818                                 topo_no_distinct
    18161819                      IF ( urban_surface  .AND.  building )  THEN
    1817                          CALL initialize_vertical_surfaces( 0, k, j, i,        &
     1820                         CALL initialize_vertical_surfaces( k, j, i,           &
    18181821                                                            surf_usm_v(0),     &
    18191822                                                            num_usm_v(0),      &
     
    18221825                                                            .FALSE., .TRUE. )
    18231826                      ELSEIF ( land_surface  .AND.  terrain )  THEN
    1824                          CALL initialize_vertical_surfaces( 0, k, j, i,        &
     1827                         CALL initialize_vertical_surfaces( k, j, i,           &
    18251828                                                            surf_lsm_v(0),     &
    18261829                                                            num_lsm_v(0),      &
     
    18291832                                                            .FALSE., .TRUE. )
    18301833                      ELSE
    1831                          CALL initialize_vertical_surfaces( 0, k, j, i,        &
     1834                         CALL initialize_vertical_surfaces( k, j, i,           &
    18321835                                                            surf_def_v(0),     &
    18331836                                                            num_def_v(0),      &
     
    18471850                                 topo_no_distinct
    18481851                      IF ( urban_surface  .AND.  building )  THEN
    1849                          CALL initialize_vertical_surfaces( 1, k, j, i,        &
     1852                         CALL initialize_vertical_surfaces( k, j, i,           &
    18501853                                                            surf_usm_v(1),     &
    18511854                                                            num_usm_v(1),      &
     
    18541857                                                            .TRUE., .FALSE. )
    18551858                      ELSEIF ( land_surface  .AND.  terrain )  THEN
    1856                          CALL initialize_vertical_surfaces( 1, k, j, i,        &
     1859                         CALL initialize_vertical_surfaces( k, j, i,           &
    18571860                                                            surf_lsm_v(1),     &
    18581861                                                            num_lsm_v(1),      &
     
    18611864                                                            .TRUE., .FALSE. ) 
    18621865                      ELSE
    1863                          CALL initialize_vertical_surfaces( 1, k, j, i,        &
     1866                         CALL initialize_vertical_surfaces( k, j, i,           &
    18641867                                                            surf_def_v(1),     &
    18651868                                                            num_def_v(1),      &
     
    18791882                                 topo_no_distinct
    18801883                      IF ( urban_surface  .AND.  building )  THEN
    1881                          CALL initialize_vertical_surfaces( 2, k, j, i,        &
     1884                         CALL initialize_vertical_surfaces( k, j, i,           &
    18821885                                                            surf_usm_v(2),     &
    18831886                                                            num_usm_v(2),      &
     
    18861889                                                            .FALSE., .FALSE. )
    18871890                      ELSEIF ( land_surface  .AND.  terrain )  THEN
    1888                          CALL initialize_vertical_surfaces( 2, k, j, i,        &
     1891                         CALL initialize_vertical_surfaces( k, j, i,           &
    18891892                                                            surf_lsm_v(2),     &
    18901893                                                            num_lsm_v(2),      &
     
    18931896                                                            .FALSE., .FALSE. )
    18941897                      ELSE
    1895                          CALL initialize_vertical_surfaces( 2, k, j, i,        &
     1898                         CALL initialize_vertical_surfaces( k, j, i,           &
    18961899                                                            surf_def_v(2),     &
    18971900                                                            num_def_v(2),      &
     
    19111914                                 topo_no_distinct
    19121915                      IF ( urban_surface  .AND.  building )  THEN
    1913                          CALL initialize_vertical_surfaces( 3, k, j, i,        &
     1916                         CALL initialize_vertical_surfaces( k, j, i,           &
    19141917                                                            surf_usm_v(3),     &
    19151918                                                            num_usm_v(3),      &
     
    19181921                                                           .FALSE., .FALSE. )
    19191922                      ELSEIF ( land_surface  .AND.  terrain )  THEN
    1920                          CALL initialize_vertical_surfaces( 3, k, j, i,        &
     1923                         CALL initialize_vertical_surfaces( k, j, i,           &
    19211924                                                            surf_lsm_v(3),     &
    19221925                                                            num_lsm_v(3),      &
     
    19251928                                                           .FALSE., .FALSE. )
    19261929                      ELSE
    1927                          CALL initialize_vertical_surfaces( 3, k, j, i,        &
     1930                         CALL initialize_vertical_surfaces( k, j, i,           &
    19281931                                                            surf_def_v(3),     &
    19291932                                                            num_def_v(3),      &
     
    23572360!> Initialize vertical surface elements.
    23582361!------------------------------------------------------------------------------!
    2359           SUBROUTINE initialize_vertical_surfaces( l, k, j, i, surf, num_v,    &
    2360                                                 num_v_kji, east_facing,        &
    2361                                                 west_facing, south_facing,     &
    2362                                                 north_facing )       
     2362          SUBROUTINE initialize_vertical_surfaces( k, j, i, surf, num_v,       &
     2363                                                   num_v_kji, east_facing,     &
     2364                                                   west_facing, south_facing,  &
     2365                                                   north_facing )       
    23632366
    23642367             IMPLICIT NONE
Note: See TracChangeset for help on using the changeset viewer.