Changeset 4346 for palm/trunk/SOURCE/chemistry_model_mod.f90
- Timestamp:
- Dec 18, 2019 11:55:56 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/chemistry_model_mod.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r4329 r4346 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Introduction of wall_flags_total_0, which currently sets bits based on static 30 ! topography information used in wall_flags_static_0 31 ! 32 ! 4329 2019-12-10 15:46:36Z motisi 29 33 ! Renamed wall_flags_0 to wall_flags_static_0 30 34 ! … … 249 253 USE indices, & 250 254 ONLY: advc_flags_s, & 251 nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt, wall_flags_static_0 255 nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt, & 256 wall_flags_total_0 252 257 253 258 USE pegrid, & … … 920 925 DO j = nysg, nyng 921 926 DO k = nzb+1, nzt 922 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )927 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 923 928 cs_3d(k,j,i) = cs_pr_init(k) * flag 924 929 ENDDO … … 945 950 DO j = nysg, nyng 946 951 DO k = nzb+1, nzt 947 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )952 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 948 953 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 949 954 ENDDO … … 982 987 DO j = ss, ee 983 988 DO k = nzb+1, nzt 984 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )989 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 985 990 cs_3d(k,j,i) = cs_pr_init(k) * flag 986 991 ENDDO … … 1008 1013 DO j = ss, ee 1009 1014 DO k = nzb+1, nzt 1010 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )1015 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1011 1016 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 1012 1017 ENDDO … … 1331 1336 chem_species(lsp)%conc(k,j,i), & 1332 1337 REAL( fill_value, KIND = wp ), & 1333 BTEST( wall_flags_ static_0(k,j,i), 0 ) )1338 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1334 1339 ENDDO 1335 1340 ENDDO … … 1343 1348 chem_species(lsp)%conc_av(k,j,i), & 1344 1349 REAL( fill_value, KIND = wp ), & 1345 BTEST( wall_flags_ static_0(k,j,i), 0 ) )1350 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1346 1351 ENDDO 1347 1352 ENDDO … … 1439 1444 chem_species(lsp)%conc(k,j,i), & 1440 1445 REAL( fill_value, KIND = wp ), & 1441 BTEST( wall_flags_ static_0(k,j,i), 0 ) )1446 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1442 1447 ENDDO 1443 1448 ENDDO … … 1452 1457 chem_species(lsp)%conc_av(k,j,i),& 1453 1458 REAL( fill_value, KIND = wp ), & 1454 BTEST( wall_flags_ static_0(k,j,i), 0 ) )1459 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1455 1460 ENDDO 1456 1461 ENDDO … … 1532 1537 im = mask_i(mid,i) 1533 1538 jm = mask_j(mid,j) 1534 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_ static_0(:,jm,im), 5 )), DIM = 1 ) - 11539 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), DIM = 1 ) - 1 1535 1540 DO k = 1, mask_size_l(mid,3) 1536 1541 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 1537 1542 !-- Set value if not in building 1538 IF ( BTEST( wall_flags_ static_0(kk,jm,im), 6 ) ) THEN1543 IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN 1539 1544 local_pf(i,j,k) = fill_value 1540 1545 ELSE … … 1568 1573 im = mask_i(mid,i) 1569 1574 jm = mask_j(mid,j) 1570 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_ static_0(:,jm,im), 5 )), DIM = 1 ) - 11575 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), DIM = 1 ) - 1 1571 1576 DO k = 1, mask_size_l(mid,3) 1572 1577 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) 1573 1578 !-- Set value if not in building 1574 IF ( BTEST( wall_flags_ static_0(kk,jm,im), 6 ) ) THEN1579 IF ( BTEST( wall_flags_total_0(kk,jm,im), 6 ) ) THEN 1575 1580 local_pf(i,j,k) = fill_value 1576 1581 ELSE … … 1895 1900 ALLOCATE( cs_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1896 1901 ! 1897 !-- In case of decyling, set Neumann boundary conditions for wall_flags_ static_01902 !-- In case of decyling, set Neumann boundary conditions for wall_flags_total_0 1898 1903 !-- bit 31 instead of cyclic boundary conditions. 1899 1904 !-- Bit 31 is used to identify extended degradation zones (please see … … 1901 1906 !-- Note, since several also other modules like Salsa or other future 1902 1907 !-- one may access this bit but may have other boundary conditions, the 1903 !-- original value of wall_flags_ static_0 bit 31 must not be modified. Hence,1908 !-- original value of wall_flags_total_0 bit 31 must not be modified. Hence, 1904 1909 !-- store the boundary conditions directly on cs_advc_flags_s. 1905 1910 !-- cs_advc_flags_s will be later overwritten in ws_init_flags_scalar and … … 1908 1913 cs_advc_flags_s = 0 1909 1914 cs_advc_flags_s = MERGE( IBSET( cs_advc_flags_s, 31 ), 0, & 1910 BTEST( wall_flags_ static_0, 31 ) )1915 BTEST( wall_flags_total_0, 31 ) ) 1911 1916 1912 1917 IF ( decycle_chem_ns ) THEN … … 2748 2753 * ( chem_species(ilsp)%conc(k,j,i) - chem_species(ilsp)%conc_pr_init(k) ) & 2749 2754 ) & 2750 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )2755 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 2751 2756 2752 2757 IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp ) THEN … … 2858 2863 ) & 2859 2864 * MERGE( 1.0_wp, 0.0_wp, & 2860 BTEST( wall_flags_ static_0(k,j,i), 0 )&2865 BTEST( wall_flags_total_0(k,j,i), 0 ) & 2861 2866 ) 2862 2867 … … 3000 3005 rmask(j,i,sr) * & 3001 3006 MERGE( 1.0_wp, 0.0_wp, & 3002 BTEST( wall_flags_ static_0(k,j,i), 22 ) )3007 BTEST( wall_flags_total_0(k,j,i), 22 ) ) 3003 3008 ENDDO 3004 3009 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
