Ignore:
Timestamp:
Mar 15, 2018 11:47:16 AM (6 years ago)
Author:
suehring
Message:

Relax restrictions for topography input via static input file, terrain and building heights, as well as building IDs can be input separately and are not mandatory any more.

File:
1 edited

Legend:

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

    r2893 r2897  
    2525! -----------------
    2626! $Id$
     27! Relax restrictions for topography input, terrain and building heights can be
     28! input separately and are not mandatory any more.
     29!
     30! 2893 2018-03-14 16:20:52Z suehring
    2731! Revise informative message concerning filtered topography (1 grid-point
    2832! holes).
     
    896900!-- and terrain height can be made. Moreover, this is also not necessary if
    897901!-- urban-surface and land-surface model are used at the same time.
    898     IF ( input_pids_static )  THEN
    899        num_buildings_l = 0
    900        num_buildings   = 0
    901 !
    902 !--    Allocate at least one element for building ids,
    903        ALLOCATE( build_ids_l(1) )
    904        DO  i = nxl, nxr
    905           DO  j = nys, nyn
    906              IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    907                 IF ( num_buildings_l(myid) > 0 )  THEN
    908                    IF ( ANY( building_id_f%var(j,i) .EQ.  build_ids_l ) )  THEN
    909                       CYCLE
    910                    ELSE
    911                       num_buildings_l(myid) = num_buildings_l(myid) + 1
     902    IF ( input_pids_static )  THEN
     903
     904       IF ( buildings_f%from_file )  THEN
     905          num_buildings_l = 0
     906          num_buildings   = 0
     907!
     908!--       Allocate at least one element for building ids,
     909          ALLOCATE( build_ids_l(1) )
     910          DO  i = nxl, nxr
     911             DO  j = nys, nyn
     912                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
     913                   IF ( num_buildings_l(myid) > 0 )  THEN
     914                      IF ( ANY( building_id_f%var(j,i) .EQ.  build_ids_l ) )   &
     915                      THEN
     916                         CYCLE
     917                      ELSE
     918                         num_buildings_l(myid) = num_buildings_l(myid) + 1
    912919!
    913920!--                   Resize array with different local building ids
     
    922929                   ENDIF
    923930!
    924 !--             First occuring building id on PE
    925                 ELSE
    926                    num_buildings_l(myid) = num_buildings_l(myid) + 1
    927                    build_ids_l(1) = building_id_f%var(j,i)
     931!--                First occuring building id on PE
     932                   ELSE
     933                      num_buildings_l(myid) = num_buildings_l(myid) + 1
     934                      build_ids_l(1) = building_id_f%var(j,i)
     935                   ENDIF
    928936                ENDIF
    929              ENDIF
    930           ENDDO
    931        ENDDO
    932 !
    933 !--    Determine number of different building ids for the entire domain
     937             ENDDO
     938          ENDDO
     939!
     940!--       Determine number of different building ids for the entire domain
    934941#if defined( __parallel )
    935        CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs,              &
    936                            MPI_INTEGER, MPI_SUM, comm2d, ierr )
     942          CALL MPI_ALLREDUCE( num_buildings_l, num_buildings, numprocs,              &
     943                              MPI_INTEGER, MPI_SUM, comm2d, ierr )
    937944#else
    938        num_buildings = num_buildings_l
     945          num_buildings = num_buildings_l
    939946#endif
    940947!
    941 !--    Gather all buildings ids on each PEs.
    942 !--    First, allocate array encompassing all building ids in model domain. 
    943        ALLOCATE( build_ids(1:SUM(num_buildings)) )
     948!--       Gather all buildings ids on each PEs.
     949!--       First, allocate array encompassing all building ids in model domain. 
     950          ALLOCATE( build_ids(1:SUM(num_buildings)) )
    944951#if defined( __parallel )
    945952!
    946 !--    Allocate array for displacements.
    947 !--    As each PE may has a different number of buildings, so that
    948 !--    the block sizes send by each PE may not be equal. Hence,
    949 !--    information about the respective displacement is required, indicating
    950 !--    the respective adress where each MPI-task writes into the receive
    951 !--    buffer array 
    952        ALLOCATE( displace_dum(0:numprocs-1) )
    953        displace_dum(0) = 0
    954        DO i = 1, numprocs-1
    955           displace_dum(i) = displace_dum(i-1) + num_buildings(i-1)
    956        ENDDO
    957 
    958        CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)),                 &
    959                             num_buildings(myid),                                  &
    960                             MPI_INTEGER,                                          &
    961                             build_ids,                                            &
    962                             num_buildings,                                        &
    963                             displace_dum,                                         &
    964                             MPI_INTEGER,                                          &
    965                             comm2d, ierr )   
    966 
    967        DEALLOCATE( displace_dum )
     953!--       Allocate array for displacements.
     954!--       As each PE may has a different number of buildings, so that
     955!--       the block sizes send by each PE may not be equal. Hence,
     956!--       information about the respective displacement is required, indicating
     957!--       the respective adress where each MPI-task writes into the receive
     958!--       buffer array 
     959          ALLOCATE( displace_dum(0:numprocs-1) )
     960          displace_dum(0) = 0
     961          DO i = 1, numprocs-1
     962             displace_dum(i) = displace_dum(i-1) + num_buildings(i-1)
     963          ENDDO
     964
     965          CALL MPI_ALLGATHERV( build_ids_l(1:num_buildings_l(myid)),                 &
     966                               num_buildings(myid),                                  &
     967                               MPI_INTEGER,                                          &
     968                               build_ids,                                            &
     969                               num_buildings,                                        &
     970                               displace_dum,                                         &
     971                               MPI_INTEGER,                                          &
     972                               comm2d, ierr )   
     973
     974          DEALLOCATE( displace_dum )
    968975
    969976#else
    970        build_ids = build_ids_l
     977          build_ids = build_ids_l
    971978#endif
    972979
    973980!
    974 !--    Note, in parallel mode building ids can occure mutliple times, as
    975 !--    each PE has send its own ids. Therefore, sort out building ids which
    976 !--    appear more than one time.
    977        num_build = 0
    978        DO  nr = 1, SIZE(build_ids)
    979 
    980           IF ( ALLOCATED(build_ids_final) )  THEN
    981              IF ( ANY( build_ids(nr) .EQ. build_ids_final ) )  THEN
    982                 CYCLE
     981!--       Note, in parallel mode building ids can occure mutliple times, as
     982!--       each PE has send its own ids. Therefore, sort out building ids which
     983!--       appear more than one time.
     984          num_build = 0
     985          DO  nr = 1, SIZE(build_ids)
     986
     987             IF ( ALLOCATED(build_ids_final) )  THEN
     988                IF ( ANY( build_ids(nr) .EQ. build_ids_final ) )  THEN
     989                   CYCLE
     990                ELSE
     991                   num_build = num_build + 1
     992!
     993!--                Resize
     994                   ALLOCATE( build_ids_final_tmp(1:num_build) )
     995                   build_ids_final_tmp(1:num_build-1) = build_ids_final(1:num_build-1)
     996                   DEALLOCATE( build_ids_final )
     997                   ALLOCATE( build_ids_final(1:num_build) )
     998                   build_ids_final(1:num_build-1) = build_ids_final_tmp(1:num_build-1)
     999                   build_ids_final(num_build) = build_ids(nr)
     1000                   DEALLOCATE( build_ids_final_tmp )
     1001                ENDIF             
    9831002             ELSE
    9841003                num_build = num_build + 1
    985 !
    986 !--             Resize
    987                 ALLOCATE( build_ids_final_tmp(1:num_build) )
    988                 build_ids_final_tmp(1:num_build-1) = build_ids_final(1:num_build-1)
    989                 DEALLOCATE( build_ids_final )
    9901004                ALLOCATE( build_ids_final(1:num_build) )
    991                 build_ids_final(1:num_build-1) = build_ids_final_tmp(1:num_build-1)
    9921005                build_ids_final(num_build) = build_ids(nr)
    993                 DEALLOCATE( build_ids_final_tmp )
    994              ENDIF             
    995           ELSE
    996              num_build = num_build + 1
    997              ALLOCATE( build_ids_final(1:num_build) )
    998              build_ids_final(num_build) = build_ids(nr)
    999           ENDIF
    1000        ENDDO
    1001 
    1002 !
    1003 !--    Finally, determine maximumum terrain height occupied by the
    1004 !--    respective building.
    1005        ALLOCATE( oro_max_l(1:SIZE(build_ids_final)) )
    1006        ALLOCATE( oro_max(1:SIZE(build_ids_final))   )
    1007        oro_max_l = 0.0_wp
    1008 
    1009        DO  nr = 1, SIZE(build_ids_final)
    1010           oro_max_l(nr) = MAXVAL(                                              &
    1011                            MERGE( terrain_height_f%var, 0.0_wp,                &
    1012                                   building_id_f%var(nys:nyn,nxl:nxr) .EQ.      &
    1013                                   build_ids_final(nr) ) )
    1014        ENDDO
     1006             ENDIF
     1007          ENDDO
     1008
     1009!
     1010!--       Finally, determine maximumum terrain height occupied by the
     1011!--       respective building.
     1012          ALLOCATE( oro_max_l(1:SIZE(build_ids_final)) )
     1013          ALLOCATE( oro_max(1:SIZE(build_ids_final))   )
     1014          oro_max_l = 0.0_wp
     1015
     1016          DO  nr = 1, SIZE(build_ids_final)
     1017             oro_max_l(nr) = MAXVAL(                                              &
     1018                              MERGE( terrain_height_f%var, 0.0_wp,                &
     1019                                     building_id_f%var(nys:nyn,nxl:nxr) .EQ.      &
     1020                                     build_ids_final(nr) ) )
     1021          ENDDO
    10151022   
    10161023#if defined( __parallel )   
    1017        IF ( SIZE(build_ids_final) >= 1 ) THEN
    1018           CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL,   &
    1019                               MPI_MAX, comm2d, ierr )
     1024          IF ( SIZE(build_ids_final) >= 1 ) THEN
     1025             CALL MPI_ALLREDUCE( oro_max_l, oro_max, SIZE( oro_max ), MPI_REAL,   &
     1026                                 MPI_MAX, comm2d, ierr )
     1027          ENDIF
     1028#else
     1029          oro_max = oro_max_l
     1030#endif
    10201031       ENDIF
    1021 #else
    1022        oro_max = oro_max_l
    1023 #endif
    10241032!
    10251033!--    Map orography as well as buildings onto grid.
     
    10471055!--             Set building grid points. Here, only consider 2D buildings.
    10481056!--             3D buildings require separate treatment.
    1049                 IF ( buildings_f%lod == 1 )  THEN
     1057                IF ( buildings_f%from_file  .AND.  buildings_f%lod == 1 )  THEN
    10501058                   IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    10511059!
     
    10711079!--          height covered by the building. In other words, extend
    10721080!--          building down to the respective local terrain-surface height.
    1073              IF ( buildings_f%lod == 2 )  THEN
     1081             IF ( buildings_f%from_file  .AND.  buildings_f%lod == 2 )  THEN
    10741082                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
    10751083!
Note: See TracChangeset for help on using the changeset viewer.