Changeset 4329 for palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
- Timestamp:
- Dec 10, 2019 3:46:36 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/lagrangian_particle_model_mod.f90
r4282 r4329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Renamed wall_flags_0 to wall_flags_static_0 28 ! 29 ! 4282 2019-10-29 16:18:46Z schwenkel 27 30 ! Bugfix of particle timeseries in case of more than one particle group 28 31 ! … … 145 148 nzb_max, nzt,nbgp, ngp_2dh_outer, & 146 149 topo_top_ind, & 147 wall_flags_ 0150 wall_flags_static_0 148 151 149 152 USE kinds … … 1352 1355 !-- of overhanging structures. 1353 1356 IF ( kp > nzt .OR. & 1354 .NOT. BTEST( wall_flags_ 0(kp,jp,ip), 0 ) ) THEN1357 .NOT. BTEST( wall_flags_static_0(kp,jp,ip), 0 ) ) THEN 1355 1358 pos_x = pos_x + pdx(i) 1356 1359 CYCLE xloop … … 1362 1365 ELSEIF ( .NOT. seed_follows_topography .AND. & 1363 1366 tmp_particle%z <= zw(k_surf) .OR. & 1364 .NOT. BTEST( wall_flags_ 0(kp,jp,ip), 0 ) )&1367 .NOT. BTEST( wall_flags_static_0(kp,jp,ip), 0 ) )& 1365 1368 THEN 1366 1369 pos_x = pos_x + pdx(i) … … 1518 1521 ! 1519 1522 !-- Check if particle is within topography 1520 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 0 ) ) THEN1523 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 0 ) ) THEN 1521 1524 particles(n)%particle_mask = .FALSE. 1522 1525 deleted_particles = deleted_particles + 1 … … 1761 1764 DO k = nzb, nzt+1 1762 1765 1763 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i-1), 0 ) .AND. &1764 BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &1765 BTEST( wall_flags_ 0(k,j,i+1), 0 ) ) &1766 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i-1), 0 ) .AND. & 1767 BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 1768 BTEST( wall_flags_static_0(k,j,i+1), 0 ) ) & 1766 1769 THEN 1767 1770 de_dx(k,j,i) = 2.0_wp * sgs_wf_part * & 1768 1771 ( e(k,j,i+1) - e(k,j,i) ) * ddx 1769 ELSEIF ( BTEST( wall_flags_ 0(k,j,i-1), 0 ) .AND. &1770 BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &1771 .NOT. BTEST( wall_flags_ 0(k,j,i+1), 0 ) ) &1772 ELSEIF ( BTEST( wall_flags_static_0(k,j,i-1), 0 ) .AND. & 1773 BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 1774 .NOT. BTEST( wall_flags_static_0(k,j,i+1), 0 ) ) & 1772 1775 THEN 1773 1776 de_dx(k,j,i) = 2.0_wp * sgs_wf_part * & 1774 1777 ( e(k,j,i) - e(k,j,i-1) ) * ddx 1775 ELSEIF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 22 ) .AND. &1776 .NOT. BTEST( wall_flags_ 0(k,j,i+1), 22 ) ) &1778 ELSEIF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 22 ) .AND. & 1779 .NOT. BTEST( wall_flags_static_0(k,j,i+1), 22 ) ) & 1777 1780 THEN 1778 1781 de_dx(k,j,i) = 0.0_wp 1779 ELSEIF ( .NOT. BTEST( wall_flags_ 0(k,j,i-1), 22 ) .AND. &1780 .NOT. BTEST( wall_flags_ 0(k,j,i), 22 ) ) &1782 ELSEIF ( .NOT. BTEST( wall_flags_static_0(k,j,i-1), 22 ) .AND. & 1783 .NOT. BTEST( wall_flags_static_0(k,j,i), 22 ) ) & 1781 1784 THEN 1782 1785 de_dx(k,j,i) = 0.0_wp … … 1785 1788 ENDIF 1786 1789 1787 IF ( .NOT. BTEST( wall_flags_ 0(k,j-1,i), 0 ) .AND. &1788 BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &1789 BTEST( wall_flags_ 0(k,j+1,i), 0 ) ) &1790 IF ( .NOT. BTEST( wall_flags_static_0(k,j-1,i), 0 ) .AND. & 1791 BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 1792 BTEST( wall_flags_static_0(k,j+1,i), 0 ) ) & 1790 1793 THEN 1791 1794 de_dy(k,j,i) = 2.0_wp * sgs_wf_part * & 1792 1795 ( e(k,j+1,i) - e(k,j,i) ) * ddy 1793 ELSEIF ( BTEST( wall_flags_ 0(k,j-1,i), 0 ) .AND. &1794 BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &1795 .NOT. BTEST( wall_flags_ 0(k,j+1,i), 0 ) ) &1796 ELSEIF ( BTEST( wall_flags_static_0(k,j-1,i), 0 ) .AND. & 1797 BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 1798 .NOT. BTEST( wall_flags_static_0(k,j+1,i), 0 ) ) & 1796 1799 THEN 1797 1800 de_dy(k,j,i) = 2.0_wp * sgs_wf_part * & 1798 1801 ( e(k,j,i) - e(k,j-1,i) ) * ddy 1799 ELSEIF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 22 ) .AND. &1800 .NOT. BTEST( wall_flags_ 0(k,j+1,i), 22 ) ) &1802 ELSEIF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 22 ) .AND. & 1803 .NOT. BTEST( wall_flags_static_0(k,j+1,i), 22 ) ) & 1801 1804 THEN 1802 1805 de_dy(k,j,i) = 0.0_wp 1803 ELSEIF ( .NOT. BTEST( wall_flags_ 0(k,j-1,i), 22 ) .AND. &1804 .NOT. BTEST( wall_flags_ 0(k,j,i), 22 ) ) &1806 ELSEIF ( .NOT. BTEST( wall_flags_static_0(k,j-1,i), 22 ) .AND. & 1807 .NOT. BTEST( wall_flags_static_0(k,j,i), 22 ) ) & 1805 1808 THEN 1806 1809 de_dy(k,j,i) = 0.0_wp … … 1820 1823 ! 1821 1824 !-- Flag to mask topography 1822 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )1825 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 1823 1826 1824 1827 de_dz(k,j,i) = 2.0_wp * sgs_wf_part * & … … 1895 1898 ! 1896 1899 !-- Flag indicating vicinity of wall 1897 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 24 ) )1900 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 24 ) ) 1898 1901 1899 1902 sums_l(k,1,0) = sums_l(k,1,0) + u(k,j,i) * flag1 … … 1935 1938 ! 1936 1939 !-- Flag indicating vicinity of wall 1937 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 24 ) )1940 flag1 = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 24 ) ) 1938 1941 1939 1942 sums_l(k,8,0) = sums_l(k,8,0) + e(k,j,i) * flag1 … … 3666 3669 j = jp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 1 ) ) 3667 3670 k = kp + MERGE( -1_iwp , 1_iwp, BTEST( nb, 0 ) ) 3668 IF ( .NOT. BTEST(wall_flags_ 0(k, jp, ip), 0) .OR. &3669 .NOT. BTEST(wall_flags_ 0(kp, j, ip), 0) .OR. &3670 .NOT. BTEST(wall_flags_ 0(kp, jp, i ), 0) ) &3671 IF ( .NOT. BTEST(wall_flags_static_0(k, jp, ip), 0) .OR. & 3672 .NOT. BTEST(wall_flags_static_0(kp, j, ip), 0) .OR. & 3673 .NOT. BTEST(wall_flags_static_0(kp, jp, i ), 0) ) & 3671 3674 THEN 3672 3675 subbox_at_wall = .TRUE. … … 4763 4766 IF ( reach_x(t_index) .AND. & 4764 4767 ABS( pos_x - xwall ) < eps .AND. & 4765 .NOT. BTEST(wall_flags_ 0(k3,j3,i3),0) .AND. &4768 .NOT. BTEST(wall_flags_static_0(k3,j3,i3),0) .AND. & 4766 4769 .NOT. reflect_x ) THEN 4767 4770 ! … … 4803 4806 IF ( reach_y(t_index) .AND. & 4804 4807 ABS( pos_y - ywall ) < eps .AND. & 4805 .NOT. BTEST(wall_flags_ 0(k3,j3,i3),0) .AND. &4808 .NOT. BTEST(wall_flags_static_0(k3,j3,i3),0) .AND. & 4806 4809 .NOT. reflect_y ) THEN 4807 4810 ! … … 4843 4846 IF ( reach_z(t_index) .AND. & 4844 4847 ABS( pos_z - zwall ) < eps .AND. & 4845 .NOT. BTEST(wall_flags_ 0(k3,j3,i3),0) .AND. &4848 .NOT. BTEST(wall_flags_static_0(k3,j3,i3),0) .AND. & 4846 4849 .NOT. reflect_z ) THEN 4847 4850 ! … … 5201 5204 ! 5202 5205 !-- Predetermine flag to mask topography 5203 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )5206 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 5204 5207 5205 5208 q(k,j,i) = q_p(k,j,i) - ql_c(k,j,i) * flag … … 5231 5234 ! 5232 5235 !-- Predetermine flag to mask topography 5233 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )5236 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 5234 5237 5235 5238 q(k,j,i) = q(k,j,i) - ql_c(k,j,i) * flag
Note: See TracChangeset
for help on using the changeset viewer.
