Changeset 4329 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Dec 10, 2019 3:46:36 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r4273 r4329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Renamed wall_flags_0 to wall_flags_static_0 28 ! 29 ! 4273 2019-10-24 13:40:54Z monakurppa 27 30 ! Add a logical switch nesting_chem and rename nest_salsa to nesting_salsa 28 31 ! … … 205 208 USE indices, & 206 209 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 207 nysv, nz, nzb, nzt, topo_top_ind, wall_flags_ 0210 nysv, nz, nzb, nzt, topo_top_ind, wall_flags_static_0 208 211 209 212 USE bulk_cloud_model_mod, & … … 1526 1529 INTEGER(iwp) :: istart !< 1527 1530 INTEGER(iwp) :: ir !< 1528 INTEGER(iwp) :: iw !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_ 01531 INTEGER(iwp) :: iw !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_static_0 1529 1532 INTEGER(iwp) :: j !< Child-grid index in the y-direction 1530 1533 INTEGER(iwp) :: jj !< Parent-grid index in the y-direction 1531 1534 INTEGER(iwp) :: jstart !< 1532 1535 INTEGER(iwp) :: jr !< 1533 INTEGER(iwp) :: jw !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_ 01536 INTEGER(iwp) :: jw !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_static_0 1534 1537 INTEGER(iwp) :: k !< Child-grid index in the z-direction 1535 1538 INTEGER(iwp) :: kk !< Parent-grid index in the z-direction 1536 1539 INTEGER(iwp) :: kstart !< 1537 INTEGER(iwp) :: kw !< Child-grid index limited to kw <= nzt+1 for wall_flags_ 01540 INTEGER(iwp) :: kw !< Child-grid index limited to kw <= nzt+1 for wall_flags_static_0 1538 1541 1539 1542 REAL(wp) :: tolex !< Tolerance for grid-line matching in x-direction … … 1776 1779 !-- Note that ii, jj, and kk are parent-grid indices. 1777 1780 !-- This information is needed in the anterpolation. 1778 !-- The indices for wall_flags_ 0 (kw,jw,iw) must be limited to the range1781 !-- The indices for wall_flags_static_0 (kw,jw,iw) must be limited to the range 1779 1782 !-- [-1,...,nx/ny/nzt+1] in order to avoid zero values on the outer ghost nodes. 1780 1783 DO ii = ipla, ipra … … 1790 1793 kw = MIN( k, nzt+1 ) 1791 1794 ijkfc_u(kk,jj,ii) = ijkfc_u(kk,jj,ii) & 1792 + MERGE( 1, 0, BTEST( wall_flags_ 0(kw,jw,iw), 1 ) )1795 + MERGE( 1, 0, BTEST( wall_flags_static_0(kw,jw,iw), 1 ) ) 1793 1796 ENDDO 1794 1797 ENDDO … … 1803 1806 kw = MIN( k, nzt+1 ) 1804 1807 ijkfc_v(kk,jj,ii) = ijkfc_v(kk,jj,ii) & 1805 + MERGE( 1, 0, BTEST( wall_flags_ 0(kw,jw,iw), 2 ) )1808 + MERGE( 1, 0, BTEST( wall_flags_static_0(kw,jw,iw), 2 ) ) 1806 1809 ENDDO 1807 1810 ENDDO … … 1816 1819 kw = MIN( k, nzt+1 ) 1817 1820 ijkfc_s(kk,jj,ii) = ijkfc_s(kk,jj,ii) & 1818 + MERGE( 1, 0, BTEST( wall_flags_ 0(kw,jw,iw), 0 ) )1821 + MERGE( 1, 0, BTEST( wall_flags_static_0(kw,jw,iw), 0 ) ) 1819 1822 ENDDO 1820 1823 ENDDO … … 1829 1832 kw = MIN( k, nzt+1 ) 1830 1833 ijkfc_w(kk,jj,ii) = ijkfc_w(kk,jj,ii) & 1831 + MERGE( 1, 0, BTEST( wall_flags_ 0(kw,jw,iw), 3 ) )1834 + MERGE( 1, 0, BTEST( wall_flags_static_0(kw,jw,iw), 3 ) ) 1832 1835 ENDDO 1833 1836 ENDDO … … 2750 2753 DO jc = nysg, nyng 2751 2754 DO kc = nzb, nzt 2752 u(kc,jc,ic) = MERGE( u(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 1 ) )2753 v(kc,jc,ic) = MERGE( v(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 2 ) )2754 w(kc,jc,ic) = MERGE( w(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 3 ) )2755 u_p(kc,jc,ic) = MERGE( u_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 1 ) )2756 v_p(kc,jc,ic) = MERGE( v_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 2 ) )2757 w_p(kc,jc,ic) = MERGE( w_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_ 0(kc,jc,ic), 3 ) )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 ) ) 2758 2761 ENDDO 2759 2762 ENDDO … … 3268 3271 DO j = nysg, nyng 3269 3272 DO k = nzb, nzt+1 3270 u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 1 ) )3271 v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 2 ) )3272 w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 3 ) )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 ) ) 3273 3276 ! 3274 3277 !-- TO_DO: zero setting of temperature within topography creates … … 4630 4633 DO kc = kfl(kp), kfu(kp) 4631 4634 cellsum = cellsum + MERGE( child_array(kc,jc,ic), 0.0_wp, & 4632 BTEST( wall_flags_ 0(kc,jc,ic), var_flag ) )4635 BTEST( wall_flags_static_0(kc,jc,ic), var_flag ) ) 4633 4636 ENDDO 4634 4637 ENDDO … … 4921 4924 DO k = nzb+1, nzt 4922 4925 sub_sum = sub_sum + innor * u(k,j,i) * dzw(k) & 4923 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 1 ) )4926 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 1 ) ) 4924 4927 ENDDO 4925 4928 volume_flux_local = volume_flux_local + sub_sum … … 4944 4947 DO k = nzb+1, nzt 4945 4948 sub_sum = sub_sum + innor * u(k,j,i) * dzw(k) & 4946 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 1 ) )4949 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 1 ) ) 4947 4950 ENDDO 4948 4951 volume_flux_local = volume_flux_local + sub_sum … … 4967 4970 DO k = nzb+1, nzt 4968 4971 sub_sum = sub_sum + innor * v(k,j,i) * dzw(k) & 4969 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 2 ) )4972 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 2 ) ) 4970 4973 ENDDO 4971 4974 volume_flux_local = volume_flux_local + sub_sum … … 4990 4993 DO k = nzb+1, nzt 4991 4994 sub_sum = sub_sum + innor * v(k,j,i) * dzw(k) & 4992 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 2 ) )4995 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 2 ) ) 4993 4996 ENDDO 4994 4997 volume_flux_local = volume_flux_local + sub_sum … … 5060 5063 DO k = nzb + 1, nzt 5061 5064 u(k,j,i) = u(k,j,i) + u_corr_left & 5062 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 1 ) )5065 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 1 ) ) 5063 5066 ENDDO 5064 5067 ENDDO … … 5072 5075 DO k = nzb + 1, nzt 5073 5076 u(k,j,i) = u(k,j,i) + u_corr_right & 5074 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 1 ) )5077 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 1 ) ) 5075 5078 ENDDO 5076 5079 ENDDO … … 5084 5087 DO k = nzb + 1, nzt 5085 5088 v(k,j,i) = v(k,j,i) + v_corr_south & 5086 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 2 ) )5089 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 2 ) ) 5087 5090 ENDDO 5088 5091 ENDDO … … 5096 5099 DO k = nzb + 1, nzt 5097 5100 v(k,j,i) = v(k,j,i) + v_corr_north & 5098 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 2 ) )5101 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 2 ) ) 5099 5102 ENDDO 5100 5103 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
