Changeset 2897 for palm/trunk/SOURCE
- Timestamp:
- Mar 15, 2018 11:47:16 AM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
init_grid.f90 (modified) (5 diffs)
-
netcdf_data_input_mod.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/init_grid.f90
r2893 r2897 25 25 ! ----------------- 26 26 ! $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 27 31 ! Revise informative message concerning filtered topography (1 grid-point 28 32 ! holes). … … 896 900 !-- and terrain height can be made. Moreover, this is also not necessary if 897 901 !-- 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 912 919 ! 913 920 !-- Resize array with different local building ids … … 922 929 ENDIF 923 930 ! 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 928 936 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 934 941 #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 ) 937 944 #else 938 num_buildings = num_buildings_l945 num_buildings = num_buildings_l 939 946 #endif 940 947 ! 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)) ) 944 951 #if defined( __parallel ) 945 952 ! 946 !-- Allocate array for displacements.947 !-- As each PE may has a different number of buildings, so that948 !-- the block sizes send by each PE may not be equal. Hence,949 !-- information about the respective displacement is required, indicating950 !-- the respective adress where each MPI-task writes into the receive951 !-- buffer array952 ALLOCATE( displace_dum(0:numprocs-1) )953 displace_dum(0) = 0954 DO i = 1, numprocs-1955 displace_dum(i) = displace_dum(i-1) + num_buildings(i-1)956 ENDDO957 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 ) 968 975 969 976 #else 970 build_ids = build_ids_l977 build_ids = build_ids_l 971 978 #endif 972 979 973 980 ! 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 983 1002 ELSE 984 1003 num_build = num_build + 1 985 !986 !-- Resize987 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 )990 1004 ALLOCATE( build_ids_final(1:num_build) ) 991 build_ids_final(1:num_build-1) = build_ids_final_tmp(1:num_build-1)992 1005 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 1015 1022 1016 1023 #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 1020 1031 ENDIF 1021 #else1022 oro_max = oro_max_l1023 #endif1024 1032 ! 1025 1033 !-- Map orography as well as buildings onto grid. … … 1047 1055 !-- Set building grid points. Here, only consider 2D buildings. 1048 1056 !-- 3D buildings require separate treatment. 1049 IF ( buildings_f% lod == 1 ) THEN1057 IF ( buildings_f%from_file .AND. buildings_f%lod == 1 ) THEN 1050 1058 IF ( building_id_f%var(j,i) /= building_id_f%fill ) THEN 1051 1059 ! … … 1071 1079 !-- height covered by the building. In other words, extend 1072 1080 !-- building down to the respective local terrain-surface height. 1073 IF ( buildings_f% lod == 2 ) THEN1081 IF ( buildings_f%from_file .AND. buildings_f%lod == 2 ) THEN 1074 1082 IF ( building_id_f%var(j,i) /= building_id_f%fill ) THEN 1075 1083 ! -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r2874 r2897 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Relax restrictions for topography input, terrain and building heights can be 28 ! input separately and are not mandatory any more. 29 ! 30 ! 2874 2018-03-13 10:55:42Z knoop 27 31 ! Bugfix: wrong placement of netcdf cpp-macros fixed 28 32 ! … … 1825 1829 ENDDO 1826 1830 ! 1827 !-- Check for minimum requirement of topography data in case 1828 !-- static input file is used. Note, doing this check in check_parameters 1831 !-- Check for minimum requirement to setup building topography. If buildings 1832 !-- are provided, also an ID and a type are required. 1833 !-- Note, doing this check in check_parameters 1829 1834 !-- will be too late (data will be used for grid inititialization before). 1830 1835 IF ( input_pids_static ) THEN 1831 IF ( .NOT. terrain_height_f%from_file .OR. & 1832 .NOT. building_id_f%from_file .OR. & 1833 .NOT. buildings_f%from_file ) THEN 1834 message_string = 'Minimum requirement for topography input ' // & 1835 'is not fulfilled. ' // & 1836 'Orography, buildings, as well as building ' // & 1837 'IDs are required.' 1836 IF ( buildings_f%from_file .AND. & 1837 .NOT. building_id_f%from_file ) THEN 1838 message_string = 'If building heigths are prescribed in ' // & 1839 'static input file, also an ID is required.' 1838 1840 CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 ) 1839 1841 ENDIF 1842 ENDIF 1843 ! 1844 !-- In case no terrain height is provided by static input file, allocate 1845 !-- array nevertheless and set terrain height to 0, which simplifies 1846 !-- topography initialization. 1847 IF ( .NOT. terrain_height_f%from_file ) THEN 1848 ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) ) 1849 terrain_height_f%var = 0.0_wp 1840 1850 ENDIF 1841 1851 !
Note: See TracChangeset
for help on using the changeset viewer.
