Changeset 3254
- Timestamp:
- Sep 17, 2018 10:53:57 AM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
netcdf_data_input_mod.f90 (modified) (9 diffs)
-
surface_mod.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3241 r3254 25 25 ! ----------------- 26 26 ! $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 27 31 ! unused variables removed 28 32 ! … … 37 41 ! 38 42 ! 3209 2018-08-27 16:58:37Z suehring 39 ! Read zsoil dimension leng htonly if soil variables are provided43 ! Read zsoil dimension length only if soil variables are provided 40 44 ! 41 45 ! 3183 2018-07-27 14:25:55Z suehring … … 3040 3044 ENDIF 3041 3045 ! 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 ! 3042 3054 !-- Check orography for fill-values. For the moment, give an error message. 3043 3055 !-- More advanced methods, e.g. a nearest neighbor algorithm as used in GIS … … 3398 3410 IF ( buildings_f%lod == 1 ) THEN 3399 3411 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 3402 3415 WRITE( message_string, * ) 'Each location where a ' // & 3403 3416 'building is set requires a type ' // & … … 3411 3424 IF ( buildings_f%lod == 2 ) THEN 3412 3425 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 3414 3429 WRITE( message_string, * ) 'Each location where a ' // & 3415 3430 'building is set requires a type ' // & … … 3428 3443 IF ( buildings_f%lod == 1 ) THEN 3429 3444 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 3431 3448 WRITE( message_string, * ) 'Each location where a ' // & 3432 3449 'building is set requires an ID ' // & … … 3437 3454 ELSEIF ( buildings_f%lod == 2 ) THEN 3438 3455 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 3440 3459 WRITE( message_string, * ) 'Each location where a ' // & 3441 3460 'building is set requires an ID ' // & … … 3447 3466 ENDIF 3448 3467 ! 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. 3451 3469 IF ( buildings_f%from_file ) THEN 3452 3470 IF ( buildings_f%lod == 1 ) THEN 3453 IF ( buildings_f%var_2d(j,i) 3454 building_id_f%var(j,i) == building_id_f%fill ) THEN3471 IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1 .AND. & 3472 building_id_f%var(j,i) == building_id_f%fill ) THEN 3455 3473 WRITE( message_string, * ) 'Each building grid point '// & 3456 3474 'requires an ID.', i, j … … 3459 3477 ENDIF 3460 3478 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 ) THEN3479 IF ( ANY( buildings_f%var_3d(:,j,i) == 1 ) .AND. & 3480 building_id_f%var(j,i) == building_id_f%fill ) THEN 3463 3481 WRITE( message_string, * ) 'Each building grid point '// & 3464 3482 'requires an ID.', i, j -
palm/trunk/SOURCE/surface_mod.f90
r3253 r3254 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Remove redundant subroutine argument 29 ! 30 ! 3253 2018-09-17 08:39:12Z suehring 28 31 ! Bugfix, missing deallocation of q_surface 29 32 ! … … 1815 1818 topo_no_distinct 1816 1819 IF ( urban_surface .AND. building ) THEN 1817 CALL initialize_vertical_surfaces( 0, k, j, i,&1820 CALL initialize_vertical_surfaces( k, j, i, & 1818 1821 surf_usm_v(0), & 1819 1822 num_usm_v(0), & … … 1822 1825 .FALSE., .TRUE. ) 1823 1826 ELSEIF ( land_surface .AND. terrain ) THEN 1824 CALL initialize_vertical_surfaces( 0, k, j, i,&1827 CALL initialize_vertical_surfaces( k, j, i, & 1825 1828 surf_lsm_v(0), & 1826 1829 num_lsm_v(0), & … … 1829 1832 .FALSE., .TRUE. ) 1830 1833 ELSE 1831 CALL initialize_vertical_surfaces( 0, k, j, i,&1834 CALL initialize_vertical_surfaces( k, j, i, & 1832 1835 surf_def_v(0), & 1833 1836 num_def_v(0), & … … 1847 1850 topo_no_distinct 1848 1851 IF ( urban_surface .AND. building ) THEN 1849 CALL initialize_vertical_surfaces( 1, k, j, i,&1852 CALL initialize_vertical_surfaces( k, j, i, & 1850 1853 surf_usm_v(1), & 1851 1854 num_usm_v(1), & … … 1854 1857 .TRUE., .FALSE. ) 1855 1858 ELSEIF ( land_surface .AND. terrain ) THEN 1856 CALL initialize_vertical_surfaces( 1, k, j, i,&1859 CALL initialize_vertical_surfaces( k, j, i, & 1857 1860 surf_lsm_v(1), & 1858 1861 num_lsm_v(1), & … … 1861 1864 .TRUE., .FALSE. ) 1862 1865 ELSE 1863 CALL initialize_vertical_surfaces( 1, k, j, i,&1866 CALL initialize_vertical_surfaces( k, j, i, & 1864 1867 surf_def_v(1), & 1865 1868 num_def_v(1), & … … 1879 1882 topo_no_distinct 1880 1883 IF ( urban_surface .AND. building ) THEN 1881 CALL initialize_vertical_surfaces( 2, k, j, i,&1884 CALL initialize_vertical_surfaces( k, j, i, & 1882 1885 surf_usm_v(2), & 1883 1886 num_usm_v(2), & … … 1886 1889 .FALSE., .FALSE. ) 1887 1890 ELSEIF ( land_surface .AND. terrain ) THEN 1888 CALL initialize_vertical_surfaces( 2, k, j, i,&1891 CALL initialize_vertical_surfaces( k, j, i, & 1889 1892 surf_lsm_v(2), & 1890 1893 num_lsm_v(2), & … … 1893 1896 .FALSE., .FALSE. ) 1894 1897 ELSE 1895 CALL initialize_vertical_surfaces( 2, k, j, i,&1898 CALL initialize_vertical_surfaces( k, j, i, & 1896 1899 surf_def_v(2), & 1897 1900 num_def_v(2), & … … 1911 1914 topo_no_distinct 1912 1915 IF ( urban_surface .AND. building ) THEN 1913 CALL initialize_vertical_surfaces( 3, k, j, i,&1916 CALL initialize_vertical_surfaces( k, j, i, & 1914 1917 surf_usm_v(3), & 1915 1918 num_usm_v(3), & … … 1918 1921 .FALSE., .FALSE. ) 1919 1922 ELSEIF ( land_surface .AND. terrain ) THEN 1920 CALL initialize_vertical_surfaces( 3, k, j, i,&1923 CALL initialize_vertical_surfaces( k, j, i, & 1921 1924 surf_lsm_v(3), & 1922 1925 num_lsm_v(3), & … … 1925 1928 .FALSE., .FALSE. ) 1926 1929 ELSE 1927 CALL initialize_vertical_surfaces( 3, k, j, i,&1930 CALL initialize_vertical_surfaces( k, j, i, & 1928 1931 surf_def_v(3), & 1929 1932 num_def_v(3), & … … 2357 2360 !> Initialize vertical surface elements. 2358 2361 !------------------------------------------------------------------------------! 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 ) 2363 2366 2364 2367 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.
