Changeset 4168 for palm/trunk
- Timestamp:
- Aug 16, 2019 1:50:17 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 19 edited
-
Makefile (modified) (3 diffs)
-
biometeorology_mod.f90 (modified) (7 diffs)
-
bulk_cloud_model_mod.f90 (modified) (5 diffs)
-
data_output_mask.f90 (modified) (5 diffs)
-
header.f90 (modified) (4 diffs)
-
init_3d_model.f90 (modified) (4 diffs)
-
init_grid.f90 (modified) (11 diffs)
-
lagrangian_particle_model_mod.f90 (modified) (6 diffs)
-
modules.f90 (modified) (2 diffs)
-
multi_agent_system_mod.f90 (modified) (5 diffs)
-
nesting_offl_mod.f90 (modified) (6 diffs)
-
plant_canopy_model_mod.f90 (modified) (19 diffs)
-
pmc_interface_mod.f90 (modified) (7 diffs)
-
radiation_model_mod.f90 (modified) (20 diffs)
-
surface_mod.f90 (modified) (5 diffs)
-
turbulence_closure_mod.f90 (modified) (6 diffs)
-
urban_surface_mod.f90 (modified) (6 diffs)
-
user_data_output_mask.f90 (modified) (7 diffs)
-
virtual_measurement_mod.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r4167 r4168 25 25 # ----------------- 26 26 # $Id$ 27 # Remove some dependencies on surface_mod that are no longer required without 28 # get_topography_top_index functions 29 # 30 # 4167 2019-08-16 11:01:48Z suehring 27 31 # Remove no longer needed dependencies on surface_mod 28 32 # … … 1237 1241 modules.o \ 1238 1242 netcdf_interface_mod.o \ 1239 surface_mod.o \1240 1243 random_function_mod.o 1241 1244 mod_kinds.o: \ … … 1272 1275 mod_kinds.o \ 1273 1276 modules.o \ 1274 netcdf_data_input_mod.o \ 1275 surface_mod.o 1277 netcdf_data_input_mod.o 1276 1278 ocean_mod.o: \ 1277 1279 advec_s_pw.o \ -
palm/trunk/SOURCE/biometeorology_mod.f90
r4144 r4168 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Replace function get_topography_top_index by topo_top_ind 30 ! 31 ! 4144 2019-08-06 09:11:47Z raasch 29 32 ! relational operators .EQ., .NE., etc. replaced by ==, /=, etc. 30 33 ! … … 178 181 USE indices, & 179 182 ONLY: nxl, nxr, nys, nyn, nzb, nzt, nys, nyn, nxl, nxr, nxlg, nxrg, & 180 nysg, nyng 183 nysg, nyng, topo_top_ind 181 184 182 185 USE kinds !< Set precision of INTEGER and REAL arrays according to PALM … … 192 195 radiation_interactions, rad_sw_in, & 193 196 rad_sw_out, rad_lw_in, rad_lw_out 194 195 USE surface_mod, &196 ONLY: get_topography_top_index_ji197 197 198 198 IMPLICIT NONE … … 1557 1557 j = mrtbl(iy,l) 1558 1558 k = mrtbl(iz,l) 1559 IF ( k - get_topography_top_index_ji( j, i, 's' ) == & 1560 bio_cell_level + 1_iwp) THEN 1559 IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp) THEN 1561 1560 ! 1562 1561 !-- Averaging was done before, so we can just copy the result here … … 1583 1582 j = mrtbl(iy,l) 1584 1583 k = mrtbl(iz,l) 1585 IF ( k - get_topography_top_index_ji( j, i, 's' ) == & 1586 bio_cell_level + 1_iwp) THEN 1584 IF ( k - topo_top_ind(j,i,0) == bio_cell_level + 1_iwp) THEN 1587 1585 IF ( mrt_include_sw ) THEN 1588 1586 tmrt_grid(j,i) = ( ( human_absorb * mrtinsw(l) + & … … 1608 1606 !------------------------------------------------------------------------------! 1609 1607 SUBROUTINE bio_get_thermal_index_input_ij( average_input, i, j, ta, vp, ws, & 1610 pair, tmrt )1608 pair, tmrt ) 1611 1609 1612 1610 IMPLICIT NONE … … 1633 1631 !-- Determine cell level closest to 1.1m above ground 1634 1632 ! by making use of truncation due to int cast 1635 k = INT( get_topography_top_index_ji(j, i, 's') + bio_cell_level ) !< Vertical cell center closest to 1.1m1633 k = INT( topo_top_ind(j,i,0) + bio_cell_level ) !< Vertical cell center closest to 1.1m 1636 1634 1637 1635 ! -
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r4110 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4110 2019-07-22 17:05:21Z suehring 27 30 ! Pass integer flag array as well as boundary flags to WS scalar advection 28 31 ! routine … … 280 283 ONLY: advc_flags_s, & 281 284 nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt, & 285 topo_top_ind, & 282 286 wall_flags_0 283 287 … … 291 295 292 296 USE surface_mod, & 293 ONLY : bc_h, get_topography_top_index_ji, surf_bulk_cloud_model, & 297 ONLY : bc_h, & 298 surf_bulk_cloud_model, & 294 299 surf_microphysics_morrison, surf_microphysics_seifert, & 295 300 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v … … 3807 3812 ! 3808 3813 !-- Determine vertical index of topography top 3809 k_wall = get_topography_top_index_ji( j, i, 's')3814 k_wall = topo_top_ind(j,i,0) 3810 3815 DO k = nzb+1, nzt 3811 3816 ! … … 3854 3859 ! 3855 3860 !-- Determine vertical index of topography top 3856 k_wall = get_topography_top_index_ji( j, i, 's')3861 k_wall = topo_top_ind(j,i,0) 3857 3862 DO k = nzb+1, nzt 3858 3863 ! -
palm/trunk/SOURCE/data_output_mask.f90
r4167 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove variable grid 28 ! 29 ! 4167 2019-08-16 11:01:48Z suehring 27 30 ! Changed behaviour of masked output over surface to follow terrain and ignore 28 31 ! buildings (J.Resler, T.Gronemeier) … … 225 228 226 229 IMPLICIT NONE 227 228 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids229 230 230 231 INTEGER(iwp) :: av !< flag for (non-)average output … … 310 311 ENDIF 311 312 ! 312 !-- Set default grid for terrain-following output313 grid = 's'314 !315 313 !-- Store the variable chosen. 316 314 resorted = .FALSE. … … 373 371 im = mask_i(mid,i) 374 372 jm = mask_j(mid,j) 375 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), DIM = 1 ) - 1 373 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )),& 374 DIM = 1 ) - 1 376 375 DO k = 1, mask_size_l(mid,3) 377 376 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 685 684 686 685 CASE ( 'w' ) 687 grid = 'w'688 686 IF ( av == 0 ) THEN 689 687 to_be_resorted => w -
palm/trunk/SOURCE/header.f90
r4069 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4069 2019-07-01 14:05:51Z Giersch 27 30 ! Masked output running index mid has been introduced as a local variable to 28 31 ! avoid runtime error (Loop variable has been modified) in time_integration … … 449 452 USE indices, & 450 453 ONLY: mg_loc_ind, nnx, nny, nnz, nx, ny, nxl_mg, nxr_mg, nyn_mg, & 451 nys_mg, nzt, nzt_mg 454 nys_mg, nzt, nzt_mg, topo_top_ind 452 455 453 456 USE kinds … … 478 481 479 482 USE surface_mod, & 480 ONLY: surf_def_h , get_topography_top_index_ji483 ONLY: surf_def_h 481 484 482 485 USE turbulence_closure_mod, & … … 1111 1114 WRITE( io, 280 ) 1112 1115 IF ( turbulent_inflow ) THEN 1113 WRITE( io, 281 ) zu( get_topography_top_index_ji( 0, 0, 's' ))1116 WRITE( io, 281 ) zu(topo_top_ind(0,0,0)) 1114 1117 ENDIF 1115 1118 IF ( TRIM( initializing_actions ) == 'cyclic_fill' ) THEN -
palm/trunk/SOURCE/init_3d_model.f90
r4151 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4151 2019-08-09 08:24:30Z suehring 27 30 ! Add netcdf directive around input calls (fix for last commit) 28 31 ! … … 719 722 surf_def_v, & 720 723 surf_lsm_h, & 721 surf_usm_h, & 722 get_topography_top_index_ji 724 surf_usm_h 723 725 724 726 #if defined( _OPENACC ) … … 1633 1635 DO i = nxlg, nxrg 1634 1636 DO j = nysg, nyng 1635 nz_u_shift = get_topography_top_index_ji( j, i, 'u')1636 nz_v_shift = get_topography_top_index_ji( j, i, 'v')1637 nz_w_shift = get_topography_top_index_ji( j, i, 'w')1638 nz_s_shift = get_topography_top_index_ji( j, i, 's')1637 nz_u_shift = topo_top_ind(j,i,1) 1638 nz_v_shift = topo_top_ind(j,i,2) 1639 nz_w_shift = topo_top_ind(j,i,3) 1640 nz_s_shift = topo_top_ind(j,i,0) 1639 1641 1640 1642 u(nz_u_shift:nzt+1,j,i) = u(0:nzt+1-nz_u_shift,j,i) … … 1677 1679 IF ( complex_terrain ) THEN 1678 1680 IF ( nxlg <= 0 .AND. nxrg >= 0 .AND. nysg <= 0 .AND. nyng >= 0 ) THEN 1679 nz_u_shift_l = get_topography_top_index_ji( 0, 0, 'u')1680 nz_v_shift_l = get_topography_top_index_ji( 0, 0, 'v')1681 nz_w_shift_l = get_topography_top_index_ji( 0, 0, 'w')1682 nz_s_shift_l = get_topography_top_index_ji( 0, 0, 's')1681 nz_u_shift_l = topo_top_ind(j,i,1) 1682 nz_v_shift_l = topo_top_ind(j,i,2) 1683 nz_w_shift_l = topo_top_ind(j,i,3) 1684 nz_s_shift_l = topo_top_ind(j,i,0) 1683 1685 ELSE 1684 1686 nz_u_shift_l = 0 -
palm/trunk/SOURCE/init_grid.f90
r4159 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Pre-calculate topography top index and store it on an array (replaces former 28 ! functions get_topography_top_index) 29 ! 30 ! 4159 2019-08-15 13:31:35Z suehring 27 31 ! Revision of topography processing. This was not consistent between 2D and 3D 28 32 ! buildings. … … 420 424 nzb_max, nzb_s_inner, nzb_s_outer, nzb_u_inner, & 421 425 nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner, & 422 nzb_w_outer, nzt, topo_ min_level426 nzb_w_outer, nzt, topo_top_ind, topo_min_level 423 427 424 428 USE kinds … … 429 433 430 434 USE surface_mod, & 431 ONLY: get_topography_top_index, get_topography_top_index_ji,init_bc435 ONLY: init_bc 432 436 433 437 USE vertical_nesting_mod, & … … 919 923 topo_min_level = 0 920 924 #if defined( __parallel ) 921 CALL MPI_ALLREDUCE( MINVAL( get_topography_top_index( 's') ), &925 CALL MPI_ALLREDUCE( MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), & 922 926 topo_min_level, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr ) 923 927 #else 924 topo_min_level = MINVAL( get_topography_top_index( 's') )928 topo_min_level = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ) 925 929 #endif 926 930 ! … … 960 964 !-- Topography height on scalar grid. Therefore, determine index of 961 965 !-- upward-facing surface element on scalar grid. 962 zu_s_inner(i,j) = zu( get_topography_top_index_ji( j, i, 's' ))966 zu_s_inner(i,j) = zu(topo_top_ind(j,i,0)) 963 967 ! 964 968 !-- Topography height on w grid. Therefore, determine index of 965 969 !-- upward-facing surface element on w grid. 966 zw_w_inner(i,j) = zw( get_topography_top_index_ji( j, i, 's' ))970 zw_w_inner(i,j) = zw(topo_top_ind(j,i,3)) 967 971 ENDDO 968 972 ENDDO … … 988 992 ! 989 993 !-- Initialize 2D-index arrays. Note, these will be removed soon! 990 nzb_local(nys:nyn,nxl:nxr) = get_topography_top_index( 's')994 nzb_local(nys:nyn,nxl:nxr) = topo_top_ind(nys:nyn,nxl:nxr,0) 991 995 CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp ) 992 996 ! … … 996 1000 IF ( TRIM( topography ) /= 'flat' ) THEN 997 1001 #if defined( __parallel ) 998 CALL MPI_ALLREDUCE( MAXVAL( get_topography_top_index( 's') ), &1002 CALL MPI_ALLREDUCE( MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ), & 999 1003 nzb_local_max, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr ) 1000 1004 #else 1001 nzb_local_max = MAXVAL( get_topography_top_index( 's') )1005 nzb_local_max = MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ) 1002 1006 #endif 1003 1007 nzb_local_min = topo_min_level … … 2017 2021 USE pegrid 2018 2022 2019 USE surface_mod, &2020 ONLY: get_topography_top_index, get_topography_top_index_ji2021 2022 2023 IMPLICIT NONE 2023 2024 … … 2572 2573 USE indices, & 2573 2574 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & 2574 nzt, wall_flags_02575 nzt, topo_top_ind, wall_flags_0 2575 2576 2576 2577 USE kinds … … 2579 2580 2580 2581 INTEGER(iwp) :: i !< index variable along x 2582 INTEGER(iwp) :: ibit !< integer bit position of topgraphy masking array 2581 2583 INTEGER(iwp) :: j !< index variable along y 2582 2584 INTEGER(iwp) :: k !< index variable along z … … 2885 2887 ENDIF 2886 2888 ENDIF 2887 2889 ! 2890 !-- Pre-calculate topography top indices (former get_topography_top_index 2891 !-- function) 2892 ALLOCATE( topo_top_ind(nysg:nyng,nxlg:nxrg,0:4) ) 2893 ! 2894 !-- Uppermost topography index on scalar grid 2895 ibit = 12 2896 topo_top_ind(:,:,0) = MAXLOC( & 2897 MERGE( 1, 0, & 2898 BTEST( wall_flags_0(:,:,:), ibit ) & 2899 ), DIM = 1 & 2900 ) - 1 2901 ! 2902 !-- Uppermost topography index on u grid 2903 ibit = 14 2904 topo_top_ind(:,:,1) = MAXLOC( & 2905 MERGE( 1, 0, & 2906 BTEST( wall_flags_0(:,:,:), ibit ) & 2907 ), DIM = 1 & 2908 ) - 1 2909 ! 2910 !-- Uppermost topography index on v grid 2911 ibit = 16 2912 topo_top_ind(:,:,2) = MAXLOC( & 2913 MERGE( 1, 0, & 2914 BTEST( wall_flags_0(:,:,:), ibit ) & 2915 ), DIM = 1 & 2916 ) - 1 2917 ! 2918 !-- Uppermost topography index on w grid 2919 ibit = 18 2920 topo_top_ind(:,:,3) = MAXLOC( & 2921 MERGE( 1, 0, & 2922 BTEST( wall_flags_0(:,:,:), ibit ) & 2923 ), DIM = 1 & 2924 ) - 1 2925 ! 2926 !-- Uppermost topography index on scalar outer grid 2927 ibit = 24 2928 topo_top_ind(:,:,4) = MAXLOC( & 2929 MERGE( 1, 0, & 2930 BTEST( wall_flags_0(:,:,:), ibit ) & 2931 ), DIM = 1 & 2932 ) - 1 2888 2933 2889 2934 END SUBROUTINE set_topo_flags -
palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
r4145 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4145 2019-08-06 09:55:22Z schwenkel 27 30 ! Some reformatting 28 31 ! … … 227 230 USE indices, & 228 231 ONLY: nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb, & 229 nzb_max, nzt, wall_flags_0,nbgp, ngp_2dh_outer 232 nzb_max, nzt,nbgp, ngp_2dh_outer, & 233 topo_top_ind, & 234 wall_flags_0 230 235 231 236 USE kinds … … 259 264 260 265 USE surface_mod, & 261 ONLY: get_topography_top_index_ji, surf_def_h, surf_lsm_h, surf_usm_h,& 262 bc_h 266 ONLY: bc_h, & 267 surf_def_h, & 268 surf_lsm_h, & 269 surf_usm_h 263 270 264 271 #if defined( __parallel ) && !defined( __mpifh ) … … 1402 1409 !-- Determine surface level. Therefore, check for 1403 1410 !-- upward-facing wall on w-grid. 1404 k_surf = get_topography_top_index_ji( jp, ip, 'w')1411 k_surf = topo_top_ind(jp,ip,3) 1405 1412 IF ( seed_follows_topography ) THEN 1406 1413 ! … … 3469 3476 !-- above topography (Prandtl-layer height) 3470 3477 !-- Determine vertical index of topography top 3471 k_wall = get_topography_top_index_ji( jp, ip, 's')3478 k_wall = topo_top_ind(jp,ip,0) 3472 3479 3473 3480 IF ( constant_flux_layer .AND. zv(n) - zw(k_wall) < z_p ) THEN … … 3558 3565 ! 3559 3566 !-- Determine vertical index of topography top 3560 k_wall = get_topography_top_index_ji( jp,ip, 's')3567 k_wall = topo_top_ind(jp,ip,0) 3561 3568 3562 3569 IF ( constant_flux_layer .AND. zv(n) - zw(k_wall) < z_p ) THEN -
palm/trunk/SOURCE/modules.f90
r4131 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! +topo_top_ind 28 ! 29 ! 4131 2019-08-02 11:06:18Z monakurppa 27 30 ! Add max_pr_salsa to control_parameters. Used in creating profile output for 28 31 ! salsa. … … 1755 1758 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: advc_flags_m !< flags used to degrade order of advection scheme for momentum 1756 1759 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: advc_flags_s !< flags used to degrade order of advection scheme for scalar quantities 1760 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: topo_top_ind !< precalculated topography top indices 1757 1761 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: wall_flags_0 !< flags to mask topography and surface-bounded grid points 1758 1762 -
palm/trunk/SOURCE/multi_agent_system_mod.f90
r3987 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 3987 2019-05-22 09:52:13Z kanani 27 30 ! Introduce alternative switch for debug output during timestepping 28 31 ! … … 131 134 USE indices, & 132 135 ONLY: nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & 136 topo_top_ind, & 133 137 wall_flags_0 134 138 … … 374 378 SUBROUTINE multi_agent_system 375 379 376 USE biometeorology_mod, & 377 ONLY: bio_calc_ipt, bio_calculate_mrt_grid, bio_get_thermal_index_input_ij 380 USE biometeorology_mod, & 381 ONLY: bio_calc_ipt, & 382 bio_calculate_mrt_grid, & 383 bio_get_thermal_index_input_ij 378 384 379 385 … … 3018 3024 ONLY: coupling_char, initializing_actions, io_blocks, io_group 3019 3025 3020 USE surface_mod, &3021 ONLY: get_topography_top_index, get_topography_top_index_ji3022 3023 3026 USE arrays_3d, & 3024 3027 ONLY: zu, zw … … 3077 3080 DO il = nxlg, nxrg 3078 3081 DO jl = nysg, nyng 3079 top_top_s(jl,il) = get_topography_top_index_ji(jl,il,'s') + 13080 top_top_w(jl,il) = get_topography_top_index_ji(jl,il,'w')3082 top_top_s(jl,il) = topo_top_ind(jl,il,0) + 1 3083 top_top_w(jl,il) = topo_top_ind(jl,il,3) 3081 3084 ENDDO 3082 3085 ENDDO -
palm/trunk/SOURCE/nesting_offl_mod.f90
r4125 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4125 2019-07-29 13:31:44Z suehring 27 30 ! In order to enable netcdf parallel access, allocate dummy arrays for the 28 31 ! lateral boundary data on cores that actually do not belong to these … … 119 122 USE indices, & 120 123 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys, & 121 nysv, nysg, nyn, nyng, nzb, nz, nzt, wall_flags_0 124 nysv, nysg, nyn, nyng, nzb, nz, nzt, & 125 topo_top_ind, & 126 wall_flags_0 122 127 123 128 USE kinds … … 873 878 874 879 USE kinds 875 876 USE surface_mod, &877 ONLY: get_topography_top_index, get_topography_top_index_ji878 880 879 881 IMPLICIT NONE … … 918 920 ! 919 921 !-- Determine topography top index at current (j,i) index 920 k_surface = get_topography_top_index_ji( j, i, 's')922 k_surface = topo_top_ind(j,i,0) 921 923 ! 922 924 !-- Pre-compute surface virtual temperature. Therefore, use 2nd … … 978 980 979 981 DO i = nxl, nxr 980 k_surface = get_topography_top_index_ji( j, i, 's')982 k_surface = topo_top_ind(j,i,0) 981 983 982 984 IF ( humidity ) THEN … … 1032 1034 !-- turbulence generator accordingly. If Rayleigh damping would be applied 1033 1035 !-- near buildings, etc., this would spoil the simulation results. 1034 topo_max_l = zw(MAXVAL( get_topography_top_index( 's' )))1036 topo_max_l = zw(MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) )) 1035 1037 1036 1038 #if defined( __parallel ) -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4127 r4168 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Replace function get_topography_top_index by topo_top_ind 30 ! 31 ! 4127 2019-07-30 14:47:10Z suehring 29 32 ! Output of 3D plant canopy variables changed. It is now relative to the local 30 33 ! terrain rather than located at the acutal vertical level in the model. This … … 269 272 USE indices, & 270 273 ONLY: nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv, & 271 nz, nzb, nzt 274 nz, nzb, nzt, topo_top_ind 272 275 273 276 USE kinds 274 277 275 278 USE pegrid 276 277 USE surface_mod, &278 ONLY: get_topography_top_index_ji279 279 280 280 … … 1292 1292 !-- Check whether topography and local vegetation on top exceed 1293 1293 !-- height of the model domain. 1294 k = get_topography_top_index_ji( j, i, 's')1294 k = topo_top_ind(j,i,0) 1295 1295 IF ( k + pch_index_ji(j,i) >= nzt + 1 ) THEN 1296 1296 message_string = 'Local vegetation height on top of ' // & … … 1591 1591 CALL message( 'pcm_read_plant_canopy_3d', 'PA0349', 1, 2, 0, 6, 0 ) 1592 1592 ENDIF 1593 kk = get_topography_top_index_ji( j, i, 's')1593 kk = topo_top_ind(j,i,0) 1594 1594 lad_s(nzb:nzpltop-kk, j, i) = col(kk:nzpl-1)*lad_type_coef(pctype) 1595 1595 CASE DEFAULT … … 1677 1677 ! 1678 1678 !-- Determine topography-top index on u-grid 1679 k_wall = get_topography_top_index_ji( j, i, 'u')1679 k_wall = topo_top_ind(j,i,1) 1680 1680 DO k = k_wall+1, k_wall + pch_index_ji(j,i) 1681 1681 … … 1741 1741 ! 1742 1742 !-- Determine topography-top index on v-grid 1743 k_wall = get_topography_top_index_ji( j, i, 'v')1743 k_wall = topo_top_ind(j,i,2) 1744 1744 1745 1745 DO k = k_wall+1, k_wall + pch_index_ji(j,i) … … 1806 1806 ! 1807 1807 !-- Determine topography-top index on w-grid 1808 k_wall = get_topography_top_index_ji( j, i, 'w')1808 k_wall = topo_top_ind(j,i,3) 1809 1809 1810 1810 DO k = k_wall+1, k_wall + pch_index_ji(j,i) - 1 … … 1858 1858 DO j = nys, nyn 1859 1859 !-- Determine topography-top index on scalar-grid 1860 k_wall = get_topography_top_index_ji( j, i, 's')1860 k_wall = topo_top_ind(j,i,0) 1861 1861 DO k = k_wall+1, k_wall + pch_index_ji(j,i) 1862 1862 kk = k - k_wall !- lad arrays are defined flat … … 1869 1869 DO j = nys, nyn 1870 1870 !-- Determine topography-top index on scalar-grid 1871 k_wall = get_topography_top_index_ji( j, i, 's')1871 k_wall = topo_top_ind(j,i,0) 1872 1872 DO k = k_wall+1, k_wall + pch_index_ji(j,i) 1873 1873 kk = k - k_wall !- lad arrays are defined flat … … 1885 1885 ! 1886 1886 !-- Determine topography-top index on scalar-grid 1887 k_wall = get_topography_top_index_ji( j, i, 's')1887 k_wall = topo_top_ind(j,i,0) 1888 1888 1889 1889 DO k = k_wall+1, k_wall + pch_index_ji(j,i) … … 1923 1923 ! 1924 1924 !-- Determine topography-top index on scalar-grid 1925 k_wall = get_topography_top_index_ji( j, i, 's')1925 k_wall = topo_top_ind(j,i,0) 1926 1926 1927 1927 DO k = k_wall+1, k_wall + pch_index_ji(j,i) … … 1952 1952 ! 1953 1953 !-- Determine topography-top index on scalar-grid 1954 k_wall = get_topography_top_index_ji( j, i, 's')1954 k_wall = topo_top_ind(j,i,0) 1955 1955 1956 1956 DO k = k_wall+1, k_wall + pch_index_ji(j,i) … … 2046 2046 ! 2047 2047 !-- Determine topography-top index on u-grid 2048 k_wall = get_topography_top_index_ji( j, i, 'u')2048 k_wall = topo_top_ind(j,i,1) 2049 2049 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) 2050 2050 … … 2106 2106 ! 2107 2107 !-- Determine topography-top index on v-grid 2108 k_wall = get_topography_top_index_ji( j, i, 'v')2108 k_wall = topo_top_ind(j,i,2) 2109 2109 2110 2110 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) … … 2166 2166 ! 2167 2167 !-- Determine topography-top index on w-grid 2168 k_wall = get_topography_top_index_ji( j, i, 'w')2168 k_wall = topo_top_ind(j,i,3) 2169 2169 2170 2170 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) - 1 … … 2213 2213 ! 2214 2214 !-- Determine topography-top index on scalar grid 2215 k_wall = get_topography_top_index_ji( j, i, 's')2215 k_wall = topo_top_ind(j,i,0) 2216 2216 2217 2217 IF ( humidity ) THEN … … 2233 2233 ! 2234 2234 !-- Determine topography-top index on scalar grid 2235 k_wall = get_topography_top_index_ji( j, i, 's')2235 k_wall = topo_top_ind(j,i,0) 2236 2236 2237 2237 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) … … 2266 2266 ! 2267 2267 !-- Determine topography-top index on scalar grid 2268 k_wall = get_topography_top_index_ji( j, i, 's')2268 k_wall = topo_top_ind(j,i,0) 2269 2269 2270 2270 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) … … 2292 2292 ! 2293 2293 !-- Determine topography-top index on scalar grid 2294 k_wall = get_topography_top_index_ji( j, i, 's')2294 k_wall = topo_top_ind(j,i,0) 2295 2295 2296 2296 DO k = k_wall + 1, k_wall + pch_index_ji(j,i) -
palm/trunk/SOURCE/pmc_interface_mod.f90
r4029 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4029 2019-06-14 14:04:35Z raasch 27 30 ! nest_chemistry switch removed 28 31 ! … … 478 481 USE indices, & 479 482 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 480 nysv, nz, nzb, nzt, wall_flags_0483 nysv, nz, nzb, nzt, topo_top_ind, wall_flags_0 481 484 482 485 USE bulk_cloud_model_mod, & … … 528 531 529 532 USE surface_mod, & 530 ONLY: get_topography_top_index_ji,surf_def_h, surf_lsm_h, surf_usm_h533 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 531 534 532 535 IMPLICIT NONE … … 2379 2382 DO j = nys, nyn 2380 2383 sub_sum = 0.0_wp 2381 k_wall = get_topography_top_index_ji( j, i, 'u')2384 k_wall = topo_top_ind(j,i,1) 2382 2385 DO k = k_wall + 1, nzt 2383 2386 sub_sum = sub_sum + dzw(k) … … 2401 2404 DO j = nys, nyn 2402 2405 sub_sum = 0.0_wp 2403 k_wall = get_topography_top_index_ji( j, i, 'u')2406 k_wall = topo_top_ind(j,i,1) 2404 2407 DO k = k_wall + 1, nzt 2405 2408 sub_sum = sub_sum + dzw(k) … … 2423 2426 DO i = nxl, nxr 2424 2427 sub_sum = 0.0_wp 2425 k_wall = get_topography_top_index_ji( j, i, 'v')2428 k_wall = topo_top_ind(j,i,2) 2426 2429 DO k = k_wall + 1, nzt 2427 2430 sub_sum = sub_sum + dzw(k) … … 2445 2448 DO i = nxl, nxr 2446 2449 sub_sum = 0.0_wp 2447 k_wall = get_topography_top_index_ji( j, i, 'v')2450 k_wall = topo_top_ind(j,i,2) 2448 2451 DO k = k_wall + 1, nzt 2449 2452 sub_sum = sub_sum + dzw(k) -
palm/trunk/SOURCE/radiation_model_mod.f90
r4167 r4168 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Changed behaviour of masked output over surface to follow terrain and ignore 31 ! buildings (J.Resler, T.Gronemeier) 30 ! Replace function get_topography_top_index by topo_top_ind 32 31 ! 33 32 ! 4157 2019-08-14 09:19:12Z suehring … … 691 690 USE indices, & 692 691 ONLY: nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 693 nzb, nzt 692 nzb, nzt, topo_top_ind 694 693 695 694 USE, INTRINSIC :: iso_c_binding … … 737 736 738 737 USE surface_mod, & 739 ONLY: get_topography_top_index, get_topography_top_index_ji, & 740 ind_pav_green, ind_veg_wall, ind_wat_win, & 738 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, & 741 739 surf_lsm_h, surf_lsm_v, surf_type, surf_usm_h, surf_usm_v, & 742 740 vertical_surfaces_exist … … 745 743 746 744 CHARACTER(10) :: radiation_scheme = 'clear-sky' ! 'constant', 'clear-sky', or 'rrtmg' 747 748 REAL(wp), PARAMETER :: fill_value = -9999.0_wp !< value for the _FillValue attribute749 745 750 746 ! … … 3583 3579 ! 3584 3580 !-- Determine minimum topography top index. 3585 k_topo_l = MINVAL( get_topography_top_index( 's') )3581 k_topo_l = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ) 3586 3582 #if defined( __parallel ) 3587 3583 CALL MPI_ALLREDUCE( k_topo_l, k_topo, 1, MPI_INTEGER, MPI_MIN, & … … 3773 3769 DO i = nxl, nxr 3774 3770 DO j = nys, nyn 3775 k_topo_l = get_topography_top_index_ji( j, i, 's')3771 k_topo_l = topo_top_ind(j,i,0) 3776 3772 DO k = k_topo_l+1, nzt+1 3777 3773 rad_lw_hr(k,j,i) = rrtm_lwhr(0,k-k_topo_l) * d_hours_day … … 4066 4062 ! 4067 4063 !-- Obtain topography top index (lower bound of RRTMG) 4068 k_topo = get_topography_top_index_ji( j, i, 's')4064 k_topo = topo_top_ind(j,i,0) 4069 4065 4070 4066 IF ( lw_radiation ) THEN … … 5688 5684 ! 5689 5685 !-- Following expression equals former kk = k - nzb_s_inner(j,i) 5690 kk = k - get_topography_top_index_ji( j, i, 's') !- lad arrays are defined flat5686 kk = k - topo_top_ind(j,i,0) !- lad arrays are defined flat 5691 5687 pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) & 5692 5688 * pchf_prep(k) * pt(k, j, i) !-- = dT/dt … … 5701 5697 j = pcbl(iy, ipcgb) 5702 5698 k = pcbl(iz, ipcgb) 5703 kk = k - get_topography_top_index_ji( j, i, 's') !- lad arrays are defined flat5699 kk = k - topo_top_ind(j,i,0) !- lad arrays are defined flat 5704 5700 CALL pcm_calc_transpiration_rate( i, j, k, kk, pcbinsw(ipcgb), pcbinlw(ipcgb), & 5705 5701 pc_transpiration_rate(kk,j,i), pc_latent_rate(kk,j,i) ) … … 6217 6213 !-- removed later). The following contruct finds the lowest / largest index 6218 6214 !-- for any upward-facing wall (see bit 12). 6219 nzubl = MINVAL( get_topography_top_index( 's') )6220 nzutl = MAXVAL( get_topography_top_index( 's') )6215 nzubl = MINVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ) 6216 nzutl = MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ) 6221 6217 6222 6218 nzubl = MAX( nzubl, nzb ) … … 6235 6231 ! 6236 6232 !-- Find topography top index 6237 k_topo = get_topography_top_index_ji( j, i, 's')6233 k_topo = topo_top_ind(j,i,0) 6238 6234 6239 6235 DO k = nzt+1, 0, -1 … … 6358 6354 ! 6359 6355 !-- Find topography top index 6360 k_topo = get_topography_top_index_ji( j, i, 's')6356 k_topo = topo_top_ind(j,i,0) 6361 6357 6362 6358 DO k = k_topo + 1, pct(j,i) … … 6793 6789 ALLOCATE( nzterrl_l((nyn-nys+1)*(nxr-nxl+1)) ) 6794 6790 nzterrl(nys:nyn,nxl:nxr) => nzterrl_l(1:(nyn-nys+1)*(nxr-nxl+1)) 6795 nzterrl = get_topography_top_index( 's')6791 nzterrl = topo_top_ind(nys:nyn,nxl:nxr,0) 6796 6792 CALL MPI_AllGather( nzterrl_l, nnx*nny, MPI_INTEGER, & 6797 6793 nzterr, nnx*nny, MPI_INTEGER, comm2d, ierr ) … … 6803 6799 DEALLOCATE(nzterrl_l) 6804 6800 #else 6805 nzterr = RESHAPE( get_topography_top_index( 's'), (/(nx+1)*(ny+1)/) )6801 nzterr = RESHAPE( topo_top_ind(nys:nyn,nxl:nxr,0), (/(nx+1)*(ny+1)/) ) 6806 6802 #endif 6807 6803 IF ( plant_canopy ) THEN … … 6884 6880 DO i = nxl, nxr 6885 6881 DO j = nys, nyn 6886 k = get_topography_top_index_ji( j, i, 's')6882 k = topo_top_ind(j,i,0) 6887 6883 6888 6884 sub_lad(k:nz_plant_t, j, i) = lad_s(0:nz_plant_t-k, j, i) … … 10143 10139 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 10144 10140 10141 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 10142 10145 10143 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 10146 10144 … … 10540 10538 LOGICAL :: found !< 10541 10539 10540 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 10541 10542 10542 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 10543 10543 … … 11107 11107 CHARACTER (LEN=*) :: variable !< 11108 11108 11109 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids 11110 11109 11111 INTEGER(iwp) :: av !< 11110 11112 INTEGER(iwp) :: i !< 11111 11113 INTEGER(iwp) :: j !< 11112 INTEGER(iwp) :: k !< 11113 INTEGER(iwp) :: im !< loop index for masked variables 11114 INTEGER(iwp) :: jm !< loop index for masked variables 11115 INTEGER(iwp) :: kk !< 11114 INTEGER(iwp) :: k !< 11116 11115 INTEGER(iwp) :: mid !< masked output running index 11117 INTEGER(iwp) :: ktt !< k index of highest terrainsurface11116 INTEGER(iwp) :: topo_top_index !< k index of highest horizontal surface 11118 11117 11119 11118 LOGICAL :: found !< true if output array was found … … 11127 11126 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which needs to be resorted for output 11128 11127 11128 11129 found = .TRUE. 11130 grid = 's' 11129 11131 resorted = .FALSE. 11130 found = .TRUE.11131 11132 11132 11133 SELECT CASE ( TRIM( variable ) ) … … 11215 11216 DO j = 1, mask_size_l(mid,2) 11216 11217 ! 11217 !-- Get k index of the highest terraing surface 11218 im = mask_i(mid,i) 11219 jm = mask_j(mid,j) 11220 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_0(:,jm,im), 5 )), & 11221 DIM = 1 ) - 1 11218 !-- Get k index of highest horizontal surface 11219 topo_top_index = topo_top_ind(mask_j(mid,j), & 11220 mask_i(mid,i), & 11221 0 ) 11222 ! 11223 !-- Save output array 11222 11224 DO k = 1, mask_size_l(mid,3) 11223 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 11224 ! 11225 !-- Set value if not in building 11226 IF ( BTEST( wall_flags_0(kk,jm,im), 6 ) ) THEN 11227 local_pf(i,j,k) = fill_value 11228 ELSE 11229 local_pf(i,j,k) = to_be_resorted(kk,jm,im) 11230 ENDIF 11225 local_pf(i,j,k) = to_be_resorted( & 11226 MIN( topo_top_index+mask_k(mid,k), & 11227 nzt+1 ), & 11228 mask_j(mid,j), & 11229 mask_i(mid,i) ) 11231 11230 ENDDO 11232 11231 ENDDO -
palm/trunk/SOURCE/surface_mod.f90
r4159 r4168 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Remove functions get_topography_top_index. These are now replaced by 29 ! precalculated arrays because of too much CPU-time consumption 30 ! 31 ! 4159 2019-08-15 13:31:35Z suehring 28 32 ! Surface classification revised and adjusted to changes in init_grid 29 33 ! … … 646 650 647 651 PRIVATE 648 652 649 653 INTERFACE init_bc 650 654 MODULE PROCEDURE init_bc … … 698 702 ! 699 703 !-- Public subroutines and functions 700 PUBLIC get_topography_top_index, & 701 get_topography_top_index_ji, & 702 init_bc, & 704 PUBLIC init_bc, & 703 705 init_single_surface_properties, & 704 706 init_surfaces, & … … 710 712 711 713 #if defined( _OPENACC ) 712 PUBLIC enter_surface_arrays, exit_surface_arrays 714 PUBLIC enter_surface_arrays, & 715 exit_surface_arrays 713 716 #endif 714 717 … … 3141 3144 3142 3145 END SUBROUTINE init_single_surface_properties 3143 3144 !------------------------------------------------------------------------------!3145 ! Description:3146 ! ------------3147 !> Determines topography-top index at given (j,i)-position.3148 !------------------------------------------------------------------------------!3149 FUNCTION get_topography_top_index_ji( j, i, grid )3150 3151 IMPLICIT NONE3152 3153 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids3154 INTEGER(iwp) :: i !< grid index in x-dimension3155 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid3156 INTEGER(iwp) :: j !< grid index in y-dimension3157 INTEGER(iwp) :: get_topography_top_index_ji !< topography top index3158 3159 SELECT CASE ( TRIM( grid ) )3160 3161 CASE ( 's' )3162 ibit = 123163 CASE ( 'u' )3164 ibit = 143165 CASE ( 'v' )3166 ibit = 163167 CASE ( 'w' )3168 ibit = 183169 CASE ( 's_out' )3170 ibit = 243171 CASE DEFAULT3172 !3173 !-- Set default to scalar grid3174 ibit = 123175 3176 END SELECT3177 3178 get_topography_top_index_ji = MAXLOC( &3179 MERGE( 1, 0, &3180 BTEST( wall_flags_0(:,j,i), ibit ) &3181 ), DIM = 1 &3182 ) - 13183 3184 RETURN3185 3186 END FUNCTION get_topography_top_index_ji3187 3188 !------------------------------------------------------------------------------!3189 ! Description:3190 ! ------------3191 !> Determines topography-top index at each (j,i)-position.3192 !------------------------------------------------------------------------------!3193 FUNCTION get_topography_top_index( grid )3194 3195 IMPLICIT NONE3196 3197 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids3198 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid3199 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: get_topography_top_index !< topography top index3200 3201 SELECT CASE ( TRIM( grid ) )3202 3203 CASE ( 's' )3204 ibit = 123205 CASE ( 'u' )3206 ibit = 143207 CASE ( 'v' )3208 ibit = 163209 CASE ( 'w' )3210 ibit = 183211 CASE ( 's_out' )3212 ibit = 243213 CASE DEFAULT3214 !3215 !-- Set default to scalar grid3216 ibit = 123217 3218 END SELECT3219 3220 get_topography_top_index(nys:nyn,nxl:nxr) = MAXLOC( &3221 MERGE( 1, 0, &3222 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), ibit )&3223 ), DIM = 1 &3224 ) - 13225 3226 RETURN3227 3228 END FUNCTION get_topography_top_index3229 3146 3230 3147 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/turbulence_closure_mod.f90
r4110 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 4110 2019-07-22 17:05:21Z suehring 27 30 ! pass integer flag array as well as boundary flags to WS scalar advection 28 31 ! routine … … 254 257 ONLY: advc_flags_s, & 255 258 nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 259 topo_top_ind, & 256 260 wall_flags_0 257 261 … … 272 276 ONLY: bc_h, & 273 277 bc_v, & 274 get_topography_top_index_ji, &275 278 surf_def_h, & 276 279 surf_def_v, & … … 1365 1368 DO i = nxlg, nxrg 1366 1369 DO j = nysg, nyng 1367 nz_s_shift = get_topography_top_index_ji( j, i, 's')1370 nz_s_shift = topo_top_ind(j,i,0) 1368 1371 1369 1372 e(nz_s_shift:nzt+1,j,i) = e(0:nzt+1-nz_s_shift,j,i) … … 1375 1378 DO i = nxlg, nxrg 1376 1379 DO j = nysg, nyng 1377 nz_s_shift = get_topography_top_index_ji( j, i, 's')1380 nz_s_shift = topo_top_ind(j,i,0) 1378 1381 1379 1382 diss(nz_s_shift:nzt+1,j,i) = diss(0:nzt+1-nz_s_shift,j,i) … … 1394 1397 IF ( nxlg <= 0 .AND. nxrg >= 0 .AND. & 1395 1398 nysg <= 0 .AND. nyng >= 0 ) THEN 1396 nz_s_shift_l = get_topography_top_index_ji( 0, 0, 's')1399 nz_s_shift_l = topo_top_ind(0,0,0) 1397 1400 ELSE 1398 1401 nz_s_shift_l = 0 -
palm/trunk/SOURCE/urban_surface_mod.f90
r4148 r4168 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Replace function get_topography_top_index by topo_top_ind 31 ! 32 ! 4148 2019-08-08 11:26:00Z suehring 30 33 ! - Add anthropogenic heat output factors for heating and cooling to building 31 34 ! data base … … 538 541 USE indices, & 539 542 ONLY: nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, & 540 nysg, nzb, nzt, nbgp, wall_flags_0543 nysg, nzb, nzt, nbgp, topo_top_ind, wall_flags_0 541 544 542 545 USE, INTRINSIC :: iso_c_binding … … 559 562 560 563 USE surface_mod, & 561 ONLY: get_topography_top_index_ji, get_topography_top_index, & 562 ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h, & 564 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_usm_h, & 563 565 surf_usm_v, surface_restore_elements 564 566 … … 6159 6161 READ( 151, *, err=12, end=13 ) i, j, k, heat 6160 6162 IF ( i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn ) THEN 6161 IF ( k <= naheatlayers .AND. k > get_topography_top_index_ji( j, i, 's') ) THEN6163 IF ( k <= naheatlayers .AND. k > topo_top_ind(j,i,0) ) THEN 6162 6164 !-- write heat into the array 6163 6165 aheat(k,j,i) = heat … … 7394 7396 ELSE 7395 7397 WRITE(9,*) 'Problem reading USM data:' 7396 WRITE(9,*) l,i,j,kw, get_topography_top_index_ji( j, i, 's')7397 WRITE(9,*) ii,iw,jw,kw, get_topography_top_index_ji( jw, iw, 's')7398 WRITE(9,*) l,i,j,kw,topo_top_ind(j,i,0) 7399 WRITE(9,*) ii,iw,jw,kw,topo_top_ind(jw,iw,0) 7398 7400 WRITE(9,*) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw) 7399 7401 WRITE(9,*) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw) … … 8614 8616 !-- TO_DO: activate, if testcase is available 8615 8617 !-- !$OMP PARALLEL DO PRIVATE (i, j, k, acoef, rho_cp) 8616 !-- it may also improve performance to move get_topography_top_index_jibefore the k-loop8618 !-- it may also improve performance to move topo_top_ind before the k-loop 8617 8619 DO i = nxl, nxr 8618 8620 DO j = nys, nyn 8619 8621 DO k = nz_urban_b, min(nz_urban_t,naheatlayers) 8620 IF ( k > get_topography_top_index_ji( j, i, 's') ) THEN8622 IF ( k > topo_top_ind(j,i,0) ) THEN 8621 8623 ! 8622 8624 !-- increase of pt in box i,j,k in time dt_3d -
palm/trunk/SOURCE/user_data_output_mask.f90
r4069 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Remove dependency on surface_mod + example for terrain-following output 28 ! adjusted 29 ! 30 ! 4069 2019-07-01 14:05:51Z Giersch 27 31 ! Masked output running index mid has been introduced as a local variable to 28 32 ! avoid runtime error (Loop variable has been modified) in time_integration … … 72 76 USE kinds 73 77 74 USE surface_mod, &75 ONLY: get_topography_top_index_ji76 77 78 USE user 78 79 … … 80 81 81 82 CHARACTER (LEN=*) :: variable !< 82 CHARACTER (LEN=5) :: grid !< flag to distinquish between staggered grids83 83 84 84 INTEGER(iwp) :: av !< … … 87 87 ! INTEGER(iwp) :: j !< 88 88 ! INTEGER(iwp) :: k !< 89 ! INTEGER(iwp) :: topo_top_ind 89 ! INTEGER(iwp) :: topo_top_index !< k index of highest horizontal surface 90 90 91 91 LOGICAL :: found !< … … 102 102 103 103 found = .TRUE. 104 grid = 's'105 104 106 105 SELECT CASE ( TRIM( variable ) ) … … 131 130 !! 132 131 !!-- Get k index of highest horizontal surface 133 ! topo_top_ind = get_topography_top_index_ji( &132 ! topo_top_index = topo_top_ind( & 134 133 ! mask_j(mid,j), & 135 134 ! mask_i(mid,i), & 136 ! grid)135 ! 1 ) 137 136 !! 138 137 !!-- Save output array 139 138 ! DO k = 1, mask_size_l(mid,3) 140 ! local_pf(i,j,k) = u2(MIN( topo_top_ind +mask_k(mid,k),&141 ! nzt+1 ), &142 ! mask_j(mid,j), &139 ! local_pf(i,j,k) = u2(MIN( topo_top_index+mask_k(mid,k),& 140 ! nzt+1 ), & 141 ! mask_j(mid,j), & 143 142 ! mask_i(mid,i) ) 144 143 ! ENDDO … … 166 165 !! 167 166 !!-- Get k index of highest horizontal surface 168 ! topo_top_ind = get_topography_top_index_ji(&167 ! topo_top_index = topo_top_ind( & 169 168 ! mask_j(mid,j), & 170 169 ! mask_i(mid,i), & 171 ! grid)170 ! 1 ) 172 171 !! 173 172 !!-- Save output array 174 173 ! DO k = 1, mask_size_l(mid,3) 175 ! local_pf(i,j,k) = u2_av( &176 ! MIN( topo_top_ind +mask_k(mid,k),&177 ! nzt+1 ), &178 ! mask_j(mid,j), &174 ! local_pf(i,j,k) = u2_av( & 175 ! MIN( topo_top_index+mask_k(mid,k),& 176 ! nzt+1 ), & 177 ! mask_j(mid,j), & 179 178 ! mask_i(mid,i) ) 180 179 ! ENDDO -
palm/trunk/SOURCE/virtual_measurement_mod.f90
r3988 r4168 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Replace function get_topography_top_index by topo_top_ind 28 ! 29 ! 3988 2019-05-22 11:32:37Z kanani 27 30 ! Add variables to enable steering of output interval for virtual measurements 28 31 ! … … 115 118 116 119 USE indices, & 117 ONLY: nzb, nzt, nxl, nxr, nys, nyn, nx, ny, wall_flags_0120 ONLY: nzb, nzt, nxl, nxr, nys, nyn, nx, ny, topo_top_ind, wall_flags_0 118 121 119 122 USE kinds … … 435 438 netcdf_data_input_get_dimension_length, & 436 439 netcdf_data_input_att, netcdf_data_input_var 437 438 USE surface_mod, &439 ONLY: get_topography_top_index_ji440 440 441 441 IMPLICIT NONE … … 763 763 !-- Determine vertical index which correspond to the observation 764 764 !-- height. 765 ksurf = get_topography_top_index_ji( js, is, 's')765 ksurf = topo_top_ind(js,is,0) 766 766 ks = MINLOC( ABS( zu - zw(ksurf) - z_ag(t,n) ), DIM = 1 ) - 1 767 767 ! … … 822 822 vmea(l)%j(ns) = j 823 823 vmea(l)%k(ns) = k 824 vmea(l)%z_ag(ns) = zu(k) - & 825 zw(get_topography_top_index_ji( j, i, 's' )) 824 vmea(l)%z_ag(ns) = zu(k) - zw(topo_top_ind(j,i,0)) 826 825 ENDIF 827 826 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
