Changeset 4346 for palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
- Timestamp:
- Dec 18, 2019 11:55:56 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
r4336 r4346 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 ! topography information used in wall_flags_static_0 29 ! 30 ! 4336 2019-12-13 10:12:05Z raasch 27 31 ! bugfix: wrong header output of particle group features (density ratio) in case 28 32 ! of restarts corrected … … 152 156 nzb_max, nzt,nbgp, ngp_2dh_outer, & 153 157 topo_top_ind, & 154 wall_flags_ static_0158 wall_flags_total_0 155 159 156 160 USE kinds … … 1354 1358 !-- of overhanging structures. 1355 1359 IF ( kp > nzt .OR. & 1356 .NOT. BTEST( wall_flags_ static_0(kp,jp,ip), 0 ) ) THEN1360 .NOT. BTEST( wall_flags_total_0(kp,jp,ip), 0 ) ) THEN 1357 1361 pos_x = pos_x + pdx(i) 1358 1362 CYCLE xloop … … 1364 1368 ELSEIF ( .NOT. seed_follows_topography .AND. & 1365 1369 tmp_particle%z <= zw(k_surf) .OR. & 1366 .NOT. BTEST( wall_flags_ static_0(kp,jp,ip), 0 ) )&1370 .NOT. BTEST( wall_flags_total_0(kp,jp,ip), 0 ) )& 1367 1371 THEN 1368 1372 pos_x = pos_x + pdx(i) … … 1520 1524 ! 1521 1525 !-- Check if particle is within topography 1522 IF ( .NOT. BTEST( wall_flags_ static_0(k,j,i), 0 ) ) THEN1526 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 1523 1527 particles(n)%particle_mask = .FALSE. 1524 1528 deleted_particles = deleted_particles + 1 … … 1763 1767 DO k = nzb, nzt+1 1764 1768 1765 IF ( .NOT. BTEST( wall_flags_ static_0(k,j,i-1), 0 ) .AND.&1766 BTEST( wall_flags_ static_0(k,j,i), 0 ) .AND.&1767 BTEST( wall_flags_ static_0(k,j,i+1), 0 ) )&1769 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) .AND. & 1770 BTEST( wall_flags_total_0(k,j,i), 0 ) .AND. & 1771 BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) & 1768 1772 THEN 1769 1773 de_dx(k,j,i) = 2.0_wp * sgs_wf_part * & 1770 1774 ( e(k,j,i+1) - e(k,j,i) ) * ddx 1771 ELSEIF ( BTEST( wall_flags_ static_0(k,j,i-1), 0 ) .AND.&1772 BTEST( wall_flags_ static_0(k,j,i), 0 ) .AND.&1773 .NOT. BTEST( wall_flags_ static_0(k,j,i+1), 0 ) )&1775 ELSEIF ( BTEST( wall_flags_total_0(k,j,i-1), 0 ) .AND. & 1776 BTEST( wall_flags_total_0(k,j,i), 0 ) .AND. & 1777 .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) & 1774 1778 THEN 1775 1779 de_dx(k,j,i) = 2.0_wp * sgs_wf_part * & 1776 1780 ( e(k,j,i) - e(k,j,i-1) ) * ddx 1777 ELSEIF ( .NOT. BTEST( wall_flags_ static_0(k,j,i), 22 ) .AND.&1778 .NOT. BTEST( wall_flags_ static_0(k,j,i+1), 22 ) )&1781 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 22 ) .AND. & 1782 .NOT. BTEST( wall_flags_total_0(k,j,i+1), 22 ) ) & 1779 1783 THEN 1780 1784 de_dx(k,j,i) = 0.0_wp 1781 ELSEIF ( .NOT. BTEST( wall_flags_ static_0(k,j,i-1), 22 ) .AND.&1782 .NOT. BTEST( wall_flags_ static_0(k,j,i), 22 ) )&1785 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 22 ) .AND. & 1786 .NOT. BTEST( wall_flags_total_0(k,j,i), 22 ) ) & 1783 1787 THEN 1784 1788 de_dx(k,j,i) = 0.0_wp … … 1787 1791 ENDIF 1788 1792 1789 IF ( .NOT. BTEST( wall_flags_ static_0(k,j-1,i), 0 ) .AND.&1790 BTEST( wall_flags_ static_0(k,j,i), 0 ) .AND.&1791 BTEST( wall_flags_ static_0(k,j+1,i), 0 ) )&1793 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) .AND. & 1794 BTEST( wall_flags_total_0(k,j,i), 0 ) .AND. & 1795 BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) & 1792 1796 THEN 1793 1797 de_dy(k,j,i) = 2.0_wp * sgs_wf_part * & 1794 1798 ( e(k,j+1,i) - e(k,j,i) ) * ddy 1795 ELSEIF ( BTEST( wall_flags_ static_0(k,j-1,i), 0 ) .AND.&1796 BTEST( wall_flags_ static_0(k,j,i), 0 ) .AND.&1797 .NOT. BTEST( wall_flags_ static_0(k,j+1,i), 0 ) )&1799 ELSEIF ( BTEST( wall_flags_total_0(k,j-1,i), 0 ) .AND. & 1800 BTEST( wall_flags_total_0(k,j,i), 0 ) .AND. & 1801 .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) & 1798 1802 THEN 1799 1803 de_dy(k,j,i) = 2.0_wp * sgs_wf_part * & 1800 1804 ( e(k,j,i) - e(k,j-1,i) ) * ddy 1801 ELSEIF ( .NOT. BTEST( wall_flags_ static_0(k,j,i), 22 ) .AND.&1802 .NOT. BTEST( wall_flags_ static_0(k,j+1,i), 22 ) )&1805 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 22 ) .AND. & 1806 .NOT. BTEST( wall_flags_total_0(k,j+1,i), 22 ) ) & 1803 1807 THEN 1804 1808 de_dy(k,j,i) = 0.0_wp 1805 ELSEIF ( .NOT. BTEST( wall_flags_ static_0(k,j-1,i), 22 ) .AND.&1806 .NOT. BTEST( wall_flags_ static_0(k,j,i), 22 ) )&1809 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 22 ) .AND. & 1810 .NOT. BTEST( wall_flags_total_0(k,j,i), 22 ) ) & 1807 1811 THEN 1808 1812 de_dy(k,j,i) = 0.0_wp … … 1822 1826 ! 1823 1827 !-- Flag to mask topography 1824 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )1828 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1825 1829 1826 1830 de_dz(k,j,i) = 2.0_wp * sgs_wf_part * & … … 1897 1901 ! 1898 1902 !-- Flag indicating vicinity of wall 1899 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 24 ) )1903 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 24 ) ) 1900 1904 1901 1905 sums_l(k,1,0) = sums_l(k,1,0) + u(k,j,i) * flag1 … … 1937 1941 ! 1938 1942 !-- Flag indicating vicinity of wall 1939 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 24 ) )1943 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 24 ) ) 1940 1944 1941 1945 sums_l(k,8,0) = sums_l(k,8,0) + e(k,j,i) * flag1 … … 3645 3649 ( gg-dd ) * w(k+1,j+1,i+1) & 3646 3650 ) / ( 3.0_wp * gg ) 3647 w_int(n) = w_int_l + ( zv(n) - zw(k) ) / dzw(k+1) * 3651 w_int(n) = w_int_l + ( zv(n) - zw(k) ) / dzw(k+1) * & 3648 3652 ( w_int_u - w_int_l ) 3649 3653 ENDIF … … 3668 3672 j = jp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 1 ) ) 3669 3673 k = kp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 0 ) ) 3670 IF ( .NOT. BTEST(wall_flags_ static_0(k, jp, ip), 0) .OR.&3671 .NOT. BTEST(wall_flags_ static_0(kp, j, ip), 0) .OR.&3672 .NOT. BTEST(wall_flags_ static_0(kp, jp, i ), 0) )&3674 IF ( .NOT. BTEST(wall_flags_total_0(k, jp, ip), 0) .OR. & 3675 .NOT. BTEST(wall_flags_total_0(kp, j, ip), 0) .OR. & 3676 .NOT. BTEST(wall_flags_total_0(kp, jp, i ), 0) ) & 3673 3677 THEN 3674 3678 subbox_at_wall = .TRUE. … … 4765 4769 IF ( reach_x(t_index) .AND. & 4766 4770 ABS( pos_x - xwall ) < eps .AND. & 4767 .NOT. BTEST(wall_flags_ static_0(k3,j3,i3),0) .AND.&4771 .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND. & 4768 4772 .NOT. reflect_x ) THEN 4769 4773 ! … … 4805 4809 IF ( reach_y(t_index) .AND. & 4806 4810 ABS( pos_y - ywall ) < eps .AND. & 4807 .NOT. BTEST(wall_flags_ static_0(k3,j3,i3),0) .AND.&4811 .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND. & 4808 4812 .NOT. reflect_y ) THEN 4809 4813 ! … … 4845 4849 IF ( reach_z(t_index) .AND. & 4846 4850 ABS( pos_z - zwall ) < eps .AND. & 4847 .NOT. BTEST(wall_flags_ static_0(k3,j3,i3),0) .AND.&4851 .NOT. BTEST(wall_flags_total_0(k3,j3,i3),0) .AND. & 4848 4852 .NOT. reflect_z ) THEN 4849 4853 ! … … 5203 5207 ! 5204 5208 !-- Predetermine flag to mask topography 5205 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )5209 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5206 5210 5207 5211 q(k,j,i) = q_p(k,j,i) - ql_c(k,j,i) * flag … … 5233 5237 ! 5234 5238 !-- Predetermine flag to mask topography 5235 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )5239 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5236 5240 5237 5241 q(k,j,i) = q(k,j,i) - ql_c(k,j,i) * flag
Note: See TracChangeset
for help on using the changeset viewer.
