Changeset 2317 for palm/trunk
- Timestamp:
- Jul 20, 2017 5:27:19 PM (7 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 11 edited
-
Makefile (modified) (3 diffs)
-
init_grid.f90 (modified) (3 diffs)
-
lpm_advec.f90 (modified) (13 diffs)
-
lpm_boundary_conds.f90 (modified) (7 diffs)
-
lpm_init.f90 (modified) (4 diffs)
-
microphysics_mod.f90 (modified) (12 diffs)
-
plant_canopy_model_mod.f90 (modified) (16 diffs)
-
pmc_interface_mod.f90 (modified) (46 diffs)
-
radiation_model_mod.f90 (modified) (5 diffs)
-
surface_mod.f90 (modified) (4 diffs)
-
urban_surface_mod.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r2296 r2317 20 20 # Current revisions: 21 21 # ------------------ 22 # 22 # Add further dependencies on surface_mod 23 23 # 24 24 # Former revisions: … … 521 521 lpm_splitting.o mod_kinds.o mod_particle_attributes.o 522 522 lpm_advec.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o surface_mod.o 523 lpm_boundary_conds.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o 523 lpm_boundary_conds.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o surface_mod.o 524 524 lpm_calc_liquid_water_content.o: modules.o cpulog_mod.o mod_kinds.o \ 525 525 mod_particle_attributes.o … … 590 590 subsidence_mod.o surface_mod.o user_actions.o wind_turbine_model_mod.o 591 591 progress_bar_mod.o: modules.o mod_kinds.o 592 radiation_model_mod.o : modules.o mod_particle_attributes.o microphysics_mod.o592 radiation_model_mod.o: modules.o mod_particle_attributes.o microphysics_mod.o surface_mod.o 593 593 random_function_mod.o: mod_kinds.o 594 594 random_gauss.o: mod_kinds.o random_function_mod.o random_generator_parallel_mod.o -
palm/trunk/SOURCE/init_grid.f90
r2302 r2317 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 278 278 279 279 USE surface_mod, & 280 ONLY: init_bc280 ONLY: get_topography_top_index, init_bc 281 281 282 282 IMPLICIT NONE … … 1713 1713 !-- nxl to nxr and nys to nyn on south and right model boundary, hence, 1714 1714 !-- use intrinsic lbound and ubound functions to infer array bounds. 1715 DO i = lbound(zu_s_inner, 1), ubound(zu_s_inner, 1)1716 DO j = lbound(zu_s_inner, 2), ubound(zu_s_inner, 2)1715 DO i = LBOUND(zu_s_inner, 1), UBOUND(zu_s_inner, 1) 1716 DO j = LBOUND(zu_s_inner, 2), UBOUND(zu_s_inner, 2) 1717 1717 ! 1718 1718 !-- Topography height on scalar grid. Therefore, determine index of 1719 !-- upward-facing surface element on scalar grid (bit 12). 1720 zu_s_inner(i,j) = zu( MAXLOC( MERGE( & 1721 1, 0, BTEST( wall_flags_0(:,j,i), 12 )& 1722 ), DIM = 1 & 1723 ) - 1 & 1724 ) 1719 !-- upward-facing surface element on scalar grid. 1720 zu_s_inner(i,j) = zu( get_topography_top_index( j, i, 's' ) ) 1721 1722 write(9,*) get_topography_top_index( j, i, 's' ), MAXLOC( & 1723 MERGE( 1, 0, & 1724 BTEST( wall_flags_0(:,j,i), 12 ) & 1725 ), DIM = 1 & 1726 ) - 1 1725 1727 ! 1726 1728 !-- Topography height on w grid. Therefore, determine index of 1727 !-- upward-facing surface element on w grid (bit 18). 1728 zw_w_inner(i,j) = zw( MAXLOC( MERGE( & 1729 1, 0, BTEST( wall_flags_0(:,j,i), 18 )& 1730 ), DIM = 1 & 1731 ) - 1 & 1732 ) 1729 !-- upward-facing surface element on w grid. 1730 zw_w_inner(i,j) = zw( get_topography_top_index( j, i, 's' ) ) 1733 1731 ENDDO 1734 1732 ENDDO 1735 1733 flush(9) 1736 1734 1737 1735 ENDIF -
palm/trunk/SOURCE/lpm_advec.f90
r2233 r2317 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 126 126 127 127 USE indices, & 128 ONLY: nzb, nz b_max, nzt, wall_flags_0128 ONLY: nzb, nzt 129 129 130 130 USE kinds … … 140 140 141 141 USE surface_mod, & 142 ONLY: surf_def_h, surf_lsm_h, surf_usm_h142 ONLY: get_topography_top_index, surf_def_h, surf_lsm_h, surf_usm_h 143 143 144 144 IMPLICIT NONE … … 284 284 ! 285 285 !-- Determine vertical index of topography top 286 k_wall = MAXLOC( & 287 MERGE( 1, 0, & 288 BTEST( wall_flags_0(nzb:nzb_max,jlog,ilog), 12 ) & 289 ), DIM = 1 & 290 ) - 1 286 k_wall = get_topography_top_index( jlog,ilog, 's' ) 291 287 292 288 IF ( constant_flux_layer .AND. zv(n) - zw(k_wall) < z_p ) THEN … … 385 381 ! 386 382 !-- Determine vertical index of topography top 387 k_wall = MAXLOC( & 388 MERGE( 1, 0, & 389 BTEST( wall_flags_0(nzb:nzb_max,jlog,ilog), 12 ) & 390 ), DIM = 1 & 391 ) - 1 383 k_wall = get_topography_top_index( jlog,ilog, 's' ) 392 384 393 385 IF ( constant_flux_layer .AND. zv(n) - zw(k_wall) < z_p ) THEN … … 677 669 ! 678 670 !-- Determine vertical index of topography top at (j,i) 679 k_wall = MAXLOC( & 680 MERGE( 1, 0, & 681 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 682 ), DIM = 1 & 683 ) - 1 671 k_wall = get_topography_top_index( j, i, 's' ) 684 672 ! 685 673 !-- To do: Reconsider order of computations in order to avoid … … 700 688 ! 701 689 !-- Determine vertical index of topography top at (j+1,i) 702 k_wall = MAXLOC( & 703 MERGE( 1, 0, & 704 BTEST( wall_flags_0(nzb:nzb_max,j+1,i), 12 ) & 705 ), DIM = 1 & 706 ) - 1 690 k_wall = get_topography_top_index( j+1, i, 's' ) 691 707 692 IF ( k > k_wall .OR. k_wall == 0 ) THEN 708 693 num_gp = num_gp + 1 … … 720 705 ! 721 706 !-- Determine vertical index of topography top at (j,i) 722 k_wall = MAXLOC( & 723 MERGE( 1, 0, & 724 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 725 ), DIM = 1 & 726 ) - 1 707 k_wall = get_topography_top_index( j, i, 's' ) 708 727 709 IF ( k+1 > k_wall .OR. k_wall == 0 ) THEN 728 710 num_gp = num_gp + 1 … … 740 722 ! 741 723 !-- Determine vertical index of topography top at (j+1,i) 742 k_wall = MAXLOC( & 743 MERGE( 1, 0, & 744 BTEST( wall_flags_0(nzb:nzb_max,j+1,i), 12 ) & 745 ), DIM = 1 & 746 ) - 1 724 k_wall = get_topography_top_index( j+1, i, 's' ) 747 725 IF ( k+1 > k_wall .OR. k_wall == 0 ) THEN 748 726 num_gp = num_gp + 1 … … 760 738 ! 761 739 !-- Determine vertical index of topography top at (j,i+1) 762 k_wall = MAXLOC( & 763 MERGE( 1, 0, & 764 BTEST( wall_flags_0(nzb:nzb_max,j,i+1), 12 ) & 765 ), DIM = 1 & 766 ) - 1 740 k_wall = get_topography_top_index( j, i+1, 's' ) 767 741 IF ( k > k_wall .OR. k_wall == 0 ) THEN 768 742 num_gp = num_gp + 1 … … 780 754 ! 781 755 !-- Determine vertical index of topography top at (j+1,i+1) 782 k_wall = MAXLOC( & 783 MERGE( 1, 0, & 784 BTEST( wall_flags_0(nzb:nzb_max,j+1,i+1), 12 )& 785 ), DIM = 1 & 786 ) - 1 756 k_wall = get_topography_top_index( j+1, i+1, 's' ) 757 787 758 IF ( k > k_wall .OR. k_wall == 0 ) THEN 788 759 num_gp = num_gp + 1 … … 800 771 ! 801 772 !-- Determine vertical index of topography top at (j,i+1) 802 k_wall = MAXLOC( & 803 MERGE( 1, 0, & 804 BTEST( wall_flags_0(nzb:nzb_max,j,i+1), 12 ) & 805 ), DIM = 1 & 806 ) - 1 773 k_wall = get_topography_top_index( j, i+1, 's' ) 774 807 775 IF ( k+1 > k_wall .OR. k_wall == 0 ) THEN 808 776 num_gp = num_gp + 1 … … 820 788 ! 821 789 !-- Determine vertical index of topography top at (j+1,i+1) 822 k_wall = MAXLOC( & 823 MERGE( 1, 0, & 824 BTEST( wall_flags_0(nzb:nzb_max,j+1,i+1), 12 )& 825 ), DIM = 1 & 826 ) - 1 790 k_wall = get_topography_top_index( j+1, i+1, 's' ) 791 827 792 IF ( k+1 > k_wall .OR. k_wall == 0) THEN 828 793 num_gp = num_gp + 1 -
palm/trunk/SOURCE/lpm_boundary_conds.f90
r2233 r2317 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 98 98 99 99 USE indices, & 100 ONLY: nxl, nxr, nyn, nys, nz, nzb , nzb_max, wall_flags_0100 ONLY: nxl, nxr, nyn, nys, nz, nzb 101 101 102 102 USE kinds … … 108 108 109 109 USE pegrid 110 111 USE surface_mod, & 112 ONLY: get_topography_top_index 110 113 111 114 IMPLICIT NONE … … 289 292 !-- The construct of MERGE and BTEST is used to determine the topography- 290 293 !-- top index (former nzb_s_inner). 291 zwall1 = zw( MAXLOC( & 292 MERGE( 1, 0, & 293 BTEST( wall_flags_0(nzb:nzb_max,j2,i2), 12 ) & 294 ), DIM = 1 & 295 ) - 1 ) 296 zwall2 = zw( MAXLOC( & 297 MERGE( 1, 0, & 298 BTEST( wall_flags_0(nzb:nzb_max,j1,i1), 12 ) & 299 ), DIM = 1 & 300 ) - 1 ) 301 zwall3 = zw( MAXLOC( & 302 MERGE( 1, 0, & 303 BTEST( wall_flags_0(nzb:nzb_max,j1,i2), 12 ) & 304 ), DIM = 1 & 305 ) - 1 ) 306 zwall4 = zw( MAXLOC( & 307 MERGE( 1, 0, & 308 BTEST( wall_flags_0(nzb:nzb_max,j2,i1), 12 ) & 309 ), DIM = 1 & 310 ) - 1 ) 294 zwall1 = zw( get_topography_top_index( j2, i2, 's' ) ) 295 zwall2 = zw( get_topography_top_index( j1, i1, 's' ) ) 296 zwall3 = zw( get_topography_top_index( j1, i2, 's' ) ) 297 zwall4 = zw( get_topography_top_index( j2, i1, 's' ) ) 311 298 ! 312 299 !-- Initialize flags to check if particle reflection is necessary … … 493 480 !-- necessarily exactly match the wall location due to rounding 494 481 !-- errors. At first, determine index of topography top at (j3,i3) 495 k_wall = MAXLOC( & 496 MERGE( 1, 0, & 497 BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 ) & 498 ), DIM = 1 & 499 ) - 1 482 k_wall = get_topography_top_index( j3, i3, 's' ) 500 483 IF ( ABS( pos_x - xwall ) < eps .AND. & 501 484 pos_z <= zw(k_wall) .AND. & … … 534 517 !-- necessary, carry out reflection. At first, determine index of 535 518 !-- topography top at (j3,i3) 536 k_wall = MAXLOC( & 537 MERGE( 1, 0, & 538 BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 ) & 539 ), DIM = 1 & 540 ) - 1 519 k_wall = get_topography_top_index( j3, i3, 's' ) 541 520 IF ( ABS( pos_y - ywall ) < eps .AND. & 542 521 pos_z <= zw(k_wall) .AND. & … … 565 544 !-- Determine index of topography top at (j3,i3) and chick if 566 545 !-- particle is below. 567 k_wall = MAXLOC( & 568 MERGE( 1, 0, & 569 BTEST( wall_flags_0(nzb:nzb_max,j3,i3), 12 )& 570 ), DIM = 1 & 571 ) - 1 546 k_wall = get_topography_top_index( j3, i3, 's' ) 572 547 IF ( pos_z - zw(k_wall) < eps ) THEN 573 548 -
palm/trunk/SOURCE/lpm_init.f90
r2312 r2317 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 178 178 USE indices, & 179 179 ONLY: nx, nxl, nxlg, nxrg, nxr, ny, nyn, nys, nyng, nysg, nz, nzb, & 180 nz b_max, nzt, wall_flags_0180 nzt, wall_flags_0 181 181 182 182 USE kinds … … 214 214 215 215 USE surface_mod, & 216 ONLY: surf_def_h, surf_lsm_h, surf_usm_h216 ONLY: get_topography_top_index, surf_def_h, surf_lsm_h, surf_usm_h 217 217 218 218 IMPLICIT NONE … … 725 725 ! 726 726 !-- Determine surface level. Therefore, check for 727 !-- upward-facing wall on w-grid. MAXLOC will return 728 !-- the index of the lowest upward-facing wall. 729 k_surf = MAXLOC( & 730 MERGE( 1, 0, & 731 BTEST( wall_flags_0(nzb:nzb_max,jp,ip), 18 )& 732 ), DIM = 1 & 733 ) - 1 727 !-- upward-facing wall on w-grid. 728 k_surf = get_topography_top_index( j, i, 'w' ) 734 729 735 730 IF ( seed_follows_topography ) THEN -
palm/trunk/SOURCE/microphysics_mod.f90
r2312 r2317 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 445 445 446 446 USE indices, & 447 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_0447 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 448 448 449 449 USE kinds … … 787 787 788 788 USE indices, & 789 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_0789 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 790 790 791 791 USE kinds … … 923 923 924 924 USE indices, & 925 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_0925 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 926 926 927 927 USE kinds 928 929 USE surface_mod, & 930 ONLY: get_topography_top_index 928 931 929 932 … … 942 945 ! 943 946 !-- Determine vertical index of topography top 944 k_wall = MAXLOC( & 945 MERGE( 1, 0, & 946 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 947 ), DIM = 1 & 948 ) - 1 947 k_wall = get_topography_top_index( j, i, 's' ) 949 948 DO k = nzb+1, nzt 950 949 ! … … 994 993 995 994 USE indices, & 996 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_0995 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 997 996 998 997 USE kinds … … 1093 1092 1094 1093 USE indices, & 1095 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_01094 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 1096 1095 1097 1096 USE kinds … … 1170 1169 1171 1170 USE indices, & 1172 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_01171 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 1173 1172 1174 1173 USE kinds … … 1331 1330 1332 1331 USE indices, & 1333 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_01332 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 1334 1333 1335 1334 USE kinds … … 1443 1442 1444 1443 USE indices, & 1445 ONLY: nxlg, nxrg, nyng, nysg, nzb, nz b_max, nzt, wall_flags_01444 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt, wall_flags_0 1446 1445 1447 1446 USE kinds … … 2329 2328 2330 2329 USE indices, & 2331 ONLY: nzb, nz b_max, nzt, wall_flags_02330 ONLY: nzb, nzt, wall_flags_0 2332 2331 2333 2332 USE kinds 2333 2334 USE surface_mod, & 2335 ONLY: get_topography_top_index 2334 2336 2335 2337 … … 2346 2348 ! 2347 2349 !-- Determine vertical index of topography top 2348 k_wall = MAXLOC( & 2349 MERGE( 1, 0, & 2350 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2351 ), DIM = 1 & 2352 ) - 1 2350 k_wall = get_topography_top_index( j, i, 's' ) 2353 2351 DO k = nzb+1, nzt 2354 2352 ! -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r2274 r2317 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 128 128 USE indices, & 129 129 ONLY: nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv, & 130 nz, nzb, nz b_max, nzt, wall_flags_0130 nz, nzb, nzt 131 131 132 132 USE kinds 133 134 USE surface_mod, & 135 ONLY: get_topography_top_index 133 136 134 137 … … 1016 1019 ! 1017 1020 !-- Determine topography-top index on u-grid 1018 k_wall = MAXLOC( & 1019 MERGE( 1, 0, & 1020 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1021 ), DIM = 1 & 1022 ) - 1 1021 k_wall = get_topography_top_index( j, i, 'u' ) 1023 1022 DO k = k_wall+1, k_wall+pch_index 1024 1023 … … 1084 1083 ! 1085 1084 !-- Determine topography-top index on v-grid 1086 k_wall = MAXLOC( & 1087 MERGE( 1, 0, & 1088 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1089 ), DIM = 1 & 1090 ) - 1 1085 k_wall = get_topography_top_index( j, i, 'v' ) 1086 1091 1087 DO k = k_wall+1, k_wall+pch_index 1092 1088 … … 1152 1148 ! 1153 1149 !-- Determine topography-top index on w-grid 1154 k_wall = MAXLOC( & 1155 MERGE( 1, 0, & 1156 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1157 ), DIM = 1 & 1158 ) - 1 1150 k_wall = get_topography_top_index( j, i, 'w' ) 1151 1159 1152 DO k = k_wall+1, k_wall+pch_index-1 1160 1153 … … 1207 1200 ! 1208 1201 !-- Determine topography-top index on scalar-grid 1209 k_wall = MAXLOC( & 1210 MERGE( 1, 0, & 1211 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1212 ), DIM = 1 & 1213 ) - 1 1202 k_wall = get_topography_top_index( j, i, 's' ) 1203 1214 1204 DO k = k_wall+1, k_wall+pch_index 1215 1205 … … 1227 1217 ! 1228 1218 !-- Determine topography-top index on scalar-grid 1229 k_wall = MAXLOC( & 1230 MERGE( 1, 0, & 1231 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1232 ), DIM = 1 & 1233 ) - 1 1219 k_wall = get_topography_top_index( j, i, 's' ) 1220 1234 1221 DO k = k_wall+1, k_wall+pch_index 1235 1222 … … 1260 1247 ! 1261 1248 !-- Determine topography-top index on scalar-grid 1262 k_wall = MAXLOC( & 1263 MERGE( 1, 0, & 1264 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1265 ), DIM = 1 & 1266 ) - 1 1249 k_wall = get_topography_top_index( j, i, 's' ) 1250 1267 1251 DO k = k_wall+1, k_wall+pch_index 1268 1252 … … 1292 1276 ! 1293 1277 !-- Determine topography-top index on scalar-grid 1294 k_wall = MAXLOC( & 1295 MERGE( 1, 0, & 1296 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1297 ), DIM = 1 & 1298 ) - 1 1278 k_wall = get_topography_top_index( j, i, 's' ) 1279 1299 1280 DO k = k_wall+1, k_wall+pch_index 1300 1281 … … 1390 1371 ! 1391 1372 !-- Determine topography-top index on u-grid 1392 k_wall = MAXLOC( & 1393 MERGE( 1, 0, & 1394 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1395 ), DIM = 1 & 1396 ) - 1 1373 k_wall = get_topography_top_index( j, i, 'u' ) 1374 1397 1375 DO k = k_wall+1, k_wall+pch_index 1398 1376 … … 1453 1431 ! 1454 1432 !-- Determine topography-top index on v-grid 1455 k_wall = MAXLOC( & 1456 MERGE( 1, 0, & 1457 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1458 ), DIM = 1 & 1459 ) - 1 1433 k_wall = get_topography_top_index( j, i, 'v' ) 1434 1460 1435 DO k = k_wall+1, k_wall+pch_index 1461 1436 … … 1516 1491 ! 1517 1492 !-- Determine topography-top index on w-grid 1518 k_wall = MAXLOC( & 1519 MERGE( 1, 0, & 1520 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1521 ), DIM = 1 & 1522 ) - 1 1493 k_wall = get_topography_top_index( j, i, 'w' ) 1494 1523 1495 DO k = k_wall+1, k_wall+pch_index-1 1524 1496 … … 1566 1538 ! 1567 1539 !-- Determine topography-top index on scalar grid 1568 k_wall = MAXLOC( & 1569 MERGE( 1, 0, & 1570 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1571 ), DIM = 1 & 1572 ) - 1 1540 k_wall = get_topography_top_index( j, i, 's' ) 1541 1573 1542 DO k = k_wall+1, k_wall+pch_index 1574 1543 kk = k - k_wall !- lad arrays are defined flat … … 1582 1551 ! 1583 1552 !-- Determine topography-top index on scalar grid 1584 k_wall = MAXLOC( & 1585 MERGE( 1, 0, & 1586 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1587 ), DIM = 1 & 1588 ) - 1 1553 k_wall = get_topography_top_index( j, i, 's' ) 1554 1589 1555 DO k = k_wall+1, k_wall+pch_index 1590 1556 … … 1611 1577 ! 1612 1578 !-- Determine topography-top index on scalar grid 1613 k_wall = MAXLOC( & 1614 MERGE( 1, 0, & 1615 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1616 ), DIM = 1 & 1617 ) - 1 1579 k_wall = get_topography_top_index( j, i, 's' ) 1580 1618 1581 DO k = k_wall+1, k_wall+pch_index 1619 1582 … … 1640 1603 ! 1641 1604 !-- Determine topography-top index on scalar grid 1642 k_wall = MAXLOC( & 1643 MERGE( 1, 0, & 1644 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1645 ), DIM = 1 & 1646 ) - 1 1605 k_wall = get_topography_top_index( j, i, 's' ) 1606 1647 1607 DO k = k_wall+1, k_wall+pch_index 1648 1608 -
palm/trunk/SOURCE/pmc_interface_mod.f90
r2311 r2317 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Get topography top index via Function call 24 24 ! 25 25 ! Former revisions: … … 192 192 USE indices, & 193 193 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 194 nysv, nz, nzb, nz b_max, nzt, wall_flags_0194 nysv, nz, nzb, nzt, wall_flags_0 195 195 196 196 USE kinds … … 233 233 234 234 USE surface_mod, & 235 ONLY: surf_def_h, surf_lsm_h, surf_usm_h235 ONLY: get_topography_top_index, surf_def_h, surf_lsm_h, surf_usm_h 236 236 237 237 IMPLICIT NONE … … 1394 1394 !-- Determine largest topography index on scalar grid 1395 1395 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1396 MAXLOC( & 1397 MERGE( 1, 0, & 1398 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1399 ), DIM = 1 & 1400 ) - 1 ) 1396 get_topography_top_index( j, i, 's' ) ) 1401 1397 ! 1402 1398 !-- Determine largest topography index on u grid 1403 1399 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1404 MAXLOC( & 1405 MERGE( 1, 0, & 1406 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1407 ), DIM = 1 & 1408 ) - 1 ) 1400 get_topography_top_index( j, i, 'u' ) ) 1409 1401 ! 1410 1402 !-- Determine largest topography index on v grid 1411 1403 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1412 MAXLOC( & 1413 MERGE( 1, 0, & 1414 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1415 ), DIM = 1 & 1416 ) - 1 ) 1404 get_topography_top_index( j, i, 'v' ) ) 1417 1405 ! 1418 1406 !-- Determine largest topography index on w grid 1419 1407 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1420 MAXLOC( & 1421 MERGE( 1, 0, & 1422 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1423 ), DIM = 1 & 1424 ) - 1 ) 1408 get_topography_top_index( j, i, 'w' ) ) 1425 1409 ENDDO 1426 1410 ENDDO … … 1436 1420 !-- Determine largest topography index on scalar grid 1437 1421 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1438 MAXLOC( & 1439 MERGE( 1, 0, & 1440 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1441 ), DIM = 1 & 1442 ) - 1 ) 1422 get_topography_top_index( j, i, 's' ) ) 1443 1423 ! 1444 1424 !-- Determine largest topography index on u grid 1445 1425 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1446 MAXLOC( & 1447 MERGE( 1, 0, & 1448 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1449 ), DIM = 1 & 1450 ) - 1 ) 1426 get_topography_top_index( j, i, 'u' ) ) 1451 1427 ! 1452 1428 !-- Determine largest topography index on v grid 1453 1429 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1454 MAXLOC( & 1455 MERGE( 1, 0, & 1456 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1457 ), DIM = 1 & 1458 ) - 1 ) 1430 get_topography_top_index( j, i, 'v' ) ) 1459 1431 ! 1460 1432 !-- Determine largest topography index on w grid 1461 1433 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1462 MAXLOC( & 1463 MERGE( 1, 0, & 1464 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1465 ), DIM = 1 & 1466 ) - 1 ) 1434 get_topography_top_index( j, i, 'w' ) ) 1467 1435 ENDDO 1468 1436 nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1 … … 1477 1445 !-- Determine largest topography index on scalar grid 1478 1446 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1479 MAXLOC( & 1480 MERGE( 1, 0, & 1481 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1482 ), DIM = 1 & 1483 ) - 1 ) 1447 get_topography_top_index( j, i, 's' ) ) 1484 1448 ! 1485 1449 !-- Determine largest topography index on u grid 1486 1450 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1487 MAXLOC( & 1488 MERGE( 1, 0, & 1489 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1490 ), DIM = 1 & 1491 ) - 1 ) 1451 get_topography_top_index( j, i, 'u' ) ) 1492 1452 ! 1493 1453 !-- Determine largest topography index on v grid 1494 1454 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1495 MAXLOC( & 1496 MERGE( 1, 0, & 1497 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1498 ), DIM = 1 & 1499 ) - 1 ) 1455 get_topography_top_index( j, i, 'v' ) ) 1500 1456 ! 1501 1457 !-- Determine largest topography index on w grid 1502 1458 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1503 MAXLOC( & 1504 MERGE( 1, 0, & 1505 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1506 ), DIM = 1 & 1507 ) - 1 ) 1459 get_topography_top_index( j, i, 'w' ) ) 1508 1460 ENDDO 1509 1461 ENDDO … … 1519 1471 !-- Determine largest topography index on scalar grid 1520 1472 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1521 MAXLOC( & 1522 MERGE( 1, 0, & 1523 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1524 ), DIM = 1 & 1525 ) - 1 ) 1473 get_topography_top_index( j, i, 's' ) ) 1526 1474 ! 1527 1475 !-- Determine largest topography index on u grid 1528 1476 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1529 MAXLOC( & 1530 MERGE( 1, 0, & 1531 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1532 ), DIM = 1 & 1533 ) - 1 ) 1477 get_topography_top_index( j, i, 'u' ) ) 1534 1478 ! 1535 1479 !-- Determine largest topography index on v grid 1536 1480 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1537 MAXLOC( & 1538 MERGE( 1, 0, & 1539 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1540 ), DIM = 1 & 1541 ) - 1 ) 1481 get_topography_top_index( j, i, 'v' ) ) 1542 1482 ! 1543 1483 !-- Determine largest topography index on w grid 1544 1484 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1545 MAXLOC( & 1546 MERGE( 1, 0, & 1547 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1548 ), DIM = 1 & 1549 ) - 1 ) 1485 get_topography_top_index( j, i, 'w' ) ) 1550 1486 ENDDO 1551 1487 nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1 … … 1603 1539 !-- is part of the surfacetypes now. Set default roughness instead. 1604 1540 !-- Determine topography top index on u-grid 1605 kb = MAXLOC( MERGE( 1, 0, & 1606 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1607 ), DIM = 1 & 1608 ) - 1 1541 kb = get_topography_top_index( j, i, 'u' ) 1609 1542 k = kb + 1 1610 1543 wall_index = kb … … 1622 1555 ! 1623 1556 !-- Determine topography top index on v-grid 1624 kb = MAXLOC( MERGE( 1, 0, & 1625 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1626 ), DIM = 1 & 1627 ) - 1 1557 kb = get_topography_top_index( j, i, 'v' ) 1628 1558 k = kb + 1 1629 1559 wall_index = kb … … 1669 1599 !-- to the present surface tpye. 1670 1600 !-- Determine topography top index on u-grid 1671 kb = MAXLOC( MERGE( 1, 0, & 1672 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1673 ), DIM = 1 & 1674 ) - 1 1601 kb = get_topography_top_index( j, i, 'u' ) 1675 1602 k = kb + 1 1676 1603 wall_index = kb … … 1688 1615 ! 1689 1616 !-- Determine topography top index on v-grid 1690 kb = MAXLOC( MERGE( 1, 0, & 1691 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1692 ), DIM = 1 & 1693 ) - 1 1617 kb = get_topography_top_index( j, i, 'v' ) 1694 1618 k = kb + 1 1695 1619 wall_index = kb … … 1732 1656 ! 1733 1657 !-- Determine topography top index on u-grid 1734 kb = MAXLOC( MERGE( 1, 0, & 1735 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1736 ), DIM = 1 & 1737 ) - 1 1658 kb = get_topography_top_index( j, i, 'u' ) 1738 1659 k = kb + 1 1739 1660 wall_index = kb … … 1751 1672 ! 1752 1673 !-- Determine topography top index on v-grid 1753 kb = MAXLOC( MERGE( 1, 0, & 1754 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1755 ), DIM = 1 & 1756 ) - 1 1674 kb = get_topography_top_index( j, i, 'v' ) 1757 1675 k = kb + 1 1758 1676 wall_index = kb … … 1794 1712 j = nyn + 1 1795 1713 ! 1796 !-- Determine topography top index on v-grid 1797 kb = MAXLOC( MERGE( 1, 0, & 1798 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1799 ), DIM = 1 & 1800 ) - 1 1714 !-- Determine topography top index on u-grid 1715 kb = get_topography_top_index( j, i, 'u' ) 1801 1716 k = kb + 1 1802 1717 wall_index = kb … … 1814 1729 ! 1815 1730 !-- Determine topography top index on v-grid 1816 kb = MAXLOC( MERGE( 1, 0, & 1817 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1818 ), DIM = 1 & 1819 ) - 1 1731 kb = get_topography_top_index( j, i, 'v' ) 1820 1732 k = kb + 1 1821 1733 wall_index = kb … … 1856 1768 1857 1769 DO j = nys, nyn 1858 k_wall_u_ji = MAXLOC( & 1859 MERGE( 1, 0, & 1860 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,0), 26 ) & 1861 ), DIM = 1 & 1862 ) - 1 1863 k_wall_u_ji_p = MAXLOC( & 1864 MERGE( 1, 0, & 1865 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,0), 26 )& 1866 ), DIM = 1 & 1867 ) - 1 1868 k_wall_u_ji_m = MAXLOC( & 1869 MERGE( 1, 0, & 1870 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,0), 26 )& 1871 ), DIM = 1 & 1872 ) - 1 1873 1874 k_wall_w_ji = MAXLOC( & 1875 MERGE( 1, 0, & 1876 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,-1), 28 )& 1877 ), DIM = 1 & 1878 ) - 1 1879 k_wall_w_ji_p = MAXLOC( & 1880 MERGE( 1, 0, & 1881 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,-1), 28 )& 1882 ), DIM = 1 & 1883 ) - 1 1884 k_wall_w_ji_m = MAXLOC( & 1885 MERGE( 1, 0, & 1886 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,-1), 28 )& 1887 ), DIM = 1 & 1888 ) - 1 1770 ! 1771 !-- Determine lowest grid on outer grids for u and w. 1772 k_wall_u_ji = get_topography_top_index( j, 0, 'u_out' ) 1773 k_wall_u_ji_p = get_topography_top_index( j+1, 0, 'u_out' ) 1774 k_wall_u_ji_m = get_topography_top_index( j-1, 0, 'u_out' ) 1775 1776 k_wall_w_ji = get_topography_top_index( j, -1, 'w_out' ) 1777 k_wall_w_ji_p = get_topography_top_index( j+1, -1, 'w_out' ) 1778 k_wall_w_ji_m = get_topography_top_index( j-1, -1, 'w_out' ) 1889 1779 1890 1780 DO k = nzb, nzt_topo_nestbc_l … … 1971 1861 1972 1862 DO j = nys, nyn 1973 1974 k_wall_u_ji = MAXLOC( & 1975 MERGE( 1, 0, & 1976 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 26 ) & 1977 ), DIM = 1 & 1978 ) - 1 1979 k_wall_u_ji_p = MAXLOC( & 1980 MERGE( 1, 0, & 1981 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 26 )& 1982 ), DIM = 1 & 1983 ) - 1 1984 k_wall_u_ji_m = MAXLOC( & 1985 MERGE( 1, 0, & 1986 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 26 )& 1987 ), DIM = 1 & 1988 ) - 1 1989 1990 k_wall_w_ji = MAXLOC( & 1991 MERGE( 1, 0, & 1992 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 28 ) & 1993 ), DIM = 1 & 1994 ) - 1 1995 k_wall_w_ji_p = MAXLOC( & 1996 MERGE( 1, 0, & 1997 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 28 )& 1998 ), DIM = 1 & 1999 ) - 1 2000 k_wall_w_ji_m = MAXLOC( & 2001 MERGE( 1, 0, & 2002 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 28 )& 2003 ), DIM = 1 & 2004 ) - 1 1863 ! 1864 !-- Determine lowest grid on outer grids for u and w. 1865 k_wall_u_ji = get_topography_top_index( j, i, 'u_out' ) 1866 k_wall_u_ji_p = get_topography_top_index( j+1, i, 'u_out' ) 1867 k_wall_u_ji_m = get_topography_top_index( j-1, i, 'u_out' ) 1868 1869 k_wall_w_ji = get_topography_top_index( j, i, 'w_out' ) 1870 k_wall_w_ji_p = get_topography_top_index( j+1, i, 'w_out' ) 1871 k_wall_w_ji_m = get_topography_top_index( j-1, i, 'w_out' ) 1872 2005 1873 DO k = nzb, nzt_topo_nestbc_r 2006 1874 ! … … 2081 1949 2082 1950 DO i = nxl, nxr 2083 2084 k_wall_v_ji = MAXLOC( & 2085 MERGE( 1, 0, & 2086 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i), 27 ) & 2087 ), DIM = 1 & 2088 ) - 1 2089 k_wall_v_ji_p = MAXLOC( & 2090 MERGE( 1, 0, & 2091 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i+1), 27 )& 2092 ), DIM = 1 & 2093 ) - 1 2094 k_wall_v_ji_m = MAXLOC( & 2095 MERGE( 1, 0, & 2096 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i-1), 27 )& 2097 ), DIM = 1 & 2098 ) - 1 2099 2100 k_wall_w_ji = MAXLOC( & 2101 MERGE( 1, 0, & 2102 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i), 28 )& 2103 ), DIM = 1 & 2104 ) - 1 2105 k_wall_w_ji_p = MAXLOC( & 2106 MERGE( 1, 0, & 2107 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i+1), 28 )& 2108 ), DIM = 1 & 2109 ) - 1 2110 k_wall_w_ji_m = MAXLOC( & 2111 MERGE( 1, 0, & 2112 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i-1), 28 )& 2113 ), DIM = 1 & 2114 ) - 1 1951 ! 1952 !-- Determine lowest grid on outer grids for v and w. 1953 k_wall_v_ji = get_topography_top_index( 0, i, 'v_out' ) 1954 k_wall_v_ji_p = get_topography_top_index( 0, i+1, 'v_out' ) 1955 k_wall_v_ji_m = get_topography_top_index( 0, i-1, 'v_out' ) 1956 1957 k_wall_w_ji = get_topography_top_index( -1, i, 'w_out' ) 1958 k_wall_w_ji_p = get_topography_top_index( -1, i+1, 'w_out' ) 1959 k_wall_w_ji_m = get_topography_top_index( -1, i-1, 'w_out' ) 1960 2115 1961 DO k = nzb, nzt_topo_nestbc_s 2116 1962 ! … … 2195 2041 2196 2042 DO i = nxl, nxr 2197 k_wall_v_ji = MAXLOC( & 2198 MERGE( 1, 0, & 2199 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 27 ) & 2200 ), DIM = 1 & 2201 ) - 1 2202 2203 k_wall_v_ji_p = MAXLOC( & 2204 MERGE( 1, 0, & 2205 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 27 )& 2206 ), DIM = 1 & 2207 ) - 1 2208 k_wall_v_ji_m = MAXLOC( & 2209 MERGE( 1, 0, & 2210 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 27 )& 2211 ), DIM = 1 & 2212 ) - 1 2213 2214 k_wall_w_ji = MAXLOC( & 2215 MERGE( 1, 0, & 2216 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 28 ) & 2217 ), DIM = 1 & 2218 ) - 1 2219 k_wall_w_ji_p = MAXLOC( & 2220 MERGE( 1, 0, & 2221 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 28 )& 2222 ), DIM = 1 & 2223 ) - 1 2224 k_wall_w_ji_m = MAXLOC( & 2225 MERGE( 1, 0, & 2226 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 28 )& 2227 ), DIM = 1 & 2228 ) - 1 2043 ! 2044 !-- Determine lowest grid on outer grids for v and w. 2045 k_wall_v_ji = get_topography_top_index( j, i, 'v_out' ) 2046 k_wall_v_ji_p = get_topography_top_index( j, i+1, 'v_out' ) 2047 k_wall_v_ji_m = get_topography_top_index( j, i-1, 'v_out' ) 2048 2049 k_wall_w_ji = get_topography_top_index( j, i, 'w_out' ) 2050 k_wall_w_ji_p = get_topography_top_index( j, i+1, 'w_out' ) 2051 k_wall_w_ji_m = get_topography_top_index( j, i-1, 'w_out' ) 2052 2229 2053 DO k = nzb, nzt_topo_nestbc_n 2230 2054 ! … … 2831 2655 i = nxl - 1 2832 2656 DO j = nysg, nyng 2833 k_wall = MAXLOC( & 2834 MERGE( 1, 0, & 2835 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2836 ), DIM = 1 & 2837 ) - 1 2657 k_wall = get_topography_top_index( j, i, 's' ) 2838 2658 2839 2659 DO k = k_wall + 1, nzt … … 2856 2676 i = nxr + 1 2857 2677 DO j = nysg, nyng 2858 k_wall = MAXLOC( & 2859 MERGE( 1, 0, & 2860 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2861 ), DIM = 1 & 2862 ) - 1 2678 k_wall = get_topography_top_index( j, i, 's' ) 2863 2679 2864 2680 DO k = k_wall + 1, nzt … … 2881 2697 j = nys - 1 2882 2698 DO i = nxlg, nxrg 2883 k_wall = MAXLOC( & 2884 MERGE( 1, 0, & 2885 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2886 ), DIM = 1 & 2887 ) - 1 2699 k_wall = get_topography_top_index( j, i, 's' ) 2888 2700 2889 2701 DO k = k_wall + 1, nzt … … 2906 2718 j = nyn + 1 2907 2719 DO i = nxlg, nxrg 2908 k_wall = MAXLOC( & 2909 MERGE( 1, 0, & 2910 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2911 ), DIM = 1 & 2912 ) - 1 2720 k_wall = get_topography_top_index( j, i, 's' ) 2721 2913 2722 DO k = k_wall + 1, nzt 2914 2723 … … 2932 2741 ! 2933 2742 !-- Determine vertical index for local topography top 2934 k_wall = MAXLOC( & 2935 MERGE( 1, 0, & 2936 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2937 ), DIM = 1 & 2938 ) - 1 2743 k_wall = get_topography_top_index( j, i, 's' ) 2939 2744 2940 2745 kc = kco(k+1) … … 3315 3120 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !: 3316 3121 3317 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid3318 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid3319 3122 INTEGER(iwp) :: i !: 3320 3123 INTEGER(iwp) :: ib !: … … 3380 3183 ENDIF 3381 3184 ENDIF 3382 ! 3383 !-- Determine number of flag array to be used to mask topography 3384 IF ( var == 'u' ) THEN 3385 flag_nr = 1 3386 flag_nr2 = 14 3387 ELSEIF ( var == 'v' ) THEN 3388 flag_nr = 2 3389 flag_nr2 = 16 3390 ELSEIF ( var == 'w' ) THEN 3391 flag_nr = 3 3392 flag_nr2 = 18 3393 ELSE 3394 flag_nr = 0 3395 flag_nr2 = 12 3396 ENDIF 3185 3397 3186 ! 3398 3187 !-- Trilinear interpolation. … … 3426 3215 ! 3427 3216 !-- Determine vertical index of topography top at grid point (j,i) 3428 k_wall = MAXLOC( & 3429 MERGE( 1, 0, & 3430 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3431 ), DIM = 1 & 3432 ) - 1 3217 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 3433 3218 ! 3434 3219 !-- kbc is the first coarse-grid point above the surface … … 3461 3246 ! 3462 3247 !-- Determine vertical index of topography top at grid point (j,i) 3463 k_wall = MAXLOC( & 3464 MERGE( 1, 0, & 3465 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3466 ), DIM = 1 & 3467 ) - 1 3248 k_wall = get_topography_top_index( j, i, 'w' ) 3468 3249 3469 3250 f(k_wall,j,i) = 0.0_wp … … 4563 4344 CHARACTER(LEN=1), INTENT(IN) :: var !: 4564 4345 4565 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid4566 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid4567 4346 INTEGER(iwp) :: i !: 4568 4347 INTEGER(iwp) :: ib !: … … 4611 4390 ib = nxr + 2 4612 4391 ENDIF 4613 !4614 !-- Determine number of flag array to be used to mask topography4615 IF ( var == 'u' ) THEN4616 flag_nr = 14617 flag_nr2 = 144618 ELSEIF ( var == 'v' ) THEN4619 flag_nr = 24620 flag_nr2 = 164621 ELSEIF ( var == 'w' ) THEN4622 flag_nr = 34623 flag_nr2 = 184624 ELSE4625 flag_nr = 04626 flag_nr2 = 124627 ENDIF4628 4392 4629 4393 DO j = nys, nyn+1 … … 4653 4417 ! 4654 4418 !-- Determine vertical index of topography top at grid point (j,i) 4655 k_wall = MAXLOC( & 4656 MERGE( 1, 0, & 4657 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4658 ), DIM = 1 & 4659 ) - 1 4419 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4660 4420 4661 4421 k = k_wall+1 … … 4683 4443 ! 4684 4444 !-- Determine vertical index of topography top at grid point (j,i) 4685 k_wall = MAXLOC( & 4686 MERGE( 1, 0, & 4687 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4688 ), DIM = 1 & 4689 ) - 1 4445 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4446 4690 4447 DO k = k_wall+1, nzt_topo_nestbc 4691 4448 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) == 0 ) ) THEN … … 4711 4468 ! 4712 4469 !-- Determine vertical index of topography top at grid point (j,i) 4713 k_wall = MAXLOC( & 4714 MERGE( 1, 0, & 4715 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4716 ), DIM = 1 & 4717 ) - 1 4470 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4471 4718 4472 k = k_wall + 1 4719 4473 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) /= 0 ) ) THEN … … 4746 4500 ! 4747 4501 !-- Determine vertical index of topography top at grid point (j,i) 4748 k_wall = MAXLOC( & 4749 MERGE( 1, 0, & 4750 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4751 ), DIM = 1 & 4752 ) - 1 4502 k_wall = get_topography_top_index( j, i, 's' ) 4503 4753 4504 DO k = k_wall, nzt + 1 4754 4505 f(k,j,i) = tkefactor_l(k,j) * f(k,j,i) … … 4759 4510 ! 4760 4511 !-- Determine vertical index of topography top at grid point (j,i) 4761 k_wall = MAXLOC( & 4762 MERGE( 1, 0, & 4763 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4764 ), DIM = 1 & 4765 ) - 1 4512 k_wall = get_topography_top_index( j, i, 's' ) 4513 4766 4514 DO k = k_wall, nzt+1 4767 4515 f(k,j,i) = tkefactor_r(k,j) * f(k,j,i) … … 4821 4569 CHARACTER(LEN=1), INTENT(IN) :: var !: 4822 4570 4823 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid4824 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid4825 4571 INTEGER(iwp) :: i !: 4826 4572 INTEGER(iwp) :: iinc !: … … 4867 4613 ENDIF 4868 4614 4869 !4870 !-- Determine number of flag array to be used to mask topography4871 IF ( var == 'u' ) THEN4872 flag_nr = 14873 flag_nr2 = 144874 ELSEIF ( var == 'v' ) THEN4875 flag_nr = 24876 flag_nr2 = 164877 ELSEIF ( var == 'w' ) THEN4878 flag_nr = 34879 flag_nr2 = 184880 ELSE4881 flag_nr = 04882 flag_nr2 = 124883 ENDIF4884 4615 4885 4616 DO i = nxl, nxr+1 4886 4617 ! 4887 4618 !-- Determine vertical index of topography top at grid point (j,i) 4888 k_wall = MAXLOC( & 4889 MERGE( 1, 0, & 4890 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4891 ), DIM = 1 & 4892 ) - 1 4619 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4620 4893 4621 DO k = k_wall, nzt+1 4894 4622 l = ic(i) … … 4916 4644 ! 4917 4645 !-- Determine vertical index of topography top at grid point (j,i) 4918 k_wall = MAXLOC( & 4919 MERGE( 1, 0, & 4920 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4921 ), DIM = 1 & 4922 ) - 1 4646 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4923 4647 4924 4648 k = k_wall + 1 … … 4945 4669 ! 4946 4670 !-- Determine vertical index of topography top at grid point (j,i) 4947 k_wall = MAXLOC( & 4948 MERGE( 1, 0, & 4949 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4950 ), DIM = 1 & 4951 ) - 1 4671 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4672 4952 4673 DO k = k_wall, nzt_topo_nestbc 4953 4674 ! … … 4975 4696 ! 4976 4697 !-- Determine vertical index of topography top at grid point (j,i) 4977 k_wall = MAXLOC( & 4978 MERGE( 1, 0, & 4979 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4980 ), DIM = 1 & 4981 ) - 1 4698 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4699 4982 4700 k = k_wall + 1 4983 4701 IF ( ( logc(2,k,i) /= 0 ) .AND. ( logc(1,k,i) /= 0 ) ) THEN … … 5010 4728 ! 5011 4729 !-- Determine vertical index of topography top at grid point (j,i) 5012 k_wall = MAXLOC( & 5013 MERGE( 1, 0, & 5014 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5015 ), DIM = 1 & 5016 ) - 1 4730 k_wall = get_topography_top_index( j, i, 's' ) 5017 4731 DO k = k_wall, nzt+1 5018 4732 f(k,j,i) = tkefactor_s(k,i) * f(k,j,i) … … 5023 4737 ! 5024 4738 !-- Determine vertical index of topography top at grid point (j,i) 5025 k_wall = MAXLOC( & 5026 MERGE( 1, 0, & 5027 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5028 ), DIM = 1 & 5029 ) - 1 4739 k_wall = get_topography_top_index( j, i, 's' ) 5030 4740 DO k = k_wall, nzt+1 5031 4741 f(k,j,i) = tkefactor_n(k,i) * f(k,j,i) … … 5153 4863 CHARACTER(LEN=1), INTENT(IN) :: var !: 5154 4864 5155 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid5156 4865 INTEGER(iwp) :: i !: 5157 4866 INTEGER(iwp) :: ib !: … … 5186 4895 outnor = 1.0_wp 5187 4896 ENDIF 5188 ! 5189 !-- Determine number of flag array to be used to mask topography 5190 IF ( var == 'u' ) THEN 5191 flag_nr = 14 5192 ELSEIF ( var == 'v' ) THEN 5193 flag_nr = 16 5194 ELSEIF ( var == 'w' ) THEN 5195 flag_nr = 18 5196 ELSE 5197 flag_nr = 12 5198 ENDIF 4897 5199 4898 5200 4899 DO j = nys, nyn+1 5201 4900 ! 5202 4901 !-- Determine vertical index of topography top at grid point (j,i) 5203 k_wall = MAXLOC( & 5204 MERGE( 1, 0, & 5205 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5206 ), DIM = 1 & 5207 ) - 1 4902 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4903 5208 4904 DO k = k_wall, nzt+1 5209 4905 vdotnor = outnor * u(k,j,ied) … … 5248 4944 CHARACTER(LEN=1), INTENT(IN) :: var !: 5249 4945 5250 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid5251 4946 INTEGER(iwp) :: i !: 5252 4947 INTEGER(iwp) :: j !: … … 5282 4977 ENDIF 5283 4978 5284 !5285 !-- Determine number of flag array to be used to mask topography5286 IF ( var == 'u' ) THEN5287 flag_nr = 145288 ELSEIF ( var == 'v' ) THEN5289 flag_nr = 165290 ELSEIF ( var == 'w' ) THEN5291 flag_nr = 185292 ELSE5293 flag_nr = 125294 ENDIF5295 4979 5296 4980 DO i = nxl, nxr+1 5297 4981 ! 5298 4982 !-- Determine vertical index of topography top at grid point (j,i) 5299 k_wall = MAXLOC( & 5300 MERGE( 1, 0, & 5301 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5302 ), DIM = 1 & 5303 ) - 1 4983 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4984 5304 4985 DO k = k_wall, nzt+1 5305 4986 vdotnor = outnor * v(k,jed,i) -
palm/trunk/SOURCE/radiation_model_mod.f90
r2299 r2317 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Get topography top index via Function call 23 23 ! 24 24 ! Former revisions: … … 169 169 170 170 USE indices, & 171 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 172 wall_flags_0 171 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 173 172 174 173 USE kinds … … 200 199 ONLY: rrtmg_sw 201 200 #endif 202 203 201 USE surface_mod, & 202 ONLY: get_topography_top_index 204 203 205 204 IMPLICIT NONE … … 1186 1185 ! 1187 1186 !-- Obtain vertical index of topography top 1188 k = MAXLOC( & 1189 MERGE( 1, 0, & 1190 BTEST( wall_flags_0(:,j,i), 12 ) & 1191 ), DIM = 1 & 1192 ) - 1 1187 k = get_topography_top_index( j, i, 's' ) 1193 1188 1194 1189 exn1 = (hyp(k+1) / 100000.0_wp )**0.286_wp … … 1243 1238 !-- Obtain vertical index of topography top. So far it is identical to 1244 1239 !-- nzb. 1245 k = MAXLOC( & 1246 MERGE( 1, 0, & 1247 BTEST( wall_flags_0(:,j,i), 12 ) & 1248 ), DIM = 1 & 1249 ) - 1 1240 k = get_topography_top_index( j, i, 's' ) 1250 1241 1251 1242 rad_net(j,i) = net_radiation -
palm/trunk/SOURCE/surface_mod.f90
r2292 r2317 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! New function to obtain topography top index. 23 23 ! 24 24 ! Former revisions: … … 269 269 270 270 PRIVATE 271 272 INTERFACE get_topography_top_index 273 MODULE PROCEDURE get_topography_top_index 274 END INTERFACE get_topography_top_index 275 276 INTERFACE init_bc 277 MODULE PROCEDURE init_bc 278 END INTERFACE init_bc 279 280 INTERFACE init_surfaces 281 MODULE PROCEDURE init_surfaces 282 END INTERFACE init_surfaces 283 284 INTERFACE init_surface_arrays 285 MODULE PROCEDURE init_surface_arrays 286 END INTERFACE init_surface_arrays 287 288 INTERFACE surface_read_restart_data 289 MODULE PROCEDURE surface_read_restart_data 290 END INTERFACE surface_read_restart_data 291 292 INTERFACE surface_write_restart_data 293 MODULE PROCEDURE surface_write_restart_data 294 END INTERFACE surface_write_restart_data 295 296 INTERFACE surface_last_actions 297 MODULE PROCEDURE surface_last_actions 298 END INTERFACE surface_last_actions 299 271 300 ! 272 301 !-- Public variables … … 274 303 surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type 275 304 ! 276 !-- Public subroutines 277 PUBLIC init_bc, init_surfaces, init_surface_arrays, & 278 surface_read_restart_data, surface_write_restart_data, & 279 surface_last_actions 280 281 INTERFACE init_bc 282 MODULE PROCEDURE init_bc 283 END INTERFACE init_bc 284 285 INTERFACE init_surfaces 286 MODULE PROCEDURE init_surfaces 287 END INTERFACE init_surfaces 288 289 INTERFACE init_surface_arrays 290 MODULE PROCEDURE init_surface_arrays 291 END INTERFACE init_surface_arrays 292 293 INTERFACE surface_read_restart_data 294 MODULE PROCEDURE surface_read_restart_data 295 END INTERFACE surface_read_restart_data 296 297 INTERFACE surface_write_restart_data 298 MODULE PROCEDURE surface_write_restart_data 299 END INTERFACE surface_write_restart_data 300 301 INTERFACE surface_last_actions 302 MODULE PROCEDURE surface_last_actions 303 END INTERFACE surface_last_actions 305 !-- Public subroutines and functions 306 PUBLIC get_topography_top_index, init_bc, init_surfaces, & 307 init_surface_arrays, surface_read_restart_data, & 308 surface_write_restart_data, surface_last_actions 304 309 305 310 … … 1642 1647 1643 1648 END SUBROUTINE init_surfaces 1649 1650 1651 !------------------------------------------------------------------------------! 1652 ! Description: 1653 ! ------------ 1654 !> Determines topography-top index at given (j,i)-position. 1655 !------------------------------------------------------------------------------! 1656 FUNCTION get_topography_top_index( j, i, grid ) 1657 1658 USE kinds 1659 1660 IMPLICIT NONE 1661 1662 CHARACTER(LEN=*) :: grid !< flag to distinquish between staggered grids 1663 INTEGER(iwp) :: i !< grid index in x-dimension 1664 INTEGER(iwp) :: ibit !< bit position where topography information is stored on respective grid 1665 INTEGER(iwp) :: j !< grid index in y-dimension 1666 INTEGER(iwp) :: get_topography_top_index !< topography top index 1667 1668 SELECT CASE ( TRIM( grid ) ) 1669 1670 CASE ( 's' ) 1671 ibit = 12 1672 CASE ( 'u' ) 1673 ibit = 14 1674 CASE ( 'v' ) 1675 ibit = 16 1676 CASE ( 'w' ) 1677 ibit = 18 1678 CASE ( 's_out' ) 1679 ibit = 24 1680 CASE ( 'u_out' ) 1681 ibit = 26 1682 CASE ( 'v_out' ) 1683 ibit = 27 1684 CASE ( 'w_out' ) 1685 ibit = 28 1686 CASE DEFAULT 1687 ! 1688 !-- Set default to scalar grid 1689 ibit = 12 1690 1691 END SELECT 1692 1693 get_topography_top_index = MAXLOC( & 1694 MERGE( 1, 0, & 1695 BTEST( wall_flags_0(:,j,i), ibit ) & 1696 ), DIM = 1 & 1697 ) - 1 1698 1699 RETURN 1700 1701 END FUNCTION get_topography_top_index 1644 1702 1645 1703 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/urban_surface_mod.f90
r2296 r2317 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Get topography top index via Function call 24 24 ! 25 25 ! Former revisions: … … 603 603 ! 604 604 !-- Find topography top index 605 k_topo = MAXLOC( MERGE( 1, 0, & 606 BTEST( wall_flags_0(:,j,i), 12 ) & 607 ), DIM = 1 & 608 ) - 1 605 k_topo = get_topography_top_index( j, i, 's' ) 606 609 607 DO k = nzt+1, 0, -1 610 608 IF ( lad_s(k,j,i) /= 0.0_wp ) THEN … … 706 704 DO j = ijdb(3,ids), ijdb(4,ids) 707 705 708 k_topo = MAXLOC( MERGE( 1, 0, & 709 BTEST( wall_flags_0(:,j,i), 12 ) & 710 ), DIM = 1 & 711 ) - 1 712 k_topo2 = MAXLOC( MERGE( 1, 0, & 713 BTEST( wall_flags_0(:,j-jdir(ids),i-idir(ids)), 12 ) & 714 ), DIM = 1 & 715 ) - 1 706 k_topo = get_topography_top_index( j, i, 's' ) 707 k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' ) 716 708 717 709 k = nzut - MAX( k_topo, k_topo2 ) … … 732 724 ! 733 725 !-- Find topography top index 734 k_topo = MAXLOC( MERGE( 1, 0, & 735 BTEST( wall_flags_0(:,j,i), 12 ) & 736 ), DIM = 1 & 737 ) - 1 726 k_topo = get_topography_top_index( j, i, 's' ) 727 738 728 DO k = k_topo + 1, pct(j,i) 739 729 ipcgb = ipcgb + 1 … … 813 803 DO i = ijdb(1,ids), ijdb(2,ids) 814 804 DO j = ijdb(3,ids), ijdb(4,ids) 815 k_topo = MAXLOC( MERGE( 1, 0, & 816 BTEST( wall_flags_0(:,j,i), 12 ) & 817 ), DIM = 1 & 818 ) - 1 819 k_topo2 = MAXLOC( MERGE( 1, 0, & 820 BTEST( wall_flags_0(:,j-jdir(ids),i-idir(ids)), 12 ) & 821 ), DIM = 1 & 822 ) - 1 805 k_topo = get_topography_top_index( j, i, 's' ) 806 k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' ) 807 823 808 DO k = MAX(k_topo,k_topo2)+1, nzut 824 809 isurf = isurf + 1 … … 1929 1914 DO i = nxl, nxr 1930 1915 DO j = nys, nyn 1931 k = MAXLOC( & 1932 MERGE( 1, 0, & 1933 BTEST( wall_flags_0(:,j,i), 12 ) & 1934 ), DIM = 1 & 1935 ) - 1 1916 k = get_topography_top_index( j, i, 's' ) 1936 1917 1937 1918 usm_lad(k:nzut, j, i) = lad_s(0:nzut-k, j, i) … … 3806 3787 ! 3807 3788 !-- Following expression equals former kk = k - nzb_s_inner(j,i) 3808 kk = k - ( MAXLOC( & 3809 MERGE( 1, 0, & 3810 BTEST( wall_flags_0(:,j,i), 12 ) & 3811 ), DIM = 1 & 3812 ) - 1 & 3813 ) !- lad arrays are defined flat 3789 kk = k - ( get_topography_top_index( j, i, 's' ) ) !- lad arrays are defined flat 3814 3790 pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) & 3815 3791 * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
Note: See TracChangeset
for help on using the changeset viewer.
