Changeset 2232 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- May 30, 2017 5:47:52 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (122 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2230 r2232 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Adjustments to new topography concept 24 24 ! 25 25 ! Former revisions: … … 139 139 USE arrays_3d, & 140 140 ONLY: dzu, dzw, e, e_p, nr, pt, pt_p, q, q_p, qr, u, u_p, v, v_p, & 141 w, w_p, zu, zw , z0141 w, w_p, zu, zw 142 142 #else 143 143 USE arrays_3d, & 144 144 ONLY: dzu, dzw, e, e_p, e_1, e_2, nr, nr_2, nr_p, pt, pt_p, pt_1, & 145 145 pt_2, q, q_p, q_1, q_2, qr, qr_2, s, s_2, u, u_p, u_1, u_2, v, & 146 v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw , z0146 v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw 147 147 #endif 148 148 … … 151 151 message_string, microphysics_seifert, nest_bound_l, nest_bound_r,& 152 152 nest_bound_s, nest_bound_n, nest_domain, neutral, passive_scalar,& 153 simulated_time, topography, volume_flow153 roughness_length, simulated_time, topography, volume_flow 154 154 155 155 USE cpulog, & … … 161 161 USE indices, & 162 162 ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, & 163 nysv, nz, nzb, nzb_s_inner, nzb_u_inner, nzb_u_outer, & 164 nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer, nzt 163 nysv, nz, nzb, nzb_max, nzt, wall_flags_0 165 164 166 165 USE kinds … … 201 200 202 201 #endif 202 203 USE surface_mod, & 204 ONLY: surf_def_h, surf_lsm_h, surf_usm_h 203 205 204 206 IMPLICIT NONE … … 1310 1312 1311 1313 INTEGER(iwp) :: direction !: Wall normal index: 1=k, 2=j, 3=i. 1314 INTEGER(iwp) :: end_index !: End index of present surface data type 1312 1315 INTEGER(iwp) :: i !: 1313 1316 INTEGER(iwp) :: icorr !: … … 1319 1322 INTEGER(iwp) :: jw !: 1320 1323 INTEGER(iwp) :: k !: 1324 INTEGER(iwp) :: k_wall_u_ji !: 1325 INTEGER(iwp) :: k_wall_u_ji_p !: 1326 INTEGER(iwp) :: k_wall_u_ji_m !: 1327 INTEGER(iwp) :: k_wall_v_ji !: 1328 INTEGER(iwp) :: k_wall_v_ji_p !: 1329 INTEGER(iwp) :: k_wall_v_ji_m !: 1330 INTEGER(iwp) :: k_wall_w_ji !: 1331 INTEGER(iwp) :: k_wall_w_ji_p !: 1332 INTEGER(iwp) :: k_wall_w_ji_m !: 1321 1333 INTEGER(iwp) :: kb !: 1322 1334 INTEGER(iwp) :: kcorr !: 1323 1335 INTEGER(iwp) :: lc !: 1336 INTEGER(iwp) :: m !: Running index for surface data type 1324 1337 INTEGER(iwp) :: ni !: 1325 1338 INTEGER(iwp) :: nj !: 1326 1339 INTEGER(iwp) :: nk !: 1327 1340 INTEGER(iwp) :: nzt_topo_max !: 1341 INTEGER(iwp) :: start_index !: Start index of present surface data type 1328 1342 INTEGER(iwp) :: wall_index !: Index of the wall-node coordinate 1329 1343 1344 REAL(wp) :: z0_topo !: roughness at vertical walls 1330 1345 REAL(wp), ALLOCATABLE, DIMENSION(:) :: lcr !: 1331 1346 … … 1339 1354 DO i = nxl-1, nxl 1340 1355 DO j = nys, nyn 1341 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i), & 1342 nzb_v_inner(j,i), nzb_w_inner(j,i) ) 1356 ! 1357 !-- Concept need to be reconsidered for 3D-topography 1358 !-- Determine largest topography index on scalar grid 1359 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1360 MAXLOC( & 1361 MERGE( 1, 0, & 1362 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1363 ), DIM = 1 & 1364 ) - 1 ) 1365 ! 1366 !-- Determine largest topography index on u grid 1367 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1368 MAXLOC( & 1369 MERGE( 1, 0, & 1370 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1371 ), DIM = 1 & 1372 ) - 1 ) 1373 ! 1374 !-- Determine largest topography index on v grid 1375 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1376 MAXLOC( & 1377 MERGE( 1, 0, & 1378 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1379 ), DIM = 1 & 1380 ) - 1 ) 1381 ! 1382 !-- Determine largest topography index on w grid 1383 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1384 MAXLOC( & 1385 MERGE( 1, 0, & 1386 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1387 ), DIM = 1 & 1388 ) - 1 ) 1343 1389 ENDDO 1344 1390 ENDDO … … 1350 1396 i = nxr + 1 1351 1397 DO j = nys, nyn 1352 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i), & 1353 nzb_v_inner(j,i), nzb_w_inner(j,i) ) 1398 ! 1399 !-- Concept need to be reconsidered for 3D-topography 1400 !-- Determine largest topography index on scalar grid 1401 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1402 MAXLOC( & 1403 MERGE( 1, 0, & 1404 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1405 ), DIM = 1 & 1406 ) - 1 ) 1407 ! 1408 !-- Determine largest topography index on u grid 1409 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1410 MAXLOC( & 1411 MERGE( 1, 0, & 1412 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1413 ), DIM = 1 & 1414 ) - 1 ) 1415 ! 1416 !-- Determine largest topography index on v grid 1417 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1418 MAXLOC( & 1419 MERGE( 1, 0, & 1420 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1421 ), DIM = 1 & 1422 ) - 1 ) 1423 ! 1424 !-- Determine largest topography index on w grid 1425 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1426 MAXLOC( & 1427 MERGE( 1, 0, & 1428 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1429 ), DIM = 1 & 1430 ) - 1 ) 1354 1431 ENDDO 1355 1432 nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1 … … 1360 1437 DO j = nys-1, nys 1361 1438 DO i = nxl, nxr 1362 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i), & 1363 nzb_v_inner(j,i), nzb_w_inner(j,i) ) 1439 ! 1440 !-- Concept need to be reconsidered for 3D-topography 1441 !-- Determine largest topography index on scalar grid 1442 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1443 MAXLOC( & 1444 MERGE( 1, 0, & 1445 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1446 ), DIM = 1 & 1447 ) - 1 ) 1448 ! 1449 !-- Determine largest topography index on u grid 1450 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1451 MAXLOC( & 1452 MERGE( 1, 0, & 1453 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1454 ), DIM = 1 & 1455 ) - 1 ) 1456 ! 1457 !-- Determine largest topography index on v grid 1458 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1459 MAXLOC( & 1460 MERGE( 1, 0, & 1461 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1462 ), DIM = 1 & 1463 ) - 1 ) 1464 ! 1465 !-- Determine largest topography index on w grid 1466 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1467 MAXLOC( & 1468 MERGE( 1, 0, & 1469 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1470 ), DIM = 1 & 1471 ) - 1 ) 1364 1472 ENDDO 1365 1473 ENDDO … … 1371 1479 j = nyn + 1 1372 1480 DO i = nxl, nxr 1373 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i), & 1374 nzb_v_inner(j,i), nzb_w_inner(j,i) ) 1481 ! 1482 !-- Concept need to be reconsidered for 3D-topography 1483 !-- Determine largest topography index on scalar grid 1484 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1485 MAXLOC( & 1486 MERGE( 1, 0, & 1487 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1488 ), DIM = 1 & 1489 ) - 1 ) 1490 ! 1491 !-- Determine largest topography index on u grid 1492 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1493 MAXLOC( & 1494 MERGE( 1, 0, & 1495 BTEST( wall_flags_0(nzb:nzb_max,j,i), 14 ) & 1496 ), DIM = 1 & 1497 ) - 1 ) 1498 ! 1499 !-- Determine largest topography index on v grid 1500 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1501 MAXLOC( & 1502 MERGE( 1, 0, & 1503 BTEST( wall_flags_0(nzb:nzb_max,j,i), 16 ) & 1504 ), DIM = 1 & 1505 ) - 1 ) 1506 ! 1507 !-- Determine largest topography index on w grid 1508 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1509 MAXLOC( & 1510 MERGE( 1, 0, & 1511 BTEST( wall_flags_0(nzb:nzb_max,j,i), 18 ) & 1512 ), DIM = 1 & 1513 ) - 1 ) 1375 1514 ENDDO 1376 1515 nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1 … … 1422 1561 !-- Left boundary for u 1423 1562 i = 0 1424 kb = nzb_u_inner(j,i) 1425 k = kb + 1 1426 wall_index = kb 1427 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1428 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1563 ! 1564 !-- For loglaw correction the roughness z0 is required. z0, however, 1565 !-- is part of the surfacetypes now, so call subroutine according 1566 !-- to the present surface tpye. 1567 !-- Default surface type 1568 IF ( surf_def_h(0)%start_index(j,i) <= & 1569 surf_def_h(0)%end_index(j,i) ) THEN 1570 start_index = surf_def_h(0)%start_index(j,i) 1571 end_index = surf_def_h(0)%end_index(j,i) 1572 DO m = start_index, end_index 1573 k = surf_def_h(0)%k(m) 1574 wall_index = k - 1 1575 kb = k - 1 1576 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1577 j, inc, wall_index, surf_def_h(0)%z0(m), & 1578 kb, direction, ncorr ) 1579 ENDDO 1580 ! 1581 !-- Natural surface type 1582 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1583 surf_lsm_h%end_index(j,i) ) THEN 1584 start_index = surf_lsm_h%start_index(j,i) 1585 end_index = surf_lsm_h%end_index(j,i) 1586 DO m = start_index, end_index 1587 k = surf_lsm_h%k(m) 1588 wall_index = k - 1 1589 kb = k - 1 1590 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1591 j, inc, wall_index, surf_lsm_h%z0(m), & 1592 kb, direction, ncorr ) 1593 ENDDO 1594 ! 1595 !-- Urban surface type 1596 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1597 surf_usm_h%end_index(j,i) ) THEN 1598 start_index = surf_usm_h%start_index(j,i) 1599 end_index = surf_usm_h%end_index(j,i) 1600 DO m = start_index, end_index 1601 k = surf_usm_h%k(m) 1602 wall_index = k - 1 1603 kb = k - 1 1604 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1605 j, inc, wall_index, surf_usm_h%z0(m), & 1606 kb, direction, ncorr ) 1607 ENDDO 1608 ENDIF 1429 1609 logc_u_l(1,k,j) = lc 1430 1610 logc_ratio_u_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1) … … 1433 1613 !-- Left boundary for v 1434 1614 i = -1 1435 kb = nzb_v_inner(j,i) 1436 k = kb + 1 1437 wall_index = kb 1438 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1439 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1615 ! 1616 !-- For loglaw correction the roughness z0 is required. z0, however, 1617 !-- is part of the surfacetypes now, so call subroutine according 1618 !-- to the present surface tpye. 1619 !-- Default surface type 1620 IF ( surf_def_h(0)%start_index(j,i) <= & 1621 surf_def_h(0)%end_index(j,i) ) THEN 1622 start_index = surf_def_h(0)%start_index(j,i) 1623 end_index = surf_def_h(0)%end_index(j,i) 1624 DO m = start_index, end_index 1625 k = surf_def_h(0)%k(m) 1626 wall_index = k - 1 1627 kb = k - 1 1628 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1629 j, inc, wall_index, surf_def_h(0)%z0(m), & 1630 kb, direction, ncorr ) 1631 ENDDO 1632 ! 1633 !-- Natural surface type 1634 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1635 surf_lsm_h%end_index(j,i) ) THEN 1636 start_index = surf_lsm_h%start_index(j,i) 1637 end_index = surf_lsm_h%end_index(j,i) 1638 DO m = start_index, end_index 1639 k = surf_lsm_h%k(m) 1640 wall_index = k - 1 1641 kb = k - 1 1642 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1643 j, inc, wall_index, surf_lsm_h%z0(m), & 1644 kb, direction, ncorr ) 1645 ENDDO 1646 ! 1647 !-- Urban surface type 1648 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1649 surf_usm_h%end_index(j,i) ) THEN 1650 start_index = surf_usm_h%start_index(j,i) 1651 end_index = surf_usm_h%end_index(j,i) 1652 DO m = start_index, end_index 1653 k = surf_usm_h%k(m) 1654 wall_index = k - 1 1655 kb = k - 1 1656 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1657 j, inc, wall_index, surf_usm_h%z0(m), & 1658 kb, direction, ncorr ) 1659 ENDDO 1660 ENDIF 1440 1661 logc_v_l(1,k,j) = lc 1441 1662 logc_ratio_v_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1) … … 1469 1690 !-- Right boundary for u 1470 1691 i = nxr + 1 1471 kb = nzb_u_inner(j,i) 1472 k = kb + 1 1473 wall_index = kb 1474 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1475 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1692 ! 1693 !-- For loglaw correction the roughness z0 is required. z0, however, 1694 !-- is part of the surfacetypes now, so call subroutine according 1695 !-- to the present surface tpye. 1696 !-- Default surface type 1697 IF ( surf_def_h(0)%start_index(j,i) <= & 1698 surf_def_h(0)%end_index(j,i) ) THEN 1699 start_index = surf_def_h(0)%start_index(j,i) 1700 end_index = surf_def_h(0)%end_index(j,i) 1701 DO m = start_index, end_index 1702 k = surf_def_h(0)%k(m) 1703 wall_index = k - 1 1704 kb = k - 1 1705 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1706 j, inc, wall_index, surf_def_h(0)%z0(m), & 1707 kb, direction, ncorr ) 1708 ENDDO 1709 ! 1710 !-- Natural surface type 1711 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1712 surf_lsm_h%end_index(j,i) ) THEN 1713 start_index = surf_lsm_h%start_index(j,i) 1714 end_index = surf_lsm_h%end_index(j,i) 1715 DO m = start_index, end_index 1716 k = surf_lsm_h%k(m) 1717 wall_index = k - 1 1718 kb = k - 1 1719 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1720 j, inc, wall_index, surf_lsm_h%z0(m), & 1721 kb, direction, ncorr ) 1722 ENDDO 1723 ! 1724 !-- Urban surface type 1725 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1726 surf_usm_h%end_index(j,i) ) THEN 1727 start_index = surf_usm_h%start_index(j,i) 1728 end_index = surf_usm_h%end_index(j,i) 1729 DO m = start_index, end_index 1730 k = surf_usm_h%k(m) 1731 wall_index = k - 1 1732 kb = k - 1 1733 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1734 j, inc, wall_index, surf_usm_h%z0(m), & 1735 kb, direction, ncorr ) 1736 ENDDO 1737 ENDIF 1738 1476 1739 logc_u_r(1,k,j) = lc 1477 1740 logc_ratio_u_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1) … … 1480 1743 !-- Right boundary for v 1481 1744 i = nxr + 1 1482 kb = nzb_v_inner(j,i) 1483 k = kb + 1 1484 wall_index = kb 1485 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1486 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1745 ! 1746 !-- For loglaw correction the roughness z0 is required. z0, however, 1747 !-- is part of the surfacetypes now, so call subroutine according 1748 !-- to the present surface tpye. 1749 !-- Default surface type 1750 IF ( surf_def_h(0)%start_index(j,i) <= & 1751 surf_def_h(0)%end_index(j,i) ) THEN 1752 start_index = surf_def_h(0)%start_index(j,i) 1753 end_index = surf_def_h(0)%end_index(j,i) 1754 DO m = start_index, end_index 1755 k = surf_def_h(0)%k(m) 1756 wall_index = k - 1 1757 kb = k - 1 1758 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1759 j, inc, wall_index, surf_def_h(0)%z0(m), & 1760 kb, direction, ncorr ) 1761 ENDDO 1762 ! 1763 !-- Natural surface type 1764 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1765 surf_lsm_h%end_index(j,i) ) THEN 1766 start_index = surf_lsm_h%start_index(j,i) 1767 end_index = surf_lsm_h%end_index(j,i) 1768 DO m = start_index, end_index 1769 k = surf_lsm_h%k(m) 1770 wall_index = k - 1 1771 kb = k - 1 1772 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1773 j, inc, wall_index, surf_lsm_h%z0(m), & 1774 kb, direction, ncorr ) 1775 ENDDO 1776 ! 1777 !-- Urban surface type 1778 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1779 surf_usm_h%end_index(j,i) ) THEN 1780 start_index = surf_usm_h%start_index(j,i) 1781 end_index = surf_usm_h%end_index(j,i) 1782 DO m = start_index, end_index 1783 k = surf_usm_h%k(m) 1784 wall_index = k - 1 1785 kb = k - 1 1786 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1787 j, inc, wall_index, surf_usm_h%z0(m), & 1788 kb, direction, ncorr ) 1789 ENDDO 1790 ENDIF 1487 1791 logc_v_r(1,k,j) = lc 1488 1792 logc_ratio_v_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1) … … 1516 1820 !-- South boundary for u 1517 1821 j = -1 1518 kb = nzb_u_inner(j,i) 1519 k = kb + 1 1520 wall_index = kb 1521 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1522 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1822 ! 1823 !-- For loglaw correction the roughness z0 is required. z0, however, 1824 !-- is part of the surfacetypes now, so call subroutine according 1825 !-- to the present surface tpye. 1826 !-- Default surface type 1827 IF ( surf_def_h(0)%start_index(j,i) <= & 1828 surf_def_h(0)%end_index(j,i) ) THEN 1829 start_index = surf_def_h(0)%start_index(j,i) 1830 end_index = surf_def_h(0)%end_index(j,i) 1831 DO m = start_index, end_index 1832 k = surf_def_h(0)%k(m) 1833 wall_index = k - 1 1834 kb = k - 1 1835 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1836 j, inc, wall_index, surf_def_h(0)%z0(m), & 1837 kb, direction, ncorr ) 1838 ENDDO 1839 ! 1840 !-- Natural surface type 1841 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1842 surf_lsm_h%end_index(j,i) ) THEN 1843 start_index = surf_lsm_h%start_index(j,i) 1844 end_index = surf_lsm_h%end_index(j,i) 1845 DO m = start_index, end_index 1846 k = surf_lsm_h%k(m) 1847 wall_index = k - 1 1848 kb = k - 1 1849 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1850 j, inc, wall_index, surf_lsm_h%z0(m), & 1851 kb, direction, ncorr ) 1852 ENDDO 1853 ! 1854 !-- Urban surface type 1855 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1856 surf_usm_h%end_index(j,i) ) THEN 1857 start_index = surf_usm_h%start_index(j,i) 1858 end_index = surf_usm_h%end_index(j,i) 1859 DO m = start_index, end_index 1860 k = surf_usm_h%k(m) 1861 wall_index = k - 1 1862 kb = k - 1 1863 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1864 j, inc, wall_index, surf_usm_h%z0(m), & 1865 kb, direction, ncorr ) 1866 ENDDO 1867 ENDIF 1523 1868 logc_u_s(1,k,i) = lc 1524 1869 logc_ratio_u_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1) … … 1527 1872 !-- South boundary for v 1528 1873 j = 0 1529 kb = nzb_v_inner(j,i) 1530 k = kb + 1 1531 wall_index = kb 1532 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1533 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1874 ! 1875 !-- For loglaw correction the roughness z0 is required. z0, however, 1876 !-- is part of the surfacetypes now, so call subroutine according 1877 !-- to the present surface tpye. 1878 !-- Default surface type 1879 IF ( surf_def_h(0)%start_index(j,i) <= & 1880 surf_def_h(0)%end_index(j,i) ) THEN 1881 start_index = surf_def_h(0)%start_index(j,i) 1882 end_index = surf_def_h(0)%end_index(j,i) 1883 DO m = start_index, end_index 1884 k = surf_def_h(0)%k(m) 1885 wall_index = k - 1 1886 kb = k - 1 1887 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1888 j, inc, wall_index, surf_def_h(0)%z0(m), & 1889 kb, direction, ncorr ) 1890 ENDDO 1891 ! 1892 !-- Natural surface type 1893 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1894 surf_lsm_h%end_index(j,i) ) THEN 1895 start_index = surf_lsm_h%start_index(j,i) 1896 end_index = surf_lsm_h%end_index(j,i) 1897 DO m = start_index, end_index 1898 k = surf_lsm_h%k(m) 1899 wall_index = k - 1 1900 kb = k - 1 1901 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1902 j, inc, wall_index, surf_lsm_h%z0(m), & 1903 kb, direction, ncorr ) 1904 ENDDO 1905 ! 1906 !-- Urban surface type 1907 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1908 surf_usm_h%end_index(j,i) ) THEN 1909 start_index = surf_usm_h%start_index(j,i) 1910 end_index = surf_usm_h%end_index(j,i) 1911 DO m = start_index, end_index 1912 k = surf_usm_h%k(m) 1913 wall_index = k - 1 1914 kb = k - 1 1915 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1916 j, inc, wall_index, surf_usm_h%z0(m), & 1917 kb, direction, ncorr ) 1918 ENDDO 1919 ENDIF 1534 1920 logc_v_s(1,k,i) = lc 1535 1921 logc_ratio_v_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1) … … 1563 1949 !-- North boundary for u 1564 1950 j = nyn + 1 1565 kb = nzb_u_inner(j,i) 1566 k = kb + 1 1567 wall_index = kb 1568 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1569 inc, wall_index, z0(j,i), kb, direction, ncorr ) 1951 ! 1952 !-- For loglaw correction the roughness z0 is required. z0, however, 1953 !-- is part of the surfacetypes now, so call subroutine according 1954 !-- to the present surface tpye. 1955 !-- Default surface type 1956 IF ( surf_def_h(0)%start_index(j,i) <= & 1957 surf_def_h(0)%end_index(j,i) ) THEN 1958 start_index = surf_def_h(0)%start_index(j,i) 1959 end_index = surf_def_h(0)%end_index(j,i) 1960 DO m = start_index, end_index 1961 k = surf_def_h(0)%k(m) 1962 wall_index = k - 1 1963 kb = k - 1 1964 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1965 j, inc, wall_index, surf_def_h(0)%z0(m), & 1966 kb, direction, ncorr ) 1967 ENDDO 1968 ! 1969 !-- Natural surface type 1970 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 1971 surf_lsm_h%end_index(j,i) ) THEN 1972 start_index = surf_lsm_h%start_index(j,i) 1973 end_index = surf_lsm_h%end_index(j,i) 1974 DO m = start_index, end_index 1975 k = surf_lsm_h%k(m) 1976 wall_index = k - 1 1977 kb = k - 1 1978 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1979 j, inc, wall_index, surf_lsm_h%z0(m), & 1980 kb, direction, ncorr ) 1981 ENDDO 1982 ! 1983 !-- Urban surface type 1984 ELSEIF ( surf_usm_h%start_index(j,i) <= & 1985 surf_usm_h%end_index(j,i) ) THEN 1986 start_index = surf_usm_h%start_index(j,i) 1987 end_index = surf_usm_h%end_index(j,i) 1988 DO m = start_index, end_index 1989 k = surf_usm_h%k(m) 1990 wall_index = k - 1 1991 kb = k - 1 1992 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 1993 j, inc, wall_index, surf_usm_h%z0(m), & 1994 kb, direction, ncorr ) 1995 ENDDO 1996 ENDIF 1570 1997 logc_u_n(1,k,i) = lc 1571 1998 logc_ratio_u_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1) … … 1574 2001 !-- North boundary for v 1575 2002 j = nyn + 1 1576 kb = nzb_v_inner(j,i) 1577 k = kb + 1 1578 wall_index = kb 1579 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, & 1580 inc, wall_index, z0(j,i), kb, direction, ncorr ) 2003 ! 2004 !-- For loglaw correction the roughness z0 is required. z0, however, 2005 !-- is part of the surfacetypes now, so call subroutine according 2006 !-- to the present surface tpye. 2007 !-- Default surface type 2008 IF ( surf_def_h(0)%start_index(j,i) <= & 2009 surf_def_h(0)%end_index(j,i) ) THEN 2010 start_index = surf_def_h(0)%start_index(j,i) 2011 end_index = surf_def_h(0)%end_index(j,i) 2012 DO m = start_index, end_index 2013 k = surf_def_h(0)%k(m) 2014 wall_index = k - 1 2015 kb = k - 1 2016 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 2017 j, inc, wall_index, surf_def_h(0)%z0(m), & 2018 kb, direction, ncorr ) 2019 ENDDO 2020 ! 2021 !-- Natural surface type 2022 ELSEIF ( surf_lsm_h%start_index(j,i) <= & 2023 surf_lsm_h%end_index(j,i) ) THEN 2024 start_index = surf_lsm_h%start_index(j,i) 2025 end_index = surf_lsm_h%end_index(j,i) 2026 DO m = start_index, end_index 2027 k = surf_lsm_h%k(m) 2028 wall_index = k - 1 2029 kb = k - 1 2030 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 2031 j, inc, wall_index, surf_lsm_h%z0(m), & 2032 kb, direction, ncorr ) 2033 ENDDO 2034 ! 2035 !-- Urban surface type 2036 ELSEIF ( surf_usm_h%start_index(j,i) <= & 2037 surf_usm_h%end_index(j,i) ) THEN 2038 start_index = surf_usm_h%start_index(j,i) 2039 end_index = surf_usm_h%end_index(j,i) 2040 DO m = start_index, end_index 2041 k = surf_usm_h%k(m) 2042 wall_index = k - 1 2043 kb = k - 1 2044 CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, & 2045 j, inc, wall_index, surf_usm_h%z0(m), & 2046 kb, direction, ncorr ) 2047 ENDDO 2048 ENDIF 1581 2049 logc_v_n(1,k,i) = lc 1582 2050 logc_ratio_v_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1) … … 1590 2058 !-- Then vertical walls and corners if necessary 1591 2059 IF ( topography /= 'flat' ) THEN 2060 ! 2061 !-- Workaround, set z0 at vertical surfaces simply to the given roughness 2062 !-- lenth, which is required to determine the logarithmic correction 2063 !-- factors at the child boundaries, which are at the ghost-points. 2064 !-- The surface data type for vertical surfaces, however, is not defined 2065 !-- at ghost-points, so that no z0 can be retrieved at this point. 2066 !-- Maybe, revise this later and define vertical surface datattype also 2067 !-- at ghost-points. 2068 z0_topo = roughness_length 1592 2069 1593 2070 kb = 0 ! kb is not used when direction > 1 1594 2071 ! 1595 2072 !-- Left boundary 2073 2074 ! 2075 !-- Are loglaw-correction parameters also calculated inside topo? 1596 2076 IF ( nest_bound_l ) THEN 1597 2077 … … 1599 2079 1600 2080 DO j = nys, nyn 2081 k_wall_u_ji = MAXLOC( & 2082 MERGE( 1, 0, & 2083 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,0), 26 ) & 2084 ), DIM = 1 & 2085 ) - 1 2086 k_wall_u_ji_p = MAXLOC( & 2087 MERGE( 1, 0, & 2088 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,0), 26 )& 2089 ), DIM = 1 & 2090 ) - 1 2091 k_wall_u_ji_m = MAXLOC( & 2092 MERGE( 1, 0, & 2093 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,0), 26 )& 2094 ), DIM = 1 & 2095 ) - 1 2096 2097 k_wall_w_ji = MAXLOC( & 2098 MERGE( 1, 0, & 2099 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j,-1), 28 )& 2100 ), DIM = 1 & 2101 ) - 1 2102 k_wall_w_ji_p = MAXLOC( & 2103 MERGE( 1, 0, & 2104 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j+1,-1), 28 )& 2105 ), DIM = 1 & 2106 ) - 1 2107 k_wall_w_ji_m = MAXLOC( & 2108 MERGE( 1, 0, & 2109 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_l,j-1,-1), 28 )& 2110 ), DIM = 1 & 2111 ) - 1 2112 1601 2113 DO k = nzb, nzt_topo_nestbc_l 2114 2115 i = 0 1602 2116 ! 1603 2117 !-- Wall for u on the south side, but not on the north side 1604 i = 0 1605 IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND. & 1606 ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) ) & 2118 IF ( ( k_wall_u_ji > k_wall_u_ji_p ) .AND. & 2119 ( k_wall_u_ji == k_wall_u_ji_m ) ) & 1607 2120 THEN 1608 2121 inc = 1 1609 2122 wall_index = j 1610 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1611 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2123 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2124 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1612 2125 ! 1613 2126 !-- The direction of the wall-normal index is stored as the … … 1620 2133 ! 1621 2134 !-- Wall for u on the north side, but not on the south side 1622 i = 0 1623 IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND. & 1624 ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) ) THEN 2135 IF ( ( k_wall_u_ji > k_wall_u_ji_m ) .AND. & 2136 ( k_wall_u_ji == k_wall_u_ji_p ) ) THEN 1625 2137 inc = -1 1626 2138 wall_index = j + 1 1627 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1628 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2139 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2140 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1629 2141 ! 1630 2142 !-- The direction of the wall-normal index is stored as the … … 1635 2147 ENDIF 1636 2148 2149 i = -1 1637 2150 ! 1638 2151 !-- Wall for w on the south side, but not on the north side. 1639 i = -1 1640 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) ) .AND. &1641 ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) ) THEN2152 2153 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2154 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 1642 2155 inc = 1 1643 2156 wall_index = j 1644 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1645 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2157 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2158 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1646 2159 ! 1647 2160 !-- The direction of the wall-normal index is stored as the … … 1654 2167 ! 1655 2168 !-- Wall for w on the north side, but not on the south side. 1656 i = -1 1657 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) .AND. & 1658 ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) ) THEN 2169 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2170 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 1659 2171 inc = -1 1660 2172 wall_index = j+1 1661 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1662 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2173 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2174 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1663 2175 ! 1664 2176 !-- The direction of the wall-normal index is stored as the … … 1682 2194 1683 2195 DO j = nys, nyn 2196 2197 k_wall_u_ji = MAXLOC( & 2198 MERGE( 1, 0, & 2199 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 26 ) & 2200 ), DIM = 1 & 2201 ) - 1 2202 k_wall_u_ji_p = MAXLOC( & 2203 MERGE( 1, 0, & 2204 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 26 )& 2205 ), DIM = 1 & 2206 ) - 1 2207 k_wall_u_ji_m = MAXLOC( & 2208 MERGE( 1, 0, & 2209 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 26 )& 2210 ), DIM = 1 & 2211 ) - 1 2212 2213 k_wall_w_ji = MAXLOC( & 2214 MERGE( 1, 0, & 2215 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j,i), 28 ) & 2216 ), DIM = 1 & 2217 ) - 1 2218 k_wall_w_ji_p = MAXLOC( & 2219 MERGE( 1, 0, & 2220 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j+1,i), 28 )& 2221 ), DIM = 1 & 2222 ) - 1 2223 k_wall_w_ji_m = MAXLOC( & 2224 MERGE( 1, 0, & 2225 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_r,j-1,i), 28 )& 2226 ), DIM = 1 & 2227 ) - 1 1684 2228 DO k = nzb, nzt_topo_nestbc_r 1685 2229 ! 1686 2230 !-- Wall for u on the south side, but not on the north side 1687 IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND.&1688 ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i)) ) THEN2231 IF ( ( k_wall_u_ji > k_wall_u_ji_p ) .AND. & 2232 ( k_wall_u_ji == k_wall_u_ji_m ) ) THEN 1689 2233 inc = 1 1690 2234 wall_index = j 1691 2235 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 1692 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2236 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1693 2237 ! 1694 2238 !-- The direction of the wall-normal index is stored as the … … 1701 2245 ! 1702 2246 !-- Wall for u on the north side, but not on the south side 1703 IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND.&1704 ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i)) ) THEN2247 IF ( ( k_wall_u_ji > k_wall_u_ji_m ) .AND. & 2248 ( k_wall_u_ji == k_wall_u_ji_p ) ) THEN 1705 2249 inc = -1 1706 2250 wall_index = j+1 1707 2251 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 1708 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2252 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1709 2253 ! 1710 2254 !-- The direction of the wall-normal index is stored as the … … 1717 2261 ! 1718 2262 !-- Wall for w on the south side, but not on the north side 1719 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) ) .AND.&1720 ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i)) ) THEN2263 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2264 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 1721 2265 inc = 1 1722 2266 wall_index = j 1723 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1724 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2267 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2268 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1725 2269 ! 1726 2270 !-- The direction of the wall-normal index is stored as the … … 1733 2277 ! 1734 2278 !-- Wall for w on the north side, but not on the south side 1735 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) .AND.&1736 ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i)) ) THEN2279 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2280 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 1737 2281 inc = -1 1738 2282 wall_index = j+1 1739 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1740 k, j, inc, wall_index, z0 (j,i), kb, direction, ncorr )2283 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2284 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 1741 2285 1742 2286 ! … … 1760 2304 1761 2305 DO i = nxl, nxr 2306 2307 k_wall_v_ji = MAXLOC( & 2308 MERGE( 1, 0, & 2309 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i), 27 ) & 2310 ), DIM = 1 & 2311 ) - 1 2312 k_wall_v_ji_p = MAXLOC( & 2313 MERGE( 1, 0, & 2314 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i+1), 27 )& 2315 ), DIM = 1 & 2316 ) - 1 2317 k_wall_v_ji_m = MAXLOC( & 2318 MERGE( 1, 0, & 2319 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,0,i-1), 27 )& 2320 ), DIM = 1 & 2321 ) - 1 2322 2323 k_wall_w_ji = MAXLOC( & 2324 MERGE( 1, 0, & 2325 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i), 28 )& 2326 ), DIM = 1 & 2327 ) - 1 2328 k_wall_w_ji_p = MAXLOC( & 2329 MERGE( 1, 0, & 2330 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i+1), 28 )& 2331 ), DIM = 1 & 2332 ) - 1 2333 k_wall_w_ji_m = MAXLOC( & 2334 MERGE( 1, 0, & 2335 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_s,-1,i-1), 28 )& 2336 ), DIM = 1 & 2337 ) - 1 1762 2338 DO k = nzb, nzt_topo_nestbc_s 1763 2339 ! 1764 2340 !-- Wall for v on the left side, but not on the right side 1765 2341 j = 0 1766 IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) ) .AND.&1767 ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1)) ) THEN2342 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2343 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 1768 2344 inc = 1 1769 2345 wall_index = i 1770 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1771 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2346 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2347 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1772 2348 ! 1773 2349 !-- The direction of the wall-normal index is stored as the … … 1781 2357 !-- Wall for v on the right side, but not on the left side 1782 2358 j = 0 1783 IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) ) .AND.&1784 ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1)) ) THEN2359 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2360 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 1785 2361 inc = -1 1786 2362 wall_index = i+1 1787 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1788 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2363 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2364 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1789 2365 ! 1790 2366 !-- The direction of the wall-normal index is stored as the … … 1798 2374 !-- Wall for w on the left side, but not on the right side 1799 2375 j = -1 1800 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) ) .AND.&1801 ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1)) ) THEN2376 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2377 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 1802 2378 inc = 1 1803 2379 wall_index = i 1804 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1805 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2380 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2381 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1806 2382 ! 1807 2383 !-- The direction of the wall-normal index is stored as the … … 1815 2391 !-- Wall for w on the right side, but not on the left side 1816 2392 j = -1 1817 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) ) .AND.&1818 ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1)) ) THEN2393 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2394 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 1819 2395 inc = -1 1820 2396 wall_index = i+1 1821 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1822 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2397 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2398 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1823 2399 ! 1824 2400 !-- The direction of the wall-normal index is stored as the … … 1842 2418 1843 2419 DO i = nxl, nxr 2420 k_wall_v_ji = MAXLOC( & 2421 MERGE( 1, 0, & 2422 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 27 ) & 2423 ), DIM = 1 & 2424 ) - 1 2425 2426 k_wall_v_ji_p = MAXLOC( & 2427 MERGE( 1, 0, & 2428 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 27 )& 2429 ), DIM = 1 & 2430 ) - 1 2431 k_wall_v_ji_m = MAXLOC( & 2432 MERGE( 1, 0, & 2433 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 27 )& 2434 ), DIM = 1 & 2435 ) - 1 2436 2437 k_wall_w_ji = MAXLOC( & 2438 MERGE( 1, 0, & 2439 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i), 28 ) & 2440 ), DIM = 1 & 2441 ) - 1 2442 k_wall_w_ji_p = MAXLOC( & 2443 MERGE( 1, 0, & 2444 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i+1), 28 )& 2445 ), DIM = 1 & 2446 ) - 1 2447 k_wall_w_ji_m = MAXLOC( & 2448 MERGE( 1, 0, & 2449 BTEST( wall_flags_0(nzb:nzt_topo_nestbc_n,j,i-1), 28 )& 2450 ), DIM = 1 & 2451 ) - 1 1844 2452 DO k = nzb, nzt_topo_nestbc_n 1845 2453 ! 1846 2454 !-- Wall for v on the left side, but not on the right side 1847 IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) ) .AND.&1848 ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1)) ) THEN2455 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2456 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 1849 2457 inc = 1 1850 2458 wall_index = i 1851 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1852 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2459 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2460 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1853 2461 ! 1854 2462 !-- The direction of the wall-normal index is stored as the … … 1861 2469 ! 1862 2470 !-- Wall for v on the right side, but not on the left side 1863 IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) ) .AND.&1864 ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1)) ) THEN2471 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2472 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 1865 2473 inc = -1 1866 2474 wall_index = i + 1 1867 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1868 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2475 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2476 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1869 2477 ! 1870 2478 !-- The direction of the wall-normal index is stored as the … … 1877 2485 ! 1878 2486 !-- Wall for w on the left side, but not on the right side 1879 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) ) .AND.&1880 ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1)) ) THEN2487 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2488 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 1881 2489 inc = 1 1882 2490 wall_index = i 1883 CALL pmci_define_loglaw_correction_parameters( lc, lcr, 1884 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2491 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2492 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1885 2493 ! 1886 2494 !-- The direction of the wall-normal index is stored as the … … 1893 2501 ! 1894 2502 !-- Wall for w on the right side, but not on the left side 1895 IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) ) .AND.&1896 ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1)) ) THEN2503 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2504 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 1897 2505 inc = -1 1898 2506 wall_index = i+1 1899 2507 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 1900 k, i, inc, wall_index, z0 (j,i), kb, direction, ncorr )2508 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 1901 2509 ! 1902 2510 !-- The direction of the wall-normal index is stored as the … … 2416 3024 2417 3025 2418 3026 SUBROUTINE pmci_init_tkefactor 2419 3027 2420 3028 ! … … 2426 3034 2427 3035 IMPLICIT NONE 3036 3037 INTEGER(iwp) :: k !: index variable along z 3038 INTEGER(iwp) :: k_wall !: topography-top index along z 3039 INTEGER(iwp) :: kc !: 3040 2428 3041 REAL(wp), PARAMETER :: cfw = 0.2_wp !: 2429 3042 REAL(wp), PARAMETER :: c_tkef = 0.6_wp !: … … 2434 3047 REAL(wp) :: height !: 2435 3048 REAL(wp), PARAMETER :: p13 = 1.0_wp/3.0_wp !: 2436 REAL(wp), PARAMETER :: p23 = 2.0_wp/3.0_wp !: 2437 INTEGER(iwp) :: k !: 2438 INTEGER(iwp) :: kc !: 2439 3049 REAL(wp), PARAMETER :: p23 = 2.0_wp/3.0_wp !: 2440 3050 2441 3051 IF ( nest_bound_l ) THEN … … 2444 3054 i = nxl - 1 2445 3055 DO j = nysg, nyng 2446 DO k = nzb_s_inner(j,i) + 1, nzt 3056 k_wall = MAXLOC( & 3057 MERGE( 1, 0, & 3058 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 3059 ), DIM = 1 & 3060 ) - 1 3061 3062 DO k = k_wall + 1, nzt 3063 2447 3064 kc = kco(k+1) 2448 3065 glsf = ( dx * dy * dzu(k) )**p13 2449 3066 glsc = ( cg%dx * cg%dy *cg%dzu(kc) )**p13 2450 height = zu(k) - zu( nzb_s_inner(j,i))3067 height = zu(k) - zu(k_wall) 2451 3068 fw = EXP( -cfw * height / glsf ) 2452 3069 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2453 3070 ( glsf / glsc )**p23 ) 2454 3071 ENDDO 2455 tkefactor_l( nzb_s_inner(j,i),j) = c_tkef * fw03072 tkefactor_l(k_wall,j) = c_tkef * fw0 2456 3073 ENDDO 2457 3074 ENDIF … … 2462 3079 i = nxr + 1 2463 3080 DO j = nysg, nyng 2464 DO k = nzb_s_inner(j,i) + 1, nzt 3081 k_wall = MAXLOC( & 3082 MERGE( 1, 0, & 3083 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 3084 ), DIM = 1 & 3085 ) - 1 3086 3087 DO k = k_wall + 1, nzt 3088 2465 3089 kc = kco(k+1) 2466 3090 glsf = ( dx * dy * dzu(k) )**p13 2467 3091 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 2468 height = zu(k) - zu( nzb_s_inner(j,i))3092 height = zu(k) - zu(k_wall) 2469 3093 fw = EXP( -cfw * height / glsf ) 2470 3094 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2471 3095 ( glsf / glsc )**p23 ) 2472 3096 ENDDO 2473 tkefactor_r( nzb_s_inner(j,i),j) = c_tkef * fw03097 tkefactor_r(k_wall,j) = c_tkef * fw0 2474 3098 ENDDO 2475 3099 ENDIF … … 2480 3104 j = nys - 1 2481 3105 DO i = nxlg, nxrg 2482 DO k = nzb_s_inner(j,i) + 1, nzt 3106 k_wall = MAXLOC( & 3107 MERGE( 1, 0, & 3108 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 3109 ), DIM = 1 & 3110 ) - 1 3111 3112 DO k = k_wall + 1, nzt 3113 2483 3114 kc = kco(k+1) 2484 3115 glsf = ( dx * dy * dzu(k) )**p13 2485 3116 glsc = ( cg%dx * cg%dy * cg%dzu(kc) ) ** p13 2486 height = zu(k) - zu( nzb_s_inner(j,i))3117 height = zu(k) - zu(k_wall) 2487 3118 fw = EXP( -cfw*height / glsf ) 2488 3119 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2489 3120 ( glsf / glsc )**p23 ) 2490 3121 ENDDO 2491 tkefactor_s( nzb_s_inner(j,i),i) = c_tkef * fw03122 tkefactor_s(k_wall,i) = c_tkef * fw0 2492 3123 ENDDO 2493 3124 ENDIF … … 2498 3129 j = nyn + 1 2499 3130 DO i = nxlg, nxrg 2500 DO k = nzb_s_inner(j,i)+1, nzt 3131 k_wall = MAXLOC( & 3132 MERGE( 1, 0, & 3133 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 3134 ), DIM = 1 & 3135 ) - 1 3136 DO k = k_wall + 1, nzt 3137 2501 3138 kc = kco(k+1) 2502 3139 glsf = ( dx * dy * dzu(k) )**p13 2503 3140 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 2504 height = zu(k) - zu( nzb_s_inner(j,i))3141 height = zu(k) - zu(k_wall) 2505 3142 fw = EXP( -cfw * height / glsf ) 2506 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * 3143 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2507 3144 ( glsf / glsc )**p23 ) 2508 3145 ENDDO 2509 tkefactor_n( nzb_s_inner(j,i),i) = c_tkef * fw03146 tkefactor_n(k_wall,i) = c_tkef * fw0 2510 3147 ENDDO 2511 3148 ENDIF … … 2513 3150 ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) ) 2514 3151 k = nzt 3152 2515 3153 DO i = nxlg, nxrg 2516 3154 DO j = nysg, nyng 3155 ! 3156 !-- Determine vertical index for local topography top 3157 k_wall = MAXLOC( & 3158 MERGE( 1, 0, & 3159 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 3160 ), DIM = 1 & 3161 ) - 1 3162 2517 3163 kc = kco(k+1) 2518 3164 glsf = ( dx * dy * dzu(k) )**p13 2519 3165 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 2520 height = zu(k) - zu( nzb_s_inner(j,i))3166 height = zu(k) - zu(k_wall) 2521 3167 fw = EXP( -cfw * height / glsf ) 2522 tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * 3168 tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 2523 3169 ( glsf / glsc )**p23 ) 2524 3170 ENDDO … … 2783 3429 INTEGER(iwp) :: jcn !: 2784 3430 INTEGER(iwp) :: jcs !: 3431 INTEGER(iwp) :: k !: 2785 3432 2786 3433 REAL(wp) :: waittime !: … … 2804 3451 !-- The interpolation. 2805 3452 CALL pmci_interp_tril_all ( u, uc, icu, jco, kco, r1xu, r2xu, r1yo, & 2806 r2yo, r1zo, r2zo, nzb_u_inner,'u' )3453 r2yo, r1zo, r2zo, 'u' ) 2807 3454 CALL pmci_interp_tril_all ( v, vc, ico, jcv, kco, r1xo, r2xo, r1yv, & 2808 r2yv, r1zo, r2zo, nzb_v_inner,'v' )3455 r2yv, r1zo, r2zo, 'v' ) 2809 3456 CALL pmci_interp_tril_all ( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 2810 r2yo, r1zw, r2zw, nzb_w_inner,'w' )3457 r2yo, r1zw, r2zw, 'w' ) 2811 3458 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 2812 r2yo, r1zo, r2zo, nzb_s_inner,'e' )3459 r2yo, r1zo, r2zo, 'e' ) 2813 3460 2814 3461 IF ( .NOT. neutral ) THEN 2815 3462 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, & 2816 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,'s' )3463 r1yo, r2yo, r1zo, r2zo, 's' ) 2817 3464 ENDIF 2818 3465 … … 2820 3467 2821 3468 CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, & 2822 r2yo, r1zo, r2zo, nzb_s_inner,'s' )3469 r2yo, r1zo, r2zo, 's' ) 2823 3470 2824 3471 IF ( cloud_physics .AND. microphysics_seifert ) THEN 2825 3472 ! CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo, & 2826 ! r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2827 ! 's' ) 3473 ! r1yo, r2yo, r1zo, r2zo, 's' ) 2828 3474 CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo, & 2829 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2830 's' ) 3475 r1yo, r2yo, r1zo, r2zo, 's' ) 2831 3476 ! CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo, & 2832 ! r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2833 ! 's' ) 3477 ! r1yo, r2yo, r1zo, r2zo, 's' ) 2834 3478 CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo, & 2835 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2836 's' ) 3479 r1yo, r2yo, r1zo, r2zo, 's' ) 2837 3480 ENDIF 2838 3481 … … 2841 3484 IF ( passive_scalar ) THEN 2842 3485 CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, & 2843 r2yo, r1zo, r2zo, nzb_s_inner,'s' )3486 r2yo, r1zo, r2zo, 's' ) 2844 3487 ENDIF 2845 3488 … … 2851 3494 DO i = nxlg, nxrg 2852 3495 DO j = nysg, nyng 2853 u(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp 2854 v(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp 2855 w(nzb:nzb_w_inner(j,i),j,i) = 0.0_wp 2856 e(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp 2857 u_p(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp 2858 v_p(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp 2859 w_p(nzb:nzb_w_inner(j,i),j,i) = 0.0_wp 2860 e_p(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp 3496 DO k = nzb, nzt 3497 u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, & 3498 BTEST( wall_flags_0(k,j,i), 1 ) ) 3499 v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, & 3500 BTEST( wall_flags_0(k,j,i), 2 ) ) 3501 w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, & 3502 BTEST( wall_flags_0(k,j,i), 3 ) ) 3503 e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, & 3504 BTEST( wall_flags_0(k,j,i), 0 ) ) 3505 u_p(k,j,i) = MERGE( u_p(k,j,i), 0.0_wp, & 3506 BTEST( wall_flags_0(k,j,i), 1 ) ) 3507 v_p(k,j,i) = MERGE( v_p(k,j,i), 0.0_wp, & 3508 BTEST( wall_flags_0(k,j,i), 2 ) ) 3509 w_p(k,j,i) = MERGE( w_p(k,j,i), 0.0_wp, & 3510 BTEST( wall_flags_0(k,j,i), 3 ) ) 3511 e_p(k,j,i) = MERGE( e_p(k,j,i), 0.0_wp, & 3512 BTEST( wall_flags_0(k,j,i), 0 ) ) 3513 ENDDO 2861 3514 ENDDO 2862 3515 ENDDO … … 2869 3522 2870 3523 SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, & 2871 r1z, r2z, kb,var )3524 r1z, r2z, var ) 2872 3525 ! 2873 3526 !-- Interpolation of the internal values for the child-domain initialization … … 2881 3534 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !: 2882 3535 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !: 2883 INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) :: kb !: 2884 2885 INTEGER(iwp) :: i !: 2886 INTEGER(iwp) :: ib !: 2887 INTEGER(iwp) :: ie !: 2888 INTEGER(iwp) :: j !: 2889 INTEGER(iwp) :: jb !: 2890 INTEGER(iwp) :: je !: 2891 INTEGER(iwp) :: k !: 2892 INTEGER(iwp) :: k1 !: 2893 INTEGER(iwp) :: kbc !: 2894 INTEGER(iwp) :: l !: 2895 INTEGER(iwp) :: m !: 2896 INTEGER(iwp) :: n !: 3536 3537 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid 3538 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid 3539 INTEGER(iwp) :: i !: 3540 INTEGER(iwp) :: ib !: 3541 INTEGER(iwp) :: ie !: 3542 INTEGER(iwp) :: j !: 3543 INTEGER(iwp) :: jb !: 3544 INTEGER(iwp) :: je !: 3545 INTEGER(iwp) :: k !: 3546 INTEGER(iwp) :: k_wall !: 3547 INTEGER(iwp) :: k1 !: 3548 INTEGER(iwp) :: kbc !: 3549 INTEGER(iwp) :: l !: 3550 INTEGER(iwp) :: m !: 3551 INTEGER(iwp) :: n !: 2897 3552 2898 3553 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !: … … 2914 3569 REAL(wp) :: logzuc1 !: 2915 3570 REAL(wp) :: zuc1 !: 3571 REAL(wp) :: z0_topo !: roughness at vertical walls 2916 3572 2917 3573 … … 2945 3601 ENDIF 2946 3602 ! 3603 !-- Determine number of flag array to be used to mask topography 3604 IF ( var == 'u' ) THEN 3605 flag_nr = 1 3606 flag_nr2 = 14 3607 ELSEIF ( var == 'v' ) THEN 3608 flag_nr = 2 3609 flag_nr2 = 16 3610 ELSEIF ( var == 'w' ) THEN 3611 flag_nr = 3 3612 flag_nr2 = 18 3613 ELSE 3614 flag_nr = 0 3615 flag_nr2 = 12 3616 ENDIF 3617 ! 2947 3618 !-- Trilinear interpolation. 2948 3619 DO i = ib, ie 2949 3620 DO j = jb, je 2950 DO k = kb(j,i), nzt + 13621 DO k = nzb, nzt + 1 2951 3622 l = ic(i) 2952 3623 m = jc(j) … … 2970 3641 !-- too. 2971 3642 IF ( var == 'u' .OR. var == 'v' ) THEN 3643 z0_topo = roughness_length 2972 3644 DO i = ib, nxr 2973 3645 DO j = jb, nyn 3646 ! 3647 !-- Determine vertical index of topography top at grid point (j,i) 3648 k_wall = MAXLOC( & 3649 MERGE( 1, 0, & 3650 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3651 ), DIM = 1 & 3652 ) - 1 3653 ! 3654 !-- kbc is the first coarse-grid point above the surface 2974 3655 kbc = 1 2975 ! 2976 !-- kbc is the first coarse-grid point above the surface 2977 DO WHILE ( cg%zu(kbc) < zu(kb(j,i)) ) 3656 DO WHILE ( cg%zu(kbc) < zu(k_wall) ) 2978 3657 kbc = kbc + 1 2979 3658 ENDDO 2980 3659 zuc1 = cg%zu(kbc) 2981 k1 = k b(j,i)+ 13660 k1 = k_wall + 1 2982 3661 DO WHILE ( zu(k1) < zuc1 ) 2983 3662 k1 = k1 + 1 2984 3663 ENDDO 2985 logzuc1 = LOG( ( zu(k1) - zu(k b(j,i)) ) / z0(j,i))2986 2987 k = k b(j,i)+ 13664 logzuc1 = LOG( ( zu(k1) - zu(k_wall) ) / z0_topo ) 3665 3666 k = k_wall + 1 2988 3667 DO WHILE ( zu(k) < zuc1 ) 2989 logratio = ( LOG( ( zu(k) - zu(k b(j,i)) ) / z0(j,i)) ) / &3668 logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) / & 2990 3669 logzuc1 2991 3670 f(k,j,i) = logratio * f(k1,j,i) 2992 3671 k = k + 1 2993 3672 ENDDO 2994 f(k b(j,i),j,i) = 0.0_wp3673 f(k_wall,j,i) = 0.0_wp 2995 3674 ENDDO 2996 3675 ENDDO … … 3000 3679 DO i = ib, nxr 3001 3680 DO j = jb, nyn 3002 f(kb(j,i),j,i) = 0.0_wp 3003 ENDDO 3004 ENDDO 3681 ! 3682 !-- Determine vertical index of topography top at grid point (j,i) 3683 k_wall = MAXLOC( & 3684 MERGE( 1, 0, & 3685 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 3686 ), DIM = 1 & 3687 ) - 1 3688 3689 f(k_wall,j,i) = 0.0_wp 3690 ENDDO 3691 ENDDO 3005 3692 3006 3693 ENDIF … … 3137 3824 innor = dy 3138 3825 DO j = nys, nyn 3139 DO k = nzb_u_inner(j,i)+1, nzt 3140 volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k) 3826 DO k = nzb+1, nzt 3827 volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k) & 3828 * MERGE( 1.0_wp, 0.0_wp, & 3829 BTEST( wall_flags_0(k,j,i), 1 ) ) 3141 3830 ENDDO 3142 3831 ENDDO … … 3147 3836 innor = -dy 3148 3837 DO j = nys, nyn 3149 DO k = nzb_u_inner(j,i)+1, nzt 3150 volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k) 3838 DO k = nzb+1, nzt 3839 volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k) & 3840 * MERGE( 1.0_wp, 0.0_wp, & 3841 BTEST( wall_flags_0(k,j,i), 1 ) ) 3151 3842 ENDDO 3152 3843 ENDDO … … 3170 3861 innor = dx 3171 3862 DO i = nxl, nxr 3172 DO k = nzb_v_inner(j,i)+1, nzt 3173 volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k) 3863 DO k = nzb+1, nzt 3864 volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k) & 3865 * MERGE( 1.0_wp, 0.0_wp, & 3866 BTEST( wall_flags_0(k,j,i), 2 ) ) 3174 3867 ENDDO 3175 3868 ENDDO … … 3180 3873 innor = -dx 3181 3874 DO i = nxl, nxr 3182 DO k = nzb_v_inner(j,i)+1, nzt 3183 volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k) 3875 DO k = nzb+1, nzt 3876 volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k) & 3877 * MERGE( 1.0_wp, 0.0_wp, & 3878 BTEST( wall_flags_0(k,j,i), 2 ) ) 3184 3879 ENDDO 3185 3880 ENDDO … … 3340 4035 INTEGER(iwp) :: child_id !: 3341 4036 INTEGER(iwp) :: i !: 4037 INTEGER(iwp) :: ierr !: 3342 4038 INTEGER(iwp) :: j !: 3343 INTEGER(iwp) :: ierr!:4039 INTEGER(iwp) :: k !: 3344 4040 INTEGER(iwp) :: m !: 3345 4041 … … 3374 4070 DO i = nxlg, nxrg 3375 4071 DO j = nysg, nyng 3376 u(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp 3377 v(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp 3378 w(nzb:nzb_w_inner(j,i),j,i) = 0.0_wp 3379 e(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp 4072 DO k = nzb, nzt+1 4073 u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, & 4074 BTEST( wall_flags_0(k,j,i), 1 ) ) 4075 v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, & 4076 BTEST( wall_flags_0(k,j,i), 2 ) ) 4077 w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, & 4078 BTEST( wall_flags_0(k,j,i), 3 ) ) 4079 e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, & 4080 BTEST( wall_flags_0(k,j,i), 0 ) ) 3380 4081 ! 3381 4082 !-- TO_DO: zero setting of temperature within topography creates … … 3385 4086 ! q(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp 3386 4087 ! ENDIF 4088 ENDDO 3387 4089 ENDDO 3388 4090 ENDDO … … 3463 4165 IF ( nest_bound_l ) THEN 3464 4166 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 3465 r1yo, r2yo, r1zo, r2zo, nzb_u_inner,&4167 r1yo, r2yo, r1zo, r2zo, & 3466 4168 logc_u_l, logc_ratio_u_l, & 3467 4169 nzt_topo_nestbc_l, 'l', 'u' ) 3468 4170 3469 4171 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 3470 r1yv, r2yv, r1zo, r2zo, nzb_v_inner,&4172 r1yv, r2yv, r1zo, r2zo, & 3471 4173 logc_v_l, logc_ratio_v_l, & 3472 4174 nzt_topo_nestbc_l, 'l', 'v' ) 3473 4175 3474 4176 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 3475 r1yo, r2yo, r1zw, r2zw, nzb_w_inner,&4177 r1yo, r2yo, r1zw, r2zw, & 3476 4178 logc_w_l, logc_ratio_w_l, & 3477 4179 nzt_topo_nestbc_l, 'l', 'w' ) 3478 4180 3479 4181 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 3480 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&4182 r1yo, r2yo, r1zo, r2zo, & 3481 4183 logc_u_l, logc_ratio_u_l, & 3482 4184 nzt_topo_nestbc_l, 'l', 'e' ) … … 3484 4186 IF ( .NOT. neutral ) THEN 3485 4187 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 3486 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&4188 r1yo, r2yo, r1zo, r2zo, & 3487 4189 logc_u_l, logc_ratio_u_l, & 3488 4190 nzt_topo_nestbc_l, 'l', 's' ) … … 3492 4194 3493 4195 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 3494 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&4196 r1yo, r2yo, r1zo, r2zo, & 3495 4197 logc_u_l, logc_ratio_u_l, & 3496 4198 nzt_topo_nestbc_l, 'l', 's' ) … … 3500 4202 ! CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, r2xo,& 3501 4203 ! r1yo, r2yo, r1zo, r2zo, & 3502 ! nzb_s_inner, logc_u_l,&4204 ! logc_u_l, & 3503 4205 ! logc_ratio_u_l, nzt_topo_nestbc_l, & 3504 4206 ! 'l', 's' ) … … 3506 4208 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, r2xo,& 3507 4209 r1yo, r2yo, r1zo, r2zo, & 3508 nzb_s_inner, logc_u_l,&4210 logc_u_l, & 3509 4211 logc_ratio_u_l, nzt_topo_nestbc_l, & 3510 4212 'l', 's' ) … … 3512 4214 ! CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, r2xo,& 3513 4215 ! r1yo, r2yo, r1zo, r2zo, & 3514 ! nzb_s_inner, logc_u_l,&4216 ! logc_u_l, & 3515 4217 ! logc_ratio_u_l, nzt_topo_nestbc_l, & 3516 4218 ! 'l', 's' ) … … 3518 4220 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, r2xo,& 3519 4221 r1yo, r2yo, r1zo, r2zo, & 3520 nzb_s_inner, logc_u_l,&4222 logc_u_l, & 3521 4223 logc_ratio_u_l, nzt_topo_nestbc_l, & 3522 4224 'l', 's' ) … … 3527 4229 IF ( passive_scalar ) THEN 3528 4230 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 3529 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&4231 r1yo, r2yo, r1zo, r2zo, & 3530 4232 logc_u_l, logc_ratio_u_l, & 3531 4233 nzt_topo_nestbc_l, 'l', 's' ) … … 3533 4235 3534 4236 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3535 3536 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' ) 3537 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' ) 3538 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' ) 3539 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' ) 4237 CALL pmci_extrap_ifoutflow_lr( u, 'l', 'u' ) 4238 CALL pmci_extrap_ifoutflow_lr( v, 'l', 'v' ) 4239 CALL pmci_extrap_ifoutflow_lr( w, 'l', 'w' ) 4240 CALL pmci_extrap_ifoutflow_lr( e, 'l', 'e' ) 3540 4241 3541 4242 IF ( .NOT. neutral ) THEN 3542 CALL pmci_extrap_ifoutflow_lr( pt, nzb_s_inner,'l', 's' )4243 CALL pmci_extrap_ifoutflow_lr( pt, 'l', 's' ) 3543 4244 ENDIF 3544 4245 3545 4246 IF ( humidity ) THEN 3546 3547 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' ) 4247 CALL pmci_extrap_ifoutflow_lr( q, 'l', 's' ) 3548 4248 3549 4249 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3550 4250 3551 ! CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner,'l', 's' )3552 CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner,'l', 's' )3553 ! CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner,'l', 's' )3554 CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner,'l', 's' )4251 ! CALL pmci_extrap_ifoutflow_lr( qc, 'l', 's' ) 4252 CALL pmci_extrap_ifoutflow_lr( qr, 'l', 's' ) 4253 ! CALL pmci_extrap_ifoutflow_lr( nc, 'l', 's' ) 4254 CALL pmci_extrap_ifoutflow_lr( nr, 'l', 's' ) 3555 4255 3556 4256 ENDIF … … 3559 4259 3560 4260 IF ( passive_scalar ) THEN 3561 CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner,'l', 's' )4261 CALL pmci_extrap_ifoutflow_lr( s, 'l', 's' ) 3562 4262 ENDIF 3563 4263 … … 3569 4269 !-- Right border pe 3570 4270 IF ( nest_bound_r ) THEN 3571 3572 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 3573 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3574 logc_u_r, logc_ratio_u_r, & 4271 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 4272 r1yo, r2yo, r1zo, r2zo, & 4273 logc_u_r, logc_ratio_u_r, & 3575 4274 nzt_topo_nestbc_r, 'r', 'u' ) 3576 4275 3577 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, &3578 r1yv, r2yv, r1zo, r2zo, nzb_v_inner,&3579 logc_v_r, logc_ratio_v_r, &4276 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 4277 r1yv, r2yv, r1zo, r2zo, & 4278 logc_v_r, logc_ratio_v_r, & 3580 4279 nzt_topo_nestbc_r, 'r', 'v' ) 3581 4280 3582 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, &3583 r1yo, r2yo, r1zw, r2zw, nzb_w_inner,&3584 logc_w_r, logc_ratio_w_r, &4281 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 4282 r1yo, r2yo, r1zw, r2zw, & 4283 logc_w_r, logc_ratio_w_r, & 3585 4284 nzt_topo_nestbc_r, 'r', 'w' ) 3586 4285 3587 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, &3588 r1yo,r2yo, r1zo, r2zo, nzb_s_inner,&3589 logc_u_r, logc_ratio_u_r, &4286 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4287 r1yo,r2yo, r1zo, r2zo, & 4288 logc_u_r, logc_ratio_u_r, & 3590 4289 nzt_topo_nestbc_r, 'r', 'e' ) 3591 4290 4291 3592 4292 IF ( .NOT. neutral ) THEN 3593 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, &3594 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&3595 logc_u_r, logc_ratio_u_r, &4293 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4294 r1yo, r2yo, r1zo, r2zo, & 4295 logc_u_r, logc_ratio_u_r, & 3596 4296 nzt_topo_nestbc_r, 'r', 's' ) 4297 3597 4298 ENDIF 3598 4299 3599 4300 IF ( humidity ) THEN 3600 3601 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 3602 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3603 logc_u_r, logc_ratio_u_r, & 4301 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 4302 r1yo, r2yo, r1zo, r2zo, & 4303 logc_u_r, logc_ratio_u_r, & 3604 4304 nzt_topo_nestbc_r, 'r', 's' ) 4305 3605 4306 3606 4307 IF ( cloud_physics .AND. microphysics_seifert ) THEN … … 3608 4309 ! CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, & 3609 4310 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3610 ! nzb_s_inner, logc_u_r,&4311 ! logc_u_r, & 3611 4312 ! logc_ratio_u_r, nzt_topo_nestbc_r,& 3612 4313 ! 'r', 's' ) … … 3614 4315 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, & 3615 4316 r2xo, r1yo, r2yo, r1zo, r2zo, & 3616 nzb_s_inner, logc_u_r,&4317 logc_u_r, & 3617 4318 logc_ratio_u_r, nzt_topo_nestbc_r,& 3618 4319 'r', 's' ) … … 3620 4321 ! CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, & 3621 4322 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3622 ! nzb_s_inner, logc_u_r,&4323 ! logc_u_r, & 3623 4324 ! logc_ratio_u_r, nzt_topo_nestbc_r,& 3624 4325 ! 'r', 's' ) … … 3626 4327 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, & 3627 4328 r2xo, r1yo, r2yo, r1zo, r2zo, & 3628 nzb_s_inner, logc_u_r,&4329 logc_u_r, & 3629 4330 logc_ratio_u_r, nzt_topo_nestbc_r,& 3630 4331 'r', 's' ) … … 3636 4337 IF ( passive_scalar ) THEN 3637 4338 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 3638 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&4339 r1yo, r2yo, r1zo, r2zo, & 3639 4340 logc_u_r, logc_ratio_u_r, & 3640 4341 nzt_topo_nestbc_r, 'r', 's' ) 4342 3641 4343 ENDIF 3642 4344 3643 4345 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3644 3645 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' ) 3646 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' ) 3647 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' ) 3648 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' ) 4346 CALL pmci_extrap_ifoutflow_lr( u, 'r', 'u' ) 4347 CALL pmci_extrap_ifoutflow_lr( v, 'r', 'v' ) 4348 CALL pmci_extrap_ifoutflow_lr( w, 'r', 'w' ) 4349 CALL pmci_extrap_ifoutflow_lr( e, 'r', 'e' ) 3649 4350 3650 4351 IF ( .NOT. neutral ) THEN 3651 CALL pmci_extrap_ifoutflow_lr( pt, nzb_s_inner,'r', 's' )4352 CALL pmci_extrap_ifoutflow_lr( pt, 'r', 's' ) 3652 4353 ENDIF 3653 4354 3654 4355 IF ( humidity ) THEN 3655 3656 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' ) 4356 CALL pmci_extrap_ifoutflow_lr( q, 'r', 's' ) 3657 4357 3658 4358 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3659 ! CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner,'r', 's' )3660 CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner,'r', 's' )3661 ! CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner,'r', 's' )3662 CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner,'r', 's' )4359 ! CALL pmci_extrap_ifoutflow_lr( qc, 'r', 's' ) 4360 CALL pmci_extrap_ifoutflow_lr( qr, 'r', 's' ) 4361 ! CALL pmci_extrap_ifoutflow_lr( nc, 'r', 's' ) 4362 CALL pmci_extrap_ifoutflow_lr( nr, 'r', 's' ) 3663 4363 ENDIF 3664 4364 … … 3666 4366 3667 4367 IF ( passive_scalar ) THEN 3668 CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner,'r', 's' )4368 CALL pmci_extrap_ifoutflow_lr( s, 'r', 's' ) 3669 4369 ENDIF 3670 4370 ENDIF … … 3675 4375 !-- South border pe 3676 4376 IF ( nest_bound_s ) THEN 3677 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, &3678 r1yo, r2yo, r1zo, r2zo, nzb_u_inner,&3679 logc_u_s, logc_ratio_u_s, &4377 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4378 r1yo, r2yo, r1zo, r2zo, & 4379 logc_u_s, logc_ratio_u_s, & 3680 4380 nzt_topo_nestbc_s, 's', 'u' ) 3681 3682 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 3683 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3684 logc_v_s, logc_ratio_v_s, & 4381 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4382 r1yv, r2yv, r1zo, r2zo, & 4383 logc_v_s, logc_ratio_v_s, & 3685 4384 nzt_topo_nestbc_s, 's', 'v' ) 3686 3687 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 3688 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3689 logc_w_s, logc_ratio_w_s, & 4385 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4386 r1yo, r2yo, r1zw, r2zw, & 4387 logc_w_s, logc_ratio_w_s, & 3690 4388 nzt_topo_nestbc_s, 's','w' ) 3691 3692 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 3693 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3694 logc_u_s, logc_ratio_u_s, & 4389 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4390 r1yo, r2yo, r1zo, r2zo, & 4391 logc_u_s, logc_ratio_u_s, & 3695 4392 nzt_topo_nestbc_s, 's', 'e' ) 3696 4393 3697 4394 IF ( .NOT. neutral ) THEN 3698 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, &3699 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&3700 logc_u_s, logc_ratio_u_s, &4395 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4396 r1yo, r2yo, r1zo, r2zo, & 4397 logc_u_s, logc_ratio_u_s, & 3701 4398 nzt_topo_nestbc_s, 's', 's' ) 3702 4399 ENDIF 3703 4400 3704 4401 IF ( humidity ) THEN 3705 3706 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 3707 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3708 logc_u_s, logc_ratio_u_s, & 4402 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4403 r1yo,r2yo, r1zo, r2zo, & 4404 logc_u_s, logc_ratio_u_s, & 3709 4405 nzt_topo_nestbc_s, 's', 's' ) 3710 4406 … … 3713 4409 ! CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 3714 4410 ! r2xo, r1yo,r2yo, r1zo, r2zo, & 3715 ! nzb_s_inner, logc_u_s,&4411 ! logc_u_s, & 3716 4412 ! logc_ratio_u_s, nzt_topo_nestbc_s,& 3717 4413 ! 's', 's' ) … … 3719 4415 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 3720 4416 r2xo, r1yo,r2yo, r1zo, r2zo, & 3721 nzb_s_inner, logc_u_s,&4417 logc_u_s, & 3722 4418 logc_ratio_u_s, nzt_topo_nestbc_s,& 3723 4419 's', 's' ) … … 3725 4421 ! CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 3726 4422 ! r2xo, r1yo,r2yo, r1zo, r2zo, & 3727 ! nzb_s_inner, logc_u_s,&4423 ! logc_u_s, & 3728 4424 ! logc_ratio_u_s, nzt_topo_nestbc_s,& 3729 4425 ! 's', 's' ) … … 3731 4427 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 3732 4428 r2xo, r1yo,r2yo, r1zo, r2zo, & 3733 nzb_s_inner, logc_u_s,&4429 logc_u_s, & 3734 4430 logc_ratio_u_s, nzt_topo_nestbc_s,& 3735 4431 's', 's' ) … … 3740 4436 3741 4437 IF ( passive_scalar ) THEN 3742 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, &3743 r1yo,r2yo, r1zo, r2zo, nzb_s_inner,&3744 logc_u_s, logc_ratio_u_s, &4438 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4439 r1yo,r2yo, r1zo, r2zo, & 4440 logc_u_s, logc_ratio_u_s, & 3745 4441 nzt_topo_nestbc_s, 's', 's' ) 3746 4442 ENDIF 3747 4443 3748 4444 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3749 3750 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' ) 3751 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' ) 3752 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' ) 3753 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' ) 4445 CALL pmci_extrap_ifoutflow_sn( u, 's', 'u' ) 4446 CALL pmci_extrap_ifoutflow_sn( v, 's', 'v' ) 4447 CALL pmci_extrap_ifoutflow_sn( w, 's', 'w' ) 4448 CALL pmci_extrap_ifoutflow_sn( e, 's', 'e' ) 3754 4449 3755 4450 IF ( .NOT. neutral ) THEN 3756 CALL pmci_extrap_ifoutflow_sn( pt, nzb_s_inner,'s', 's' )4451 CALL pmci_extrap_ifoutflow_sn( pt, 's', 's' ) 3757 4452 ENDIF 3758 4453 3759 4454 IF ( humidity ) THEN 3760 3761 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' ) 4455 CALL pmci_extrap_ifoutflow_sn( q, 's', 's' ) 3762 4456 3763 4457 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3764 ! CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner,'s', 's' )3765 CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner,'s', 's' )3766 ! CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner,'s', 's' )3767 CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner,'s', 's' )4458 ! CALL pmci_extrap_ifoutflow_sn( qc, 's', 's' ) 4459 CALL pmci_extrap_ifoutflow_sn( qr, 's', 's' ) 4460 ! CALL pmci_extrap_ifoutflow_sn( nc, 's', 's' ) 4461 CALL pmci_extrap_ifoutflow_sn( nr, 's', 's' ) 3768 4462 3769 4463 ENDIF … … 3772 4466 3773 4467 IF ( passive_scalar ) THEN 3774 CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner,'s', 's' )4468 CALL pmci_extrap_ifoutflow_sn( s, 's', 's' ) 3775 4469 ENDIF 3776 4470 … … 3782 4476 !-- North border pe 3783 4477 IF ( nest_bound_n ) THEN 3784 3785 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 3786 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3787 logc_u_n, logc_ratio_u_n, & 4478 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 4479 r1yo, r2yo, r1zo, r2zo, & 4480 logc_u_n, logc_ratio_u_n, & 3788 4481 nzt_topo_nestbc_n, 'n', 'u' ) 3789 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 3790 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3791 logc_v_n, logc_ratio_v_n, & 4482 4483 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4484 r1yv, r2yv, r1zo, r2zo, & 4485 logc_v_n, logc_ratio_v_n, & 3792 4486 nzt_topo_nestbc_n, 'n', 'v' ) 3793 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 3794 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3795 logc_w_n, logc_ratio_w_n, & 4487 4488 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4489 r1yo, r2yo, r1zw, r2zw, & 4490 logc_w_n, logc_ratio_w_n, & 3796 4491 nzt_topo_nestbc_n, 'n', 'w' ) 3797 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 3798 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3799 logc_u_n, logc_ratio_u_n, & 4492 4493 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4494 r1yo, r2yo, r1zo, r2zo, & 4495 logc_u_n, logc_ratio_u_n, & 3800 4496 nzt_topo_nestbc_n, 'n', 'e' ) 3801 4497 3802 4498 IF ( .NOT. neutral ) THEN 3803 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, &3804 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&3805 logc_u_n, logc_ratio_u_n, &4499 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4500 r1yo, r2yo, r1zo, r2zo, & 4501 logc_u_n, logc_ratio_u_n, & 3806 4502 nzt_topo_nestbc_n, 'n', 's' ) 3807 4503 ENDIF 3808 4504 3809 4505 IF ( humidity ) THEN 3810 3811 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 3812 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3813 logc_u_n, logc_ratio_u_n, & 4506 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4507 r1yo, r2yo, r1zo, r2zo, & 4508 logc_u_n, logc_ratio_u_n, & 3814 4509 nzt_topo_nestbc_n, 'n', 's' ) 3815 4510 … … 3818 4513 ! CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 3819 4514 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3820 ! nzb_s_inner, logc_u_n,&4515 ! logc_u_n, & 3821 4516 ! logc_ratio_u_n, nzt_topo_nestbc_n,& 3822 4517 ! 'n', 's' ) … … 3824 4519 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 3825 4520 r2xo, r1yo, r2yo, r1zo, r2zo, & 3826 nzb_s_inner, logc_u_n,&4521 logc_u_n, & 3827 4522 logc_ratio_u_n, nzt_topo_nestbc_n,& 3828 4523 'n', 's' ) … … 3830 4525 ! CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 3831 4526 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3832 ! nzb_s_inner, logc_u_n,&4527 ! logc_u_n, & 3833 4528 ! logc_ratio_u_n, nzt_topo_nestbc_n,& 3834 4529 ! 'n', 's' ) … … 3836 4531 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 3837 4532 r2xo, r1yo, r2yo, r1zo, r2zo, & 3838 nzb_s_inner, logc_u_n,&4533 logc_u_n, & 3839 4534 logc_ratio_u_n, nzt_topo_nestbc_n,& 3840 4535 'n', 's' ) … … 3845 4540 3846 4541 IF ( passive_scalar ) THEN 3847 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, &3848 r1yo, r2yo, r1zo, r2zo, nzb_s_inner,&3849 logc_u_n, logc_ratio_u_n, &4542 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4543 r1yo, r2yo, r1zo, r2zo, & 4544 logc_u_n, logc_ratio_u_n, & 3850 4545 nzt_topo_nestbc_n, 'n', 's' ) 3851 4546 ENDIF 3852 4547 3853 4548 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3854 3855 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' ) 3856 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' ) 3857 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' ) 3858 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' ) 4549 CALL pmci_extrap_ifoutflow_sn( u, 'n', 'u' ) 4550 CALL pmci_extrap_ifoutflow_sn( v, 'n', 'v' ) 4551 CALL pmci_extrap_ifoutflow_sn( w, 'n', 'w' ) 4552 CALL pmci_extrap_ifoutflow_sn( e, 'n', 'e' ) 3859 4553 3860 4554 IF ( .NOT. neutral ) THEN 3861 CALL pmci_extrap_ifoutflow_sn( pt, nzb_s_inner,'n', 's' )4555 CALL pmci_extrap_ifoutflow_sn( pt, 'n', 's' ) 3862 4556 ENDIF 3863 4557 3864 4558 IF ( humidity ) THEN 3865 3866 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' ) 4559 CALL pmci_extrap_ifoutflow_sn( q, 'n', 's' ) 3867 4560 3868 4561 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3869 ! CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner,'n', 's' )3870 CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner,'n', 's' )3871 ! CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner,'n', 's' )3872 CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner,'n', 's' )4562 ! CALL pmci_extrap_ifoutflow_sn( qc, 'n', 's' ) 4563 CALL pmci_extrap_ifoutflow_sn( qr, 'n', 's' ) 4564 ! CALL pmci_extrap_ifoutflow_sn( nc, 'n', 's' ) 4565 CALL pmci_extrap_ifoutflow_sn( nr, 'n', 's' ) 3873 4566 ENDIF 3874 4567 … … 3876 4569 3877 4570 IF ( passive_scalar ) THEN 3878 CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner,'n', 's' )4571 CALL pmci_extrap_ifoutflow_sn( s, 'n', 's' ) 3879 4572 ENDIF 3880 4573 … … 3883 4576 ENDIF 3884 4577 3885 ENDIF ! :IF ( nesting_mode /= 'vertical' )4578 ENDIF ! IF ( nesting_mode /= 'vertical' ) 3886 4579 3887 4580 ! … … 4016 4709 4017 4710 SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4018 r2z, kb, logc, logc_ratio, nzt_topo_nestbc,&4711 r2z, logc, logc_ratio, nzt_topo_nestbc, & 4019 4712 edge, var ) 4020 4713 ! … … 4040 4733 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !: 4041 4734 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !: 4042 INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) :: kb !:4043 4735 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !: 4044 4736 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn), & … … 4049 4741 CHARACTER(LEN=1), INTENT(IN) :: var !: 4050 4742 4051 INTEGER(iwp) :: i !: 4052 INTEGER(iwp) :: ib !: 4053 INTEGER(iwp) :: ibgp !: 4054 INTEGER(iwp) :: iw !: 4055 INTEGER(iwp) :: j !: 4056 INTEGER(iwp) :: jco !: 4057 INTEGER(iwp) :: jcorr !: 4058 INTEGER(iwp) :: jinc !: 4059 INTEGER(iwp) :: jw !: 4060 INTEGER(iwp) :: j1 !: 4061 INTEGER(iwp) :: k !: 4062 INTEGER(iwp) :: kco !: 4063 INTEGER(iwp) :: kcorr !: 4064 INTEGER(iwp) :: k1 !: 4065 INTEGER(iwp) :: l !: 4066 INTEGER(iwp) :: m !: 4067 INTEGER(iwp) :: n !: 4068 INTEGER(iwp) :: kbc !: 4743 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid 4744 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid 4745 INTEGER(iwp) :: i !: 4746 INTEGER(iwp) :: ib !: 4747 INTEGER(iwp) :: ibgp !: 4748 INTEGER(iwp) :: iw !: 4749 INTEGER(iwp) :: j !: 4750 INTEGER(iwp) :: jco !: 4751 INTEGER(iwp) :: jcorr !: 4752 INTEGER(iwp) :: jinc !: 4753 INTEGER(iwp) :: jw !: 4754 INTEGER(iwp) :: j1 !: 4755 INTEGER(iwp) :: k !: 4756 INTEGER(iwp) :: k_wall !: vertical index of topography top 4757 INTEGER(iwp) :: kco !: 4758 INTEGER(iwp) :: kcorr !: 4759 INTEGER(iwp) :: k1 !: 4760 INTEGER(iwp) :: l !: 4761 INTEGER(iwp) :: m !: 4762 INTEGER(iwp) :: n !: 4763 INTEGER(iwp) :: kbc !: 4069 4764 4070 4765 REAL(wp) :: coarse_dx !: … … 4094 4789 ib = nxr + 2 4095 4790 ENDIF 4791 ! 4792 !-- Determine number of flag array to be used to mask topography 4793 IF ( var == 'u' ) THEN 4794 flag_nr = 1 4795 flag_nr2 = 14 4796 ELSEIF ( var == 'v' ) THEN 4797 flag_nr = 2 4798 flag_nr2 = 16 4799 ELSEIF ( var == 'w' ) THEN 4800 flag_nr = 3 4801 flag_nr2 = 18 4802 ELSE 4803 flag_nr = 0 4804 flag_nr2 = 12 4805 ENDIF 4096 4806 4097 4807 DO j = nys, nyn+1 4098 DO k = kb(j,i), nzt+14808 DO k = nzb, nzt+1 4099 4809 l = ic(i) 4100 4810 m = jc(j) … … 4119 4829 IF ( var == 'u' .OR. var == 'v' ) THEN 4120 4830 DO j = nys, nyn 4121 k = kb(j,i)+1 4831 ! 4832 !-- Determine vertical index of topography top at grid point (j,i) 4833 k_wall = MAXLOC( & 4834 MERGE( 1, 0, & 4835 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 4836 ), DIM = 1 & 4837 ) - 1 4838 4839 k = k_wall+1 4122 4840 IF ( ( logc(1,k,j) /= 0 ) .AND. ( logc(2,k,j) == 0 ) ) THEN 4123 4841 k1 = logc(1,k,j) … … 4141 4859 !-- Solid surface only on south/north side of the node 4142 4860 DO j = nys, nyn 4143 DO k = kb(j,i)+1, nzt_topo_nestbc 4861 ! 4862 !-- Determine vertical index of topography top at grid point (j,i) 4863 k_wall = MAXLOC( & 4864 MERGE( 1, 0, & 4865 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4866 ), DIM = 1 & 4867 ) - 1 4868 DO k = k_wall+1, nzt_topo_nestbc 4144 4869 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) == 0 ) ) THEN 4145 4870 ! … … 4162 4887 IF ( var == 'u' ) THEN 4163 4888 DO j = nys, nyn 4164 k = kb(j,i) + 1 4889 ! 4890 !-- Determine vertical index of topography top at grid point (j,i) 4891 k_wall = MAXLOC( & 4892 MERGE( 1, 0, & 4893 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4894 ), DIM = 1 & 4895 ) - 1 4896 k = k_wall + 1 4165 4897 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) /= 0 ) ) THEN 4166 4898 k1 = logc(1,k,j) … … 4190 4922 IF ( edge == 'l' ) THEN 4191 4923 DO j = nys, nyn + 1 4192 DO k = kb(j,i), nzt + 1 4924 ! 4925 !-- Determine vertical index of topography top at grid point (j,i) 4926 k_wall = MAXLOC( & 4927 MERGE( 1, 0, & 4928 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4929 ), DIM = 1 & 4930 ) - 1 4931 DO k = k_wall, nzt + 1 4193 4932 f(k,j,i) = tkefactor_l(k,j) * f(k,j,i) 4194 4933 ENDDO … … 4196 4935 ELSEIF ( edge == 'r' ) THEN 4197 4936 DO j = nys, nyn+1 4198 DO k = kb(j,i), nzt+1 4937 ! 4938 !-- Determine vertical index of topography top at grid point (j,i) 4939 k_wall = MAXLOC( & 4940 MERGE( 1, 0, & 4941 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 4942 ), DIM = 1 & 4943 ) - 1 4944 DO k = k_wall, nzt+1 4199 4945 f(k,j,i) = tkefactor_r(k,j) * f(k,j,i) 4200 4946 ENDDO … … 4220 4966 4221 4967 SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4222 r2z, kb,logc, logc_ratio, &4968 r2z, logc, logc_ratio, & 4223 4969 nzt_topo_nestbc, edge, var ) 4224 4970 … … 4245 4991 INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) :: ic !: 4246 4992 INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) :: jc !: 4247 INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) :: kb !:4248 4993 INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) :: kc !: 4249 4994 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr), & … … 4254 4999 CHARACTER(LEN=1), INTENT(IN) :: var !: 4255 5000 5001 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid 5002 INTEGER(iwp) :: flag_nr2 !: Number of flag array to indicate vertical index of topography top on respective u/v/w or s grid 4256 5003 INTEGER(iwp) :: i !: 4257 5004 INTEGER(iwp) :: iinc !: … … 4263 5010 INTEGER(iwp) :: jbgp !: 4264 5011 INTEGER(iwp) :: k !: 5012 INTEGER(iwp) :: k_wall !: vertical index of topography top 4265 5013 INTEGER(iwp) :: kcorr !: 4266 5014 INTEGER(iwp) :: kco !: … … 4297 5045 ENDIF 4298 5046 5047 ! 5048 !-- Determine number of flag array to be used to mask topography 5049 IF ( var == 'u' ) THEN 5050 flag_nr = 1 5051 flag_nr2 = 14 5052 ELSEIF ( var == 'v' ) THEN 5053 flag_nr = 2 5054 flag_nr2 = 16 5055 ELSEIF ( var == 'w' ) THEN 5056 flag_nr = 3 5057 flag_nr2 = 18 5058 ELSE 5059 flag_nr = 0 5060 flag_nr2 = 12 5061 ENDIF 5062 4299 5063 DO i = nxl, nxr+1 4300 DO k = kb(j,i), nzt+1 5064 ! 5065 !-- Determine vertical index of topography top at grid point (j,i) 5066 k_wall = MAXLOC( & 5067 MERGE( 1, 0, & 5068 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 5069 ), DIM = 1 & 5070 ) - 1 5071 DO k = k_wall, nzt+1 4301 5072 l = ic(i) 4302 5073 m = jc(j) … … 4321 5092 IF ( var == 'u' .OR. var == 'v' ) THEN 4322 5093 DO i = nxl, nxr 4323 k = kb(j,i) + 1 5094 ! 5095 !-- Determine vertical index of topography top at grid point (j,i) 5096 k_wall = MAXLOC( & 5097 MERGE( 1, 0, & 5098 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 )& 5099 ), DIM = 1 & 5100 ) - 1 5101 5102 k = k_wall + 1 4324 5103 IF ( ( logc(1,k,i) /= 0 ) .AND. ( logc(2,k,i) == 0 ) ) THEN 4325 5104 k1 = logc(1,k,i) … … 4342 5121 IF ( var == 'v' .OR. var == 'w' ) THEN 4343 5122 DO i = nxl, nxr 4344 DO k = kb(j,i), nzt_topo_nestbc 5123 ! 5124 !-- Determine vertical index of topography top at grid point (j,i) 5125 k_wall = MAXLOC( & 5126 MERGE( 1, 0, & 5127 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5128 ), DIM = 1 & 5129 ) - 1 5130 DO k = k_wall, nzt_topo_nestbc 4345 5131 ! 4346 5132 !-- Solid surface only on left/right side of the node … … 4365 5151 IF ( var == 'v' ) THEN 4366 5152 DO i = nxl, nxr 4367 k = kb(j,i) + 1 5153 ! 5154 !-- Determine vertical index of topography top at grid point (j,i) 5155 k_wall = MAXLOC( & 5156 MERGE( 1, 0, & 5157 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5158 ), DIM = 1 & 5159 ) - 1 5160 k = k_wall + 1 4368 5161 IF ( ( logc(2,k,i) /= 0 ) .AND. ( logc(1,k,i) /= 0 ) ) THEN 4369 5162 k1 = logc(1,k,i) … … 4393 5186 IF ( edge == 's' ) THEN 4394 5187 DO i = nxl, nxr + 1 4395 DO k = kb(j,i), nzt+1 5188 ! 5189 !-- Determine vertical index of topography top at grid point (j,i) 5190 k_wall = MAXLOC( & 5191 MERGE( 1, 0, & 5192 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr2 ) & 5193 ), DIM = 1 & 5194 ) - 1 5195 DO k = k_wall, nzt+1 4396 5196 f(k,j,i) = tkefactor_s(k,i) * f(k,j,i) 4397 5197 ENDDO … … 4399 5199 ELSEIF ( edge == 'n' ) THEN 4400 5200 DO i = nxl, nxr + 1 4401 DO k = kb(j,i), nzt+1 5201 ! 5202 !-- 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_nr2 ) & 5206 ), DIM = 1 & 5207 ) - 1 5208 DO k = k_wall, nzt+1 4402 5209 f(k,j,i) = tkefactor_n(k,i) * f(k,j,i) 4403 5210 ENDDO … … 4510 5317 4511 5318 4512 SUBROUTINE pmci_extrap_ifoutflow_lr( f, kb,edge, var )5319 SUBROUTINE pmci_extrap_ifoutflow_lr( f, edge, var ) 4513 5320 ! 4514 5321 !-- After the interpolation of ghost-node values for the child-domain … … 4524 5331 CHARACTER(LEN=1), INTENT(IN) :: var !: 4525 5332 4526 INTEGER(iwp) :: i !:4527 INTEGER(iwp) :: i b!:4528 INTEGER(iwp) :: ib gp!:4529 INTEGER(iwp) :: i ed!:4530 INTEGER(iwp) :: j!:4531 INTEGER(iwp) :: k!:4532 4533 INTEGER(iwp) , DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) :: kb!:5333 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid 5334 INTEGER(iwp) :: i !: 5335 INTEGER(iwp) :: ib !: 5336 INTEGER(iwp) :: ibgp !: 5337 INTEGER(iwp) :: ied !: 5338 INTEGER(iwp) :: j !: 5339 INTEGER(iwp) :: k !: 5340 INTEGER(iwp) :: k_wall !: 4534 5341 4535 5342 REAL(wp) :: outnor !: … … 4557 5364 outnor = 1.0_wp 4558 5365 ENDIF 5366 ! 5367 !-- Determine number of flag array to be used to mask topography 5368 IF ( var == 'u' ) THEN 5369 flag_nr = 14 5370 ELSEIF ( var == 'v' ) THEN 5371 flag_nr = 16 5372 ELSEIF ( var == 'w' ) THEN 5373 flag_nr = 18 5374 ELSE 5375 flag_nr = 12 5376 ENDIF 4559 5377 4560 5378 DO j = nys, nyn+1 4561 DO k = kb(j,i), nzt+1 5379 ! 5380 !-- Determine vertical index of topography top at grid point (j,i) 5381 k_wall = MAXLOC( & 5382 MERGE( 1, 0, & 5383 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5384 ), DIM = 1 & 5385 ) - 1 5386 DO k = k_wall, nzt+1 4562 5387 vdotnor = outnor * u(k,j,ied) 4563 5388 ! … … 4568 5393 ENDDO 4569 5394 IF ( (var == 'u' ) .OR. (var == 'v' ) .OR. (var == 'w') ) THEN 4570 f(k b(j,i),j,i) = 0.0_wp5395 f(k_wall,j,i) = 0.0_wp 4571 5396 ENDIF 4572 5397 ENDDO … … 4588 5413 4589 5414 4590 SUBROUTINE pmci_extrap_ifoutflow_sn( f, kb,edge, var )5415 SUBROUTINE pmci_extrap_ifoutflow_sn( f, edge, var ) 4591 5416 ! 4592 5417 !-- After the interpolation of ghost-node values for the child-domain … … 4601 5426 CHARACTER(LEN=1), INTENT(IN) :: var !: 4602 5427 5428 INTEGER(iwp) :: flag_nr !: Number of flag array to mask topography on respective u/v/w or s grid 4603 5429 INTEGER(iwp) :: i !: 4604 5430 INTEGER(iwp) :: j !: … … 4607 5433 INTEGER(iwp) :: jed !: 4608 5434 INTEGER(iwp) :: k !: 4609 4610 INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) :: kb !: 5435 INTEGER(iwp) :: k_wall !: 4611 5436 4612 5437 REAL(wp) :: outnor !: … … 4635 5460 ENDIF 4636 5461 5462 ! 5463 !-- Determine number of flag array to be used to mask topography 5464 IF ( var == 'u' ) THEN 5465 flag_nr = 14 5466 ELSEIF ( var == 'v' ) THEN 5467 flag_nr = 16 5468 ELSEIF ( var == 'w' ) THEN 5469 flag_nr = 18 5470 ELSE 5471 flag_nr = 12 5472 ENDIF 5473 4637 5474 DO i = nxl, nxr+1 4638 DO k = kb(j,i), nzt+1 5475 ! 5476 !-- Determine vertical index of topography top at grid point (j,i) 5477 k_wall = MAXLOC( & 5478 MERGE( 1, 0, & 5479 BTEST( wall_flags_0(nzb:nzb_max,j,i), flag_nr ) & 5480 ), DIM = 1 & 5481 ) - 1 5482 DO k = k_wall, nzt+1 4639 5483 vdotnor = outnor * v(k,jed,i) 4640 5484 ! … … 4645 5489 ENDDO 4646 5490 IF ( (var == 'u' ) .OR. (var == 'v' ) .OR. (var == 'w') ) THEN 4647 f(k b(j,i),j,i) = 0.0_wp5491 f(k_wall,j,i) = 0.0_wp 4648 5492 ENDIF 4649 5493 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
