Changeset 4346 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Dec 18, 2019 11:55:56 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_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 ! … … 208 212 USE indices, & 209 213 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 210 nysv, nz, nzb, nzt, topo_top_ind, wall_flags_ static_0214 nysv, nz, nzb, nzt, topo_top_ind, wall_flags_total_0 211 215 212 216 USE bulk_cloud_model_mod, & … … 1529 1533 INTEGER(iwp) :: istart !< 1530 1534 INTEGER(iwp) :: ir !< 1531 INTEGER(iwp) :: iw !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_ static_01535 INTEGER(iwp) :: iw !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_total_0 1532 1536 INTEGER(iwp) :: j !< Child-grid index in the y-direction 1533 1537 INTEGER(iwp) :: jj !< Parent-grid index in the y-direction 1534 1538 INTEGER(iwp) :: jstart !< 1535 1539 INTEGER(iwp) :: jr !< 1536 INTEGER(iwp) :: jw !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_ static_01540 INTEGER(iwp) :: jw !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_total_0 1537 1541 INTEGER(iwp) :: k !< Child-grid index in the z-direction 1538 1542 INTEGER(iwp) :: kk !< Parent-grid index in the z-direction 1539 1543 INTEGER(iwp) :: kstart !< 1540 INTEGER(iwp) :: kw !< Child-grid index limited to kw <= nzt+1 for wall_flags_ static_01544 INTEGER(iwp) :: kw !< Child-grid index limited to kw <= nzt+1 for wall_flags_total_0 1541 1545 1542 1546 REAL(wp) :: tolex !< Tolerance for grid-line matching in x-direction … … 1779 1783 !-- Note that ii, jj, and kk are parent-grid indices. 1780 1784 !-- This information is needed in the anterpolation. 1781 !-- The indices for wall_flags_ static_0 (kw,jw,iw) must be limited to the range1785 !-- The indices for wall_flags_total_0 (kw,jw,iw) must be limited to the range 1782 1786 !-- [-1,...,nx/ny/nzt+1] in order to avoid zero values on the outer ghost nodes. 1783 1787 DO ii = ipla, ipra … … 1793 1797 kw = MIN( k, nzt+1 ) 1794 1798 ijkfc_u(kk,jj,ii) = ijkfc_u(kk,jj,ii) & 1795 + MERGE( 1, 0, BTEST( wall_flags_ static_0(kw,jw,iw), 1 ) )1799 + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 1 ) ) 1796 1800 ENDDO 1797 1801 ENDDO … … 1806 1810 kw = MIN( k, nzt+1 ) 1807 1811 ijkfc_v(kk,jj,ii) = ijkfc_v(kk,jj,ii) & 1808 + MERGE( 1, 0, BTEST( wall_flags_ static_0(kw,jw,iw), 2 ) )1812 + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 2 ) ) 1809 1813 ENDDO 1810 1814 ENDDO … … 1819 1823 kw = MIN( k, nzt+1 ) 1820 1824 ijkfc_s(kk,jj,ii) = ijkfc_s(kk,jj,ii) & 1821 + MERGE( 1, 0, BTEST( wall_flags_ static_0(kw,jw,iw), 0 ) )1825 + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 0 ) ) 1822 1826 ENDDO 1823 1827 ENDDO … … 1832 1836 kw = MIN( k, nzt+1 ) 1833 1837 ijkfc_w(kk,jj,ii) = ijkfc_w(kk,jj,ii) & 1834 + MERGE( 1, 0, BTEST( wall_flags_ static_0(kw,jw,iw), 3 ) )1838 + MERGE( 1, 0, BTEST( wall_flags_total_0(kw,jw,iw), 3 ) ) 1835 1839 ENDDO 1836 1840 ENDDO … … 2753 2757 DO jc = nysg, nyng 2754 2758 DO kc = nzb, nzt 2755 u(kc,jc,ic) = MERGE( u(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 1 ) )2756 v(kc,jc,ic) = MERGE( v(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 2 ) )2757 w(kc,jc,ic) = MERGE( w(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 3 ) )2758 u_p(kc,jc,ic) = MERGE( u_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 1 ) )2759 v_p(kc,jc,ic) = MERGE( v_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 2 ) )2760 w_p(kc,jc,ic) = MERGE( w_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ static_0(kc,jc,ic), 3 ) )2759 u(kc,jc,ic) = MERGE( u(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 1 ) ) 2760 v(kc,jc,ic) = MERGE( v(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 2 ) ) 2761 w(kc,jc,ic) = MERGE( w(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 3 ) ) 2762 u_p(kc,jc,ic) = MERGE( u_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 1 ) ) 2763 v_p(kc,jc,ic) = MERGE( v_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 2 ) ) 2764 w_p(kc,jc,ic) = MERGE( w_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_total_0(kc,jc,ic), 3 ) ) 2761 2765 ENDDO 2762 2766 ENDDO … … 3271 3275 DO j = nysg, nyng 3272 3276 DO k = nzb, nzt+1 3273 u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 1 ) )3274 v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 2 ) )3275 w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 3 ) )3277 u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 3278 v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 3279 w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) ) 3276 3280 ! 3277 3281 !-- TO_DO: zero setting of temperature within topography creates … … 4633 4637 DO kc = kfl(kp), kfu(kp) 4634 4638 cellsum = cellsum + MERGE( child_array(kc,jc,ic), 0.0_wp, & 4635 BTEST( wall_flags_ static_0(kc,jc,ic), var_flag ) )4639 BTEST( wall_flags_total_0(kc,jc,ic), var_flag ) ) 4636 4640 ENDDO 4637 4641 ENDDO … … 4924 4928 DO k = nzb+1, nzt 4925 4929 sub_sum = sub_sum + innor * u(k,j,i) * dzw(k) & 4926 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 1 ) )4930 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 4927 4931 ENDDO 4928 4932 volume_flux_local = volume_flux_local + sub_sum … … 4947 4951 DO k = nzb+1, nzt 4948 4952 sub_sum = sub_sum + innor * u(k,j,i) * dzw(k) & 4949 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 1 ) )4953 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 4950 4954 ENDDO 4951 4955 volume_flux_local = volume_flux_local + sub_sum … … 4970 4974 DO k = nzb+1, nzt 4971 4975 sub_sum = sub_sum + innor * v(k,j,i) * dzw(k) & 4972 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 2 ) )4976 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 4973 4977 ENDDO 4974 4978 volume_flux_local = volume_flux_local + sub_sum … … 4993 4997 DO k = nzb+1, nzt 4994 4998 sub_sum = sub_sum + innor * v(k,j,i) * dzw(k) & 4995 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 2 ) )4999 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 4996 5000 ENDDO 4997 5001 volume_flux_local = volume_flux_local + sub_sum … … 5063 5067 DO k = nzb + 1, nzt 5064 5068 u(k,j,i) = u(k,j,i) + u_corr_left & 5065 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 1 ) )5069 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 5066 5070 ENDDO 5067 5071 ENDDO … … 5075 5079 DO k = nzb + 1, nzt 5076 5080 u(k,j,i) = u(k,j,i) + u_corr_right & 5077 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 1 ) )5081 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) ) 5078 5082 ENDDO 5079 5083 ENDDO … … 5087 5091 DO k = nzb + 1, nzt 5088 5092 v(k,j,i) = v(k,j,i) + v_corr_south & 5089 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 2 ) )5093 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 5090 5094 ENDDO 5091 5095 ENDDO … … 5099 5103 DO k = nzb + 1, nzt 5100 5104 v(k,j,i) = v(k,j,i) + v_corr_north & 5101 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 2 ) )5105 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) ) 5102 5106 ENDDO 5103 5107 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.