Changeset 4346 for palm/trunk/SOURCE/bulk_cloud_model_mod.f90
- Timestamp:
- Dec 18, 2019 11:55:56 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90 (modified) (40 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r4329 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 ! 4329 2019-12-10 15:46:36Z motisi 27 31 ! Renamed wall_flags_0 to wall_flags_static_0 28 32 ! … … 144 148 nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt, & 145 149 topo_top_ind, & 146 wall_flags_ static_0150 wall_flags_total_0 147 151 148 152 USE kinds … … 152 156 153 157 USE statistics, & 154 ONLY: weight_pres, weight_substep, sums_wsncs_ws_l, sums_wsnrs_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l 158 ONLY: weight_pres, weight_substep, sums_wsncs_ws_l, sums_wsnrs_ws_l, & 159 sums_wsqcs_ws_l, sums_wsqrs_ws_l 155 160 156 161 USE surface_mod, & … … 1399 1404 ) & 1400 1405 * MERGE( 1.0_wp, 0.0_wp, & 1401 BTEST( wall_flags_static_0(k,j,i), 0 ) &1406 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1402 1407 ) 1403 1408 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp … … 1489 1494 ) & 1490 1495 * MERGE( 1.0_wp, 0.0_wp, & 1491 BTEST( wall_flags_static_0(k,j,i), 0 ) &1496 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1492 1497 ) 1493 1498 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp … … 1586 1591 ) & 1587 1592 * MERGE( 1.0_wp, 0.0_wp, & 1588 BTEST( wall_flags_static_0(k,j,i), 0 ) &1593 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1589 1594 ) 1590 1595 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp … … 1676 1681 ) & 1677 1682 * MERGE( 1.0_wp, 0.0_wp, & 1678 BTEST( wall_flags_static_0(k,j,i), 0 ) &1683 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1679 1684 ) 1680 1685 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp … … 1773 1778 ) & 1774 1779 * MERGE( 1.0_wp, 0.0_wp, & 1775 BTEST( wall_flags_static_0(k,j,i), 0 )&1780 BTEST( wall_flags_total_0(k,j,i), 0 )& 1776 1781 ) 1777 1782 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp … … 1832 1837 ) & 1833 1838 * MERGE( 1.0_wp, 0.0_wp, & 1834 BTEST( wall_flags_static_0(k,j,i), 0 )&1839 BTEST( wall_flags_total_0(k,j,i), 0 )& 1835 1840 ) 1836 1841 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp … … 1897 1902 ) & 1898 1903 * MERGE( 1.0_wp, 0.0_wp, & 1899 BTEST( wall_flags_static_0(k,j,i), 0 )&1904 BTEST( wall_flags_total_0(k,j,i), 0 )& 1900 1905 ) 1901 1906 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp … … 1956 1961 ) & 1957 1962 * MERGE( 1.0_wp, 0.0_wp, & 1958 BTEST( wall_flags_static_0(k,j,i), 0 )&1963 BTEST( wall_flags_total_0(k,j,i), 0 )& 1959 1964 ) 1960 1965 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp … … 2502 2507 DO k = nzb_do, nzt_do 2503 2508 local_pf(i,j,k) = MERGE( & 2504 to_be_resorted(k,j,i), &2505 REAL( fill_value, KIND = wp ), &2506 BTEST( wall_flags_ static_0(k,j,i), flag_nr )&2509 to_be_resorted(k,j,i), & 2510 REAL( fill_value, KIND = wp ), & 2511 BTEST( wall_flags_total_0(k,j,i), flag_nr ) & 2507 2512 ) 2508 2513 ENDDO … … 2643 2648 DO j = nys, nyn 2644 2649 DO k = nzb_do, nzt_do 2645 local_pf(i,j,k) = MERGE( &2646 to_be_resorted(k,j,i), &2647 REAL( fill_value, KIND = wp ), &2648 BTEST( wall_flags_ static_0(k,j,i), flag_nr )&2650 local_pf(i,j,k) = MERGE( & 2651 to_be_resorted(k,j,i), & 2652 REAL( fill_value, KIND = wp ), & 2653 BTEST( wall_flags_total_0(k,j,i), flag_nr ) & 2649 2654 ) 2650 2655 ENDDO … … 3046 3051 ! 3047 3052 !-- Predetermine flag to mask topography 3048 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3053 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3049 3054 3050 3055 IF ( qr(k,j,i) <= eps_sb ) THEN … … 3100 3105 ! 3101 3106 !-- Predetermine flag to mask topography 3102 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3107 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3103 3108 3104 3109 IF ( qr(k,j,i) <= eps_sb ) THEN … … 3168 3173 ! 3169 3174 !-- Predetermine flag to mask topography 3170 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3175 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3171 3176 3172 3177 ! … … 3269 3274 ! 3270 3275 !-- Predetermine flag to mask topography 3271 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3276 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3272 3277 ! 3273 3278 !-- Call calculation of supersaturation … … 3369 3374 ! 3370 3375 !-- Predetermine flag to mask topography 3371 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3376 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3372 3377 ! 3373 3378 !-- Call calculation of supersaturation … … 3456 3461 ! 3457 3462 !-- Predetermine flag to mask topography 3458 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3463 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3459 3464 ! 3460 3465 !-- Call calculation of supersaturation … … 3545 3550 ! 3546 3551 !-- Predetermine flag to mask topography 3547 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3552 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3548 3553 3549 3554 IF ( microphysics_morrison ) THEN … … 3671 3676 ! 3672 3677 !-- Predetermine flag to mask topography 3673 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3678 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3674 3679 IF ( microphysics_morrison ) THEN 3675 3680 nc_auto = nc(k,j,i) … … 3782 3787 ! 3783 3788 !-- Predetermine flag to mask topography 3784 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3789 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3785 3790 3786 3791 IF ( qc(k,j,i) > ql_crit ) THEN … … 3829 3834 ! 3830 3835 !-- Predetermine flag to mask topography 3831 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3836 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3832 3837 3833 3838 IF ( qc(k,j,i) > ql_crit ) THEN … … 3880 3885 ! 3881 3886 !-- Predetermine flag to mask topography 3882 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3887 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3883 3888 3884 3889 IF ( microphysics_morrison ) THEN … … 3961 3966 ! 3962 3967 !-- Predetermine flag to mask topography 3963 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )3968 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3964 3969 IF ( microphysics_morrison ) THEN 3965 3970 nc_accr = nc(k,j,i) … … 4041 4046 ! 4042 4047 !-- Predetermine flag to mask topography 4043 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4048 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4044 4049 4045 4050 IF ( qr(k,j,i) > eps_sb ) THEN … … 4096 4101 ! 4097 4102 !-- Predetermine flag to mask topography 4098 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4103 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4099 4104 4100 4105 IF ( qr(k,j,i) > eps_sb ) THEN … … 4158 4163 ! 4159 4164 !-- Predetermine flag to mask topography 4160 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4165 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4161 4166 4162 4167 IF ( qr(k,j,i) > eps_sb ) THEN … … 4280 4285 ! 4281 4286 !-- Predetermine flag to mask topography 4282 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4287 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4283 4288 4284 4289 IF ( qr(k,j,i) > eps_sb ) THEN … … 4394 4399 ! 4395 4400 !-- Predetermine flag to mask topography 4396 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4401 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4397 4402 4398 4403 IF ( microphysics_morrison ) THEN … … 4488 4493 ! 4489 4494 !-- Predetermine flag to mask topography 4490 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4495 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4491 4496 IF ( microphysics_morrison ) THEN 4492 4497 nc_sedi = nc(k,j,i) … … 4594 4599 ! 4595 4600 !-- Predetermine flag to mask topography 4596 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4601 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4597 4602 4598 4603 IF ( qr(k,j,i) > eps_sb ) THEN … … 4659 4664 ! 4660 4665 !-- Predetermine flag to mask topography 4661 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4666 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4662 4667 4663 4668 c_nr(k) = 0.25_wp * ( w_nr(k-1) + & … … 4675 4680 ! 4676 4681 !-- Predetermine flag to mask topography 4677 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4682 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4678 4683 4679 4684 d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) ) … … 4709 4714 ! 4710 4715 !-- Predetermine flag to mask topography 4711 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4716 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4712 4717 ! 4713 4718 !-- Sum up all rain drop number densities which contribute to the flux … … 4836 4841 ! 4837 4842 !-- Predetermine flag to mask topography 4838 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4843 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4839 4844 4840 4845 IF ( qr(k,j,i) > eps_sb ) THEN … … 4896 4901 ! 4897 4902 !-- Predetermine flag to mask topography 4898 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4903 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4899 4904 4900 4905 c_nr(k) = 0.25_wp * ( w_nr(k-1) + 2.0_wp * w_nr(k) + w_nr(k+1) ) * & … … 4910 4915 ! 4911 4916 !-- Predetermine flag to mask topography 4912 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4917 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4913 4918 4914 4919 d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) ) … … 4943 4948 ! 4944 4949 !-- Predetermine flag to mask topography 4945 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4950 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4946 4951 ! 4947 4952 !-- Sum up all rain drop number densities which contribute to the flux … … 5153 5158 ! 5154 5159 !-- Predetermine flag to mask topography 5155 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )5160 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5156 5161 5157 5162 !
Note: See TracChangeset
for help on using the changeset viewer.
