Changeset 2812 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Feb 16, 2018 1:40:25 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (78 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2809 r2812 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfixes in computation of the interpolation loglaw-correction parameters 28 ! 29 ! 2809 2018-02-15 09:55:58Z schwenkel 27 30 ! Bugfix for gfortran: Replace the function C_SIZEOF with STORAGE_SIZE 28 31 ! … … 415 418 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_r !< 416 419 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: logc_w_s !< 420 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_u_l !< 421 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_u_n !< 422 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_u_r !< 423 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_u_s !< 424 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_v_l !< 425 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_v_n !< 426 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_v_r !< 427 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_v_s !< 428 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_w_l !< 429 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_w_n !< 430 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_w_r !< 431 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: logc_kbounds_w_s !< 417 432 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_l !< 418 433 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: logc_ratio_u_n !< … … 629 644 IF ( TRIM( nesting_mode ) /= 'one-way' .AND. & 630 645 TRIM( nesting_mode ) /= 'two-way' .AND. & 631 TRIM( nesting_mode ) /= 'vertical' ) & 646 TRIM( nesting_mode ) /= 'vertical' ) & 632 647 THEN 633 648 message_string = 'illegal nesting mode: ' // TRIM( nesting_mode ) … … 1184 1199 1185 1200 IF( particle_advection ) THEN 1186 CALL pmc_set_dataarray_name( 'coarse', 'nr_part' ,'fine', 'nr_part', ierr ) 1187 CALL pmc_set_dataarray_name( 'coarse', 'part_adr' ,'fine', 'part_adr', ierr ) 1201 CALL pmc_set_dataarray_name( 'coarse', 'nr_part' ,'fine', & 1202 'nr_part', ierr ) 1203 CALL pmc_set_dataarray_name( 'coarse', 'part_adr' ,'fine', & 1204 'part_adr', ierr ) 1188 1205 ENDIF 1189 1206 … … 1599 1616 !-- Determine largest topography index on scalar grid 1600 1617 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1601 1618 get_topography_top_index_ji( j, i, 's' ) ) 1602 1619 ! 1603 1620 !-- Determine largest topography index on u grid 1604 1621 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1605 1622 get_topography_top_index_ji( j, i, 'u' ) ) 1606 1623 ! 1607 1624 !-- Determine largest topography index on v grid 1608 1625 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1609 1626 get_topography_top_index_ji( j, i, 'v' ) ) 1610 1627 ! 1611 1628 !-- Determine largest topography index on w grid 1612 1629 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, & 1613 1630 get_topography_top_index_ji( j, i, 'w' ) ) 1614 1631 ENDDO 1615 1632 ENDDO … … 1625 1642 !-- Determine largest topography index on scalar grid 1626 1643 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1627 1644 get_topography_top_index_ji( j, i, 's' ) ) 1628 1645 ! 1629 1646 !-- Determine largest topography index on u grid 1630 1647 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1631 1648 get_topography_top_index_ji( j, i, 'u' ) ) 1632 1649 ! 1633 1650 !-- Determine largest topography index on v grid 1634 1651 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1635 1652 get_topography_top_index_ji( j, i, 'v' ) ) 1636 1653 ! 1637 1654 !-- Determine largest topography index on w grid 1638 1655 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, & 1639 1656 get_topography_top_index_ji( j, i, 'w' ) ) 1640 1657 ENDDO 1641 1658 nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1 … … 1650 1667 !-- Determine largest topography index on scalar grid 1651 1668 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1652 1669 get_topography_top_index_ji( j, i, 's' ) ) 1653 1670 ! 1654 1671 !-- Determine largest topography index on u grid 1655 1672 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1656 1673 get_topography_top_index_ji( j, i, 'u' ) ) 1657 1674 ! 1658 1675 !-- Determine largest topography index on v grid 1659 1676 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1660 1677 get_topography_top_index_ji( j, i, 'v' ) ) 1661 1678 ! 1662 1679 !-- Determine largest topography index on w grid 1663 1680 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, & 1664 1681 get_topography_top_index_ji( j, i, 'w' ) ) 1665 1682 ENDDO 1666 1683 ENDDO … … 1676 1693 !-- Determine largest topography index on scalar grid 1677 1694 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1678 1695 get_topography_top_index_ji( j, i, 's' ) ) 1679 1696 ! 1680 1697 !-- Determine largest topography index on u grid 1681 1698 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1682 1699 get_topography_top_index_ji( j, i, 'u' ) ) 1683 1700 ! 1684 1701 !-- Determine largest topography index on v grid 1685 1702 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1686 1703 get_topography_top_index_ji( j, i, 'v' ) ) 1687 1704 ! 1688 1705 !-- Determine largest topography index on w grid 1689 1706 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, & 1690 1707 get_topography_top_index_ji( j, i, 'w' ) ) 1691 1708 ENDDO 1692 1709 nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1 … … 1695 1712 !-- Then determine the maximum number of near-wall nodes per wall point based 1696 1713 !-- on the grid-spacing ratios. 1697 nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r, 1714 nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r, & 1698 1715 nzt_topo_nestbc_s, nzt_topo_nestbc_n ) 1699 1716 ! … … 1713 1730 z0_topo = roughness_length 1714 1731 ! 1715 !-- First horizontal walls. Note that also logc_w_? and logc_ratio_w_? need to1716 !-- be allocated and initialized here.1732 !-- First horizontal walls. Note that also logc_w_? and logc_ratio_w_? and 1733 !-- logc_kbounds_* need to be allocated and initialized here. 1717 1734 !-- Left boundary 1718 1735 IF ( nest_bound_l ) THEN … … 1721 1738 ALLOCATE( logc_v_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) ) 1722 1739 ALLOCATE( logc_w_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) ) 1740 ALLOCATE( logc_kbounds_u_l(1:2,nys:nyn) ) 1741 ALLOCATE( logc_kbounds_v_l(1:2,nys:nyn) ) 1742 ALLOCATE( logc_kbounds_w_l(1:2,nys:nyn) ) 1723 1743 ALLOCATE( logc_ratio_u_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) ) 1724 1744 ALLOCATE( logc_ratio_v_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) ) … … 1778 1798 ALLOCATE( logc_u_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) ) 1779 1799 ALLOCATE( logc_v_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) ) 1780 ALLOCATE( logc_w_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) ) 1800 ALLOCATE( logc_w_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) ) 1801 ALLOCATE( logc_kbounds_u_r(1:2,nys:nyn) ) 1802 ALLOCATE( logc_kbounds_v_r(1:2,nys:nyn) ) 1803 ALLOCATE( logc_kbounds_w_r(1:2,nys:nyn) ) 1781 1804 ALLOCATE( logc_ratio_u_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) ) 1782 1805 ALLOCATE( logc_ratio_v_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) ) … … 1838 1861 ALLOCATE( logc_v_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) ) 1839 1862 ALLOCATE( logc_w_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) ) 1863 ALLOCATE( logc_kbounds_u_s(1:2,nxl:nxr) ) 1864 ALLOCATE( logc_kbounds_v_s(1:2,nxl:nxr) ) 1865 ALLOCATE( logc_kbounds_w_s(1:2,nxl:nxr) ) 1840 1866 ALLOCATE( logc_ratio_u_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) ) 1841 1867 ALLOCATE( logc_ratio_v_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) ) … … 1894 1920 ALLOCATE( logc_v_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) ) 1895 1921 ALLOCATE( logc_w_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) ) 1922 ALLOCATE( logc_kbounds_u_n(1:2,nxl:nxr) ) 1923 ALLOCATE( logc_kbounds_v_n(1:2,nxl:nxr) ) 1924 ALLOCATE( logc_kbounds_w_n(1:2,nxl:nxr) ) 1896 1925 ALLOCATE( logc_ratio_u_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) ) 1897 1926 ALLOCATE( logc_ratio_v_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) ) … … 1955 1984 z0_topo = roughness_length 1956 1985 1957 kb = 0 ! kb is not used when direction > 1 1986 kb = 0 ! kb is not used when direction > 1 1958 1987 ! 1959 1988 !-- Left boundary 1960 1961 !1962 !-- Are loglaw-correction parameters also calculated inside topo?1963 1989 IF ( nest_bound_l ) THEN 1964 1990 logc_kbounds_u_l(1:2,nys:nyn) = 0 1991 logc_kbounds_v_l(1:2,nys:nyn) = 0 1992 logc_kbounds_w_l(1:2,nys:nyn) = 0 1993 1965 1994 direction = 2 1966 1995 1967 1996 DO j = nys, nyn 1968 1997 ! 1969 !-- Determine lowest grid on outer grids for u and w. 1970 k_wall_u_ji = get_topography_top_index_ji( j, 0, 'u_out' ) 1971 k_wall_u_ji_p = get_topography_top_index_ji( j+1, 0, 'u_out' ) 1972 k_wall_u_ji_m = get_topography_top_index_ji( j-1, 0, 'u_out' ) 1973 1974 k_wall_w_ji = get_topography_top_index_ji( j, -1, 'w_out' ) 1975 k_wall_w_ji_p = get_topography_top_index_ji( j+1, -1, 'w_out' ) 1976 k_wall_w_ji_m = get_topography_top_index_ji( j-1, -1, 'w_out' ) 1977 1978 DO k = nzb, nzt_topo_nestbc_l 1979 1980 i = 0 1981 ! 1982 !-- Wall for u on the south side, but not on the north side 1983 IF ( ( k_wall_u_ji > k_wall_u_ji_p ) .AND. & 1984 ( k_wall_u_ji == k_wall_u_ji_m ) ) & 1985 THEN 1986 inc = 1 1987 wall_index = j 1998 !-- Determine the lowest k-indices for u at j,i, j+1,i and j-1,i. 1999 i = 0 2000 k_wall_u_ji = get_topography_top_index_ji( j, i, 'u' ) 2001 k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' ) 2002 k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' ) 2003 ! 2004 !-- Wall for u on the south side. 2005 IF ( ( k_wall_u_ji < k_wall_u_ji_m ) .AND. & 2006 ( k_wall_u_ji >= k_wall_u_ji_p ) ) THEN 2007 inc = 1 2008 wall_index = j 2009 ! 2010 !-- Store the kbounds for use in pmci_interp_tril_lr. 2011 logc_kbounds_u_l(1,j) = k_wall_u_ji + 1 2012 logc_kbounds_u_l(2,j) = k_wall_u_ji_m 2013 DO k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j) 1988 2014 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 1989 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2015 k, j, inc, wall_index, z0_topo, kb, direction, & 2016 ncorr ) 1990 2017 ! 1991 2018 !-- The direction of the wall-normal index is stored as the … … 1994 2021 logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 1995 2022 lcr(0:ncorr-1) = 1.0_wp 1996 ENDIF 1997 ! 1998 !-- Wall for u on the north side, but not on the south side 1999 IF ( ( k_wall_u_ji > k_wall_u_ji_m ) .AND. & 2000 ( k_wall_u_ji == k_wall_u_ji_p ) ) THEN 2001 inc = -1 2002 wall_index = j + 1 2023 ENDDO 2024 ENDIF 2025 ! 2026 !-- Wall for u on the north side. 2027 IF ( ( k_wall_u_ji < k_wall_u_ji_p ) .AND. & 2028 ( k_wall_u_ji >= k_wall_u_ji_m ) ) THEN 2029 inc = -1 2030 wall_index = j + 1 2031 ! 2032 !-- Store the kbounds for use in pmci_interp_tril_lr. 2033 logc_kbounds_u_l(1,j) = k_wall_u_ji + 1 2034 logc_kbounds_u_l(2,j) = k_wall_u_ji_p 2035 DO k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j) 2003 2036 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2004 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2037 k, j, inc, wall_index, z0_topo, kb, direction, & 2038 ncorr ) 2005 2039 ! 2006 2040 !-- The direction of the wall-normal index is stored as the … … 2009 2043 logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2010 2044 lcr(0:ncorr-1) = 1.0_wp 2011 ENDIF 2012 2013 i = -1 2014 ! 2015 !-- Wall for w on the south side, but not on the north side. 2016 2017 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2018 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 2019 inc = 1 2020 wall_index = j 2045 ENDDO 2046 ENDIF 2047 ! 2048 !-- Determine the lowest k-indices for w at j,i, j+1,i and j-1,i. 2049 i = -1 2050 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w' ) 2051 k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' ) 2052 k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' ) 2053 ! 2054 !-- Wall for w on the south side. 2055 IF ( ( k_wall_w_ji < k_wall_w_ji_m ) .AND. & 2056 ( k_wall_w_ji >= k_wall_w_ji_p ) ) THEN 2057 inc = 1 2058 wall_index = j 2059 ! 2060 !-- Store the kbounds for use in pmci_interp_tril_lr. 2061 logc_kbounds_w_l(1,j) = k_wall_w_ji + 1 2062 logc_kbounds_w_l(2,j) = k_wall_w_ji_m 2063 DO k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j) 2021 2064 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2022 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2065 k, j, inc, wall_index, z0_topo, kb, direction, & 2066 ncorr ) 2023 2067 ! 2024 2068 !-- The direction of the wall-normal index is stored as the … … 2027 2071 logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2028 2072 lcr(0:ncorr-1) = 1.0_wp 2029 ENDIF 2030 ! 2031 !-- Wall for w on the north side, but not on the south side. 2032 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2033 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 2034 inc = -1 2035 wall_index = j+1 2073 ENDDO 2074 ENDIF 2075 ! 2076 !-- Wall for w on the north side. 2077 IF ( ( k_wall_w_ji < k_wall_w_ji_p ) .AND. & 2078 ( k_wall_w_ji >= k_wall_w_ji_m ) ) THEN 2079 inc = -1 2080 wall_index = j+1 2081 ! 2082 !-- Store the kbounds for use in pmci_interp_tril_lr. 2083 logc_kbounds_w_l(1,j) = k_wall_w_ji + 1 2084 logc_kbounds_w_l(2,j) = k_wall_w_ji_p 2085 DO k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j) 2036 2086 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2037 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2087 k, j, inc, wall_index, z0_topo, kb, direction, & 2088 ncorr ) 2038 2089 ! 2039 2090 !-- The direction of the wall-normal index is stored as the … … 2042 2093 logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2043 2094 lcr(0:ncorr-1) = 1.0_wp 2044 END IF2045 2046 ENDDO2095 ENDDO 2096 ENDIF 2097 2047 2098 ENDDO 2048 2099 … … 2051 2102 !-- Right boundary 2052 2103 IF ( nest_bound_r ) THEN 2104 logc_kbounds_u_r(1:2,nys:nyn) = 0 2105 logc_kbounds_v_r(1:2,nys:nyn) = 0 2106 logc_kbounds_w_r(1:2,nys:nyn) = 0 2053 2107 2054 2108 direction = 2 2055 i = nx r+ 12109 i = nx + 1 2056 2110 2057 2111 DO j = nys, nyn 2058 2112 ! 2059 !-- Determine lowest grid on outer grids for u and w. 2060 k_wall_u_ji = get_topography_top_index_ji( j, i, 'u_out' ) 2061 k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u_out' ) 2062 k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u_out' ) 2063 2064 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w_out' ) 2065 k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w_out' ) 2066 k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w_out' ) 2067 2068 DO k = nzb, nzt_topo_nestbc_r 2069 ! 2070 !-- Wall for u on the south side, but not on the north side 2071 IF ( ( k_wall_u_ji > k_wall_u_ji_p ) .AND. & 2072 ( k_wall_u_ji == k_wall_u_ji_m ) ) THEN 2073 inc = 1 2074 wall_index = j 2113 !-- Determine the lowest k-indices for u at j,i, j+1,i and j-1,i. 2114 k_wall_u_ji = get_topography_top_index_ji( j, i, 'u' ) 2115 k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' ) 2116 k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' ) 2117 ! 2118 !-- Wall for u on the south side. 2119 IF ( ( k_wall_u_ji < k_wall_u_ji_m ) .AND. & 2120 ( k_wall_u_ji >= k_wall_u_ji_p ) ) THEN 2121 inc = 1 2122 wall_index = j 2123 ! 2124 !-- Store the kbounds for use in pmci_interp_tril_lr. 2125 logc_kbounds_u_r(1,j) = k_wall_u_ji + 1 2126 logc_kbounds_u_r(2,j) = k_wall_u_ji_m 2127 DO k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j) 2075 2128 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2076 k, j, inc, wall_index, z0_topo, kb, direction, ncorr )2129 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2077 2130 ! 2078 2131 !-- The direction of the wall-normal index is stored as the … … 2081 2134 logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2082 2135 lcr(0:ncorr-1) = 1.0_wp 2083 ENDIF 2084 ! 2085 !-- Wall for u on the north side, but not on the south side 2086 IF ( ( k_wall_u_ji > k_wall_u_ji_m ) .AND. & 2087 ( k_wall_u_ji == k_wall_u_ji_p ) ) THEN 2088 inc = -1 2089 wall_index = j+1 2090 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2091 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2136 ENDDO 2137 ENDIF 2138 ! 2139 !-- Wall for u on the south side. 2140 IF ( ( k_wall_u_ji < k_wall_u_ji_p ) .AND. & 2141 ( k_wall_u_ji >= k_wall_u_ji_m ) ) THEN 2142 inc = -1 2143 wall_index = j + 1 2144 ! 2145 !-- Store the kbounds for use in pmci_interp_tril_lr. 2146 logc_kbounds_u_r(1,j) = k_wall_u_ji + 1 2147 logc_kbounds_u_r(2,j) = k_wall_u_ji_p 2148 DO k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j) 2149 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2150 k, j, inc, wall_index, z0_topo, kb, direction, & 2151 ncorr ) 2092 2152 ! 2093 2153 !-- The direction of the wall-normal index is stored as the … … 2096 2156 logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2097 2157 lcr(0:ncorr-1) = 1.0_wp 2098 ENDIF 2099 ! 2100 !-- Wall for w on the south side, but not on the north side 2101 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2102 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 2103 inc = 1 2104 wall_index = j 2158 ENDDO 2159 ENDIF 2160 ! 2161 !-- Determine the lowest k-indices for w at j,i, j+1,i and j-1,i. 2162 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w' ) 2163 k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' ) 2164 k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' ) 2165 ! 2166 !-- Wall for w on the south side. 2167 IF ( ( k_wall_w_ji < k_wall_w_ji_m ) .AND. & 2168 ( k_wall_w_ji >= k_wall_w_ji_p ) ) THEN 2169 inc = 1 2170 wall_index = j 2171 ! 2172 !-- Store the kbounds for use in pmci_interp_tril_lr. 2173 logc_kbounds_w_r(1,j) = k_wall_w_ji + 1 2174 logc_kbounds_w_r(2,j) = k_wall_w_ji_m 2175 DO k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j) 2105 2176 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2106 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2177 k, j, inc, wall_index, z0_topo, kb, direction, & 2178 ncorr ) 2107 2179 ! 2108 2180 !-- The direction of the wall-normal index is stored as the … … 2111 2183 logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2112 2184 lcr(0:ncorr-1) = 1.0_wp 2113 ENDIF 2114 ! 2115 !-- Wall for w on the north side, but not on the south side 2116 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2117 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 2118 inc = -1 2119 wall_index = j+1 2185 ENDDO 2186 ENDIF 2187 ! 2188 !-- Wall for w on the north side. 2189 IF ( ( k_wall_w_ji < k_wall_w_ji_p ) .AND. & 2190 ( k_wall_w_ji >= k_wall_w_ji_m ) ) THEN 2191 inc = -1 2192 wall_index = j+1 2193 ! 2194 !-- Store the kbounds for use in pmci_interp_tril_lr. 2195 logc_kbounds_w_r(1,j) = k_wall_w_ji + 1 2196 logc_kbounds_w_r(2,j) = k_wall_w_ji_p 2197 DO k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j) 2120 2198 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2121 k, j, inc, wall_index, z0_topo, kb, direction, ncorr ) 2199 k, j, inc, wall_index, z0_topo, kb, direction, & 2200 ncorr ) 2122 2201 ! 2123 2202 !-- The direction of the wall-normal index is stored as the … … 2126 2205 logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1) 2127 2206 lcr(0:ncorr-1) = 1.0_wp 2128 END IF2129 2130 ENDDO2207 ENDDO 2208 ENDIF 2209 2131 2210 ENDDO 2132 2211 2133 2212 ENDIF ! IF ( nest_bound_r ) 2134 2213 ! 2135 2214 !-- South boundary 2136 2215 IF ( nest_bound_s ) THEN 2216 logc_kbounds_u_s(1:2,nxl:nxr) = 0 2217 logc_kbounds_v_s(1:2,nxl:nxr) = 0 2218 logc_kbounds_w_s(1:2,nxl:nxr) = 0 2137 2219 2138 2220 direction = 3 … … 2140 2222 DO i = nxl, nxr 2141 2223 ! 2142 !-- Determine lowest grid on outer grids for v and w. 2143 k_wall_v_ji = get_topography_top_index_ji( 0, i, 'v_out' ) 2144 k_wall_v_ji_p = get_topography_top_index_ji( 0, i+1, 'v_out' ) 2145 k_wall_v_ji_m = get_topography_top_index_ji( 0, i-1, 'v_out' ) 2146 2147 k_wall_w_ji = get_topography_top_index_ji( -1, i, 'w_out' ) 2148 k_wall_w_ji_p = get_topography_top_index_ji( -1, i+1, 'w_out' ) 2149 k_wall_w_ji_m = get_topography_top_index_ji( -1, i-1, 'w_out' ) 2150 2151 DO k = nzb, nzt_topo_nestbc_s 2152 ! 2153 !-- Wall for v on the left side, but not on the right side 2154 j = 0 2155 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2156 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 2157 inc = 1 2158 wall_index = i 2224 !-- Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1. 2225 j = 0 2226 k_wall_v_ji = get_topography_top_index_ji( j, i, 'v' ) 2227 k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' ) 2228 k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' ) 2229 ! 2230 !-- Wall for v on the left side. 2231 IF ( ( k_wall_v_ji < k_wall_v_ji_m ) .AND. & 2232 ( k_wall_v_ji >= k_wall_v_ji_p ) ) THEN 2233 inc = 1 2234 wall_index = i 2235 ! 2236 !-- Store the kbounds for use in pmci_interp_tril_sn. 2237 logc_kbounds_v_s(1,i) = k_wall_v_ji + 1 2238 logc_kbounds_v_s(2,i) = k_wall_v_ji_m 2239 DO k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i) 2159 2240 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2160 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2241 k, i, inc, wall_index, z0_topo, kb, direction, & 2242 ncorr ) 2161 2243 ! 2162 2244 !-- The direction of the wall-normal index is stored as the … … 2165 2247 logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2166 2248 lcr(0:ncorr-1) = 1.0_wp 2167 ENDIF 2168 ! 2169 !-- Wall for v on the right side, but not on the left side 2170 j = 0 2171 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2172 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 2173 inc = -1 2174 wall_index = i+1 2249 ENDDO 2250 ENDIF 2251 ! 2252 !-- Wall for v on the right side. 2253 IF ( ( k_wall_v_ji < k_wall_v_ji_p ) .AND. & 2254 ( k_wall_v_ji >= k_wall_v_ji_m ) ) THEN 2255 inc = -1 2256 wall_index = i+1 2257 ! 2258 !-- Store the kbounds for use in pmci_interp_tril_sn. 2259 logc_kbounds_v_s(1,i) = k_wall_v_ji + 1 2260 logc_kbounds_v_s(2,i) = k_wall_v_ji_p 2261 DO k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i) 2175 2262 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2176 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2263 k, i, inc, wall_index, z0_topo, kb, direction, & 2264 ncorr ) 2177 2265 ! 2178 2266 !-- The direction of the wall-normal index is stored as the … … 2181 2269 logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2182 2270 lcr(0:ncorr-1) = 1.0_wp 2183 ENDIF 2184 ! 2185 !-- Wall for w on the left side, but not on the right side 2186 j = -1 2187 IF ( ( k_wall_w_ji > k_wall_w_ji_p ) .AND. & 2188 ( k_wall_w_ji == k_wall_w_ji_m ) ) THEN 2189 inc = 1 2190 wall_index = i 2271 ENDDO 2272 ENDIF 2273 ! 2274 !-- Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1. 2275 j = -1 2276 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w' ) 2277 k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' ) 2278 k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' ) 2279 ! 2280 !-- Wall for w on the left side. 2281 IF ( ( k_wall_w_ji < k_wall_w_ji_m ) .AND. & 2282 ( k_wall_w_ji >= k_wall_w_ji_p ) ) THEN 2283 inc = 1 2284 wall_index = i 2285 ! 2286 !-- Store the kbounds for use in pmci_interp_tril_sn. 2287 logc_kbounds_w_s(1,i) = k_wall_w_ji + 1 2288 logc_kbounds_w_s(2,i) = k_wall_w_ji_m 2289 DO k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i) 2191 2290 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2192 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2291 k, i, inc, wall_index, z0_topo, kb, direction, & 2292 ncorr ) 2193 2293 ! 2194 2294 !-- The direction of the wall-normal index is stored as the … … 2197 2297 logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2198 2298 lcr(0:ncorr-1) = 1.0_wp 2199 ENDIF 2200 2201 ! 2202 !-- Wall for w on the right side, but not on the left side 2203 j = -1 2204 IF ( ( k_wall_w_ji > k_wall_w_ji_m ) .AND. & 2205 ( k_wall_w_ji == k_wall_w_ji_p ) ) THEN 2206 inc = -1 2207 wall_index = i+1 2299 ENDDO 2300 ENDIF 2301 ! 2302 !-- Wall for w on the right side. 2303 IF ( ( k_wall_w_ji < k_wall_w_ji_p ) .AND. & 2304 ( k_wall_w_ji >= k_wall_w_ji_m ) ) THEN 2305 inc = -1 2306 wall_index = i+1 2307 ! 2308 !-- Store the kbounds for use in pmci_interp_tril_sn. 2309 logc_kbounds_w_s(1,i) = k_wall_w_ji + 1 2310 logc_kbounds_w_s(2,i) = k_wall_w_ji_p 2311 DO k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i) 2208 2312 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2209 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2313 k, i, inc, wall_index, z0_topo, kb, direction, & 2314 ncorr ) 2210 2315 ! 2211 2316 !-- The direction of the wall-normal index is stored as the … … 2214 2319 logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2215 2320 lcr(0:ncorr-1) = 1.0_wp 2216 END IF2217 2218 ENDDO 2321 ENDDO 2322 ENDIF 2323 2219 2324 ENDDO 2220 2325 … … 2223 2328 !-- North boundary 2224 2329 IF ( nest_bound_n ) THEN 2330 logc_kbounds_u_n(1:2,nxl:nxr) = 0 2331 logc_kbounds_v_n(1:2,nxl:nxr) = 0 2332 logc_kbounds_w_n(1:2,nxl:nxr) = 0 2225 2333 2226 2334 direction = 3 2227 j = ny n+ 12335 j = ny + 1 2228 2336 2229 2337 DO i = nxl, nxr 2230 2338 ! 2231 !-- Determine lowest grid on outer grids for v and w. 2232 k_wall_v_ji = get_topography_top_index_ji( j, i, 'v_out' ) 2233 k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v_out' ) 2234 k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v_out' ) 2235 2236 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w_out' ) 2237 k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w_out' ) 2238 k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w_out' ) 2239 2240 DO k = nzb, nzt_topo_nestbc_n 2241 ! 2242 !-- Wall for v on the left side, but not on the right side 2243 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2244 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 2245 inc = 1 2246 wall_index = i 2339 !-- Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1 2340 k_wall_v_ji = get_topography_top_index_ji( j, i, 'v' ) 2341 k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' ) 2342 k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' ) 2343 ! 2344 !-- Wall for v on the left side. 2345 IF ( ( k_wall_v_ji < k_wall_v_ji_m ) .AND. & 2346 ( k_wall_v_ji >= k_wall_v_ji_p ) ) THEN 2347 inc = 1 2348 wall_index = i 2349 ! 2350 !-- Store the kbounds for use in pmci_interp_tril_sn. 2351 logc_kbounds_v_n(1,i) = k_wall_v_ji + 1 2352 logc_kbounds_v_n(2,i) = k_wall_v_ji_m 2353 DO k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i) 2247 2354 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2248 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2355 k, i, inc, wall_index, z0_topo, kb, direction, & 2356 ncorr ) 2249 2357 ! 2250 2358 !-- The direction of the wall-normal index is stored as the … … 2253 2361 logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2254 2362 lcr(0:ncorr-1) = 1.0_wp 2255 ENDIF 2256 ! 2257 !-- Wall for v on the right side, but not on the left side 2258 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2259 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 2260 inc = -1 2261 wall_index = i + 1 2363 ENDDO 2364 ENDIF 2365 ! 2366 !-- Wall for v on the right side. 2367 IF ( ( k_wall_v_ji < k_wall_v_ji_p ) .AND. & 2368 ( k_wall_v_ji >= k_wall_v_ji_m ) ) THEN 2369 inc = -1 2370 wall_index = i + 1 2371 ! 2372 !-- Store the kbounds for use in pmci_interp_tril_sn. 2373 logc_kbounds_v_n(1,i) = k_wall_v_ji + 1 2374 logc_kbounds_v_n(2,i) = k_wall_v_ji_p 2375 DO k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i) 2262 2376 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2263 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2377 k, i, inc, wall_index, z0_topo, kb, direction, & 2378 ncorr ) 2264 2379 ! 2265 2380 !-- The direction of the wall-normal index is stored as the … … 2268 2383 logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2269 2384 lcr(0:ncorr-1) = 1.0_wp 2270 ENDIF 2271 ! 2272 !-- Wall for w on the left side, but not on the right side 2273 IF ( ( k_wall_v_ji > k_wall_v_ji_p ) .AND. & 2274 ( k_wall_v_ji == k_wall_v_ji_m ) ) THEN 2275 inc = 1 2276 wall_index = i 2385 ENDDO 2386 ENDIF 2387 ! 2388 !-- Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1. 2389 k_wall_w_ji = get_topography_top_index_ji( j, i, 'w' ) 2390 k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' ) 2391 k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' ) 2392 ! 2393 !-- Wall for w on the left side. 2394 IF ( ( k_wall_w_ji < k_wall_w_ji_m ) .AND. & 2395 ( k_wall_w_ji >= k_wall_w_ji_p ) ) THEN 2396 inc = 1 2397 wall_index = i 2398 ! 2399 !-- Store the kbounds for use in pmci_interp_tril_sn. 2400 logc_kbounds_w_n(1,i) = k_wall_w_ji + 1 2401 logc_kbounds_w_n(2,i) = k_wall_w_ji_m 2402 DO k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i) 2277 2403 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2278 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2404 k, i, inc, wall_index, z0_topo, kb, direction, & 2405 ncorr ) 2279 2406 ! 2280 2407 !-- The direction of the wall-normal index is stored as the … … 2283 2410 logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2284 2411 lcr(0:ncorr-1) = 1.0_wp 2285 ENDIF 2286 ! 2287 !-- Wall for w on the right side, but not on the left side 2288 IF ( ( k_wall_v_ji > k_wall_v_ji_m ) .AND. & 2289 ( k_wall_v_ji == k_wall_v_ji_p ) ) THEN 2290 inc = -1 2291 wall_index = i+1 2292 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2293 k, i, inc, wall_index, z0_topo, kb, direction, ncorr ) 2412 ENDDO 2413 ENDIF 2414 ! 2415 !-- Wall for w on the right side, but not on the left side 2416 IF ( ( k_wall_w_ji < k_wall_w_ji_p ) .AND. & 2417 ( k_wall_w_ji >= k_wall_w_ji_m ) ) THEN 2418 inc = -1 2419 wall_index = i+1 2420 ! 2421 !-- Store the kbounds for use in pmci_interp_tril_sn. 2422 logc_kbounds_w_n(1,i) = k_wall_w_ji + 1 2423 logc_kbounds_w_n(2,i) = k_wall_w_ji_p 2424 DO k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i) 2425 CALL pmci_define_loglaw_correction_parameters( lc, lcr, & 2426 k, i, inc, wall_index, z0_topo, kb, direction, & 2427 ncorr ) 2294 2428 ! 2295 2429 !-- The direction of the wall-normal index is stored as the … … 2298 2432 logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1) 2299 2433 lcr(0:ncorr-1) = 1.0_wp 2300 END IF2301 2302 ENDDO 2434 ENDDO 2435 ENDIF 2436 2303 2437 ENDDO 2304 2438 … … 2311 2445 2312 2446 2313 SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc, 2314 2447 SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc, & 2448 wall_index, z0_l, kb, direction, ncorr ) 2315 2449 2316 2450 IMPLICIT NONE … … 2365 2499 corr_index = ij + lcorr ! In this case (direction = 2) ij is j 2366 2500 IF ( lcorr == 0 ) THEN 2367 CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index, 2501 CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index, & 2368 2502 z0_l, inc ) 2369 2503 ENDIF … … 2372 2506 !-- valid in both directions 2373 2507 IF ( inc * corr_index < inc * lc ) THEN 2374 lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy 2375 - coord_y(wall_index) ) / z0_l ) 2508 lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy & 2509 - coord_y(wall_index) ) / z0_l ) & 2376 2510 / logvelc1 2377 2511 more = .TRUE. … … 2391 2525 corr_index = ij + lcorr ! In this case (direction = 3) ij is i 2392 2526 IF ( lcorr == 0 ) THEN 2393 CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index, 2527 CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index, & 2394 2528 z0_l, inc ) 2395 2529 ENDIF … … 2398 2532 !-- valid in both directions 2399 2533 IF ( inc * corr_index < inc * lc ) THEN 2400 lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx 2401 - coord_x(wall_index) ) / z0_l ) 2534 lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx & 2535 - coord_x(wall_index) ) / z0_l ) & 2402 2536 / logvelc1 2403 2537 more = .TRUE. … … 3995 4129 r1yo, r2yo, r1zo, r2zo, & 3996 4130 logc_u_l, logc_ratio_u_l, & 4131 logc_kbounds_u_l, & 3997 4132 nzt_topo_nestbc_l, 'l', 'u' ) 3998 4133 … … 4000 4135 r1yv, r2yv, r1zo, r2zo, & 4001 4136 logc_v_l, logc_ratio_v_l, & 4137 logc_kbounds_v_l, & 4002 4138 nzt_topo_nestbc_l, 'l', 'v' ) 4003 4139 … … 4005 4141 r1yo, r2yo, r1zw, r2zw, & 4006 4142 logc_w_l, logc_ratio_w_l, & 4143 logc_kbounds_w_l, & 4007 4144 nzt_topo_nestbc_l, 'l', 'w' ) 4008 4145 4009 4146 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4010 4147 r1yo, r2yo, r1zo, r2zo, & 4011 logc_u_l, logc_ratio_u_l, & 4148 logc_w_l, logc_ratio_w_l, & 4149 logc_kbounds_w_l, & 4012 4150 nzt_topo_nestbc_l, 'l', 'e' ) 4013 4151 … … 4015 4153 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4016 4154 r1yo, r2yo, r1zo, r2zo, & 4017 logc_u_l, logc_ratio_u_l, & 4155 logc_w_l, logc_ratio_w_l, & 4156 logc_kbounds_w_l, & 4018 4157 nzt_topo_nestbc_l, 'l', 's' ) 4019 4158 ENDIF … … 4023 4162 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 4024 4163 r1yo, r2yo, r1zo, r2zo, & 4025 logc_u_l, logc_ratio_u_l, & 4164 logc_w_l, logc_ratio_w_l, & 4165 logc_kbounds_w_l, & 4026 4166 nzt_topo_nestbc_l, 'l', 's' ) 4027 4167 4028 4168 IF ( cloud_physics .AND. microphysics_morrison ) THEN 4029 CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, r2xo,&4030 r 1yo, r2yo, r1zo, r2zo,&4031 logc_ u_l,&4032 logc_ ratio_u_l, nzt_topo_nestbc_l,&4033 'l', 's' )4034 4035 CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, r2xo,&4036 r 1yo, r2yo, r1zo, r2zo,&4037 logc_ u_l,&4038 logc_ ratio_u_l, nzt_topo_nestbc_l,&4039 'l', 's' )4169 CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, & 4170 r2xo, r1yo, r2yo, r1zo, r2zo, & 4171 logc_w_l, logc_ratio_w_l, & 4172 logc_kbounds_w_l, & 4173 nzt_topo_nestbc_l, 'l', 's' ) 4174 4175 CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, & 4176 r2xo, r1yo, r2yo, r1zo, r2zo, & 4177 logc_w_l, logc_ratio_w_l, & 4178 logc_kbounds_w_l, & 4179 nzt_topo_nestbc_l, 'l', 's' ) 4040 4180 ENDIF 4041 4181 4042 4182 IF ( cloud_physics .AND. microphysics_seifert ) THEN 4043 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, r2xo,&4044 r 1yo, r2yo, r1zo, r2zo,&4045 logc_ u_l,&4046 logc_ ratio_u_l, nzt_topo_nestbc_l,&4047 'l', 's' )4048 4049 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, r2xo,&4050 r 1yo, r2yo, r1zo, r2zo,&4051 logc_ u_l,&4052 logc_ ratio_u_l, nzt_topo_nestbc_l, &4053 'l', 's' )4183 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, & 4184 r2xo, r1yo, r2yo, r1zo, r2zo, & 4185 logc_w_l, logc_ratio_w_l, & 4186 logc_kbounds_w_l, & 4187 nzt_topo_nestbc_l, 'l', 's' ) 4188 4189 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, & 4190 r2xo, r1yo, r2yo, r1zo, r2zo, & 4191 logc_w_l, logc_ratio_w_l, & 4192 logc_kbounds_w_l, & 4193 nzt_topo_nestbc_l, 'l', 's' ) 4054 4194 ENDIF 4055 4195 … … 4059 4199 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 4060 4200 r1yo, r2yo, r1zo, r2zo, & 4061 logc_u_l, logc_ratio_u_l, & 4201 logc_w_l, logc_ratio_w_l, & 4202 logc_kbounds_w_l, & 4062 4203 nzt_topo_nestbc_l, 'l', 's' ) 4063 4204 ENDIF … … 4065 4206 IF ( air_chemistry ) THEN 4066 4207 DO n = 1, nspec 4067 CALL pmci_interp_tril_lr( chem_species(n)%conc, & 4068 chem_spec_c(:,:,:,n), & 4069 ico, jco, kco, r1xo, r2xo, & 4070 r1yo, r2yo, r1zo, r2zo, & 4071 logc_u_l, logc_ratio_u_l, & 4208 CALL pmci_interp_tril_lr( chem_species(n)%conc, & 4209 chem_spec_c(:,:,:,n), & 4210 ico, jco, kco, r1xo, r2xo, & 4211 r1yo, r2yo, r1zo, r2zo, & 4212 logc_w_l, logc_ratio_w_l, & 4213 logc_kbounds_w_l, & 4072 4214 nzt_topo_nestbc_l, 'l', 's' ) 4073 4215 ENDDO … … 4123 4265 r1yo, r2yo, r1zo, r2zo, & 4124 4266 logc_u_r, logc_ratio_u_r, & 4267 logc_kbounds_u_r, & 4125 4268 nzt_topo_nestbc_r, 'r', 'u' ) 4126 4269 … … 4128 4271 r1yv, r2yv, r1zo, r2zo, & 4129 4272 logc_v_r, logc_ratio_v_r, & 4273 logc_kbounds_v_r, & 4130 4274 nzt_topo_nestbc_r, 'r', 'v' ) 4131 4275 … … 4133 4277 r1yo, r2yo, r1zw, r2zw, & 4134 4278 logc_w_r, logc_ratio_w_r, & 4279 logc_kbounds_w_r, & 4135 4280 nzt_topo_nestbc_r, 'r', 'w' ) 4136 4281 4137 4282 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4138 4283 r1yo,r2yo, r1zo, r2zo, & 4139 logc_u_r, logc_ratio_u_r, & 4284 logc_w_r, logc_ratio_w_r, & 4285 logc_kbounds_w_r, & 4140 4286 nzt_topo_nestbc_r, 'r', 'e' ) 4141 4287 … … 4144 4290 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4145 4291 r1yo, r2yo, r1zo, r2zo, & 4146 logc_u_r, logc_ratio_u_r, & 4292 logc_w_r, logc_ratio_w_r, & 4293 logc_kbounds_w_r, & 4147 4294 nzt_topo_nestbc_r, 'r', 's' ) 4148 4295 … … 4152 4299 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 4153 4300 r1yo, r2yo, r1zo, r2zo, & 4154 logc_u_r, logc_ratio_u_r, & 4301 logc_w_r, logc_ratio_w_r, & 4302 logc_kbounds_w_r, & 4155 4303 nzt_topo_nestbc_r, 'r', 's' ) 4156 4304 … … 4159 4307 CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, & 4160 4308 r2xo, r1yo, r2yo, r1zo, r2zo, & 4161 logc_ u_r,&4162 logc_ ratio_u_r, nzt_topo_nestbc_r,&4163 'r', 's' )4309 logc_w_r, logc_ratio_w_r, & 4310 logc_kbounds_w_r, & 4311 nzt_topo_nestbc_r, 'r', 's' ) 4164 4312 4165 4313 CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, & 4166 4314 r2xo, r1yo, r2yo, r1zo, r2zo, & 4167 logc_ u_r,&4168 logc_ ratio_u_r, nzt_topo_nestbc_r,&4169 'r', 's' )4315 logc_w_r, logc_ratio_w_r, & 4316 logc_kbounds_w_r, & 4317 nzt_topo_nestbc_r, 'r', 's' ) 4170 4318 4171 4319 … … 4177 4325 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, & 4178 4326 r2xo, r1yo, r2yo, r1zo, r2zo, & 4179 logc_ u_r,&4180 logc_ ratio_u_r, nzt_topo_nestbc_r,&4181 'r', 's' )4327 logc_w_r, logc_ratio_w_r, & 4328 logc_kbounds_w_r, & 4329 nzt_topo_nestbc_r, 'r', 's' ) 4182 4330 4183 4331 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, & 4184 4332 r2xo, r1yo, r2yo, r1zo, r2zo, & 4185 logc_ u_r,&4186 logc_ ratio_u_r, nzt_topo_nestbc_r,&4187 'r', 's' )4333 logc_w_r, logc_ratio_w_r, & 4334 logc_kbounds_w_r, & 4335 nzt_topo_nestbc_r, 'r', 's' ) 4188 4336 4189 4337 ENDIF … … 4194 4342 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 4195 4343 r1yo, r2yo, r1zo, r2zo, & 4196 logc_u_r, logc_ratio_u_r, & 4344 logc_w_r, logc_ratio_w_r, & 4345 logc_kbounds_w_r, & 4197 4346 nzt_topo_nestbc_r, 'r', 's' ) 4198 4347 … … 4203 4352 ico, jco, kco, r1xo, r2xo, & 4204 4353 r1yo, r2yo, r1zo, r2zo, & 4205 logc_u_r, logc_ratio_u_r, & 4354 logc_w_r, logc_ratio_w_r, & 4355 logc_kbounds_w_r, & 4206 4356 nzt_topo_nestbc_r, 'r', 's' ) 4207 4357 ENDDO … … 4254 4404 r1yo, r2yo, r1zo, r2zo, & 4255 4405 logc_u_s, logc_ratio_u_s, & 4406 logc_kbounds_u_s, & 4256 4407 nzt_topo_nestbc_s, 's', 'u' ) 4257 4408 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4258 4409 r1yv, r2yv, r1zo, r2zo, & 4259 4410 logc_v_s, logc_ratio_v_s, & 4411 logc_kbounds_v_s, & 4260 4412 nzt_topo_nestbc_s, 's', 'v' ) 4261 4413 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 4262 4414 r1yo, r2yo, r1zw, r2zw, & 4263 4415 logc_w_s, logc_ratio_w_s, & 4416 logc_kbounds_w_s, & 4264 4417 nzt_topo_nestbc_s, 's','w' ) 4265 4418 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4266 4419 r1yo, r2yo, r1zo, r2zo, & 4267 logc_u_s, logc_ratio_u_s, & 4420 logc_w_s, logc_ratio_w_s, & 4421 logc_kbounds_w_s, & 4268 4422 nzt_topo_nestbc_s, 's', 'e' ) 4269 4423 … … 4271 4425 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4272 4426 r1yo, r2yo, r1zo, r2zo, & 4273 logc_u_s, logc_ratio_u_s, & 4427 logc_w_s, logc_ratio_w_s, & 4428 logc_kbounds_w_s, & 4274 4429 nzt_topo_nestbc_s, 's', 's' ) 4275 4430 ENDIF … … 4278 4433 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4279 4434 r1yo,r2yo, r1zo, r2zo, & 4280 logc_u_s, logc_ratio_u_s, & 4435 logc_w_s, logc_ratio_w_s, & 4436 logc_kbounds_w_s, & 4281 4437 nzt_topo_nestbc_s, 's', 's' ) 4282 4438 … … 4285 4441 CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 4286 4442 r2xo, r1yo,r2yo, r1zo, r2zo, & 4287 logc_ u_s,&4288 logc_ ratio_u_s, nzt_topo_nestbc_s,&4289 's', 's' )4443 logc_w_s, logc_ratio_w_s, & 4444 logc_kbounds_w_s, & 4445 nzt_topo_nestbc_s, 's', 's' ) 4290 4446 4291 4447 CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 4292 4448 r2xo, r1yo,r2yo, r1zo, r2zo, & 4293 logc_ u_s,&4294 logc_ ratio_u_s, nzt_topo_nestbc_s,&4295 's', 's' )4449 logc_w_s, logc_ratio_w_s, & 4450 logc_kbounds_w_s, & 4451 nzt_topo_nestbc_s, 's', 's' ) 4296 4452 4297 4453 ENDIF … … 4301 4457 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 4302 4458 r2xo, r1yo,r2yo, r1zo, r2zo, & 4303 logc_ u_s,&4304 logc_ ratio_u_s, nzt_topo_nestbc_s,&4305 's', 's' )4459 logc_w_s, logc_ratio_w_s, & 4460 logc_kbounds_w_s, & 4461 nzt_topo_nestbc_s, 's', 's' ) 4306 4462 4307 4463 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 4308 4464 r2xo, r1yo,r2yo, r1zo, r2zo, & 4309 logc_ u_s,&4310 logc_ ratio_u_s, nzt_topo_nestbc_s,&4311 's', 's' )4465 logc_w_s, logc_ratio_w_s, & 4466 logc_kbounds_w_s, & 4467 nzt_topo_nestbc_s, 's', 's' ) 4312 4468 4313 4469 ENDIF … … 4318 4474 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4319 4475 r1yo,r2yo, r1zo, r2zo, & 4320 logc_u_s, logc_ratio_u_s, & 4476 logc_w_s, logc_ratio_w_s, & 4477 logc_kbounds_w_s, & 4321 4478 nzt_topo_nestbc_s, 's', 's' ) 4322 4479 ENDIF … … 4328 4485 ico, jco, kco, r1xo, r2xo, & 4329 4486 r1yo, r2yo, r1zo, r2zo, & 4330 logc_u_s, logc_ratio_u_s, & 4487 logc_w_s, logc_ratio_w_s, & 4488 logc_kbounds_w_s, & 4331 4489 nzt_topo_nestbc_s, 's', 's' ) 4332 4490 ENDDO … … 4379 4537 r1yo, r2yo, r1zo, r2zo, & 4380 4538 logc_u_n, logc_ratio_u_n, & 4539 logc_kbounds_u_n, & 4381 4540 nzt_topo_nestbc_n, 'n', 'u' ) 4382 4541 4383 4542 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 4384 4543 r1yv, r2yv, r1zo, r2zo, & 4385 logc_v_n, logc_ratio_v_n, & 4544 logc_v_n, logc_ratio_v_n, & 4545 logc_kbounds_v_n, & 4386 4546 nzt_topo_nestbc_n, 'n', 'v' ) 4387 4547 … … 4389 4549 r1yo, r2yo, r1zw, r2zw, & 4390 4550 logc_w_n, logc_ratio_w_n, & 4551 logc_kbounds_w_n, & 4391 4552 nzt_topo_nestbc_n, 'n', 'w' ) 4392 4553 4393 4554 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4394 4555 r1yo, r2yo, r1zo, r2zo, & 4395 logc_u_n, logc_ratio_u_n, & 4556 logc_w_n, logc_ratio_w_n, & 4557 logc_kbounds_w_n, & 4396 4558 nzt_topo_nestbc_n, 'n', 'e' ) 4397 4559 … … 4399 4561 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 4400 4562 r1yo, r2yo, r1zo, r2zo, & 4401 logc_u_n, logc_ratio_u_n, & 4563 logc_w_n, logc_ratio_w_n, & 4564 logc_kbounds_w_n, & 4402 4565 nzt_topo_nestbc_n, 'n', 's' ) 4403 4566 ENDIF … … 4406 4569 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 4407 4570 r1yo, r2yo, r1zo, r2zo, & 4408 logc_u_n, logc_ratio_u_n, & 4571 logc_w_n, logc_ratio_w_n, & 4572 logc_kbounds_w_n, & 4409 4573 nzt_topo_nestbc_n, 'n', 's' ) 4410 4574 … … 4413 4577 CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 4414 4578 r2xo, r1yo, r2yo, r1zo, r2zo, & 4415 logc_ u_n,&4416 logc_ ratio_u_n, nzt_topo_nestbc_n,&4417 'n', 's' )4579 logc_w_n, logc_ratio_w_n, & 4580 logc_kbounds_w_n, & 4581 nzt_topo_nestbc_n, 'n', 's' ) 4418 4582 4419 4583 CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 4420 4584 r2xo, r1yo, r2yo, r1zo, r2zo, & 4421 logc_u_n, 4422 logc_ ratio_u_n, nzt_topo_nestbc_n,&4423 'n', 's' )4585 logc_u_n, logc_ratio_u_n, & 4586 logc_kbounds_w_n, & 4587 nzt_topo_nestbc_n, 'n', 's' ) 4424 4588 4425 4589 ENDIF … … 4429 4593 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 4430 4594 r2xo, r1yo, r2yo, r1zo, r2zo, & 4431 logc_ u_n,&4432 logc_ ratio_u_n, nzt_topo_nestbc_n,&4433 'n', 's' )4595 logc_w_n, logc_ratio_w_n, & 4596 logc_kbounds_w_n, & 4597 nzt_topo_nestbc_n, 'n', 's' ) 4434 4598 4435 4599 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 4436 4600 r2xo, r1yo, r2yo, r1zo, r2zo, & 4437 logc_ u_n,&4438 logc_ ratio_u_n, nzt_topo_nestbc_n,&4439 'n', 's' )4601 logc_w_n, logc_ratio_w_n, & 4602 logc_kbounds_w_n, & 4603 nzt_topo_nestbc_n, 'n', 's' ) 4440 4604 4441 4605 ENDIF … … 4446 4610 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 4447 4611 r1yo, r2yo, r1zo, r2zo, & 4448 logc_u_n, logc_ratio_u_n, & 4612 logc_w_n, logc_ratio_w_n, & 4613 logc_kbounds_w_n, & 4449 4614 nzt_topo_nestbc_n, 'n', 's' ) 4450 4615 ENDIF … … 4452 4617 IF ( air_chemistry ) THEN 4453 4618 DO n = 1, nspec 4454 CALL pmci_interp_tril_sn( chem_species(n)%conc, & 4455 chem_spec_c(:,:,:,n), & 4456 ico, jco, kco, r1xo, r2xo, & 4457 r1yo, r2yo, r1zo, r2zo, & 4458 logc_u_n, logc_ratio_u_n, & 4619 CALL pmci_interp_tril_sn( chem_species(n)%conc, & 4620 chem_spec_c(:,:,:,n), & 4621 ico, jco, kco, r1xo, r2xo, & 4622 r1yo, r2yo, r1zo, r2zo, & 4623 logc_w_n, logc_ratio_w_n, & 4624 logc_kbounds_w_n, & 4459 4625 nzt_topo_nestbc_n, 'n', 's' ) 4460 4626 ENDDO … … 4673 4839 4674 4840 4675 SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, 4676 r2z, logc, logc_ratio, nzt_topo_nestbc,&4677 edge, var )4841 SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4842 r2z, logc, logc_ratio, logc_kbounds, & 4843 nzt_topo_nestbc, edge, var ) 4678 4844 ! 4679 4845 !-- Interpolation of ghost-node values used as the child-domain boundary … … 4701 4867 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn), & 4702 4868 INTENT(IN) :: logc !< 4869 INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN) :: logc_kbounds !< 4703 4870 INTEGER(iwp) :: nzt_topo_nestbc !< 4704 4871 … … 4805 4972 !-- Solid surface only on south/north side of the node 4806 4973 DO j = nys, nyn 4807 ! 4808 !-- Determine vertical index of topography top at grid point (j,i) 4809 k_wall = get_topography_top_index_ji( j, i, TRIM ( var ) ) 4810 4811 DO k = k_wall+1, nzt_topo_nestbc 4974 DO k = logc_kbounds(1,j), logc_kbounds(2,j) 4812 4975 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) == 0 ) ) THEN 4813 4976 ! … … 4830 4993 IF ( var == 'u' ) THEN 4831 4994 DO j = nys, nyn 4832 ! 4833 !-- Determine vertical index of topography top at grid point (j,i) 4834 k_wall = get_topography_top_index_ji( j, i, TRIM ( var ) ) 4835 4836 k = k_wall + 1 4995 k = logc_kbounds(1,j) 4837 4996 IF ( ( logc(2,k,j) /= 0 ) .AND. ( logc(1,k,j) /= 0 ) ) THEN 4838 4997 k1 = logc(1,k,j) … … 4900 5059 4901 5060 SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, & 4902 r2z, logc, logc_ratio, 5061 r2z, logc, logc_ratio, logc_kbounds, & 4903 5062 nzt_topo_nestbc, edge, var ) 4904 5063 … … 4928 5087 INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr), & 4929 5088 INTENT(IN) :: logc !< 5089 INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN) :: logc_kbounds !< 4930 5090 INTEGER(iwp) :: nzt_topo_nestbc !< 4931 5091 … … 5028 5188 IF ( var == 'v' .OR. var == 'w' ) THEN 5029 5189 DO i = nxl, nxr 5030 ! 5031 !-- Determine vertical index of topography top at grid point (j,i) 5032 k_wall = get_topography_top_index_ji( j, i, TRIM( var ) ) 5033 5034 DO k = k_wall, nzt_topo_nestbc 5190 DO k = logc_kbounds(1,i), logc_kbounds(2,i) 5035 5191 ! 5036 5192 !-- Solid surface only on left/right side of the node … … 5055 5211 IF ( var == 'v' ) THEN 5056 5212 DO i = nxl, nxr 5057 ! 5058 !-- Determine vertical index of topography top at grid point (j,i) 5059 k_wall = get_topography_top_index_ji( j, i, TRIM( var ) ) 5060 5061 k = k_wall + 1 5213 k = logc_kbounds(1,i) 5062 5214 IF ( ( logc(2,k,i) /= 0 ) .AND. ( logc(1,k,i) /= 0 ) ) THEN 5063 5215 k1 = logc(1,k,i)
Note: See TracChangeset
for help on using the changeset viewer.
