1662
1663
1666
1668# ifdef DISTRIBUTE
1670# endif
1671
1672
1673
1674 integer, intent(in) :: ng, tile, model
1675 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1676 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
1677 integer, intent(in) :: Nghost, NHsteps, NVsteps
1678
1679 real(r8), intent(in) :: DTsizeH, DTsizeV
1680
1681# ifdef ASSUMED_SHAPE
1682 real(r8), intent(in) :: pm(LBi:,LBj:)
1683 real(r8), intent(in) :: pn(LBi:,LBj:)
1684# ifdef GEOPOTENTIAL_HCONV
1685 real(r8), intent(in) :: on_p(LBi:,LBj:)
1686 real(r8), intent(in) :: om_r(LBi:,LBj:)
1687# else
1688 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
1689 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
1690# endif
1691# ifdef MASKING
1692# ifdef GEOPOTENTIAL_HCONV
1693 real(r8), intent(in) :: pmask(LBi:,LBj:)
1694 real(r8), intent(in) :: rmask(LBi:,LBj:)
1695 real(r8), intent(in) :: umask(LBi:,LBj:)
1696 real(r8), intent(in) :: vmask(LBi:,LBj:)
1697# else
1698 real(r8), intent(in) :: vmask(LBi:,LBj:)
1699 real(r8), intent(in) :: pmask(LBi:,LBj:)
1700# endif
1701# endif
1702 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
1703 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
1704
1705 real(r8), intent(in) :: Kh(LBi:,LBj:)
1706 real(r8), intent(in) :: Kv(LBi:,LBj:,0:)
1707
1708 real(r8), intent(inout) :: tl_A(LBi:,LBj:,LBk:)
1709# else
1710 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
1711 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
1712# ifdef GEOPOTENTIAL_HCONV
1713 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
1714 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
1715# else
1716 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
1717 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
1718# endif
1719# ifdef MASKING
1720# ifdef GEOPOTENTIAL_HCONV
1721 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
1722 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
1723 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
1724 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
1725# else
1726 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
1727 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
1728# endif
1729# endif
1730 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
1731 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
1732
1733 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
1734 real(r8), intent(in) :: Kv(LBi:UBi,LBj:UBj,0:UBk)
1735
1736 real(r8), intent(inout) :: tl_A(LBi:UBi,LBj:UBj,LBk:UBk)
1737# endif
1738
1739
1740
1741 integer :: Nnew, Nold, Nsav, i, j, k, k1, k2, step
1742
1743 real(r8) :: cff, cff1, cff2, cff3, cff4
1744
1745 real(r8), dimension(LBi:UBi,LBj:UBj,LBk:UBk,2) :: tl_Awrk
1746
1747 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
1748 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
1749 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
1750# ifdef VCONVOLUTION
1751# ifndef SPLINES_VCONV
1752 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: FC
1753# endif
1754# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
1755 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
1756# endif
1757# if defined IMPLICIT_VCONV || defined SPLINES_VCONV
1758 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: BC
1759 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: CF
1760 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_DC
1761# ifdef SPLINES_VCONV
1762 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
1763 real(r8), dimension(IminS:ImaxS,N(ng)) :: Hzk
1764# endif
1765# else
1766 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: tl_FS
1767# endif
1768# endif
1769# ifdef GEOPOTENTIAL_HCONV
1770 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: dZdx
1771 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: dZde
1772
1773 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_p
1774 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_r
1775 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_FZ
1776 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dAdz
1777 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dAdx
1778 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dAde
1779# endif
1780
1781# include "set_bounds.h"
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792 cff=dtsizeh*0.25_r8
1793 DO j=jstrv-1,jend+1
1794 DO i=istr-1,iend+1
1795 hfac(i,j)=cff*(pm(i,j-1)+pm(i,j))*(pn(i,j-1)+pn(i,j))
1796# ifdef VCONVOLUTION
1797# ifndef SPLINES_VCONV
1798 fc(i,j,
n(ng))=0.0_r8
1800# ifdef IMPLICIT_VCONV
1801 fc(i,j,k)=-dtsizev*(kv(i,j-1,k)+kv(i,j,k))/ &
1802 & (z_r(i,j-1,k+1)+z_r(i,j,k+1)- &
1803 & z_r(i,j-1,k )-z_r(i,j,k ))
1804# else
1805 fc(i,j,k)=dtsizev*(kv(i,j-1,k)+kv(i,j,k))/ &
1806 & (z_r(i,j-1,k+1)+z_r(i,j,k+1)- &
1807 & z_r(i,j-1,k )-z_r(i,j,k ))
1808# endif
1809 END DO
1810 fc(i,j,0)=0.0_r8
1811# endif
1812# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
1814 ohz(i,j,k)=2.0_r8/(hz(i,j-1,k)+hz(i,j,k))
1815 END DO
1816# endif
1817# endif
1818 END DO
1819 END DO
1820
1821
1822
1823 nold=1
1824 nnew=2
1825
1826
1827
1828
1830 & lbi, ubi, lbj, ubj, lbk, ubk, &
1831 & tl_a)
1832# ifdef DISTRIBUTE
1833
1834
1835
1836
1837
1838
1840 & lbi, ubi, lbj, ubj, lbk, ubk, &
1841 & nghost, &
1843 & tl_a)
1844# endif
1846 DO j=jstrv-1,jend+1
1847 DO i=istr-1,iend+1
1848
1849
1850 tl_awrk(i,j,k,nold)=tl_a(i,j,k)
1851 END DO
1852 END DO
1853 END DO
1854
1855
1856
1857
1858
1859 DO step=1,nhsteps
1860
1861# ifdef GEOPOTENTIAL_HCONV
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872 k2=1
1873 k_loop :
DO k=0,
n(ng)
1874 k1=k2
1875 k2=3-k1
1876 IF (k.lt.
n(ng))
THEN
1877 DO j=jstrv-1,jend
1878 DO i=istr,iend+1
1879 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
1880# ifdef MASKING
1881 cff=cff*umask(i,j)
1882# endif
1883 dzdx(i,j)=cff*(z_r(i ,j,k+1)- &
1884 & z_r(i-1,j,k+1))
1885 END DO
1886 END DO
1887
1888 DO j=jstrv-1,jend+1
1889 DO i=istr,iend
1890 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
1891# ifdef MASKING
1892 cff=cff*vmask(i,j)
1893# endif
1894 dzde(i,j)=cff*(z_r(i,j ,k+1)- &
1895 & z_r(i,j-1,k+1))
1896 END DO
1897 END DO
1898
1899 DO j=jstrv,jend
1900 DO i=istr,iend+1
1901 cff=0.25_r8*(pm(i-1,j-1)+pm(i-1,j)+ &
1902 & pm(i ,j-1)+pm(i ,j))
1903# ifdef MASKING
1904
1905
1906
1907
1908 tl_dadx(i,j,k2)=cff* &
1909 & (tl_awrk(i ,j,k+1,nold)*vmask(i ,j)- &
1910 & tl_awrk(i-1,j,k+1,nold)*vmask(i-1,j))
1911
1912
1913 tl_dadx(i,j,k2)=tl_dadx(i,j,k2)*pmask(i,j)
1914# else
1915
1916
1917
1918 tl_dadx(i,j,k2)=cff*(tl_awrk(i ,j,k+1,nold)- &
1919 & tl_awrk(i-1,j,k+1,nold))
1920# endif
1921 dzdx_p(i,j,k2)=0.5_r8*(dzdx(i,j-1)+ &
1922 & dzdx(i,j ))
1923 END DO
1924 END DO
1925
1926 DO j=jstrv-1,jend
1927 DO i=istr,iend
1928# ifdef MASKING
1929
1930
1931
1932
1933 tl_dade(i,j,k2)=pn(i,j)* &
1934 & (tl_awrk(i,j+1,k+1,nold)*vmask(i,j+1)- &
1935 & tl_awrk(i,j ,k+1,nold)*vmask(i,j ))
1936
1937
1938 tl_dade(i,j,k2)=tl_dade(i,j,k2)*rmask(i,j)
1939# else
1940
1941
1942
1943 tl_dade(i,j,k2)=pn(i,j)*(tl_awrk(i,j+1,k+1,nold)- &
1944 & tl_awrk(i,j ,k+1,nold))
1945# endif
1946 dzde_r(i,j,k2)=0.5_r8*(dzde(i,j )+ &
1947 & dzde(i,j+1))
1948 END DO
1949 END DO
1950 END IF
1951
1952 IF ((k.eq.0).or.(k.eq.
n(ng)))
THEN
1953 DO j=jstrv-1,jend+1
1954 DO i=istr-1,iend+1
1955
1956
1957 tl_dadz(i,j,k2)=0.0_r8
1958
1959
1960 tl_fz(i,j,k2)=0.0_r8
1961 END DO
1962 END DO
1963 ELSE
1964 DO j=jstrv-1,jend+1
1965 DO i=istr-1,iend+1
1966 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
1967
1968
1969
1970 tl_dadz(i,j,k2)=cff*(tl_awrk(i,j,k+1,nold)- &
1971 & tl_awrk(i,j,k ,nold))
1972# ifdef MASKING
1973
1974
1975 tl_dadz(i,j,k2)=tl_dadz(i,j,k2)*vmask(i,j)
1976# endif
1977 END DO
1978 END DO
1979 END IF
1980
1981
1982
1983
1984 IF (k.gt.0) THEN
1985 DO j=jstrv,jend
1986 DO i=istr,iend+1
1987 cff=0.0625_r8*(kh(i-1,j-1)+kh(i-1,j)+ &
1988 & kh(i ,j-1)+kh(i ,j))*on_p(i,j)
1989 cff1=min(dzdx_p(i,j,k1),0.0_r8)
1990 cff2=max(dzdx_p(i,j,k1),0.0_r8)
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000 tl_fx(i,j)=cff* &
2001 & (hz(i-1,j-1,k)+hz(i-1,j,k)+ &
2002 & hz(i ,j-1,k)+hz(i ,j,k))* &
2003 & (tl_dadx(i,j,k1)- &
2004 & 0.5_r8*(cff1*(tl_dadz(i-1,j,k1)+ &
2005 & tl_dadz(i ,j,k2))+ &
2006 & cff2*(tl_dadz(i-1,j,k2)+ &
2007 & tl_dadz(i ,j,k1))))
2008 END DO
2009 END DO
2010 DO j=jstrv-1,jend
2011 DO i=istr,iend
2012 cff=kh(i,j)*om_r(i,j)
2013 cff1=min(dzde_r(i,j,k1),0.0_r8)
2014 cff2=max(dzde_r(i,j,k1),0.0_r8)
2015
2016
2017
2018
2019
2020
2021
2022
2023 tl_fe(i,j)=cff* &
2024 & hz(i,j,k)* &
2025 & (tl_dade(i,j,k1)- &
2026 & 0.5_r8*(cff1*(tl_dadz(i,j ,k1)+ &
2027 & tl_dadz(i,j+1,k2))+ &
2028 & cff2*(tl_dadz(i,j ,k2)+ &
2029 & tl_dadz(i,j+1,k1))))
2030 END DO
2031 END DO
2032 IF (k.lt.
n(ng))
THEN
2033 DO j=jstrv,jend
2034 DO i=istr,iend
2035 cff=0.5_r8*(kh(i,j-1)+kh(i,j))
2036 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
2037 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
2038 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
2039 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
2040
2041
2042
2043
2044
2045
2046 tl_fz(i,j,k2)=cff* &
2047 & (cff1*(cff1*tl_dadz(i,j,k2)- &
2048 & tl_dadx(i ,j,k1))+ &
2049 & cff2*(cff2*tl_dadz(i,j,k2)- &
2050 & tl_dadx(i+1,j,k2))+ &
2051 & cff3*(cff3*tl_dadz(i,j,k2)- &
2052 & tl_dadx(i ,j,k2))+ &
2053 & cff4*(cff4*tl_dadz(i,j,k2)- &
2054 & tl_dadx(i+1,j,k1)))
2055 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
2056 cff2=min(dzde_r(i,j ,k2),0.0_r8)
2057 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
2058 cff4=max(dzde_r(i,j ,k1),0.0_r8)
2059
2060
2061
2062
2063
2064
2065
2066 tl_fz(i,j,k2)=tl_fz(i,j,k2)+ &
2067 & cff* &
2068 & (cff1*(cff1*tl_dadz(i,j,k2)- &
2069 & tl_dade(i,j-1,k1))+ &
2070 & cff2*(cff2*tl_dadz(i,j,k2)- &
2071 & tl_dade(i,j ,k2))+ &
2072 & cff3*(cff3*tl_dadz(i,j,k2)- &
2073 & tl_dade(i,j-1,k2))+ &
2074 & cff4*(cff4*tl_dadz(i,j,k2)- &
2075 & tl_dade(i,j ,k1)))
2076 END DO
2077 END DO
2078 END IF
2079
2080
2081
2082 DO j=jstrv,jend
2083 DO i=istr,iend
2084
2085
2086
2087
2088
2089
2090
2091 tl_awrk(i,j,k,nnew)=tl_awrk(i,j,k,nold)+ &
2092 & hfac(i,j)* &
2093 & (tl_fx(i+1,j)-tl_fx(i,j )+ &
2094 & tl_fe(i ,j)-tl_fe(i,j-1))+ &
2095 & dtsizeh* &
2096 & (tl_fz(i,j,k2)-tl_fz(i,j,k1))
2097 END DO
2098 END DO
2099 END IF
2100 END DO k_loop
2101
2102# else
2103
2104
2105
2106
2108 DO j=jstrv,jend
2109 DO i=istr,iend+1
2110
2111
2112
2113
2114 tl_fx(i,j)=pmon_p(i,j)*0.25_r8*(kh(i-1,j )+kh(i,j )+ &
2115 & kh(i-1,j-1)+kh(i,j-1))* &
2116 & (tl_awrk(i,j,k,nold)-tl_awrk(i-1,j,k,nold))
2117# ifdef MASKING
2118
2119
2120 tl_fx(i,j)=tl_fx(i,j)*pmask(i,j)
2121# endif
2122 END DO
2123 END DO
2124 DO j=jstrv-1,jend
2125 DO i=istr,iend
2126
2127
2128
2129 tl_fe(i,j)=pnom_r(i,j)*kh(i,j)* &
2130 & (tl_awrk(i,j+1,k,nold)-tl_awrk(i,j,k,nold))
2131 END DO
2132 END DO
2133
2134
2135
2136 DO j=jstrv,jend
2137 DO i=istr,iend
2138
2139
2140
2141
2142
2143 tl_awrk(i,j,k,nnew)=tl_awrk(i,j,k,nold)+ &
2144 & hfac(i,j)* &
2145 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
2146 & tl_fe(i,j)-tl_fe(i,j-1))
2147 END DO
2148 END DO
2149 END DO
2150# endif
2151
2152
2153
2154
2155
2156
2157
2159 & lbi, ubi, lbj, ubj, lbk, ubk, &
2160 & tl_awrk(:,:,:,nnew))
2161# ifdef DISTRIBUTE
2162
2163
2164
2165
2166
2167
2169 & lbi, ubi, lbj, ubj, lbk, ubk, &
2170 & nghost, &
2172 & tl_awrk(:,:,:,nnew))
2173# endif
2174
2175
2176
2177 nsav=nold
2178 nold=nnew
2179 nnew=nsav
2180 END DO
2181
2182# ifdef VCONVOLUTION
2183# ifdef IMPLICIT_VCONV
2184# ifdef SPLINES_VCONV
2185
2186
2187
2188
2189
2190
2191 DO step=1,nvsteps
2192
2193
2194
2195
2196
2197 DO j=jstrv,jend
2199 DO i=istr,iend
2200 hzk(i,k)=0.5_r8*(hz(i,j-1,k)+ &
2201 & hz(i,j ,k))
2202 END DO
2203 END DO
2204 cff1=1.0_r8/6.0_r8
2206 DO i=istr,iend
2207 fc(i,k)=cff1*hzk(i,k )-dtsizev*kv(i,j,k-1)*ohz(i,j,k )
2208 cf(i,k)=cff1*hzk(i,k+1)-dtsizev*kv(i,j,k+1)*ohz(i,j,k+1)
2209 END DO
2210 END DO
2211 DO i=istr,iend
2212 cf(i,0)=0.0_r8
2213
2214
2215 tl_dc(i,0)=0.0_r8
2216 END DO
2217
2218
2219
2220 cff1=1.0_r8/3.0_r8
2222 DO i=istr,iend
2223 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
2224 & dtsizev*kv(i,j,k)*(ohz(i,j,k)+ohz(i,j,k+1))
2225 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
2226 cf(i,k)=cff*cf(i,k)
2227
2228
2229
2230
2231 tl_dc(i,k)=cff*(tl_awrk(i,j,k+1,nold)- &
2232 & tl_awrk(i,j,k ,nold)- &
2233 & fc(i,k)*tl_dc(i,k-1))
2234 END DO
2235 END DO
2236
2237
2238
2239 DO i=istr,iend
2240
2241
2242 tl_dc(i,
n(ng))=0.0_r8
2243 END DO
2245 DO i=istr,iend
2246
2247
2248 tl_dc(i,k)=tl_dc(i,k)-cf(i,k)*tl_dc(i,k+1)
2249 END DO
2250 END DO
2251
2253 DO i=istr,iend
2254
2255
2256 tl_dc(i,k)=tl_dc(i,k)*kv(i,j,k)
2257
2258
2259
2260
2261 tl_awrk(i,j,k,nnew)=tl_awrk(i,j,k,nold)+ &
2262 & dtsizev*ohz(i,j,k)* &
2263 & (tl_dc(i,k)-tl_dc(i,k-1))
2264 END DO
2265 END DO
2266 END DO
2267
2268
2269
2270 nsav=nold
2271 nold=nnew
2272 nnew=nsav
2273 END DO
2274# else
2275
2276
2277
2278
2279
2280 DO step=1,nvsteps
2281
2282
2283
2284
2285 DO j=jstrv,jend
2287 DO i=istr,iend
2288 cff=0.5_r8*(hz(i,j-1,k)+hz(i,j,k))
2289 bc(i,k)=cff-fc(i,j,k)-fc(i,j,k-1)
2290
2291
2292 tl_dc(i,k)=tl_awrk(i,j,k,nold)*cff
2293 END DO
2294 END DO
2295
2296
2297
2298 DO i=istr,iend
2299 cff=1.0_r8/bc(i,1)
2300 cf(i,1)=cff*fc(i,j,1)
2301
2302
2303 tl_dc(i,1)=cff*tl_dc(i,1)
2304 END DO
2306 DO i=istr,iend
2307 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
2308 cf(i,k)=cff*fc(i,j,k)
2309
2310
2311 tl_dc(i,k)=cff*(tl_dc(i,k)-fc(i,j,k-1)*tl_dc(i,k-1))
2312 END DO
2313 END DO
2314
2315
2316
2317 DO i=istr,iend
2318
2319
2320
2321
2322 tl_dc(i,
n(ng))=(tl_dc(i,
n(ng))- &
2323 & fc(i,j,
n(ng)-1)*tl_dc(i,
n(ng)-1))/ &
2324 & (bc(i,
n(ng))-fc(i,j,
n(ng)-1)*cf(i,
n(ng)-1))
2325
2326
2327 tl_awrk(i,j,
n(ng),nnew)=tl_dc(i,
n(ng))
2328# ifdef MASKING
2329
2330
2331 tl_awrk(i,j,
n(ng),nnew)=tl_awrk(i,j,
n(ng),nnew)*vmask(i,j)
2332# endif
2333 END DO
2335 DO i=istr,iend
2336
2337
2338 tl_dc(i,k)=tl_dc(i,k)-cf(i,k)*tl_dc(i,k+1)
2339
2340
2341 tl_awrk(i,j,k,nnew)=tl_dc(i,k)
2342# ifdef MASKING
2343
2344
2345 tl_awrk(i,j,k,nnew)=tl_awrk(i,j,k,nnew)*vmask(i,j)
2346# endif
2347 END DO
2348 END DO
2349 END DO
2350
2351
2352
2353 nsav=nold
2354 nold=nnew
2355 nnew=nsav
2356 END DO
2357# endif
2358# else
2359
2360
2361
2362
2363
2364 DO step=1,nvsteps
2365
2366
2367
2368
2369 DO j=jstrv,jend
2371 DO i=istr,iend
2372
2373
2374
2375 tl_fs(i,k)=fc(i,j,k)*(tl_awrk(i,j,k+1,nold)- &
2376 & tl_awrk(i,j,k ,nold))
2377# ifdef MASKING
2378
2379
2380 tl_fs(i,k)=tl_fs(i,k)*vmask(i,j)
2381# endif
2382 END DO
2383 END DO
2384 DO i=istr,iend
2385
2386
2387 tl_fs(i,0)=0.0_r8
2388
2389
2390 tl_fs(i,
n(ng))=0.0_r8
2391 END DO
2392
2393
2394
2395
2397 DO i=istr,iend
2398
2399
2400
2401
2402 tl_awrk(i,j,k,nnew)=tl_awrk(i,j,k,nold)+ &
2403 & ohz(i,j,k)*(tl_fs(i,k )- &
2404 & tl_fs(i,k-1))
2405 END DO
2406 END DO
2407 END DO
2408
2409
2410
2411 nsav=nold
2412 nold=nnew
2413 nnew=nsav
2414 END DO
2415# endif
2416# endif
2417
2418
2419
2420
2421
2423 DO j=jstrv,jend
2424 DO i=istr,iend
2425
2426
2427 tl_a(i,j,k)=tl_awrk(i,j,k,nold)
2428 END DO
2429 END DO
2430 END DO
2431
2432
2433
2434
2436 & lbi, ubi, lbj, ubj, lbk, ubk, &
2437 & tl_a)
2438# ifdef DISTRIBUTE
2439
2440
2441
2442
2443
2444
2446 & lbi, ubi, lbj, ubj, lbk, ubk, &
2447 & nghost, &
2449 & tl_a)
2450# endif
2451
2452 RETURN
subroutine dabc_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)