Changeset 2317 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Jul 20, 2017 5:27:19 PM (8 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (46 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2311 r2317 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Get topography top index via Function call 24 24 ! 25 25 ! Former revisions: … … 192 192 USE indices, & 193 193 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 194 nysv, nz, nzb, nz b_max, nzt, wall_flags_0194 nysv, nz, nzb, nzt, wall_flags_0 195 195 196 196 USE kinds … … 233 233 234 234 USE surface_mod, & 235 ONLY: surf_def_h, surf_lsm_h, surf_usm_h235 ONLY: get_topography_top_index, surf_def_h, surf_lsm_h, surf_usm_h 236 236 237 237 IMPLICIT NONE … … 1394 1394 !-- Determine largest topography index on scalar grid 1395 1395 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1396 MAXLOC( & 1397 MERGE( 1, 0, & 1398 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1399 ), DIM = 1 & 1400 ) - 1 ) 1396 get_topography_top_index( j, i, 's' ) ) 1401 1397 ! 1402 1398 !-- Determine largest topography index on u grid 1403 1399 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1404 MAXLOC( & 1405 MERGE( 1, 0, & 1406 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1407 ), DIM = 1 & 1408 ) - 1 ) 1400 get_topography_top_index( j, i, 'u' ) ) 1409 1401 ! 1410 1402 !-- Determine largest topography index on v grid 1411 1403 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1412 MAXLOC( & 1413 MERGE( 1, 0, & 1414 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1415 ), DIM = 1 & 1416 ) - 1 ) 1404 get_topography_top_index( j, i, 'v' ) ) 1417 1405 ! 1418 1406 !-- Determine largest topography index on w grid 1419 1407 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1420 MAXLOC( & 1421 MERGE( 1, 0, & 1422 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1423 ), DIM = 1 & 1424 ) - 1 ) 1408 get_topography_top_index( j, i, 'w' ) ) 1425 1409 ENDDO 1426 1410 ENDDO … … 1436 1420 !-- Determine largest topography index on scalar grid 1437 1421 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1438 MAXLOC( & 1439 MERGE( 1, 0, & 1440 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1441 ), DIM = 1 & 1442 ) - 1 ) 1422 get_topography_top_index( j, i, 's' ) ) 1443 1423 ! 1444 1424 !-- Determine largest topography index on u grid 1445 1425 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1446 MAXLOC( & 1447 MERGE( 1, 0, & 1448 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1449 ), DIM = 1 & 1450 ) - 1 ) 1426 get_topography_top_index( j, i, 'u' ) ) 1451 1427 ! 1452 1428 !-- Determine largest topography index on v grid 1453 1429 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1454 MAXLOC( & 1455 MERGE( 1, 0, & 1456 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1457 ), DIM = 1 & 1458 ) - 1 ) 1430 get_topography_top_index( j, i, 'v' ) ) 1459 1431 ! 1460 1432 !-- Determine largest topography index on w grid 1461 1433 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1462 MAXLOC( & 1463 MERGE( 1, 0, & 1464 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1465 ), DIM = 1 & 1466 ) - 1 ) 1434 get_topography_top_index( j, i, 'w' ) ) 1467 1435 ENDDO 1468 1436 nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1 … … 1477 1445 !-- Determine largest topography index on scalar grid 1478 1446 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1479 MAXLOC( & 1480 MERGE( 1, 0, & 1481 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1482 ), DIM = 1 & 1483 ) - 1 ) 1447 get_topography_top_index( j, i, 's' ) ) 1484 1448 ! 1485 1449 !-- Determine largest topography index on u grid 1486 1450 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1487 MAXLOC( & 1488 MERGE( 1, 0, & 1489 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1490 ), DIM = 1 & 1491 ) - 1 ) 1451 get_topography_top_index( j, i, 'u' ) ) 1492 1452 ! 1493 1453 !-- Determine largest topography index on v grid 1494 1454 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1495 MAXLOC( & 1496 MERGE( 1, 0, & 1497 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1498 ), DIM = 1 & 1499 ) - 1 ) 1455 get_topography_top_index( j, i, 'v' ) ) 1500 1456 ! 1501 1457 !-- Determine largest topography index on w grid 1502 1458 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1503 MAXLOC( & 1504 MERGE( 1, 0, & 1505 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1506 ), DIM = 1 & 1507 ) - 1 ) 1459 get_topography_top_index( j, i, 'w' ) ) 1508 1460 ENDDO 1509 1461 ENDDO … … 1519 1471 !-- Determine largest topography index on scalar grid 1520 1472 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1521 MAXLOC( & 1522 MERGE( 1, 0, & 1523 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1524 ), DIM = 1 & 1525 ) - 1 ) 1473 get_topography_top_index( j, i, 's' ) ) 1526 1474 ! 1527 1475 !-- Determine largest topography index on u grid 1528 1476 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1529 MAXLOC( & 1530 MERGE( 1, 0, & 1531 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1532 ), DIM = 1 & 1533 ) - 1 ) 1477 get_topography_top_index( j, i, 'u' ) ) 1534 1478 ! 1535 1479 !-- Determine largest topography index on v grid 1536 1480 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1537 MAXLOC( & 1538 MERGE( 1, 0, & 1539 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1540 ), DIM = 1 & 1541 ) - 1 ) 1481 get_topography_top_index( j, i, 'v' ) ) 1542 1482 ! 1543 1483 !-- Determine largest topography index on w grid 1544 1484 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1545 MAXLOC( & 1546 MERGE( 1, 0, & 1547 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1548 ), DIM = 1 & 1549 ) - 1 ) 1485 get_topography_top_index( j, i, 'w' ) ) 1550 1486 ENDDO 1551 1487 nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1 … … 1603 1539 !-- is part of the surfacetypes now. Set default roughness instead. 1604 1540 !-- Determine topography top index on u-grid 1605 kb = MAXLOC( MERGE( 1, 0, & 1606 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1607 ), DIM = 1 & 1608 ) - 1 1541 kb = get_topography_top_index( j, i, 'u' ) 1609 1542 k = kb + 1 1610 1543 wall_index = kb … … 1622 1555 ! 1623 1556 !-- Determine topography top index on v-grid 1624 kb = MAXLOC( MERGE( 1, 0, & 1625 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1626 ), DIM = 1 & 1627 ) - 1 1557 kb = get_topography_top_index( j, i, 'v' ) 1628 1558 k = kb + 1 1629 1559 wall_index = kb … … 1669 1599 !-- to the present surface tpye. 1670 1600 !-- Determine topography top index on u-grid 1671 kb = MAXLOC( MERGE( 1, 0, & 1672 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1673 ), DIM = 1 & 1674 ) - 1 1601 kb = get_topography_top_index( j, i, 'u' ) 1675 1602 k = kb + 1 1676 1603 wall_index = kb … … 1688 1615 ! 1689 1616 !-- Determine topography top index on v-grid 1690 kb = MAXLOC( MERGE( 1, 0, & 1691 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1692 ), DIM = 1 & 1693 ) - 1 1617 kb = get_topography_top_index( j, i, 'v' ) 1694 1618 k = kb + 1 1695 1619 wall_index = kb … … 1732 1656 ! 1733 1657 !-- Determine topography top index on u-grid 1734 kb = MAXLOC( MERGE( 1, 0, & 1735 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1736 ), DIM = 1 & 1737 ) - 1 1658 kb = get_topography_top_index( j, i, 'u' ) 1738 1659 k = kb + 1 1739 1660 wall_index = kb … … 1751 1672 ! 1752 1673 !-- Determine topography top index on v-grid 1753 kb = MAXLOC( MERGE( 1, 0, & 1754 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1755 ), DIM = 1 & 1756 ) - 1 1674 kb = get_topography_top_index( j, i, 'v' ) 1757 1675 k = kb + 1 1758 1676 wall_index = kb … … 1794 1712 j = nyn + 1 1795 1713 ! 1796 !-- Determine topography top index on v-grid 1797 kb = MAXLOC( MERGE( 1, 0, & 1798 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 14 ) & 1799 ), DIM = 1 & 1800 ) - 1 1714 !-- Determine topography top index on u-grid 1715 kb = get_topography_top_index( j, i, 'u' ) 1801 1716 k = kb + 1 1802 1717 wall_index = kb … … 1814 1729 ! 1815 1730 !-- Determine topography top index on v-grid 1816 kb = MAXLOC( MERGE( 1, 0, & 1817 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,i), 16 ) & 1818 ), DIM = 1 & 1819 ) - 1 1731 kb = get_topography_top_index( j, i, 'v' ) 1820 1732 k = kb + 1 1821 1733 wall_index = kb … … 1856 1768 1857 1769 DO j = nys, nyn 1858 k_wall_u_ji = MAXLOC( & 1859 MERGE( 1, 0, & 1860 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,0), 26 ) & 1861 ), DIM = 1 & 1862 ) - 1 1863 k_wall_u_ji_p = MAXLOC( & 1864 MERGE( 1, 0, & 1865 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,0), 26 )& 1866 ), DIM = 1 & 1867 ) - 1 1868 k_wall_u_ji_m = MAXLOC( & 1869 MERGE( 1, 0, & 1870 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,0), 26 )& 1871 ), DIM = 1 & 1872 ) - 1 1873 1874 k_wall_w_ji = MAXLOC( & 1875 MERGE( 1, 0, & 1876 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,-1), 28 )& 1877 ), DIM = 1 & 1878 ) - 1 1879 k_wall_w_ji_p = MAXLOC( & 1880 MERGE( 1, 0, & 1881 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,-1), 28 )& 1882 ), DIM = 1 & 1883 ) - 1 1884 k_wall_w_ji_m = MAXLOC( & 1885 MERGE( 1, 0, & 1886 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,-1), 28 )& 1887 ), DIM = 1 & 1888 ) - 1 1770 ! 1771 !-- Determine lowest grid on outer grids for u and w. 1772 k_wall_u_ji = get_topography_top_index( j, 0, 'u_out' ) 1773 k_wall_u_ji_p = get_topography_top_index( j+1, 0, 'u_out' ) 1774 k_wall_u_ji_m = get_topography_top_index( j-1, 0, 'u_out' ) 1775 1776 k_wall_w_ji = get_topography_top_index( j, -1, 'w_out' ) 1777 k_wall_w_ji_p = get_topography_top_index( j+1, -1, 'w_out' ) 1778 k_wall_w_ji_m = get_topography_top_index( j-1, -1, 'w_out' ) 1889 1779 1890 1780 DO k = nzb, nzt_topo_nestbc_l … … 1971 1861 1972 1862 DO j = nys, nyn 1973 1974 k_wall_u_ji = MAXLOC( & 1975 MERGE( 1, 0, & 1976 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 26 ) & 1977 ), DIM = 1 & 1978 ) - 1 1979 k_wall_u_ji_p = MAXLOC( & 1980 MERGE( 1, 0, & 1981 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 26 )& 1982 ), DIM = 1 & 1983 ) - 1 1984 k_wall_u_ji_m = MAXLOC( & 1985 MERGE( 1, 0, & 1986 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 26 )& 1987 ), DIM = 1 & 1988 ) - 1 1989 1990 k_wall_w_ji = MAXLOC( & 1991 MERGE( 1, 0, & 1992 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 28 ) & 1993 ), DIM = 1 & 1994 ) - 1 1995 k_wall_w_ji_p = MAXLOC( & 1996 MERGE( 1, 0, & 1997 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 28 )& 1998 ), DIM = 1 & 1999 ) - 1 2000 k_wall_w_ji_m = MAXLOC( & 2001 MERGE( 1, 0, & 2002 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 28 )& 2003 ), DIM = 1 & 2004 ) - 1 1863 ! 1864 !-- Determine lowest grid on outer grids for u and w. 1865 k_wall_u_ji = get_topography_top_index( j, i, 'u_out' ) 1866 k_wall_u_ji_p = get_topography_top_index( j+1, i, 'u_out' ) 1867 k_wall_u_ji_m = get_topography_top_index( j-1, i, 'u_out' ) 1868 1869 k_wall_w_ji = get_topography_top_index( j, i, 'w_out' ) 1870 k_wall_w_ji_p = get_topography_top_index( j+1, i, 'w_out' ) 1871 k_wall_w_ji_m = get_topography_top_index( j-1, i, 'w_out' ) 1872 2005 1873 DO k = nzb, nzt_topo_nestbc_r 2006 1874 ! … … 2081 1949 2082 1950 DO i = nxl, nxr 2083 2084 k_wall_v_ji = MAXLOC( & 2085 MERGE( 1, 0, & 2086 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i), 27 ) & 2087 ), DIM = 1 & 2088 ) - 1 2089 k_wall_v_ji_p = MAXLOC( & 2090 MERGE( 1, 0, & 2091 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i+1), 27 )& 2092 ), DIM = 1 & 2093 ) - 1 2094 k_wall_v_ji_m = MAXLOC( & 2095 MERGE( 1, 0, & 2096 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i-1), 27 )& 2097 ), DIM = 1 & 2098 ) - 1 2099 2100 k_wall_w_ji = MAXLOC( & 2101 MERGE( 1, 0, & 2102 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i), 28 )& 2103 ), DIM = 1 & 2104 ) - 1 2105 k_wall_w_ji_p = MAXLOC( & 2106 MERGE( 1, 0, & 2107 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i+1), 28 )& 2108 ), DIM = 1 & 2109 ) - 1 2110 k_wall_w_ji_m = MAXLOC( & 2111 MERGE( 1, 0, & 2112 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i-1), 28 )& 2113 ), DIM = 1 & 2114 ) - 1 1951 ! 1952 !-- Determine lowest grid on outer grids for v and w. 1953 k_wall_v_ji = get_topography_top_index( 0, i, 'v_out' ) 1954 k_wall_v_ji_p = get_topography_top_index( 0, i+1, 'v_out' ) 1955 k_wall_v_ji_m = get_topography_top_index( 0, i-1, 'v_out' ) 1956 1957 k_wall_w_ji = get_topography_top_index( -1, i, 'w_out' ) 1958 k_wall_w_ji_p = get_topography_top_index( -1, i+1, 'w_out' ) 1959 k_wall_w_ji_m = get_topography_top_index( -1, i-1, 'w_out' ) 1960 2115 1961 DO k = nzb, nzt_topo_nestbc_s 2116 1962 ! … … 2195 2041 2196 2042 DO i = nxl, nxr 2197 k_wall_v_ji = MAXLOC( & 2198 MERGE( 1, 0, & 2199 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 27 ) & 2200 ), DIM = 1 & 2201 ) - 1 2202 2203 k_wall_v_ji_p = MAXLOC( & 2204 MERGE( 1, 0, & 2205 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 27 )& 2206 ), DIM = 1 & 2207 ) - 1 2208 k_wall_v_ji_m = MAXLOC( & 2209 MERGE( 1, 0, & 2210 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 27 )& 2211 ), DIM = 1 & 2212 ) - 1 2213 2214 k_wall_w_ji = MAXLOC( & 2215 MERGE( 1, 0, & 2216 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 28 ) & 2217 ), DIM = 1 & 2218 ) - 1 2219 k_wall_w_ji_p = MAXLOC( & 2220 MERGE( 1, 0, & 2221 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 28 )& 2222 ), DIM = 1 & 2223 ) - 1 2224 k_wall_w_ji_m = MAXLOC( & 2225 MERGE( 1, 0, & 2226 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 28 )& 2227 ), DIM = 1 & 2228 ) - 1 2043 ! 2044 !-- Determine lowest grid on outer grids for v and w. 2045 k_wall_v_ji = get_topography_top_index( j, i, 'v_out' ) 2046 k_wall_v_ji_p = get_topography_top_index( j, i+1, 'v_out' ) 2047 k_wall_v_ji_m = get_topography_top_index( j, i-1, 'v_out' ) 2048 2049 k_wall_w_ji = get_topography_top_index( j, i, 'w_out' ) 2050 k_wall_w_ji_p = get_topography_top_index( j, i+1, 'w_out' ) 2051 k_wall_w_ji_m = get_topography_top_index( j, i-1, 'w_out' ) 2052 2229 2053 DO k = nzb, nzt_topo_nestbc_n 2230 2054 ! … … 2831 2655 i = nxl - 1 2832 2656 DO j = nysg, nyng 2833 k_wall = MAXLOC( & 2834 MERGE( 1, 0, & 2835 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2836 ), DIM = 1 & 2837 ) - 1 2657 k_wall = get_topography_top_index( j, i, 's' ) 2838 2658 2839 2659 DO k = k_wall + 1, nzt … … 2856 2676 i = nxr + 1 2857 2677 DO j = nysg, nyng 2858 k_wall = MAXLOC( & 2859 MERGE( 1, 0, & 2860 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2861 ), DIM = 1 & 2862 ) - 1 2678 k_wall = get_topography_top_index( j, i, 's' ) 2863 2679 2864 2680 DO k = k_wall + 1, nzt … … 2881 2697 j = nys - 1 2882 2698 DO i = nxlg, nxrg 2883 k_wall = MAXLOC( & 2884 MERGE( 1, 0, & 2885 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2886 ), DIM = 1 & 2887 ) - 1 2699 k_wall = get_topography_top_index( j, i, 's' ) 2888 2700 2889 2701 DO k = k_wall + 1, nzt … … 2906 2718 j = nyn + 1 2907 2719 DO i = nxlg, nxrg 2908 k_wall = MAXLOC( & 2909 MERGE( 1, 0, & 2910 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2911 ), DIM = 1 & 2912 ) - 1 2720 k_wall = get_topography_top_index( j, i, 's' ) 2721 2913 2722 DO k = k_wall + 1, nzt 2914 2723 … … 2932 2741 ! 2933 2742 !-- Determine vertical index for local topography top 2934 k_wall = MAXLOC( & 2935 MERGE( 1, 0, & 2936 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 2937 ), DIM = 1 & 2938 ) - 1 2743 k_wall = get_topography_top_index( j, i, 's' ) 2939 2744 2940 2745 kc = kco(k+1) … … 3315 3120 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !: 3316 3121 3317 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid3318 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid3319 3122 INTEGER(iwp) :: i !: 3320 3123 INTEGER(iwp) :: ib !: … … 3380 3183 ENDIF 3381 3184 ENDIF 3382 ! 3383 !-- Determine number of flag array to be used to mask topography 3384 IF ( var == 'u' ) THEN 3385 flag_nr = 1 3386 flag_nr2 = 14 3387 ELSEIF ( var == 'v' ) THEN 3388 flag_nr = 2 3389 flag_nr2 = 16 3390 ELSEIF ( var == 'w' ) THEN 3391 flag_nr = 3 3392 flag_nr2 = 18 3393 ELSE 3394 flag_nr = 0 3395 flag_nr2 = 12 3396 ENDIF 3185 3397 3186 ! 3398 3187 !-- Trilinear interpolation. … … 3426 3215 ! 3427 3216 !-- Determine vertical index of topography top at grid point (j,i) 3428 k_wall = MAXLOC( & 3429 MERGE( 1, 0, & 3430 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3431 ), DIM = 1 & 3432 ) - 1 3217 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 3433 3218 ! 3434 3219 !-- kbc is the first coarse-grid point above the surface … … 3461 3246 ! 3462 3247 !-- Determine vertical index of topography top at grid point (j,i) 3463 k_wall = MAXLOC( & 3464 MERGE( 1, 0, & 3465 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3466 ), DIM = 1 & 3467 ) - 1 3248 k_wall = get_topography_top_index( j, i, 'w' ) 3468 3249 3469 3250 f(k_wall,j,i) = 0.0_wp … … 4563 4344 CHARACTER(LEN=1), INTENT(IN) :: var !: 4564 4345 4565 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid4566 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid4567 4346 INTEGER(iwp) :: i !: 4568 4347 INTEGER(iwp) :: ib !: … … 4611 4390 ib = nxr + 2 4612 4391 ENDIF 4613 !4614 !-- Determine number of flag array to be used to mask topography4615 IF ( var == 'u' ) THEN4616 flag_nr = 14617 flag_nr2 = 144618 ELSEIF ( var == 'v' ) THEN4619 flag_nr = 24620 flag_nr2 = 164621 ELSEIF ( var == 'w' ) THEN4622 flag_nr = 34623 flag_nr2 = 184624 ELSE4625 flag_nr = 04626 flag_nr2 = 124627 ENDIF4628 4392 4629 4393 DO j = nys, nyn+1 … … 4653 4417 ! 4654 4418 !-- Determine vertical index of topography top at grid point (j,i) 4655 k_wall = MAXLOC( & 4656 MERGE( 1, 0, & 4657 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4658 ), DIM = 1 & 4659 ) - 1 4419 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4660 4420 4661 4421 k = k_wall+1 … … 4683 4443 ! 4684 4444 !-- Determine vertical index of topography top at grid point (j,i) 4685 k_wall = MAXLOC( & 4686 MERGE( 1, 0, & 4687 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4688 ), DIM = 1 & 4689 ) - 1 4445 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4446 4690 4447 DO k = k_wall+1, nzt_topo_nestbc 4691 4448 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) == 0 ) ) THEN … … 4711 4468 ! 4712 4469 !-- Determine vertical index of topography top at grid point (j,i) 4713 k_wall = MAXLOC( & 4714 MERGE( 1, 0, & 4715 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4716 ), DIM = 1 & 4717 ) - 1 4470 k_wall = get_topography_top_index( j, i, TRIM ( var ) ) 4471 4718 4472 k = k_wall + 1 4719 4473 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) /= 0 ) ) THEN … … 4746 4500 ! 4747 4501 !-- Determine vertical index of topography top at grid point (j,i) 4748 k_wall = MAXLOC( & 4749 MERGE( 1, 0, & 4750 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4751 ), DIM = 1 & 4752 ) - 1 4502 k_wall = get_topography_top_index( j, i, 's' ) 4503 4753 4504 DO k = k_wall, nzt + 1 4754 4505 f(k,j,i) = tkefactor_l(k,j) * f(k,j,i) … … 4759 4510 ! 4760 4511 !-- Determine vertical index of topography top at grid point (j,i) 4761 k_wall = MAXLOC( & 4762 MERGE( 1, 0, & 4763 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4764 ), DIM = 1 & 4765 ) - 1 4512 k_wall = get_topography_top_index( j, i, 's' ) 4513 4766 4514 DO k = k_wall, nzt+1 4767 4515 f(k,j,i) = tkefactor_r(k,j) * f(k,j,i) … … 4821 4569 CHARACTER(LEN=1), INTENT(IN) :: var !: 4822 4570 4823 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid4824 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid4825 4571 INTEGER(iwp) :: i !: 4826 4572 INTEGER(iwp) :: iinc !: … … 4867 4613 ENDIF 4868 4614 4869 !4870 !-- Determine number of flag array to be used to mask topography4871 IF ( var == 'u' ) THEN4872 flag_nr = 14873 flag_nr2 = 144874 ELSEIF ( var == 'v' ) THEN4875 flag_nr = 24876 flag_nr2 = 164877 ELSEIF ( var == 'w' ) THEN4878 flag_nr = 34879 flag_nr2 = 184880 ELSE4881 flag_nr = 04882 flag_nr2 = 124883 ENDIF4884 4615 4885 4616 DO i = nxl, nxr+1 4886 4617 ! 4887 4618 !-- Determine vertical index of topography top at grid point (j,i) 4888 k_wall = MAXLOC( & 4889 MERGE( 1, 0, & 4890 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4891 ), DIM = 1 & 4892 ) - 1 4619 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4620 4893 4621 DO k = k_wall, nzt+1 4894 4622 l = ic(i) … … 4916 4644 ! 4917 4645 !-- Determine vertical index of topography top at grid point (j,i) 4918 k_wall = MAXLOC( & 4919 MERGE( 1, 0, & 4920 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4921 ), DIM = 1 & 4922 ) - 1 4646 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4923 4647 4924 4648 k = k_wall + 1 … … 4945 4669 ! 4946 4670 !-- Determine vertical index of topography top at grid point (j,i) 4947 k_wall = MAXLOC( & 4948 MERGE( 1, 0, & 4949 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4950 ), DIM = 1 & 4951 ) - 1 4671 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4672 4952 4673 DO k = k_wall, nzt_topo_nestbc 4953 4674 ! … … 4975 4696 ! 4976 4697 !-- Determine vertical index of topography top at grid point (j,i) 4977 k_wall = MAXLOC( & 4978 MERGE( 1, 0, & 4979 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4980 ), DIM = 1 & 4981 ) - 1 4698 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4699 4982 4700 k = k_wall + 1 4983 4701 IF ( ( logc(2,k,i) /= 0 ) .AND. ( logc(1,k,i) /= 0 ) ) THEN … … 5010 4728 ! 5011 4729 !-- Determine vertical index of topography top at grid point (j,i) 5012 k_wall = MAXLOC( & 5013 MERGE( 1, 0, & 5014 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5015 ), DIM = 1 & 5016 ) - 1 4730 k_wall = get_topography_top_index( j, i, 's' ) 5017 4731 DO k = k_wall, nzt+1 5018 4732 f(k,j,i) = tkefactor_s(k,i) * f(k,j,i) … … 5023 4737 ! 5024 4738 !-- Determine vertical index of topography top at grid point (j,i) 5025 k_wall = MAXLOC( & 5026 MERGE( 1, 0, & 5027 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5028 ), DIM = 1 & 5029 ) - 1 4739 k_wall = get_topography_top_index( j, i, 's' ) 5030 4740 DO k = k_wall, nzt+1 5031 4741 f(k,j,i) = tkefactor_n(k,i) * f(k,j,i) … … 5153 4863 CHARACTER(LEN=1), INTENT(IN) :: var !: 5154 4864 5155 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid5156 4865 INTEGER(iwp) :: i !: 5157 4866 INTEGER(iwp) :: ib !: … … 5186 4895 outnor = 1.0_wp 5187 4896 ENDIF 5188 ! 5189 !-- Determine number of flag array to be used to mask topography 5190 IF ( var == 'u' ) THEN 5191 flag_nr = 14 5192 ELSEIF ( var == 'v' ) THEN 5193 flag_nr = 16 5194 ELSEIF ( var == 'w' ) THEN 5195 flag_nr = 18 5196 ELSE 5197 flag_nr = 12 5198 ENDIF 4897 5199 4898 5200 4899 DO j = nys, nyn+1 5201 4900 ! 5202 4901 !-- Determine vertical index of topography top at grid point (j,i) 5203 k_wall = MAXLOC( & 5204 MERGE( 1, 0, & 5205 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5206 ), DIM = 1 & 5207 ) - 1 4902 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4903 5208 4904 DO k = k_wall, nzt+1 5209 4905 vdotnor = outnor * u(k,j,ied) … … 5248 4944 CHARACTER(LEN=1), INTENT(IN) :: var !: 5249 4945 5250 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid5251 4946 INTEGER(iwp) :: i !: 5252 4947 INTEGER(iwp) :: j !: … … 5282 4977 ENDIF 5283 4978 5284 !5285 !-- Determine number of flag array to be used to mask topography5286 IF ( var == 'u' ) THEN5287 flag_nr = 145288 ELSEIF ( var == 'v' ) THEN5289 flag_nr = 165290 ELSEIF ( var == 'w' ) THEN5291 flag_nr = 185292 ELSE5293 flag_nr = 125294 ENDIF5295 4979 5296 4980 DO i = nxl, nxr+1 5297 4981 ! 5298 4982 !-- Determine vertical index of topography top at grid point (j,i) 5299 k_wall = MAXLOC( & 5300 MERGE( 1, 0, & 5301 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5302 ), DIM = 1 & 5303 ) - 1 4983 k_wall = get_topography_top_index( j, i, TRIM( var ) ) 4984 5304 4985 DO k = k_wall, nzt+1 5305 4986 vdotnor = outnor * v(k,jed,i)
Note: See TracChangeset
for help on using the changeset viewer.
