diff --git a/ChangeLog b/ChangeLog index 6a5e3bc..6b307c3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,35 @@ -version 0.7.2 +version 0.8 + - New versions of the RAMI-V test scene input files (see + test/rami5/README), using explicit vegetation fractional standard + deviation + +version 0.7.3 (27 October 2021) + - Redefined veg_contact_fraction: now the fraction of the building + edge that is touching veg, not the fraction of the vegetation edge + that is touching a building + - Default veg_contact_fraction (in + spartacus_surface_read_input.F90) is equal to the fraction of the + non-building area containing vegetation, equivalent to randomly + placed vegetation + - Normalized perimeter of vegetation-air interface now properly + takes into account the building fraction in the symmetric + vegetation scale formula; this is now in radsurf_norm_perim.F90 + - vegetation_isolation_factor treatment changed such that a value + of 1 now indicates that thick and thin vegetation regions equally + likely to be in contact with the clear-air region, rather than + that only the thick region is in contact with clear-air + - Modified the test/rami5/scene_nc files to use the new definition + of veg_contact_fraction and a consistent definition of veg_scale + to the code + - Added surface types 4 (SimpleUrban) and 5 (InfiniteStreet): fast + methods for single-layer unvegetated urban canopies + - test/single_layer case for testing the new surface types + - Namelist parameter radsurf_config:isurfacetype can be used to + override the surface_type in the input file + - Namelist parameter radsurf_config:vegetation_extinction_scaling + can scale the vegetation extinction in the input file + +version 0.7.2 (4 October 2021) - Longwave urban modifications to give correct emission from walls, fixing error most noticeable with 2-streams - see radtool_legendre_gauss.F90 and radsurf_urban_lw.F90 @@ -20,6 +51,9 @@ version 0.7.2 or no clear-air region): exchange coefficients to/from such regions are now zero, and eigenvalues only computed for regions of finite size + - Added solar_zenith_angle to driver namelist to specify in + degrees as an alternative to cos_solar_zenith_angle + - Added RAMI-V test scenes in test/rami5 version 0.7.1 (23 October 2020) - Added Apache license statement to each source file diff --git a/Makefile b/Makefile index fc212e2..8563740 100644 --- a/Makefile +++ b/Makefile @@ -83,7 +83,7 @@ libradsurf: libradtool driver: libradsurf cd driver && $(MAKE) -test: test_simple test_rami4pilps test_urban +test: test_simple test_rami4pilps test_urban test_rami5 test_single_layer test_simple: cd test/simple && $(MAKE) test @@ -94,9 +94,17 @@ test_rami4pilps: test_urban: cd test/urban && $(MAKE) test +# Single profile test_urban_single: cd test/urban && $(MAKE) test_single +# Single layer +test_single_layer: + cd test/single_layer && $(MAKE) test + +test_rami5: + cd test/rami5 && $(MAKE) test + test_code: cd driver && $(MAKE) test_code @@ -108,6 +116,8 @@ clean-tests: cd test/simple && $(MAKE) clean cd test/rami4pilps && $(MAKE) clean cd test/urban && $(MAKE) clean + cd test/rami5 && $(MAKE) clean + cd test/single_layer && $(MAKE) clean clean-toplevel: cd radsurf && $(MAKE) clean diff --git a/Makefile_include.gfortran b/Makefile_include.gfortran index b0b627d..7875318 100644 --- a/Makefile_include.gfortran +++ b/Makefile_include.gfortran @@ -14,8 +14,11 @@ OMPFLAG = -fopenmp ifndef DEBUG # --NORMAL CONFIGURATION-- -# Optimization flags -OPTFLAGS = -O3 +# Optimization flags: note that experience with gfortran is that the +# code is faster with -O2 than with -O3. The "-march=native" optimizes +# for the architecture on which the compilation takes place, but this +# means the code might not run on older CPUs. +OPTFLAGS = -O2 -march=native # Warning flags: all except those that warn about unused stuff WARNFLAGS = -Wall -Wno-unused-label -Wno-unused-dummy-argument -Wno-unused-variable -Wimplicit-interface @@ -30,4 +33,9 @@ OPTFLAGS = -O0 WARNFLAGS = -Wall DEBUGFLAGS = -g -ffpe-trap=invalid,zero,overflow -fcheck=bounds -finit-real=snan -endif \ No newline at end of file +endif + +ifdef GPROF +# Add gprof output +DEBUGFLAGS += -pg +endif diff --git a/README.md b/README.md index c48f02c..356ac8a 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ Robin Hogan -This document was last updated 10 October 2020 +This document was last updated 6 October 2021 ## INTRODUCTION @@ -105,6 +105,8 @@ RAMI4PILPS test cases that were used by Hogan et al. (2018). The `test/urban` directory contains an urban profile from Fig. 1 of Hogan (2019). +The `test/rami5` directory contains the files necessary to run five of +the actual forest scenes from the RAMI-V intercomparison project. ## LICENCE diff --git a/TODO b/TODO index 6d8fee4..f8f713f 100644 --- a/TODO +++ b/TODO @@ -1,18 +1,16 @@ FEATURES -Compute leaf sunlit fraction (wavelength independent) -Broadband or spectral fluxes each optional Gas optics -Closed forest: optimization by looking for veg cover = 0 or 1 -Report radiation components into a horizontal and vertical surface for calculation MRT -Road/roofs/wall direct fraction, and direct flux attenuated only by air Dump out inputs like in ecRad Combine lw_spectral_props%calc_monochromatic_emission and calc_simple_spectrum_lw into one function call for broadband Planck function Support implicit solvers, e.g. windows in TEB with very low heat capacity -Way to calculate thermal comfort / mean radiant temperature considering diffuse angles +Store norm_perims for verification BUG FIXES +Fix use of veg_contact_fraction +test_surface_out.nc fails with number of veg regions = 1 +Fix crash when vegetation region has zero vegetation extinction, esp. in single precision Fix non-zero residual in urban longwave when nstream>=2 CHECK diff --git a/doc/spartacus_surface_documentation.pdf b/doc/spartacus_surface_documentation.pdf index 522378b..a5636de 100644 Binary files a/doc/spartacus_surface_documentation.pdf and b/doc/spartacus_surface_documentation.pdf differ diff --git a/doc/spartacus_surface_documentation.tex b/doc/spartacus_surface_documentation.tex index 516d882..fd75caf 100644 --- a/doc/spartacus_surface_documentation.tex +++ b/doc/spartacus_surface_documentation.tex @@ -18,7 +18,7 @@ \newcolumntype{L}{>{\raggedright\arraybackslash\hangindent=1em}} \newcolumntype{M}{>{\raggedright\arraybackslash\hangindent=1em\ttfamily}} \newcolumntype{X}{>{\nullfont}c} -\def\tablesetup{\rowcolors{2}{light-gray}{light-gray}\footnotesize} +\def\tablesetup{\rowcolors{2}{light-gray}{light-gray}\small} \newmdenv[ leftmargin = 0pt, innerleftmargin = 1em, @@ -106,8 +106,8 @@ \author{Robin J. Hogan\\ \emph{European Centre for Medium Range Weather Forecasts, Reading, UK}} -\date{Document version 0.7.1 (October 2020) applicable to - \spsurf\ version 0.7.1\thanks{This document is copyright +\date{Document version 0.7.3 (October 2021) applicable to + \spsurf\ version 0.7.3\thanks{This document is copyright \copyright\ 2019-- ECMWF. If you have any queries about \spsurf\ that are not answered by this document % @@ -358,24 +358,26 @@ \section{Running the offline scheme} \ref{sec:nam_radsurf_config}). \pagebreak -\begin{center} +%\begin{center} +{ \tablesetup \begin{longtable}{llLp{8cm}}% \caption{\label{tab:invar}Main variables contained in the input netCDF file to \spsurf. All are floating-point numbers except for - \code{surface\_type}, which contains integers.}\\ + \code{surface\_type} and \code{nlayer}, which contain integers.}\\ % \hline Variable & Dimensions & Description \\ \hline \codetab{cos\_solar\_zenith\_angle} & \codetab{col} & Cosine of solar zenith angle \\ -\codetab{surface\_type} & \codetab{col} & Surface type: (0) flat, (1) forest, (2) urban, and (3) vegetated urban \\ +\codetab{surface\_type} & \codetab{col} & Surface type: (0) flat, (1) forest, (2) urban, (3) vegetated urban, (4) simple urban, and (5) infinite street \\ +\codetab{nlayer} & \codetab{col} & Number of active layers \\ \codetab{height} & \codetab{col, layer\_int} & Height of layer interfaces (m) \\ \codetab{veg\_fraction} & \codetab{col, layer} & Vegetation fraction \\ \codetab{veg\_scale} & \codetab{col, layer} & Vegetation horizontal scale (m) \\ \codetab{veg\_extinction} & \codetab{col, layer} & Wavelength-independent vegetation extinction coefficient (m$^{-1}$) \\ \codetab{veg\_fsd} & \codetab{col, layer} & Fractional standard deviation of vegetation extinction \\ -\codetab{veg\_contact\_fraction} & \codetab{col, layer} & Fraction of vegetation edge in contact with building walls \\ +\codetab{veg\_contact\_fraction} & \codetab{col, layer} & Fraction of building walls in contact with vegetation; note that in version 0.7.2 and earlier this was instead defined as the fraction of vegetation edge in contact with buildings \\ % \codetab{building\_fraction} & \codetab{col, layer} & Building fraction \\ \codetab{building\_scale} & \codetab{col, layer} & Building horizontal scale (m) \\ @@ -408,18 +410,32 @@ \section{Running the offline scheme} \codetab{top\_flux\_dn\_direct\_sw} & \codetab{col, sw} & Top-of-canopy downwelling direct shortwave flux (W m$^{-2}$) \\ \hline \end{longtable} -\end{center} +} +%\end{center} Input fields should be provided in order of increasing height, and the output data use the same convention. The \code{surface\_type} variable selects how the column is to be treated, as depicted in -Fig.\ \ref{fig:type_schematic}. +Fig.\ \ref{fig:type_schematic}. Types 1--3 use the SPARTACUS method as +described by \cite{Hogan2019b} but differ according to whether trees, +buildings or both are represented. Types 4 and 5 use a simplified +description of unvegetated urban areas in which all buildings are +assumed to have the same height, and the \cite{Harman+2004} method is +used to represent multiple scattering within the urban canopy by +solving a $2\times2$ matrix problem. Type 4 makes the same assumption +about the horizontal distribution of buildings as SPARTACUS, which is +that the wall-to-wall separation distances follow an exponential +distribution \citep{Hogan2019a}. Type 5 makes the `infinite street' +assumption: streets are assumed to be of equal width and infinite in +length. While the latter assumption is commonly used in urban exchange +models, it was found by \cite{Hogan2019a} to be a poorer fit to the +building distributions in real cities. \begin{figure}[tb!] \centerline{\includegraphics[width=0.75\textwidth]{surface_type_schematic.pdf}} - \caption{\label{fig:type_schematic}Schematic of the four surfaces - represented by the \code{surface\_type} variable provided in the - \spsurf\ input file (see Table \ref{tab:invar}).} + \caption{\label{fig:type_schematic}Schematic of the six surface + types represented by the \code{surface\_type} variable provided in + the \spsurf\ input file (see Table \ref{tab:invar}).} \end{figure} The output netCDF file contains the typical set of broadband fluxes @@ -429,16 +445,20 @@ \section{Running the offline scheme} \code{do\_spectral} to \code{true} and the same variables will be output but with the prefix \code{spectral\_}. -\begin{center} +%\begin{center} +{ \tablesetup \begin{longtable}{llLp{7cm}}% +%\begin{table}[tb!] \caption{\label{tab:outvar}Variables contained in the output netCDF file from \spsurf. All fluxes (or irradiances) and absorption rates - have units of W~m$^{-2}$, but note that this is power per unit area - of the \emph{entire domain}, not per unit area of a specific facet - type. `Net' fluxes are defined as the flux into a facet type (or downward) minus the - flux out of a facet type (or upward).}\\ + have units of W~m$^{-2}$, but note that this is power per unit + horizontal area of the \emph{entire domain}, not per unit area of a + specific facet type. `Net' fluxes are defined as the flux into a + facet type (or downward) minus the flux out of a facet type (or + upward).}\\ % +%\begin{tabular}{llLp{7cm}}% \hline Variable & Dimensions & Description\\ \hline @@ -451,12 +471,12 @@ \section{Running the offline scheme} \codetab{top\_flux\_dn\_sw} & \codetab{col} & Top-of-canopy downwelling shortwave flux\\ \codetab{top\_flux\_net\_sw} & \codetab{col} & Top-of-canopy net shortwave flux\\ \codetab{top\_flux\_dn\_direct\_sw} & \codetab{col} & Top-of-canopy direct downwelling shortwave flux\\ -\codetab{roof\_flux\_in\_sw} & \codetab{col, layer} & Shortwave flux into roofs \\ +\codetab{roof\_flux\_in\_sw} & \codetab{col, layer} & Shortwave flux into roofs at the top of the layer\\ \codetab{roof\_flux\_in\_direct\_sw} & \codetab{col, layer} & Direct shortwave flux into roofs \\ -\codetab{roof\_flux\_net\_sw} & \codetab{col, layer} & Net shortwave flux into roofs\\ +\codetab{roof\_flux\_net\_sw} & \codetab{col, layer} & Net shortwave flux into roofs (in minus out)\\ \codetab{wall\_flux\_in\_sw} & \codetab{col, layer} & Shortwave flux into walls\\ \codetab{wall\_flux\_in\_direct\_sw} & \codetab{col, layer} & Direct shortwave flux into walls\\ -\codetab{wall\_flux\_net\_sw} & \codetab{col, layer} & Net shortwave flux into walls\\ +\codetab{wall\_flux\_net\_sw} & \codetab{col, layer} & Net shortwave flux into walls (in minus out)\\ \codetab{clear\_air\_absorption\_sw} & \codetab{col, layer} & Shortwave absorption rate in clear-air part of layer\\ \codetab{veg\_absorption\_sw} & \codetab{col, layer} & Shortwave absorption rate by leaves\\ \codetab{veg\_absorption\_direct\_sw} & \codetab{col, layer} & Direct shortwave absorption rate by leaves\\ @@ -466,10 +486,10 @@ \section{Running the offline scheme} \codetab{ground\_flux\_vertical\_lw} & \codetab{col} & Longwave flux into a vertical surface at ground level\\ \codetab{top\_flux\_dn\_lw} & \codetab{col} & Top-of-canopy donwelling longwave flux\\ \codetab{top\_flux\_net\_lw} & \codetab{col} & Top-of-canopy net longwave flux\\ -\codetab{roof\_flux\_in\_lw} & \codetab{col, layer} & Longwave flux into roofs\\ -\codetab{roof\_flux\_net\_lw} & \codetab{col, layer} & Net longwave flux into roofs\\ +\codetab{roof\_flux\_in\_lw} & \codetab{col, layer} & Longwave flux into roofs at the top of the layer\\ +\codetab{roof\_flux\_net\_lw} & \codetab{col, layer} & Net longwave flux into roofs (in minus out)\\ \codetab{wall\_flux\_in\_lw} & \codetab{col, layer} & Longwave flux into walls\\ -\codetab{wall\_flux\_net\_lw} & \codetab{col, layer} & Net flux into walls\\ +\codetab{wall\_flux\_net\_lw} & \codetab{col, layer} & Net flux into walls (in minus out)\\ \codetab{clear\_air\_absorption\_lw} & \codetab{col, layer} & Net longwave absorption rate in clear-air part of layer\\ \codetab{veg\_absorption\_lw} & \codetab{col, layer} & Net longwave absorption rate by leaves\\ \codetab{veg\_air\_absorption\_lw} & \codetab{col, layer} & Net longwave absorption rate by air in vegetated part of layer\\ @@ -479,7 +499,16 @@ \section{Running the offline scheme} \codetab{veg\_sunlit\_fraction} & \codetab{col, layer} & Fraction of the one-sided leaf area that is in direct sunlight\\ \hline \end{longtable} -\end{center} +%\end{tabular}\end{table} +} +%\end{center} + +Note that the roof fluxes, e.g.\ \code{roof\_flux\_in\_sw}, have a +\code{layer} dimension but since (flat) roofs are only assumed to +exist at the interface between layers, these variables correspond to +the fluxes into roofs at the top of each layer. The ground fluxes are +similar to the roof fluxes but at the interface between the lowest +layer and the ground. The \code{ground\_flux\_vertical\_*} variables are diffuse fluxes into a vertical plane at ground level, and are useful for computing thermal @@ -531,12 +560,12 @@ \section{Running the offline scheme} \begin{center} \tablesetup \begin{longtable}{llLp{7cm}}% -\caption{\label{tab:outfluxprofvar}Additional variables contained in the - output netCDF file from \spsurf\ if the namelist parameter +\caption{\label{tab:outfluxprofvar}Additional variables contained in + the output netCDF file from \spsurf\ if the namelist parameter \code{do\_save\_flux\_profile} is set to \code{true}. All fluxes - have units of W~m$^{-2}$, but - note that this is power per unit area of the \emph{entire domain}, - not per unit area of the clear/vegetated part of the layer.}\\ + have units of W~m$^{-2}$, but note that this is power per unit + horizontal area of the \emph{entire domain}, not per unit area of + the clear/vegetated part of the layer.}\\ % \hline Variable & Dimensions & Description\\ @@ -555,6 +584,7 @@ \section{Running the offline scheme} \end{longtable} \end{center} +%\pagebreak \section{Configuring the \spsurf\ algorithm} \label{sec:nam_radsurf} @@ -567,8 +597,10 @@ \section{Configuring the \spsurf\ algorithm} %\newcommand{\namedef}{3}{\code{#1} & #2 & #3\\} %\begin{table} -\begin{center} +{ +%\begin{center} \tablesetup +%\pagebreak %\begin{longtable}{lc>{\raggedright}p{5cm}>{\raggedright}p{5cm}} %\begin{longtable}{lXLp{4cm}Lp{5.5cm}} \begin{longtable}{lXlLp{5.5cm}} @@ -596,7 +628,7 @@ \section{Configuring the \spsurf\ algorithm} \multicolumn{4}{l}{\emph{Options specific to forest tiles}}\\ \codetab{n\_vegetation\_region\_forest} & I & \codetabemph{1}, \code{2} & Number of regions used to describe vegetation (2 needed for heterogeneity)\\ \codetab{n\_stream\_sw\_forest} & I & \codetabemph{4} & Streams per hemisphere to describe diffuse shortwave radiation\\ -\codetab{n\_stream\_sw\_forest} & I & \codetabemph{4} & Streams per hemisphere to describe longwave radiation\\ +\codetab{n\_stream\_lw\_forest} & I & \codetabemph{4} & Streams per hemisphere to describe longwave radiation\\ \codetab{use\_symmetric\_vegetation\_scale\_forest} & L & \codetabemph{true} & Compute vegetation perimeter length using Eq.\ 20 of \cite{Hogan+2018}? Otherwise Eq.\ 19\\ \codetab{vegetation\_isolation\_factor\_forest} & R & \codetabemph{0.0}, \code{0.0}--\code{1.0} & In forests dense vegetation region is (0.0) embedded within sparse region or (1.0) in physically isolated regions, or in between\\ \codetab{vegetation\_isolation\_factor\_urban} & R & \codetabemph{0.0}, \code{0.0}--\code{1.0} & In urban areas dense vegetation region is (0.0) embedded within sparse region or (1.0) in physically isolated regions, or in between\\ @@ -605,7 +637,7 @@ \section{Configuring the \spsurf\ algorithm} \codetab{min\_building\_fraction} & R & \codetabemph{10$^{-6}$} & Minimum building area fraction below which a building is ignored\\ \codetab{n\_vegetation\_region\_urban} & I & \codetabemph{1}, \code{2} & Number of regions used to describe vegetation (2 needed for heterogeneity)\\ \codetab{n\_stream\_sw\_urban} & I & \codetabemph{4} & Streams per hemisphere to describe diffuse shortwave radiation\\ -\codetab{n\_stream\_sw\_urban} & I & \codetabemph{4} & Streams per hemisphere to describe longwave radiation\\ +\codetab{n\_stream\_lw\_urban} & I & \codetabemph{4} & Streams per hemisphere to describe longwave radiation\\ \codetab{use\_symmetric\_vegetation\_scale\_urban} & L & \codetabemph{true} & Compute vegetation perimeter length using Eq.\ 20 of \cite{Hogan+2018}? Otherwise Eq.\ 19\\ \codetab{vegetation\_isolation\_factor\_urban} & R & \codetabemph{0.0}, \code{0.0}--\code{1.0} & Dense vegetation region is (0.0) embedded within sparse region or (1.0) in physically isolated regions\\ %\hline @@ -615,7 +647,8 @@ \section{Configuring the \spsurf\ algorithm} % To be added: % & do_canopy_gases_sw, do_canopy_gases_lw, \end{longtable} -\end{center} +%\end{center} +} %\end{table} The number of streams can be any positive integer, but note that this @@ -640,7 +673,7 @@ \section{Configuring the \spsurf\ algorithm} assumption used by][]{Hogan+2018}, and 1.0 in which the dense and sparse regions form unconnected tree crowns. -\begin{figure}[b!] +\begin{figure}[tb!] \centerline{\includegraphics[width=0.75\textwidth]{isolation_schematic.pdf}} \caption{\label{fig:isolation_schematic}Schematic illustrating how the \code{vegetation\_isolation\_factor\_*} parameters in Table @@ -648,44 +681,6 @@ \section{Configuring the \spsurf\ algorithm} region and the two vegetated regions in each layer.} \end{figure} -\spsurf\ assumes that the rate of lateral exchange of radiation -between the clear and vegetated regions is proportional to the -normalized perimeter length, $L$, separating the vegetation and clear -regions, i.e.\ the perimeter length divided by the horizontal area of -the domain. This variable has units of m$^{-1}$ and is a strong -function of vegetation fraction, so it is more convenient for models to -parameterize the horizontal size of typical tree crowns, as expressed -by the \code{vegetation\_scale} input variable in Table -\ref{tab:invar}. The \code{use\_symmetric\_vegetation\_scale\_*} -parameters determine how this scale is used to compute $L$. If a -symmetric vegetation scale is selected then Eq.\ 20 of -\cite{Hogan+2018} is used: -% -\begin{equation} - L=4v(1-v)/S,\label{eq:S} -\end{equation} -% -where $v$ is the vegetation fraction and $S$ is the vegetation scale. -In this case, as the vegetation fraction approaches one, the -normalized perimeter approaches zero, indicating that the tree crowns -effectively merge. If \code{use\_symmetric\_vegetation\_scale\_*} is -\code{false} then Eq.\ 19 of \cite{Hogan+2018} is used: -% -\begin{equation} - L=4v/D,\label{eq:D} -\end{equation} -% -where this time \code{vegetation\_scale} is interpreted as the -effective crown diameter, $D$. This has the property that $L$ -approaches a constant value as the vegetation fraction approaches one, -which could be thought of as the property of \emph{crown shyness} -exhibited by some forest canopies. - -The \code{building\_scale} input variable in Table \ref{tab:invar} is -always interpreted as an effective building diameter, i.e.\ the code -uses (\ref{eq:D}) to convert to the normalized building perimeter -length in each layer, $L$, given the building fraction $v$. - \section{Configuring the offline package} \label{sec:nam_radsurf_config} In addition to the namelist parameters described in section @@ -696,7 +691,8 @@ \section{Configuring the offline package} present in the namelist then they will override the corresponding variable provided in the input file. -\begin{center} +%\begin{center} +{ \tablesetup \begin{longtable}{ll} % @@ -720,6 +716,7 @@ \section{Configuring the offline package} \hline \multicolumn{2}{l}{\emph{Override input variables}}\\ \codetab{cos\_solar\_zenith\_angle} & Override cosine of solar zenith angle\\ +\codetab{isurfacetype} & Override value of surface type (0--5)\\ \codetab{ground\_sw\_albedo} & Override shortwave albedo of ground\\ \codetab{roof\_sw\_albedo} & Override shortwave albedo of roofs\\ \codetab{wall\_sw\_albedo} & Override shortwave albedo of walls\\ @@ -728,6 +725,7 @@ \section{Configuring the offline package} \codetab{wall\_lw\_emissivity} & Override longwave emissivity of walls\\ \codetab{vegetation\_fraction} & Override vegetation fraction \\ \codetab{vegetation\_extinction} & Override vegetation extinction coefficient (m$^{-1}$)\\ +\codetab{vegetation\_extinction\_scaling} & Scale vegetation extinction coefficient\\ \codetab{vegetation\_fsd} & Override vegetation fractional standard deviation of extinction\\ \codetab{vegetation\_sw\_ssa} & Override vegetation shortwave single scattering albedo \\ \codetab{vegetation\_lw\_ssa} & Override vegetation longwave single scattering albedo \\ @@ -736,7 +734,177 @@ \section{Configuring the offline package} \codetab{top\_flux\_dn\_lw} & Override top-of-canopy downwelling longwave flux (W~m$^{-2}$)\\ \hline \end{longtable} -\end{center} +} +%\end{center} +%\pagebreak + +\section{Interpretation of geometry input variables} +\subsection{Forests} +\spsurf\ assumes that the rate of lateral exchange of radiation +between the clear-air and vegetated regions is proportional to the +normalized length of the perimeter separating the vegetation and clear +regions, $L_{av}$, i.e.\ the perimeter length divided by the horizontal +area of the domain. This variable has units of m$^{-1}$ and in +practice is a strong function of vegetation fraction, so it is more +convenient for models to parameterize the horizontal size of typical +tree crowns, as expressed by the \code{vegetation\_scale} input +variable in Table \ref{tab:invar}. The +\code{use\_symmetric\_vegetation\_scale\_*} parameters determine how +this scale is used to compute $L_{av}$ in the `forest' and `vegetated +urban' surface types (shown in Fig.\ \ref{fig:type_schematic}). If a +symmetric vegetation scale is selected then Eq.\ 20 of +\cite{Hogan+2018} is used: +% +\begin{equation} + L_{av}=\frac{4av}{S_v},\label{eq:S} +\end{equation} +% +where $a$ is the clear-air fraction, $v$ is the vegetation fraction +and $S_v$ is the vegetation scale. In the case of a forest, there are +no other regions so $a=1-v$ and as the vegetation fraction approaches +one, the normalized perimeter approaches zero, indicating that the +tree crowns effectively merge. If +\code{use\_symmetric\_vegetation\_scale\_*} is \code{false} then +Eq.\ 19 of \cite{Hogan+2018} is used: +% +\begin{equation} + L_{av}=\frac{4v}{D_v},\label{eq:D} +\end{equation} +% +where this time \code{vegetation\_scale} is interpreted as the +effective crown diameter, $D_v$. This has the property that $L_{av}$ +approaches a constant value as the vegetation fraction approaches one, +which could be thought of as the property of \emph{crown shyness} +exhibited by some forest canopies. + +If you have two vegetated regions (\code{n\_vegetation\_region\_*} in +Table \ref{tab:nam_radsurf} is 2) then the normalized perimeter length +between vegetation and clear-air, $L_{av}$, will be partitioned between the +two vegetated regions in proportion to the relevant +\code{vegetation\_isolation\_factor\_*} parameter $f$: +% +\begin{align} +L_{a1}=&L_{av}(1-f/2);\label{eq:La1}\\ +L_{a2}=&L_{av}f/2,\label{eq:La2} +\end{align} +% +where $L_{a1}$ and $L_{a2}$ are the normalized perimeter lengths +between clear-air and each of the two vegetation regions. Figure +\ref{fig:isolation_schematic} illustrates the limits of $f=0$ and +$f=1$. +% +This still leaves the length of the interface between the two +vegetated regions, $L_{12}$, to be determined, which is used +internally to compute the rate of lateral radiation exchange between +these two regions. It is computed in \spsurf\ as follows. If the +symmetric vegetation scale is selected then the horizontal scale of +the vegetation inhomogeneities is assumed to be the same as the scale +of the tree crowns themselves. Therefore, to compute the length of the +interface between the two vegetated regions we use (\ref{eq:S}) but +replace the vegetation fraction $v$ with the fraction of just one of +the two vegetation regions, $v/2$, such that +% +\begin{equation} +L_{12}=(1-f)\frac{4(v/2)(1-v/2)}{S_v}=(1-f)\frac{v(2-v)}{S_v}.\label{eq:L12S} +\end{equation} +% +If the non-symmetric vegetation scale, $D_v$, is to be used then the +following formula is applied instead +% +\begin{equation} +L_{12}=(1-f)\frac{4v}{2^{1/2}D_v}.\label{eq:L12D} +\end{equation} +% +The factor of $2^{1/2}$ on the denominator was used by +\cite{Hogan+2018} and is consistent with a tree model depicted in +their Fig.\ 1 in which crowns are quasi-circular in horizontal +cross-section and the optically thicker of the two region lies within +a quasi-circular core surrounded by the optically thinner region. + +If you are trying to simulate a 3D forest scene for which you know the +exact location and sizes of the trees (e.g.\ from one of the RAMI +intercomparisons) then you should analyze the scene to compute the +vertical profile of $L_{av}$, then invert either (\ref{eq:S}) or +(\ref{eq:D}) to obtain the profile of vegetation scale to use as input +to the algorithm. The two formulas for $L_{12}$ above do not allow for +both $L_{av}$ and $L_{12}$ to be specified independently, even if you are +analysing a 3D scene for which information on $L_{12}$ might be known, +but it should be noted that $L_{av}$ has a much larger impact on radiative +fluxes in the canopy than $L_{12}$. + +\subsection{Urban areas} +The \code{building\_scale} input variable in Table \ref{tab:invar} is +always interpreted as an effective building diameter, i.e.\ the code +uses the equivalent of (\ref{eq:D}) to convert to the normalized +building perimeter length in each layer, $L_b$, given the building +fraction $b$: +% +\begin{equation} + L_b=\frac{4b}{D_b}. +\end{equation} +% +If there is no vegetation then all the building perimeter length is in +contact with clear air, so $L_{ab}=L_b$. If vegetation is present then +the building perimeter $L_b$ is divided between clear-air and +vegetation according to the \code{veg\_contact\_fraction} variable, +$c$: +% +\begin{align} + L_{ab}&=(1-c)L_b;\\ + L_{vb}&=cL_b. +\end{align} +% +In the offline version of \spsurf, if \code{veg\_contact\_fraction} is +not provided in the input file then it is assumed that trees are +randomly located in the space between buildings, and therefore that +the probability of a building wall being in contact with vegetation is +equal to the fraction of this space containing vegetation, i.e.: +% +\begin{equation} + c=v/(a+v).\label{eq:c} +\end{equation} +% +Note that the building, clear-air and vegetation fractions sum to one: +$b+a+v=1$. If \spsurf\ is embedded in a larger model then +\code{veg\_contact\_fraction} must be provided explicitly, in which +case it is recommended that (\ref{eq:c}) is used. Please note that in +\spsurf\ version 0.7.2 and earlier, \code{veg\_contact\_fraction} was +defined as the fraction of vegetation perimeter in contact with the +walls, rather than the current definition which is the fraction of +building perimeter in contact with vegetation. + +The length of the interface between vegetation and clear-air is +treated slightly differently for vegetated urban areas than forests, +due to the fact that the building fraction $b$ is removed from +consideration. If a symmetric vegetation scale is selected then we +apply (\ref{eq:S}) to the non-building part of the domain only (with +fraction $a+v$): +% +\begin{equation} + \frac{L_{av}}{a+v}=\frac{4}{S_v}\,\frac{a}{a+v}\,\frac{v}{a+v}, +\end{equation} +% +leading to +% +\begin{equation} + L_{av}=\frac{4}{S_v}\frac{av}{a+v}. +\end{equation} +% +If a non-symmetric vegetation scale is selected then (\ref{eq:D}) is +applied as before. +% +If there are two vegetation regions in an urban area then the +normalized perimeter length between clear-air and each of the two +vegetation regions uses (\ref{eq:La1}) and (\ref{eq:La2}), as +before. If the symmetric vegetation scale is selected then we take a +similar approach and (\ref{eq:L12S}) becomes +% +\begin{equation} + L_{12}=(1-f)\frac{4(v/2)(1-v/2-b)}{(a+b)S_v}, +\end{equation} +% +while for a non-symmetric vegetation scale, (\ref{eq:L12D}) is applied +as before. \section{Checking the configuration} \label{sec:checking} @@ -838,7 +1006,7 @@ \section{Incorporating \spsurf\ into another program} ! Allocatable integer vectors of length "ncol" nlay ! Number of layers in column istartlay ! Index of first layer - i_representation ! Surface type (0-4) + i_representation ! Surface type (0-5) ! Allocatable real vectors of length "ncol" dz ! Layer thickness (m) @@ -915,7 +1083,7 @@ \section{Incorporating \spsurf\ into another program} ! Allocatable integer vectors of length "ncol" nlay ! Number of layers in column (can be 0) istartlay ! Index to first layer of the column - i_representation ! Surface type (0-3) + i_representation ! Surface type (0-5) ! Allocatable real vectors of length "ncol" cos_sza, ground_temperature @@ -1097,6 +1265,11 @@ \section{License and copyright} \begin{thebibliography}{00} \markright{References} % +\harvarditem{Harman~et~al.}{2004}{Harman+2004}Harman, I. N., +M. J. Best and S. E. Belcher, 2004: Radiative exchange in an urban +street canyon. \textit{Boundary-Layer Meteorol.,} \textbf{110,} +301--316. +% \harvarditem{Hogan}{2019a}{Hogan2019a}Hogan, R. J., 2019a: An exponential model of urban geometry for use in radiative transfer applications. \textit{Boundary-Layer Meteorol.,} \textbf{170,} diff --git a/doc/surface_type_schematic.fig b/doc/surface_type_schematic.fig index 09a5fe5..0dbe925 100644 --- a/doc/surface_type_schematic.fig +++ b/doc/surface_type_schematic.fig @@ -1,438 +1,810 @@ -#FIG 3.2 Produced by xfig version 3.2.7a +#FIG 3.2 Produced by xfig version 3.2.5c Landscape Center Inches -Letter +Letter 100.00 Single -2 1200 2 -6 -150 6975 150 7575 +6 -2100 6300 600 7800 +6 -150 6750 150 7350 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -150 6975 -75 6975 -75 7125 -150 7125 -150 6975 + -150 6750 -75 6750 -75 6900 -150 6900 -150 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -75 6975 0 6975 0 7125 -75 7125 -75 6975 + -75 6750 0 6750 0 6900 -75 6900 -75 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 0 6975 75 6975 75 7125 0 7125 0 6975 + 0 6750 75 6750 75 6900 0 6900 0 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 75 6975 150 6975 150 7125 75 7125 75 6975 + 75 6750 150 6750 150 6900 75 6900 75 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -150 7275 -75 7275 -75 7425 -150 7425 -150 7275 + -150 7050 -75 7050 -75 7200 -150 7200 -150 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -150 7425 -75 7425 -75 7575 -150 7575 -150 7425 + -150 7200 -75 7200 -75 7350 -150 7350 -150 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -75 7125 0 7125 0 7275 -75 7275 -75 7125 + -75 6900 0 6900 0 7050 -75 7050 -75 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 0 7125 75 7125 75 7275 0 7275 0 7125 + 0 6900 75 6900 75 7050 0 7050 0 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 75 7125 150 7125 150 7275 75 7275 75 7125 + 75 6900 150 6900 150 7050 75 7050 75 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -150 7125 -75 7125 -75 7275 -150 7275 -150 7125 + -150 6900 -75 6900 -75 7050 -150 7050 -150 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -75 7275 0 7275 0 7425 -75 7425 -75 7275 + -75 7050 0 7050 0 7200 -75 7200 -75 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -75 7425 0 7425 0 7575 -75 7575 -75 7425 + -75 7200 0 7200 0 7350 -75 7350 -75 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 0 7275 75 7275 75 7425 0 7425 0 7275 + 0 7050 75 7050 75 7200 0 7200 0 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 0 7425 75 7425 75 7575 0 7575 0 7425 + 0 7200 75 7200 75 7350 0 7350 0 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 75 7425 150 7425 150 7575 75 7575 75 7425 + 75 7200 150 7200 150 7350 75 7350 75 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 75 7275 150 7275 150 7425 75 7425 75 7275 + 75 7050 150 7050 150 7200 75 7200 75 7050 -6 -6 150 6975 300 7275 +6 150 6750 300 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 150 6975 225 6975 225 7125 150 7125 150 6975 + 150 6750 225 6750 225 6900 150 6900 150 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 225 7125 300 7125 300 7275 225 7275 225 7125 + 225 6900 300 6900 300 7050 225 7050 225 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 150 7125 225 7125 225 7275 150 7275 150 7125 + 150 6900 225 6900 225 7050 150 7050 150 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 225 6975 300 6975 300 7125 225 7125 225 6975 + 225 6750 300 6750 300 6900 225 6900 225 6750 -6 -6 150 7275 300 7575 +6 150 7050 300 7350 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 150 7275 225 7275 225 7425 150 7425 150 7275 + 150 7050 225 7050 225 7200 150 7200 150 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 225 7425 300 7425 300 7575 225 7575 225 7425 + 225 7200 300 7200 300 7350 225 7350 225 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 150 7425 225 7425 225 7575 150 7575 150 7425 + 150 7200 225 7200 225 7350 150 7350 150 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 225 7275 300 7275 300 7425 225 7425 225 7275 + 225 7050 300 7050 300 7200 225 7200 225 7050 -6 -6 3600 6975 3750 7275 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3600 6975 3675 6975 3675 7125 3600 7125 3600 6975 + -1575 6450 -1500 6450 -1500 6600 -1575 6600 -1575 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3675 7125 3750 7125 3750 7275 3675 7275 3675 7125 + -1650 6600 -1575 6600 -1575 6750 -1650 6750 -1650 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3600 7125 3675 7125 3675 7275 3600 7275 3600 7125 + -1575 6600 -1500 6600 -1500 6750 -1575 6750 -1575 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3675 6975 3750 6975 3750 7125 3675 7125 3675 6975 + -1500 6450 -1425 6450 -1425 6600 -1500 6600 -1500 6450 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 6450 -1350 6450 -1350 6600 -1425 6600 -1425 6450 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 6600 -1350 6600 -1350 6750 -1425 6750 -1425 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 6600 -1425 6600 -1425 6750 -1500 6750 -1500 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -150 6600 -75 6600 -75 6750 -150 6750 -150 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -75 6600 0 6600 0 6750 -75 6750 -75 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 0 6600 75 6600 75 6750 0 6750 0 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 75 6600 150 6600 150 6750 75 6750 75 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 225 6600 300 6600 300 6750 225 6750 225 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 150 6600 225 6600 225 6750 150 6750 150 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 6300 -1575 6300 -1575 6450 -1650 6450 -1650 6300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1575 6300 -1500 6300 -1500 6450 -1575 6450 -1575 6300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 6300 -1425 6300 -1425 6450 -1500 6450 -1500 6300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 6300 -1350 6300 -1350 6450 -1425 6450 -1425 6300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -525 7200 -450 7200 -450 7350 -525 7350 -525 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -525 7050 -450 7050 -450 7200 -525 7200 -525 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -600 7050 -525 7050 -525 7200 -600 7200 -600 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -600 7200 -525 7200 -525 7350 -600 7350 -600 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -675 7050 -600 7050 -600 7200 -675 7200 -675 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -675 7200 -600 7200 -600 7350 -675 7350 -675 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -750 7050 -675 7050 -675 7200 -750 7200 -750 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -750 7200 -675 7200 -675 7350 -750 7350 -750 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 6450 -1575 6450 -1575 6600 -1650 6600 -1650 6450 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -750 6900 -675 6900 -675 7050 -750 7050 -750 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 6750 -1425 6750 -1425 6900 -1500 6900 -1500 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 6750 -1350 6750 -1350 6900 -1425 6900 -1425 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 7050 -1425 7050 -1425 7200 -1500 7200 -1500 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 7200 -1425 7200 -1425 7350 -1500 7350 -1500 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 6900 -1350 6900 -1350 7050 -1425 7050 -1425 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1350 6900 -1275 6900 -1275 7050 -1350 7050 -1350 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1275 6900 -1200 6900 -1200 7050 -1275 7050 -1275 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1500 6900 -1425 6900 -1425 7050 -1500 7050 -1500 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 7050 -1350 7050 -1350 7200 -1425 7200 -1425 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1425 7200 -1350 7200 -1350 7350 -1425 7350 -1425 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1350 7050 -1275 7050 -1275 7200 -1350 7200 -1350 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1350 7200 -1275 7200 -1275 7350 -1350 7350 -1350 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1275 7200 -1200 7200 -1200 7350 -1275 7350 -1275 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1275 7050 -1200 7050 -1200 7200 -1275 7200 -1275 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 6750 -1650 6750 -1650 6900 -1725 6900 -1725 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 6750 -1575 6750 -1575 6900 -1650 6900 -1650 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1575 6750 -1500 6750 -1500 6900 -1575 6900 -1575 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 7050 -1725 7050 -1725 7200 -1800 7200 -1800 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 7200 -1725 7200 -1725 7350 -1800 7350 -1800 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 6900 -1650 6900 -1650 7050 -1725 7050 -1725 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 6900 -1575 6900 -1575 7050 -1650 7050 -1650 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1575 6900 -1500 6900 -1500 7050 -1575 7050 -1575 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 6900 -1725 6900 -1725 7050 -1800 7050 -1800 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 7050 -1650 7050 -1650 7200 -1725 7200 -1725 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 7200 -1650 7200 -1650 7350 -1725 7350 -1725 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 7050 -1575 7050 -1575 7200 -1650 7200 -1650 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1650 7200 -1575 7200 -1575 7350 -1650 7350 -1650 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1575 7200 -1500 7200 -1500 7350 -1575 7350 -1575 7200 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1575 7050 -1500 7050 -1500 7200 -1575 7200 -1575 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -675 6900 -600 6900 -600 7050 -675 7050 -675 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -600 6900 -525 6900 -525 7050 -600 7050 -600 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -525 6900 -450 6900 -450 7050 -525 7050 -525 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 6600 -1650 6600 -1650 6750 -1725 6750 -1725 6600 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 6450 -1650 6450 -1650 6600 -1725 6600 -1725 6450 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1725 6300 -1650 6300 -1650 6450 -1725 6450 -1725 6300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 6900 -1800 6900 -1800 7050 -1875 7050 -1875 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 7050 -1800 7050 -1800 7200 -1875 7200 -1875 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 7200 -1800 7200 -1800 7350 -1875 7350 -1875 7200 +2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 + -2100 7350 600 7350 600 7500 -2100 7500 -2100 7350 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + -2100 7200 600 7200 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + -2100 6900 600 6900 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + -2100 6600 600 6600 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + -2100 6300 600 6300 +4 0 0 50 -1 18 11 0.0000 4 165 795 -2100 7725 (2) Urban\001 +-6 +6 1200 6300 3900 7800 +6 3600 6750 3750 7050 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 6750 3675 6750 3675 6900 3600 6900 3600 6750 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3675 6900 3750 6900 3750 7050 3675 7050 3675 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 6900 3675 6900 3675 7050 3600 7050 3600 6900 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3675 6750 3750 6750 3750 6900 3675 6900 3675 6750 -6 -6 3600 7275 3750 7575 +6 3600 7050 3750 7350 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3600 7275 3675 7275 3675 7425 3600 7425 3600 7275 + 3600 7050 3675 7050 3675 7200 3600 7200 3600 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3675 7425 3750 7425 3750 7575 3675 7575 3675 7425 + 3675 7200 3750 7200 3750 7350 3675 7350 3675 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3600 7425 3675 7425 3675 7575 3600 7575 3600 7425 + 3600 7200 3675 7200 3675 7350 3600 7350 3600 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3675 7275 3750 7275 3750 7425 3675 7425 3675 7275 + 3675 7050 3750 7050 3750 7200 3675 7200 3675 7050 -6 -6 3300 6975 3600 7575 +6 3300 6750 3600 7350 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3300 6975 3375 6975 3375 7125 3300 7125 3300 6975 + 3300 6750 3375 6750 3375 6900 3300 6900 3300 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3375 6975 3450 6975 3450 7125 3375 7125 3375 6975 + 3375 6750 3450 6750 3450 6900 3375 6900 3375 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3450 6975 3525 6975 3525 7125 3450 7125 3450 6975 + 3450 6750 3525 6750 3525 6900 3450 6900 3450 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3525 6975 3600 6975 3600 7125 3525 7125 3525 6975 + 3525 6750 3600 6750 3600 6900 3525 6900 3525 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3300 7275 3375 7275 3375 7425 3300 7425 3300 7275 + 3300 7050 3375 7050 3375 7200 3300 7200 3300 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3300 7425 3375 7425 3375 7575 3300 7575 3300 7425 + 3300 7200 3375 7200 3375 7350 3300 7350 3300 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3375 7125 3450 7125 3450 7275 3375 7275 3375 7125 + 3375 6900 3450 6900 3450 7050 3375 7050 3375 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3450 7125 3525 7125 3525 7275 3450 7275 3450 7125 + 3450 6900 3525 6900 3525 7050 3450 7050 3450 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3525 7125 3600 7125 3600 7275 3525 7275 3525 7125 + 3525 6900 3600 6900 3600 7050 3525 7050 3525 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3300 7125 3375 7125 3375 7275 3300 7275 3300 7125 + 3300 6900 3375 6900 3375 7050 3300 7050 3300 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3375 7275 3450 7275 3450 7425 3375 7425 3375 7275 + 3375 7050 3450 7050 3450 7200 3375 7200 3375 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3375 7425 3450 7425 3450 7575 3375 7575 3375 7425 + 3375 7200 3450 7200 3450 7350 3375 7350 3375 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3450 7275 3525 7275 3525 7425 3450 7425 3450 7275 + 3450 7050 3525 7050 3525 7200 3450 7200 3450 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3450 7425 3525 7425 3525 7575 3450 7575 3450 7425 + 3450 7200 3525 7200 3525 7350 3450 7350 3450 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3525 7425 3600 7425 3600 7575 3525 7575 3525 7425 + 3525 7200 3600 7200 3600 7350 3525 7350 3525 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3525 7275 3600 7275 3600 7425 3525 7425 3525 7275 + 3525 7050 3600 7050 3600 7200 3525 7200 3525 7050 -6 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 1575 5175 1725 5025 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 1500 4875 1575 4725 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 1500 4875 1425 4800 -2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 - 1575 5400 1575 5175 1500 4875 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 3525 5175 3600 5100 -2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 - 3525 5400 3525 5175 3450 5025 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2625 5175 2775 5025 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2550 4875 2625 4500 -2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2550 4875 2400 4800 -2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 - 2625 5400 2625 5175 2550 4875 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 6825 1575 6825 1575 6975 1500 6975 1500 6825 + 1500 6600 1575 6600 1575 6750 1500 6750 1500 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 6825 1650 6825 1650 6975 1575 6975 1575 6825 + 1575 6600 1650 6600 1650 6750 1575 6750 1575 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 6675 1650 6675 1650 6825 1575 6825 1575 6675 + 1575 6450 1650 6450 1650 6600 1575 6600 1575 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 6825 1725 6825 1725 6975 1650 6975 1650 6825 + 1650 6600 1725 6600 1725 6750 1650 6750 1650 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 6675 1800 6675 1800 6825 1725 6825 1725 6675 + 1725 6450 1800 6450 1800 6600 1725 6600 1725 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 6825 1800 6825 1800 6975 1725 6975 1725 6825 + 1725 6600 1800 6600 1800 6750 1725 6750 1725 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 6675 1875 6675 1875 6825 1800 6825 1800 6675 + 1800 6450 1875 6450 1875 6600 1800 6600 1800 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 6825 1875 6825 1875 6975 1800 6975 1800 6825 + 1800 6600 1875 6600 1875 6750 1800 6750 1800 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 6675 1725 6675 1725 6825 1650 6825 1650 6675 + 1650 6450 1725 6450 1725 6600 1650 6600 1650 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 6975 1725 6975 1725 7125 1650 7125 1650 6975 + 1650 6750 1725 6750 1725 6900 1650 6900 1650 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 6975 1800 6975 1800 7125 1725 7125 1725 6975 + 1725 6750 1800 6750 1800 6900 1725 6900 1725 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 6975 1875 6975 1875 7125 1800 7125 1800 6975 + 1800 6750 1875 6750 1875 6900 1800 6900 1800 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 7275 1725 7275 1725 7425 1650 7425 1650 7275 + 1650 7050 1725 7050 1725 7200 1650 7200 1650 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 7425 1725 7425 1725 7575 1650 7575 1650 7425 + 1650 7200 1725 7200 1725 7350 1650 7350 1650 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 7125 1800 7125 1800 7275 1725 7275 1725 7125 + 1725 6900 1800 6900 1800 7050 1725 7050 1725 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 7125 1875 7125 1875 7275 1800 7275 1800 7125 + 1800 6900 1875 6900 1875 7050 1800 7050 1800 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 7125 1950 7125 1950 7275 1875 7275 1875 7125 + 1875 6900 1950 6900 1950 7050 1875 7050 1875 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 7125 1725 7125 1725 7275 1650 7275 1650 7125 + 1650 6900 1725 6900 1725 7050 1650 7050 1650 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 7275 1800 7275 1800 7425 1725 7425 1725 7275 + 1725 7050 1800 7050 1800 7200 1725 7200 1725 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 7425 1800 7425 1800 7575 1725 7575 1725 7425 + 1725 7200 1800 7200 1800 7350 1725 7350 1725 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 7275 1875 7275 1875 7425 1800 7425 1800 7275 + 1800 7050 1875 7050 1875 7200 1800 7200 1800 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 7425 1875 7425 1875 7575 1800 7575 1800 7425 + 1800 7200 1875 7200 1875 7350 1800 7350 1800 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 7425 1950 7425 1950 7575 1875 7575 1875 7425 + 1875 7200 1950 7200 1950 7350 1875 7350 1875 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 7275 1950 7275 1950 7425 1875 7425 1875 7275 + 1875 7050 1950 7050 1950 7200 1875 7200 1875 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 6975 1575 6975 1575 7125 1500 7125 1500 6975 + 1500 6750 1575 6750 1575 6900 1500 6900 1500 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 6975 1650 6975 1650 7125 1575 7125 1575 6975 + 1575 6750 1650 6750 1650 6900 1575 6900 1575 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1350 7275 1425 7275 1425 7425 1350 7425 1350 7275 + 1350 7050 1425 7050 1425 7200 1350 7200 1350 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1350 7425 1425 7425 1425 7575 1350 7575 1350 7425 + 1350 7200 1425 7200 1425 7350 1350 7350 1350 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1425 7125 1500 7125 1500 7275 1425 7275 1425 7125 + 1425 6900 1500 6900 1500 7050 1425 7050 1425 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 7125 1575 7125 1575 7275 1500 7275 1500 7125 + 1500 6900 1575 6900 1575 7050 1500 7050 1500 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 7125 1650 7125 1650 7275 1575 7275 1575 7125 + 1575 6900 1650 6900 1650 7050 1575 7050 1575 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1350 7125 1425 7125 1425 7275 1350 7275 1350 7125 + 1350 6900 1425 6900 1425 7050 1350 7050 1350 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1425 7275 1500 7275 1500 7425 1425 7425 1425 7275 + 1425 7050 1500 7050 1500 7200 1425 7200 1425 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1425 7425 1500 7425 1500 7575 1425 7575 1425 7425 + 1425 7200 1500 7200 1500 7350 1425 7350 1425 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 7275 1575 7275 1575 7425 1500 7425 1500 7275 + 1500 7050 1575 7050 1575 7200 1500 7200 1500 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 7425 1575 7425 1575 7575 1500 7575 1500 7425 + 1500 7200 1575 7200 1575 7350 1500 7350 1500 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 7425 1650 7425 1650 7575 1575 7575 1575 7425 + 1575 7200 1650 7200 1650 7350 1575 7350 1575 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 7275 1650 7275 1650 7425 1575 7425 1575 7275 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 1350 4950 1800 4950 1800 5250 1350 5250 1350 4950 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 2325 4950 2925 4950 2925 5250 2325 5250 2325 4950 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 1350 4650 1725 4650 1725 4950 1350 4950 1350 4650 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 2475 4350 2775 4350 2775 4650 2475 4650 2475 4350 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 2325 4650 2850 4650 2850 4950 2325 4950 2325 4650 -2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 3375 4950 3675 4950 3675 5250 3375 5250 3375 4950 -2 2 0 1 -1 24 50 -1 10 0.000 0 0 -1 0 0 5 - 1200 5400 3900 5400 3900 5550 1200 5550 1200 5400 + 1575 7050 1650 7050 1650 7200 1575 7200 1575 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 6675 1575 6675 1575 6825 1500 6825 1500 6675 + 1500 6450 1575 6450 1575 6600 1500 6600 1500 6450 2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 - 2625 7575 2625 7350 2550 7050 + 2625 7350 2625 7125 2550 6825 2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2625 7350 2775 7200 + 2625 7125 2775 6975 2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2550 7050 2625 6900 + 2550 6825 2625 6675 2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 - 2550 7050 2475 6975 + 2550 6825 2475 6750 2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 2400 6825 2775 6825 2775 7125 2400 7125 2400 6825 + 2400 6600 2775 6600 2775 6900 2400 6900 2400 6600 2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 - 2400 7125 2850 7125 2850 7425 2400 7425 2400 7125 + 2400 6900 2850 6900 2850 7200 2400 7200 2400 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1950 7425 2025 7425 2025 7575 1950 7575 1950 7425 + 1950 7200 2025 7200 2025 7350 1950 7350 1950 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1950 7275 2025 7275 2025 7425 1950 7425 1950 7275 + 1950 7050 2025 7050 2025 7200 1950 7200 1950 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1950 7125 2025 7125 2025 7275 1950 7275 1950 7125 + 1950 6900 2025 6900 2025 7050 1950 7050 1950 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1500 6525 1575 6525 1575 6675 1500 6675 1500 6525 + 1500 6300 1575 6300 1575 6450 1500 6450 1500 6300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1575 6525 1650 6525 1650 6675 1575 6675 1575 6525 + 1575 6300 1650 6300 1650 6450 1575 6450 1575 6300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1650 6525 1725 6525 1725 6675 1650 6675 1650 6525 + 1650 6300 1725 6300 1725 6450 1650 6450 1650 6300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1725 6525 1800 6525 1800 6675 1725 6675 1725 6525 + 1725 6300 1800 6300 1800 6450 1725 6450 1725 6300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1800 6525 1875 6525 1875 6675 1800 6675 1800 6525 + 1800 6300 1875 6300 1875 6450 1800 6450 1800 6300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3300 6825 3375 6825 3375 6975 3300 6975 3300 6825 + 3300 6600 3375 6600 3375 6750 3300 6750 3300 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3375 6825 3450 6825 3450 6975 3375 6975 3375 6825 + 3375 6600 3450 6600 3450 6750 3375 6750 3375 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3450 6825 3525 6825 3525 6975 3450 6975 3450 6825 + 3450 6600 3525 6600 3525 6750 3450 6750 3450 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3525 6825 3600 6825 3600 6975 3525 6975 3525 6825 + 3525 6600 3600 6600 3600 6750 3525 6750 3525 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3675 6825 3750 6825 3750 6975 3675 6975 3675 6825 + 3675 6600 3750 6600 3750 6750 3675 6750 3675 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 3600 6825 3675 6825 3675 6975 3600 6975 3600 6825 + 3600 6600 3675 6600 3675 6750 3600 6750 3600 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 2025 7125 2100 7125 2100 7275 2025 7275 2025 7125 + 2025 6900 2100 6900 2100 7050 2025 7050 2025 6900 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 2025 7275 2100 7275 2100 7425 2025 7425 2025 7275 + 2025 7050 2100 7050 2100 7200 2025 7200 2025 7050 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 2025 7425 2100 7425 2100 7575 2025 7575 2025 7425 + 2025 7200 2100 7200 2100 7350 2025 7350 2025 7200 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 6975 1950 6975 1950 7125 1875 7125 1875 6975 + 1875 6750 1950 6750 1950 6900 1875 6900 1875 6750 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 6825 1950 6825 1950 6975 1875 6975 1875 6825 + 1875 6600 1950 6600 1950 6750 1875 6750 1875 6600 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 6675 1950 6675 1950 6825 1875 6825 1875 6675 + 1875 6450 1950 6450 1950 6600 1875 6600 1875 6450 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 1875 6525 1950 6525 1950 6675 1875 6675 1875 6525 -2 2 0 1 -1 24 50 -1 10 0.000 0 0 -1 0 0 5 - -2100 5400 600 5400 600 5550 -2100 5550 -2100 5400 + 1875 6300 1950 6300 1950 6450 1875 6450 1875 6300 +2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 + 1200 7350 3900 7350 3900 7500 1200 7500 1200 7350 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + 1200 6900 3900 6900 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + 1200 6600 3900 6600 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + 1200 7200 3900 7200 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + 1200 6300 3900 6300 +4 0 0 50 -1 18 11 0.0000 4 180 1680 1200 7725 (3) Vegetated urban\001 +-6 +6 -1050 8700 -900 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 6675 -1500 6675 -1500 6825 -1575 6825 -1575 6675 + -1050 8700 -975 8700 -975 8850 -1050 8850 -1050 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 6825 -1575 6825 -1575 6975 -1650 6975 -1650 6825 + -975 8850 -900 8850 -900 9000 -975 9000 -975 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 6825 -1500 6825 -1500 6975 -1575 6975 -1575 6825 + -1050 8850 -975 8850 -975 9000 -1050 9000 -1050 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 6675 -1425 6675 -1425 6825 -1500 6825 -1500 6675 + -975 8700 -900 8700 -900 8850 -975 8850 -975 8700 +-6 +6 -1050 9000 -900 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 6675 -1350 6675 -1350 6825 -1425 6825 -1425 6675 + -1050 9000 -975 9000 -975 9150 -1050 9150 -1050 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 6825 -1350 6825 -1350 6975 -1425 6975 -1425 6825 + -975 9150 -900 9150 -900 9300 -975 9300 -975 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 6825 -1425 6825 -1425 6975 -1500 6975 -1500 6825 + -1050 9150 -975 9150 -975 9300 -1050 9300 -1050 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -150 6825 -75 6825 -75 6975 -150 6975 -150 6825 + -975 9000 -900 9000 -900 9150 -975 9150 -975 9000 +-6 +6 -900 8700 -750 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -75 6825 0 6825 0 6975 -75 6975 -75 6825 + -900 8700 -825 8700 -825 8850 -900 8850 -900 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 0 6825 75 6825 75 6975 0 6975 0 6825 + -825 8850 -750 8850 -750 9000 -825 9000 -825 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 75 6825 150 6825 150 6975 75 6975 75 6825 + -900 8850 -825 8850 -825 9000 -900 9000 -900 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 225 6825 300 6825 300 6975 225 6975 225 6825 + -825 8700 -750 8700 -750 8850 -825 8850 -825 8700 +-6 +6 -900 9000 -750 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - 150 6825 225 6825 225 6975 150 6975 150 6825 + -900 9000 -825 9000 -825 9150 -900 9150 -900 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 6525 -1575 6525 -1575 6675 -1650 6675 -1650 6525 + -825 9150 -750 9150 -750 9300 -825 9300 -825 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 6525 -1500 6525 -1500 6675 -1575 6675 -1575 6525 + -900 9150 -825 9150 -825 9300 -900 9300 -900 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 6525 -1425 6525 -1425 6675 -1500 6675 -1500 6525 + -825 9000 -750 9000 -750 9150 -825 9150 -825 9000 +-6 +6 -750 8700 -600 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 6525 -1350 6525 -1350 6675 -1425 6675 -1425 6525 + -750 8700 -675 8700 -675 8850 -750 8850 -750 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -525 7425 -450 7425 -450 7575 -525 7575 -525 7425 + -675 8850 -600 8850 -600 9000 -675 9000 -675 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -525 7275 -450 7275 -450 7425 -525 7425 -525 7275 + -750 8850 -675 8850 -675 9000 -750 9000 -750 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -600 7275 -525 7275 -525 7425 -600 7425 -600 7275 + -675 8700 -600 8700 -600 8850 -675 8850 -675 8700 +-6 +6 -750 9000 -600 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -600 7425 -525 7425 -525 7575 -600 7575 -600 7425 + -750 9000 -675 9000 -675 9150 -750 9150 -750 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -675 7275 -600 7275 -600 7425 -675 7425 -675 7275 + -675 9150 -600 9150 -600 9300 -675 9300 -675 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -675 7425 -600 7425 -600 7575 -675 7575 -675 7425 + -750 9150 -675 9150 -675 9300 -750 9300 -750 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -750 7275 -675 7275 -675 7425 -750 7425 -750 7275 + -675 9000 -600 9000 -600 9150 -675 9150 -675 9000 +-6 +6 -600 8700 -450 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -750 7425 -675 7425 -675 7575 -750 7575 -750 7425 + -600 8700 -525 8700 -525 8850 -600 8850 -600 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 6675 -1575 6675 -1575 6825 -1650 6825 -1650 6675 + -525 8850 -450 8850 -450 9000 -525 9000 -525 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -750 7125 -675 7125 -675 7275 -750 7275 -750 7125 + -600 8850 -525 8850 -525 9000 -600 9000 -600 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 6975 -1425 6975 -1425 7125 -1500 7125 -1500 6975 + -525 8700 -450 8700 -450 8850 -525 8850 -525 8700 +-6 +6 -600 9000 -450 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 6975 -1350 6975 -1350 7125 -1425 7125 -1425 6975 + -600 9000 -525 9000 -525 9150 -600 9150 -600 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 7275 -1425 7275 -1425 7425 -1500 7425 -1500 7275 + -525 9150 -450 9150 -450 9300 -525 9300 -525 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 7425 -1425 7425 -1425 7575 -1500 7575 -1500 7425 + -600 9150 -525 9150 -525 9300 -600 9300 -600 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 7125 -1350 7125 -1350 7275 -1425 7275 -1425 7125 + -525 9000 -450 9000 -450 9150 -525 9150 -525 9000 +-6 +6 300 8700 450 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1350 7125 -1275 7125 -1275 7275 -1350 7275 -1350 7125 + 300 8700 375 8700 375 8850 300 8850 300 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1275 7125 -1200 7125 -1200 7275 -1275 7275 -1275 7125 + 375 8850 450 8850 450 9000 375 9000 375 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1500 7125 -1425 7125 -1425 7275 -1500 7275 -1500 7125 + 300 8850 375 8850 375 9000 300 9000 300 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 7275 -1350 7275 -1350 7425 -1425 7425 -1425 7275 + 375 8700 450 8700 450 8850 375 8850 375 8700 +-6 +6 300 9000 450 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1425 7425 -1350 7425 -1350 7575 -1425 7575 -1425 7425 + 300 9000 375 9000 375 9150 300 9150 300 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1350 7275 -1275 7275 -1275 7425 -1350 7425 -1350 7275 + 375 9150 450 9150 450 9300 375 9300 375 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1350 7425 -1275 7425 -1275 7575 -1350 7575 -1350 7425 + 300 9150 375 9150 375 9300 300 9300 300 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1275 7425 -1200 7425 -1200 7575 -1275 7575 -1275 7425 + 375 9000 450 9000 450 9150 375 9150 375 9000 +-6 +6 150 8700 300 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1275 7275 -1200 7275 -1200 7425 -1275 7425 -1275 7275 + 150 8700 225 8700 225 8850 150 8850 150 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 6975 -1650 6975 -1650 7125 -1725 7125 -1725 6975 + 225 8850 300 8850 300 9000 225 9000 225 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 6975 -1575 6975 -1575 7125 -1650 7125 -1650 6975 + 150 8850 225 8850 225 9000 150 9000 150 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 6975 -1500 6975 -1500 7125 -1575 7125 -1575 6975 + 225 8700 300 8700 300 8850 225 8850 225 8700 +-6 +6 150 9000 300 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1800 7275 -1725 7275 -1725 7425 -1800 7425 -1800 7275 + 150 9000 225 9000 225 9150 150 9150 150 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1800 7425 -1725 7425 -1725 7575 -1800 7575 -1800 7425 + 225 9150 300 9150 300 9300 225 9300 225 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 7125 -1650 7125 -1650 7275 -1725 7275 -1725 7125 + 150 9150 225 9150 225 9300 150 9300 150 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 7125 -1575 7125 -1575 7275 -1650 7275 -1650 7125 + 225 9000 300 9000 300 9150 225 9150 225 9000 +-6 +6 0 8700 150 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 7125 -1500 7125 -1500 7275 -1575 7275 -1575 7125 + 0 8700 75 8700 75 8850 0 8850 0 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1800 7125 -1725 7125 -1725 7275 -1800 7275 -1800 7125 + 75 8850 150 8850 150 9000 75 9000 75 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 7275 -1650 7275 -1650 7425 -1725 7425 -1725 7275 + 0 8850 75 8850 75 9000 0 9000 0 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 7425 -1650 7425 -1650 7575 -1725 7575 -1725 7425 + 75 8700 150 8700 150 8850 75 8850 75 8700 +-6 +6 0 9000 150 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 7275 -1575 7275 -1575 7425 -1650 7425 -1650 7275 + 0 9000 75 9000 75 9150 0 9150 0 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1650 7425 -1575 7425 -1575 7575 -1650 7575 -1650 7425 + 75 9150 150 9150 150 9300 75 9300 75 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 7425 -1500 7425 -1500 7575 -1575 7575 -1575 7425 + 0 9150 75 9150 75 9300 0 9300 0 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1575 7275 -1500 7275 -1500 7425 -1575 7425 -1575 7275 + 75 9000 150 9000 150 9150 75 9150 75 9000 +-6 +6 -2025 8700 -1875 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -675 7125 -600 7125 -600 7275 -675 7275 -675 7125 + -2025 8700 -1950 8700 -1950 8850 -2025 8850 -2025 8700 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -600 7125 -525 7125 -525 7275 -600 7275 -600 7125 + -1950 8850 -1875 8850 -1875 9000 -1950 9000 -1950 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -525 7125 -450 7125 -450 7275 -525 7275 -525 7125 + -2025 8850 -1950 8850 -1950 9000 -2025 9000 -2025 8850 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 6825 -1650 6825 -1650 6975 -1725 6975 -1725 6825 + -1950 8700 -1875 8700 -1875 8850 -1950 8850 -1950 8700 +-6 +6 -2025 9000 -1875 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 6675 -1650 6675 -1650 6825 -1725 6825 -1725 6675 + -2025 9000 -1950 9000 -1950 9150 -2025 9150 -2025 9000 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1725 6525 -1650 6525 -1650 6675 -1725 6675 -1725 6525 + -1950 9150 -1875 9150 -1875 9300 -1950 9300 -1950 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1875 7125 -1800 7125 -1800 7275 -1875 7275 -1875 7125 + -2025 9150 -1950 9150 -1950 9300 -2025 9300 -2025 9150 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1875 7275 -1800 7275 -1800 7425 -1875 7425 -1875 7275 + -1950 9000 -1875 9000 -1875 9150 -1950 9150 -1950 9000 +-6 +6 -1875 9000 -1725 9300 2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 - -1875 7425 -1800 7425 -1800 7575 -1875 7575 -1875 7425 -2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 - -2100 7575 600 7575 600 7725 -2100 7725 -2100 7575 -2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 - 1200 7575 3900 7575 3900 7725 1200 7725 1200 7575 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - 1200 7125 3900 7125 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - 1200 6825 3900 6825 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - 1200 7425 3900 7425 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - 1200 6525 3900 6525 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - -2100 7425 600 7425 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - -2100 7125 600 7125 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - -2100 6825 600 6825 -2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 - -2100 6525 600 6525 + -1875 9000 -1800 9000 -1800 9150 -1875 9150 -1875 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 9150 -1725 9150 -1725 9300 -1800 9300 -1800 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 9150 -1800 9150 -1800 9300 -1875 9300 -1875 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 9000 -1725 9000 -1725 9150 -1800 9150 -1800 9000 +-6 +6 -1875 8700 -1725 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 8700 -1800 8700 -1800 8850 -1875 8850 -1875 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 8850 -1725 8850 -1725 9000 -1800 9000 -1800 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1875 8850 -1800 8850 -1800 9000 -1875 9000 -1875 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + -1800 8700 -1725 8700 -1725 8850 -1800 8850 -1800 8700 +-6 +6 3225 8700 3675 9300 +6 3225 8700 3375 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3225 8700 3300 8700 3300 8850 3225 8850 3225 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3300 8850 3375 8850 3375 9000 3300 9000 3300 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3225 8850 3300 8850 3300 9000 3225 9000 3225 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3300 8700 3375 8700 3375 8850 3300 8850 3300 8700 +-6 +6 3225 9000 3375 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3225 9000 3300 9000 3300 9150 3225 9150 3225 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3300 9150 3375 9150 3375 9300 3300 9300 3300 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3225 9150 3300 9150 3300 9300 3225 9300 3225 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3300 9000 3375 9000 3375 9150 3300 9150 3300 9000 +-6 +6 3375 8700 3525 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3375 8700 3450 8700 3450 8850 3375 8850 3375 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3450 8850 3525 8850 3525 9000 3450 9000 3450 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3375 8850 3450 8850 3450 9000 3375 9000 3375 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3450 8700 3525 8700 3525 8850 3450 8850 3450 8700 +-6 +6 3375 9000 3525 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3375 9000 3450 9000 3450 9150 3375 9150 3375 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3450 9150 3525 9150 3525 9300 3450 9300 3450 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3375 9150 3450 9150 3450 9300 3375 9300 3375 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3450 9000 3525 9000 3525 9150 3450 9150 3450 9000 +-6 +6 3525 8700 3675 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3525 8700 3600 8700 3600 8850 3525 8850 3525 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 8850 3675 8850 3675 9000 3600 9000 3600 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3525 8850 3600 8850 3600 9000 3525 9000 3525 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 8700 3675 8700 3675 8850 3600 8850 3600 8700 +-6 +6 3525 9000 3675 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3525 9000 3600 9000 3600 9150 3525 9150 3525 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 9150 3675 9150 3675 9300 3600 9300 3600 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3525 9150 3600 9150 3600 9300 3525 9300 3525 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 3600 9000 3675 9000 3675 9150 3600 9150 3600 9000 +-6 +-6 +6 2325 8700 2775 9300 +6 2325 8700 2475 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2325 8700 2400 8700 2400 8850 2325 8850 2325 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2400 8850 2475 8850 2475 9000 2400 9000 2400 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2325 8850 2400 8850 2400 9000 2325 9000 2325 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2400 8700 2475 8700 2475 8850 2400 8850 2400 8700 +-6 +6 2325 9000 2475 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2325 9000 2400 9000 2400 9150 2325 9150 2325 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2400 9150 2475 9150 2475 9300 2400 9300 2400 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2325 9150 2400 9150 2400 9300 2325 9300 2325 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2400 9000 2475 9000 2475 9150 2400 9150 2400 9000 +-6 +6 2475 8700 2625 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2475 8700 2550 8700 2550 8850 2475 8850 2475 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2550 8850 2625 8850 2625 9000 2550 9000 2550 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2475 8850 2550 8850 2550 9000 2475 9000 2475 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2550 8700 2625 8700 2625 8850 2550 8850 2550 8700 +-6 +6 2475 9000 2625 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2475 9000 2550 9000 2550 9150 2475 9150 2475 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2550 9150 2625 9150 2625 9300 2550 9300 2550 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2475 9150 2550 9150 2550 9300 2475 9300 2475 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2550 9000 2625 9000 2625 9150 2550 9150 2550 9000 +-6 +6 2625 8700 2775 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2625 8700 2700 8700 2700 8850 2625 8850 2625 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2700 8850 2775 8850 2775 9000 2700 9000 2700 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2625 8850 2700 8850 2700 9000 2625 9000 2625 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2700 8700 2775 8700 2775 8850 2700 8850 2700 8700 +-6 +6 2625 9000 2775 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2625 9000 2700 9000 2700 9150 2625 9150 2625 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2700 9150 2775 9150 2775 9300 2700 9300 2700 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2625 9150 2700 9150 2700 9300 2625 9300 2625 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 2700 9000 2775 9000 2775 9150 2700 9150 2700 9000 +-6 +-6 +6 1425 8700 1875 9300 +6 1425 8700 1575 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1425 8700 1500 8700 1500 8850 1425 8850 1425 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1500 8850 1575 8850 1575 9000 1500 9000 1500 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1425 8850 1500 8850 1500 9000 1425 9000 1425 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1500 8700 1575 8700 1575 8850 1500 8850 1500 8700 +-6 +6 1425 9000 1575 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1425 9000 1500 9000 1500 9150 1425 9150 1425 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1500 9150 1575 9150 1575 9300 1500 9300 1500 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1425 9150 1500 9150 1500 9300 1425 9300 1425 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1500 9000 1575 9000 1575 9150 1500 9150 1500 9000 +-6 +6 1575 8700 1725 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1575 8700 1650 8700 1650 8850 1575 8850 1575 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1650 8850 1725 8850 1725 9000 1650 9000 1650 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1575 8850 1650 8850 1650 9000 1575 9000 1575 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1650 8700 1725 8700 1725 8850 1650 8850 1650 8700 +-6 +6 1575 9000 1725 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1575 9000 1650 9000 1650 9150 1575 9150 1575 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1650 9150 1725 9150 1725 9300 1650 9300 1650 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1575 9150 1650 9150 1650 9300 1575 9300 1575 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1650 9000 1725 9000 1725 9150 1650 9150 1650 9000 +-6 +6 1725 8700 1875 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1725 8700 1800 8700 1800 8850 1725 8850 1725 8700 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1800 8850 1875 8850 1875 9000 1800 9000 1800 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1725 8850 1800 8850 1800 9000 1725 9000 1725 8850 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1800 8700 1875 8700 1875 8850 1800 8850 1800 8700 +-6 +6 1725 9000 1875 9300 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1725 9000 1800 9000 1800 9150 1725 9150 1725 9000 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1800 9150 1875 9150 1875 9300 1800 9300 1800 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1725 9150 1800 9150 1800 9300 1725 9300 1725 9150 +2 2 0 1 15 17 50 -1 20 0.000 0 0 -1 0 0 5 + 1800 9000 1875 9000 1875 9150 1800 9150 1800 9000 +-6 +-6 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 1575 5175 1725 5025 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 1500 4875 1575 4725 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 1500 4875 1425 4800 +2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 + 1575 5400 1575 5175 1500 4875 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 3525 5175 3600 5100 +2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 + 3525 5400 3525 5175 3450 5025 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 2625 5175 2775 5025 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 2550 4875 2625 4500 +2 1 0 1 25 7 50 -1 -1 0.000 0 0 -1 0 0 2 + 2550 4875 2400 4800 +2 1 0 2 25 7 50 -1 -1 0.000 0 0 -1 0 0 3 + 2625 5400 2625 5175 2550 4875 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 1350 4950 1800 4950 1800 5250 1350 5250 1350 4950 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 2325 4950 2925 4950 2925 5250 2325 5250 2325 4950 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 1350 4650 1725 4650 1725 4950 1350 4950 1350 4650 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 2475 4350 2775 4350 2775 4650 2475 4650 2475 4350 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 2325 4650 2850 4650 2850 4950 2325 4950 2325 4650 +2 2 0 1 12 14 51 -1 20 0.000 0 0 -1 0 0 5 + 3375 4950 3675 4950 3675 5250 3375 5250 3375 4950 +2 2 0 1 -1 24 50 -1 10 0.000 0 0 -1 0 0 5 + 1200 5400 3900 5400 3900 5550 1200 5550 1200 5400 +2 2 0 1 -1 24 50 -1 10 0.000 0 0 -1 0 0 5 + -2100 5400 600 5400 600 5550 -2100 5550 -2100 5400 2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 1200 5250 3900 5250 2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 @@ -441,7 +813,15 @@ Single 1200 4650 3900 4650 2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 1200 4350 3900 4350 -4 0 0 50 -1 18 11 0.0000 4 165 720 -2100 5775 (0) Flat\001 -4 0 0 50 -1 18 11 0.0000 4 165 900 1200 5775 (1) Forest\001 -4 0 0 50 -1 18 11 0.0000 4 180 1710 1200 7950 (3) Vegetated urban\001 -4 0 0 50 -1 18 11 0.0000 4 165 810 -2100 7950 (2) Urban\001 +2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 + -2100 9300 600 9300 600 9450 -2100 9450 -2100 9300 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + -2100 8700 600 8700 +2 2 0 1 -1 24 44 -1 10 0.000 0 0 -1 0 0 5 + 1200 9300 3900 9300 3900 9450 1200 9450 1200 9300 +2 1 1 1 0 7 56 -1 -1 3.000 0 0 -1 0 0 2 + 1200 8700 3900 8700 +4 0 0 50 -1 18 11 0.0000 4 165 585 -2100 5775 (0) Flat\001 +4 0 0 50 -1 18 11 0.0000 4 165 825 1200 5775 (1) Forest\001 +4 0 0 50 -1 18 11 0.0000 4 165 1395 -2100 9675 (4) Simple urban\001 +4 0 0 50 -1 18 11 0.0000 4 165 1395 1200 9675 (5) Infinite street\001 diff --git a/doc/surface_type_schematic.pdf b/doc/surface_type_schematic.pdf index 77a87ca..d817fdf 100644 Binary files a/doc/surface_type_schematic.pdf and b/doc/surface_type_schematic.pdf differ diff --git a/driver/spartacus_surface_config.F90 b/driver/spartacus_surface_config.F90 index ffd4b5d..7b05ca6 100644 --- a/driver/spartacus_surface_config.F90 +++ b/driver/spartacus_surface_config.F90 @@ -41,22 +41,25 @@ module spartacus_surface_config logical :: do_conservation_check = .false. ! Override values - real(kind=jprb) :: cos_sza_override = -1.0 - real(kind=jprb) :: ground_sw_albedo = -1.0 - real(kind=jprb) :: roof_sw_albedo = -1.0 - real(kind=jprb) :: wall_sw_albedo = -1.0 - real(kind=jprb) :: ground_lw_emissivity = -1.0 - real(kind=jprb) :: roof_lw_emissivity = -1.0 - real(kind=jprb) :: wall_lw_emissivity = -1.0 - real(kind=jprb) :: vegetation_fraction = -1.0 - real(kind=jprb) :: vegetation_extinction = -1.0 - real(kind=jprb) :: vegetation_fsd = -1.0 - real(kind=jprb) :: vegetation_sw_ssa = -1.0 - real(kind=jprb) :: vegetation_lw_ssa = -1.0 - real(kind=jprb) :: top_flux_dn_sw = -1.0 - real(kind=jprb) :: top_flux_dn_direct_sw = -1.0 - real(kind=jprb) :: top_flux_dn_lw = -1.0 - + real(kind=jprb) :: cos_sza_override = -1.0_jprb + real(kind=jprb) :: ground_sw_albedo = -1.0_jprb + real(kind=jprb) :: roof_sw_albedo = -1.0_jprb + real(kind=jprb) :: wall_sw_albedo = -1.0_jprb + real(kind=jprb) :: ground_lw_emissivity = -1.0_jprb + real(kind=jprb) :: roof_lw_emissivity = -1.0_jprb + real(kind=jprb) :: wall_lw_emissivity = -1.0_jprb + real(kind=jprb) :: vegetation_fraction = -1.0_jprb + real(kind=jprb) :: vegetation_extinction = -1.0_jprb + real(kind=jprb) :: vegetation_extinction_scaling = -1.0_jprb + real(kind=jprb) :: vegetation_fsd = -1.0_jprb + real(kind=jprb) :: vegetation_sw_ssa = -1.0_jprb + real(kind=jprb) :: vegetation_lw_ssa = -1.0_jprb + real(kind=jprb) :: top_flux_dn_sw = -1.0_jprb + real(kind=jprb) :: top_flux_dn_direct_sw = -1.0_jprb + real(kind=jprb) :: top_flux_dn_lw = -1.0_jprb + + integer(kind=jpim) :: isurfacetype = -1 + contains procedure :: read => read_config_from_namelist @@ -72,7 +75,8 @@ module spartacus_surface_config ! argument is missing then on error the program will be aborted. subroutine read_config_from_namelist(this, file_name, is_success) - use radiation_io, only : nulerr, radiation_abort + use radiation_io, only : nulerr, radiation_abort + use radiation_constants, only : Pi class(driver_config_type), intent(inout), target :: this character(*), intent(in) :: file_name @@ -86,16 +90,20 @@ subroutine read_config_from_namelist(this, file_name, is_success) real(kind=jprb), pointer :: ground_sw_albedo, roof_sw_albedo, wall_sw_albedo real(kind=jprb), pointer :: ground_lw_emissivity, roof_lw_emissivity, wall_lw_emissivity real(kind=jprb), pointer :: vegetation_extinction, vegetation_sw_ssa + real(kind=jprb), pointer :: vegetation_extinction_scaling real(kind=jprb), pointer :: top_flux_dn_sw, top_flux_dn_direct_sw real(kind=jprb), pointer :: top_flux_dn_lw + integer(kind=jpim), pointer :: isurfacetype + + real(kind=jprb) :: solar_zenith_angle namelist /radsurf_driver/ do_parallel, nblocksize, nrepeat, istartcol, iendcol, & - & iverbose, cos_solar_zenith_angle, vegetation_fsd, & + & iverbose, cos_solar_zenith_angle, solar_zenith_angle, vegetation_fsd, & & ground_sw_albedo, roof_sw_albedo, wall_sw_albedo, & & ground_lw_emissivity, roof_lw_emissivity, wall_lw_emissivity, & & vegetation_extinction, vegetation_sw_ssa, vegetation_fraction, & & top_flux_dn_sw, top_flux_dn_direct_sw, top_flux_dn_lw, & - & do_conservation_check + & do_conservation_check, isurfacetype, vegetation_extinction_scaling do_parallel => this%do_parallel do_conservation_check => this%do_conservation_check @@ -114,10 +122,15 @@ subroutine read_config_from_namelist(this, file_name, is_success) vegetation_fraction => this%vegetation_fraction vegetation_fsd => this%vegetation_fsd vegetation_extinction =>this%vegetation_extinction + vegetation_extinction_scaling=>this%vegetation_extinction_scaling vegetation_sw_ssa => this%vegetation_sw_ssa top_flux_dn_sw => this%top_flux_dn_sw top_flux_dn_direct_sw => this%top_flux_dn_direct_sw top_flux_dn_lw => this%top_flux_dn_lw + isurfacetype => this%isurfacetype + + ! Alternative way to specify solar zenith angle, in degrees + solar_zenith_angle = -100.0_jprb ! Open the namelist file and read the radiation_driver namelist open(unit=10, iostat=iosopen, file=trim(file_name)) @@ -138,6 +151,15 @@ subroutine read_config_from_namelist(this, file_name, is_success) ! variables are present in the NetCDF data file instead read(unit=10, nml=radsurf_driver) close(unit=10) + + if (cos_solar_zenith_angle == -1.0_jprb) then + ! User has not specified cos_solar_zenith_angle; try + ! solar_zenith_angle + if (solar_zenith_angle >= 0.0_jprb .and. solar_zenith_angle <= 180.0_jprb) then + cos_solar_zenith_angle = cos(solar_zenith_angle * Pi/180.0_jprb) + end if + end if + end if end subroutine read_config_from_namelist diff --git a/driver/spartacus_surface_driver.F90 b/driver/spartacus_surface_driver.F90 index 26443c5..d661731 100644 --- a/driver/spartacus_surface_driver.F90 +++ b/driver/spartacus_surface_driver.F90 @@ -23,7 +23,7 @@ program spartacus_surface_driver ! Section 1: Declarations ! -------------------------------------------------------- - use parkind1, only : jprb ! Working precision + use parkind1, only : jprb, jprd ! Working precision use radiation_io, only : nulout use radsurf_config, only : config_type @@ -74,7 +74,13 @@ program spartacus_surface_driver ! For parallel processing of multiple blocks integer :: jblock, nblock ! Block loop index and number + +#ifndef NO_OPENMP integer, external :: omp_get_thread_num + double precision, external :: omp_get_wtime + ! Start/stop time in seconds + real(kind=jprd) :: tstart, tstop +#endif ! Loop index for repeats (for benchmarking) integer :: jrepeat @@ -185,6 +191,9 @@ program spartacus_surface_driver ! Option of repeating calculation multiple time for more accurate ! profiling +#ifndef NO_OPENMP + tstart = omp_get_wtime() +#endif do jrepeat = 1,driver_config%nrepeat if (driver_config%do_parallel) then @@ -252,6 +261,12 @@ program spartacus_surface_driver end if end do +#ifndef NO_OPENMP + tstop = omp_get_wtime() + if (driver_config%iverbose >= 2) then + write(nulout, '(a,g11.5,a)') 'Time elapsed in radiative transfer: ', tstop-tstart, ' seconds' + endif +#endif ! -------------------------------------------------------- ! Section 5: Check and save output diff --git a/driver/spartacus_surface_read_input.F90 b/driver/spartacus_surface_read_input.F90 index 2a9cd3c..25c06ba 100644 --- a/driver/spartacus_surface_read_input.F90 +++ b/driver/spartacus_surface_read_input.F90 @@ -26,7 +26,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & use easy_netcdf, only : netcdf_file use radsurf_config, only : config_type use spartacus_surface_config, only : driver_config_type - use radsurf_canopy_properties, only : canopy_properties_type + use radsurf_canopy_properties, only : canopy_properties_type, TileRepresentationName use radsurf_sw_spectral_properties, only : sw_spectral_properties_type use radsurf_lw_spectral_properties, only : lw_spectral_properties_type use radiation_constants, only : StefanBoltzmann @@ -91,7 +91,17 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & ilay = ilay + canopy_props%nlay(jcol) end do - call file%get('surface_type', canopy_props%i_representation) + if (driver_config%isurfacetype >= 0) then + allocate(canopy_props%i_representation(ncol)) + if (driver_config%iverbose >= 2) then + write(nulout,'(a,i0,a,a,a)') ' Overriding all surface types with ', & + & driver_config%isurfacetype, ' (', & + & trim(TileRepresentationName(driver_config%isurfacetype)), ')' + end if + canopy_props%i_representation = driver_config%isurfacetype + else + call file%get('surface_type', canopy_props%i_representation) + end if ! Read canopy geometry if (config%do_urban) then @@ -99,17 +109,14 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & & canopy_props%building_fraction) call read_packed_1d(file, 'building_scale', canopy_props%nlay, & & canopy_props%building_scale) - if (file%exists('veg_contact_fraction')) then - call read_packed_1d(file, 'veg_contact_fraction', canopy_props%nlay, & - & canopy_props%veg_contact_fraction) - else - allocate(canopy_props%veg_contact_fraction(ntotlay)) - canopy_props%veg_contact_fraction = 0.0_jprb - end if end if if (config%do_vegetation) then if (driver_config%vegetation_fraction >= 0.0_jprb) then allocate(canopy_props%veg_fraction(ntotlay)) + if (driver_config%iverbose >= 2) then + write(nulout,'(a,g10.3)') ' Overriding vegetation fraction with ', & + & driver_config%vegetation_fraction + end if canopy_props%veg_fraction = driver_config%vegetation_fraction else call read_packed_1d(file, 'veg_fraction', canopy_props%nlay, & @@ -117,22 +124,48 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & end if call read_packed_1d(file, 'veg_extinction', canopy_props%nlay, & & canopy_props%veg_ext) - if (driver_config%vegetation_extinction >= 0.0) then + if (driver_config%vegetation_extinction >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding vegetation extinction with ', & & driver_config%vegetation_extinction end if canopy_props%veg_ext = driver_config%vegetation_extinction + else if (driver_config%vegetation_extinction_scaling >= 0.0_jprb) then + canopy_props%veg_ext = canopy_props%veg_ext * driver_config%vegetation_extinction_scaling + if (driver_config%iverbose >= 2) then + write(nulout,'(a,g10.3)') ' Scaling vegetation extinction with ', & + & driver_config%vegetation_extinction_scaling + end if end if call read_packed_1d(file, 'veg_scale', canopy_props%nlay, & & canopy_props%veg_scale) if (driver_config%vegetation_fsd >= 0.0_jprb) then allocate(canopy_props%veg_fsd(ntotlay)) + if (driver_config%iverbose >= 2) then + write(nulout,'(a,g10.3)') ' Overriding vegetation fractional standard deviation with ', & + & driver_config%vegetation_fsd + end if canopy_props%veg_fsd = driver_config%vegetation_fsd else call read_packed_1d(file, 'veg_fsd', canopy_props%nlay, & & canopy_props%veg_fsd) end if + + if (config%do_urban) then + if (file%exists('veg_contact_fraction')) then + call read_packed_1d(file, 'veg_contact_fraction', canopy_props%nlay, & + & canopy_props%veg_contact_fraction) + else + allocate(canopy_props%veg_contact_fraction(ntotlay)) + ! By default the vegetation is assumed to be randomly + ! placed, which means that the probability of a wall being + ! in contact with vegetation is equal to the fraction of the + ! non-building area that contains vegetation + canopy_props%veg_contact_fraction = min(1.0_jprb, canopy_props%veg_fraction & + & / max(config%min_vegetation_fraction, 1.0_jprb-canopy_props%building_fraction)) + end if + end if + end if if (config%do_lw) then @@ -147,7 +180,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & end if call read_2d(file, 'ground_lw_emissivity', lw_spectral_props%ground_emissivity) - if (driver_config%ground_lw_emissivity >= 0.0) then + if (driver_config%ground_lw_emissivity >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding ground longwave emissivity with ', & & driver_config%ground_lw_emissivity @@ -159,7 +192,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & ! Read urban properties needed for longwave calculations call read_packed_2d(file, 'roof_lw_emissivity', canopy_props%nlay, lw_spectral_props%roof_emissivity) - if (driver_config%roof_lw_emissivity >= 0.0) then + if (driver_config%roof_lw_emissivity >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding roof longwave emissivity with ', & & driver_config%roof_lw_emissivity @@ -169,7 +202,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & call read_packed_2d(file, 'wall_lw_emissivity', canopy_props%nlay, & & lw_spectral_props%wall_emissivity) - if (driver_config%wall_lw_emissivity >= 0.0) then + if (driver_config%wall_lw_emissivity >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding wall longwave emissivity with ', & & driver_config%wall_lw_emissivity @@ -182,7 +215,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & ! Read vegetation properties needed for longwave calculations call read_packed_2d(file, 'veg_lw_ssa', canopy_props%nlay, & & lw_spectral_props%veg_ssa) - if (driver_config%vegetation_lw_ssa >= 0.0) then + if (driver_config%vegetation_lw_ssa >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding vegetation longwave single-scattering albedo with ', & & driver_config%vegetation_lw_ssa @@ -251,7 +284,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & if (config%do_sw) then ! Read ground properties needed for shortwave calculations call read_2d(file, 'ground_sw_albedo', sw_spectral_props%ground_albedo) - if (driver_config%ground_sw_albedo >= 0.0) then + if (driver_config%ground_sw_albedo >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding ground shortwave albedo with ', & & driver_config%ground_sw_albedo @@ -267,7 +300,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & ! Read urban properties needed for shortwave calculations call read_packed_2d(file, 'roof_sw_albedo', canopy_props%nlay, & & sw_spectral_props%roof_albedo) - if (driver_config%roof_sw_albedo >= 0.0) then + if (driver_config%roof_sw_albedo >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding roof shortwave albedo with ', & & driver_config%roof_sw_albedo @@ -283,7 +316,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & write(nulout,'(a)') ' Assuming roof albedo to direct albedo is the same as to diffuse' end if allocate(sw_spectral_props%roof_albedo_dir(ubound(sw_spectral_props%roof_albedo,1),ntotlay)) - if (driver_config%roof_sw_albedo >= 0.0) then + if (driver_config%roof_sw_albedo >= 0.0_jprb) then sw_spectral_props%roof_albedo_dir = driver_config%roof_sw_albedo else sw_spectral_props%roof_albedo_dir = sw_spectral_props%roof_albedo @@ -291,7 +324,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & end if call read_packed_2d(file, 'wall_sw_albedo', canopy_props%nlay, sw_spectral_props%wall_albedo) - if (driver_config%wall_sw_albedo >= 0.0) then + if (driver_config%wall_sw_albedo >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding wall shortwave albedo with ', & & driver_config%wall_sw_albedo @@ -316,7 +349,7 @@ subroutine read_input(file, config, driver_config, ncol, ntotlay, & ! Read vegetation properties needed for shortwave calculations call read_packed_2d(file, 'veg_sw_ssa', canopy_props%nlay, & & sw_spectral_props%veg_ssa) - if (driver_config%vegetation_sw_ssa >= 0.0) then + if (driver_config%vegetation_sw_ssa >= 0.0_jprb) then if (driver_config%iverbose >= 2) then write(nulout,'(a,g10.3)') ' Overriding vegetation shortwave single-scattering albedo with ', & & driver_config%vegetation_sw_ssa diff --git a/radsurf/Makefile b/radsurf/Makefile index 721498b..849b112 100644 --- a/radsurf/Makefile +++ b/radsurf/Makefile @@ -12,7 +12,11 @@ SOURCES = \ radsurf_save.F90 \ radsurf_simple_spectrum.F90 \ radsurf_sw_spectral_properties.F90 \ - radsurf_lw_spectral_properties.F90 + radsurf_lw_spectral_properties.F90 \ + radsurf_norm_perim.F90 \ + radsurf_view_factor.F90 \ + radsurf_simple_urban_sw.F90 \ + radsurf_simple_urban_lw.F90 OBJECTS := $(SOURCES:.F90=.o) LIBSURF = ../lib/libradsurf.a @@ -28,28 +32,35 @@ $(LIBSURF): $(OBJECTS) clean: rm -f *.o $(LIBSURF) -radsurf_canopy_properties.o: radsurf_config.o +radsurf_canopy_properties.o radsurf_norm_perim.o: radsurf_config.o radsurf_lw_spectral_properties.o: radsurf_canopy_properties.o radsurf_config.o radsurf_sw_spectral_properties.o: radsurf_canopy_properties.o radsurf_config.o radsurf_interface.o: radsurf_canopy_properties.o \ radsurf_sw_spectral_properties.o radsurf_lw_spectral_properties.o \ - radsurf_boundary_conds_out.o \ + radsurf_boundary_conds_out.o radsurf_simple_urban_sw.o \ radsurf_canopy_flux.o radsurf_config.o radsurf_forest_sw.o \ - radsurf_forest_lw.o radsurf_urban_sw.o radsurf_urban_lw.o + radsurf_forest_lw.o radsurf_urban_sw.o radsurf_urban_lw.o \ + radsurf_simple_urban_lw.o radsurf_forest_sw.o: radsurf_config.o radsurf_canopy_properties.o \ radsurf_sw_spectral_properties.o radsurf_boundary_conds_out.o \ - radsurf_canopy_flux.o radsurf_overlap.o + radsurf_canopy_flux.o radsurf_overlap.o radsurf_norm_perim.o radsurf_forest_lw.o: radsurf_config.o radsurf_canopy_properties.o \ - radsurf_boundary_conds_out.o \ + radsurf_boundary_conds_out.o radsurf_norm_perim.o \ radsurf_canopy_flux.o radsurf_overlap.o radsurf_lw_spectral_properties.o radsurf_urban_sw.o: radsurf_config.o radsurf_canopy_properties.o \ - radsurf_boundary_conds_out.o \ + radsurf_boundary_conds_out.o radsurf_norm_perim.o \ radsurf_canopy_flux.o radsurf_overlap.o radsurf_sw_spectral_properties.o radsurf_urban_lw.o: radsurf_config.o radsurf_canopy_properties.o \ - radsurf_boundary_conds_out.o \ + radsurf_boundary_conds_out.o radsurf_norm_perim.o \ radsurf_canopy_flux.o radsurf_overlap.o radsurf_lw_spectral_properties.o radsurf_save.o: radsurf_config.o radsurf_canopy_properties.o \ radsurf_canopy_flux.o radsurf_simple_spectrum.o: radsurf_config.o radsurf_canopy_properties.o \ radsurf_lw_spectral_properties.o radsurf_canopy_flux.o: radsurf_canopy_properties.o +radsurf_simple_urban_sw.o: radsurf_config.o radsurf_canopy_properties.o \ + radsurf_sw_spectral_properties.o radsurf_canopy_flux.o \ + radsurf_norm_perim.o radsurf_view_factor.o +radsurf_simple_urban_lw.o: radsurf_config.o radsurf_canopy_properties.o \ + radsurf_lw_spectral_properties.o radsurf_canopy_flux.o \ + radsurf_norm_perim.o radsurf_view_factor.o diff --git a/radsurf/radsurf_canopy_flux.F90 b/radsurf/radsurf_canopy_flux.F90 index 9bc8fd2..c9732f7 100644 --- a/radsurf/radsurf_canopy_flux.F90 +++ b/radsurf/radsurf_canopy_flux.F90 @@ -467,6 +467,7 @@ subroutine check_canopy_flux(this, canopy_props, istartcol, iendcol, iverbose) use radiation_io, only : nulout use radsurf_canopy_properties, only : ITileFlat, ITileForest, & & ITileUrban, ITileVegetatedUrban, & + & ITileSimpleUrban, ITileInfiniteStreet, & & canopy_properties_type class(canopy_flux_type), intent(inout) :: this @@ -513,7 +514,9 @@ subroutine check_canopy_flux(this, canopy_props, istartcol, iendcol, iverbose) clear_air_net = 0.0_jprb end if if (canopy_props%i_representation(jcol) == ITileUrban & - & .or. canopy_props%i_representation(jcol) == ITileVegetatedUrban) then + & .or. canopy_props%i_representation(jcol) == ITileVegetatedUrban & + & .or. canopy_props%i_representation(jcol) == ITileSimpleUrban & + & .or. canopy_props%i_representation(jcol) == ITileInfiniteStreet ) then roof_net = sum(this%roof_net(:,ilay1:ilay2)) wall_net = sum(this%wall_net(:,ilay1:ilay2)) else diff --git a/radsurf/radsurf_canopy_properties.F90 b/radsurf/radsurf_canopy_properties.F90 index 139f624..5bff340 100644 --- a/radsurf/radsurf_canopy_properties.F90 +++ b/radsurf/radsurf_canopy_properties.F90 @@ -20,22 +20,25 @@ module radsurf_canopy_properties implicit none ! Number of tile types - integer(kind=jpim), parameter :: NTileTypes = 4 + integer(kind=jpim), parameter :: NTileTypes = 6 ! Codes for the different type of tile enum, bind(c) enumerator :: ITileFlat = 0, & & ITileForest, & & ITileUrban, & - & ITileVegetatedUrban + & ITileVegetatedUrban, & + & ITileSimpleUrban, & + & ITileInfiniteStreet end enum - character(len=*), parameter :: TileRepresentationName(NTileTypes) & - & = (/ 'Flat ', & - & 'Forest ', & - & 'Urban ', & - & 'VegetatedUrban' /) - + character(len=*), parameter :: TileRepresentationName(0:NTileTypes-1) & + & = [ 'Flat ', & + & 'Forest ', & + & 'Urban ', & + & 'VegetatedUrban', & + & 'SimpleUrban ', & + & 'InfiniteStreet' ] !--------------------------------------------------------------------- ! Derived type storing a physical, non spectral, description of the @@ -88,8 +91,8 @@ module radsurf_canopy_properties ! Fractional standard deviation of vegetation optical depth real(kind=jprb), allocatable :: veg_fsd(:) ! (ntotlay) - ! Fraction of vegetation edge in contact with buildings rather - ! than air + ! Fraction of building edge in contact with vegetation rather than + ! air (note that this was redefined in v0.7.3) real(kind=jprb), allocatable :: veg_contact_fraction(:) ! (ntotlay) ! Representation codes (ITileFlat etc) for each tile: dimensioning @@ -142,7 +145,8 @@ subroutine allocate_canopy(this, config, ncol, ntotlay, & do_vegetation = .false. end if if (.not. any(i_representation == ITileUrban & - & .or. i_representation == ITileVegetatedUrban)) then + & .or. i_representation == ITileVegetatedUrban & + & .or. i_representation == ITileSimpleUrban)) then do_urban = .false. end if end if diff --git a/radsurf/radsurf_config.F90 b/radsurf/radsurf_config.F90 index 5ec5354..866c247 100644 --- a/radsurf/radsurf_config.F90 +++ b/radsurf/radsurf_config.F90 @@ -298,6 +298,10 @@ subroutine print_config(this, iverbose) & 'do_sw', this%do_sw) call print_logical(' Do longwave (LW) calculations', & & 'do_sw', this%do_lw) + call print_logical(' Save broadband fluxes', & + & 'do_save_broadband_flux', this%do_save_broadband_flux) + call print_logical(' Save spectral fluxes', & + & 'do_save_spectral_flux', this%do_save_spectral_flux) if (this%do_sw) then call print_integer(' Number of SW spectral intervals', & & 'nsw', this%nsw) diff --git a/radsurf/radsurf_forest_lw.F90 b/radsurf/radsurf_forest_lw.F90 index d6c82f8..92ecc18 100644 --- a/radsurf/radsurf_forest_lw.F90 +++ b/radsurf/radsurf_forest_lw.F90 @@ -53,6 +53,7 @@ subroutine spartacus_forest_lw(config, & & rect_mat_x_expandedmat, rect_expandedmat_x_vec, solve_vec, & & solve_rect_mat, rect_mat_x_singlemat, rect_singlemat_x_vec use radsurf_overlap, only : calc_overlap_matrices + use radsurf_norm_perim, only : calc_norm_perim_forest !#define PRINT_ARRAYS 1 @@ -124,14 +125,14 @@ subroutine spartacus_forest_lw(config, & ! Normalized vegetation perimeter length (perimeter length divided ! by domain area), m-1. If nreg=2 then there is a clear-sky and a - ! vegetation region, and norm_perim(1) is the normalized length - ! between the two regions, while norm_perim(2) is unused. If - ! nreg=3 then region 1 is clear-sky, region 2 is low optical depth - ! vegetation and region 3 is high optical depth - ! vegetation. norm_perim(1) is the normalized length between - ! regions 1 and 2, norm_perim(2) is that between regions 2 and 3, - ! and norm_perim(3) is that between regions 3 and 1. - real(kind=jprb) :: norm_perim(nreg) + ! vegetation region, and norm_perim(1,jlay) is the normalized + ! length between the two regions, while norm_perim(2,jlay) is + ! unused. If nreg=3 then region 1 is clear-sky, region 2 is low + ! optical depth vegetation and region 3 is high optical depth + ! vegetation. norm_perim(1,jlay) is the normalized length between + ! regions 1 and 2, norm_perim(2,jlay) is that between regions 2 + ! and 3, and norm_perim(3,jlay) is that between regions 3 and 1. + real(kind=jprb) :: norm_perim(nreg,nlay) ! Rate of exchange between regions, excluding the tangent term, ! where the dimensions are in the sense of @@ -249,6 +250,12 @@ subroutine spartacus_forest_lw(config, & call print_array3('v_overlap',v_overlap) #endif + ! Compute normalized lengths + call calc_norm_perim_forest(config,nlay,nreg, & + & canopy_props%veg_fraction(ilay1:ilay2), & + & canopy_props%veg_scale(ilay1:ilay2), & + & norm_perim) + ! -------------------------------------------------------- ! Section 3: First loop over layers ! -------------------------------------------------------- @@ -293,48 +300,6 @@ subroutine spartacus_forest_lw(config, & & / max(ext_reg(:,3)*(1.0_jprb-ssa_reg(:,3)), 1.0e-8_jprb) end if - norm_perim = 0.0_jprb - if (nreg > 1 .and. veg_fraction(jlay) > config%min_vegetation_fraction) then - ! Compute the normalized vegetation perimeter length - if (config%use_symmetric_vegetation_scale_forest) then - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) * (1.0_jprb - veg_fraction(jlay)) & - & / veg_scale(jlay) - else - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) - end if - - if (nreg > 2) then - ! Share the clear-air/vegetation perimeter between the two - ! vegetated regions - norm_perim(nreg) = config%vegetation_isolation_factor_forest * norm_perim(1) - norm_perim(1) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * norm_perim(1) - ! We assume that the horizontal scale of the vegetation - ! inhomogeneities is the same as the scale of the tree - ! crowns themselves. Therefore, to compute the interface - ! between the two vegetated regions, we use the same - ! formula as before but with the fraction associated with - ! one of the two vegetated regions, which is half the - ! total vegetation fraction. - if (config%use_symmetric_vegetation_scale_forest) then - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & - & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay))) & - & / veg_scale(jlay) - else - ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) - ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) - end if - else - ! Only one vegetated region so the other column of norm_perim - ! is unused - norm_perim(2:) = 0.0_jprb - end if - end if - ! Compute the rates of exchange between regions, excluding the ! tangent term f_exchange = 0.0_jprb @@ -344,18 +309,18 @@ subroutine spartacus_forest_lw(config, & f_exchange(jreg+1,jreg) = 0.0_jprb f_exchange(jreg,jreg+1) = 0.0_jprb else - f_exchange(jreg+1,jreg) = norm_perim(jreg) / (Pi * frac(jreg,jlay)) - f_exchange(jreg,jreg+1) = norm_perim(jreg) / (Pi * frac(jreg+1,jlay)) + f_exchange(jreg+1,jreg) = norm_perim(jreg,jlay) / (Pi * frac(jreg,jlay)) + f_exchange(jreg,jreg+1) = norm_perim(jreg,jlay) / (Pi * frac(jreg+1,jlay)) end if end do - if (nreg > 2 .and. norm_perim(nreg) > 0.0_jprb) then + if (nreg > 2 .and. norm_perim(nreg,jlay) > 0.0_jprb) then if (frac(3,jlay) <= config%min_vegetation_fraction & & .or. frac(1,jlay) <= config%min_vegetation_fraction) then f_exchange(1,3) = 0.0_jprb f_exchange(3,1) = 0.0_jprb else - f_exchange(1,3) = norm_perim(jreg) / (Pi * frac(3,jlay)) - f_exchange(3,1) = norm_perim(jreg) / (Pi * frac(1,jlay)) + f_exchange(1,3) = norm_perim(jreg,jlay) / (Pi * frac(3,jlay)) + f_exchange(3,1) = norm_perim(jreg,jlay) / (Pi * frac(1,jlay)) end if end if @@ -435,7 +400,7 @@ subroutine spartacus_forest_lw(config, & call print_vector('ext_reg',ext_reg(1,:)) call print_vector('ssa_reg',ssa_reg(1,:)) call print_matrix('f_exchange',f_exchange) - call print_vector('norm_perim', norm_perim) + call print_vector('norm_perim', norm_perim(:,jlay)) call print_matrix('gamma1',gamma1(1,:,:)) call print_matrix('gamma2',gamma2(1,:,:)) call print_vector('emiss_rate',emiss_rate(1,:)) @@ -608,19 +573,19 @@ subroutine spartacus_forest_lw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 lw_internal%clear_air_abs(:,ilay) = lw_internal%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,nlw,1), 2) & + & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,1,nlw), 2) & & - emiss_reg(:,1,jlay)*dz(jlay) do jreg = 2,nreg ! Absorption by clear-air in the vegetated regions lw_internal%veg_air_abs(:,ilay) = lw_internal%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) & + & * spread(1.0_jprb/lg%mu,1,nlw), 2) & & - emiss_air(:,jreg,jlay)*dz(jlay) lw_internal%veg_abs(:,ilay) = lw_internal%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) * od_scaling(jreg,jlay) & + & * spread(1.0_jprb/lg%mu,1,nlw), 2) * od_scaling(jreg,jlay) & & - emiss_veg(:,jreg,jlay)*dz(jlay) end do @@ -651,7 +616,7 @@ subroutine spartacus_forest_lw(config, & ! each spectral interval, so use the Legendre-Gauss horizontal ! weights flux_dn_above = 0.0_jprb - flux_dn_above(:,1:ns) = spread(lg%hweight,nlw,1) + flux_dn_above(:,1:ns) = spread(lg%hweight,1,nlw) lw_norm%top_dn(:,icol) = 1.0_jprb lw_norm%top_net(:,icol) = top_emissivity @@ -695,17 +660,17 @@ subroutine spartacus_forest_lw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 lw_norm%clear_air_abs(:,ilay) = lw_norm%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,nlw,1), 2) + & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,1,nlw), 2) do jreg = 2,nreg ! Absorption by clear-air in the vegetated regions lw_norm%veg_air_abs(:,ilay) = lw_norm%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) + & * spread(1.0_jprb/lg%mu,1,nlw), 2) lw_norm%veg_abs(:,ilay) = lw_norm%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nlw), 2) * od_scaling(jreg,jlay) end do #ifdef PRINT_ARRAYS diff --git a/radsurf/radsurf_forest_sw.F90 b/radsurf/radsurf_forest_sw.F90 index 2f44880..4ddefcd 100644 --- a/radsurf/radsurf_forest_sw.F90 +++ b/radsurf/radsurf_forest_sw.F90 @@ -55,6 +55,7 @@ subroutine spartacus_forest_sw(config, & & rect_mat_x_expandedmat, rect_expandedmat_x_vec, solve_vec, & & solve_rect_mat, rect_mat_x_singlemat use radsurf_overlap, only : calc_overlap_matrices + use radsurf_norm_perim, only : calc_norm_perim_forest !#define PRINT_ARRAYS 1 @@ -124,14 +125,14 @@ subroutine spartacus_forest_sw(config, & ! Normalized vegetation perimeter length (perimeter length divided ! by domain area), m-1. If nreg=2 then there is a clear-sky and a - ! vegetation region, and norm_perim(1) is the normalized length - ! between the two regions, while norm_perim(2) is unused. If - ! nreg=3 then region 1 is clear-sky, region 2 is low optical depth - ! vegetation and region 3 is high optical depth - ! vegetation. norm_perim(1) is the normalized length between - ! regions 1 and 2, norm_perim(2) is that between regions 2 and 3, - ! and norm_perim(3) is that between regions 3 and 1. - real(kind=jprb) :: norm_perim(nreg) + ! vegetation region, and norm_perim(1,jlay) is the normalized + ! length between the two regions, while norm_perim(2,jlay) is + ! unused. If nreg=3 then region 1 is clear-sky, region 2 is low + ! optical depth vegetation and region 3 is high optical depth + ! vegetation. norm_perim(1,jlay) is the normalized length between + ! regions 1 and 2, norm_perim(2,jlay) is that between regions 2 + ! and 3, and norm_perim(3,jlay) is that between regions 3 and 1. + real(kind=jprb) :: norm_perim(nreg,nlay) ! Tangent of solar zenith angle real(kind=jprb) :: tan0 @@ -255,6 +256,12 @@ subroutine spartacus_forest_sw(config, & call calc_overlap_matrices(nlay,nreg,frac,u_overlap,v_overlap, & & config%min_vegetation_fraction); + ! Compute normalized lengths + call calc_norm_perim_forest(config,nlay,nreg, & + & canopy_props%veg_fraction(ilay1:ilay2), & + & canopy_props%veg_scale(ilay1:ilay2), & + & norm_perim) + ! -------------------------------------------------------- ! Section 3: First loop over layers ! -------------------------------------------------------- @@ -289,51 +296,6 @@ subroutine spartacus_forest_sw(config, & & / max(ext_reg(:,3), 1.0e-8_jprb) end if - ! Compute the normalized vegetation perimeter length - if (veg_fraction(jlay) > config%min_vegetation_fraction) then - if (config%use_symmetric_vegetation_scale_forest) then - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) * (1.0_jprb - veg_fraction(jlay)) & - & / veg_scale(jlay) - else - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) - end if - - if (nreg > 2) then - ! Share the clear-air/vegetation perimeter between the two - ! vegetated regions - norm_perim(nreg) = config%vegetation_isolation_factor_forest * norm_perim(1) - norm_perim(1) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * norm_perim(1) - ! We assume that the horizontal scale of the vegetation - ! inhomogeneities is the same as the scale of the tree - ! crowns themselves. Therefore, to compute the interface - ! between the two vegetated regions, we use the same - ! formula as before but with the fraction associated with - ! one of the two vegetated regions, which is half the - ! total vegetation fraction. - if (config%use_symmetric_vegetation_scale_forest) then - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & - & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay))) & - & / veg_scale(jlay) - else - ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) - ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & - & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) - end if - else - ! Only one vegetated region so the other column of norm_perim - ! is unused - norm_perim(2:) = 0.0_jprb - end if - - else - ! No vegetation so no perimeters - norm_perim = 0.0_jprb - end if - ! Compute the rates of exchange between regions, excluding the ! tangent term f_exchange = 0.0_jprb @@ -343,18 +305,18 @@ subroutine spartacus_forest_sw(config, & f_exchange(jreg+1,jreg) = 0.0_jprb f_exchange(jreg,jreg+1) = 0.0_jprb else - f_exchange(jreg+1,jreg) = norm_perim(jreg) / (Pi * frac(jreg,jlay)) - f_exchange(jreg,jreg+1) = norm_perim(jreg) / (Pi * frac(jreg+1,jlay)) + f_exchange(jreg+1,jreg) = norm_perim(jreg,jlay) / (Pi * frac(jreg,jlay)) + f_exchange(jreg,jreg+1) = norm_perim(jreg,jlay) / (Pi * frac(jreg+1,jlay)) end if end do - if (nreg > 2 .and. norm_perim(nreg) > 0.0_jprb) then + if (nreg > 2 .and. norm_perim(nreg,jlay) > 0.0_jprb) then if (frac(3,jlay) <= config%min_vegetation_fraction & & .or. frac(1,jlay) <= config%min_vegetation_fraction) then f_exchange(1,3) = 0.0_jprb f_exchange(3,1) = 0.0_jprb else - f_exchange(1,3) = norm_perim(jreg) / (Pi * frac(3,jlay)) - f_exchange(3,1) = norm_perim(jreg) / (Pi * frac(1,jlay)) + f_exchange(1,3) = norm_perim(jreg,jlay) / (Pi * frac(3,jlay)) + f_exchange(3,1) = norm_perim(jreg,jlay) / (Pi * frac(1,jlay)) end if end if @@ -431,7 +393,7 @@ subroutine spartacus_forest_sw(config, & call print_vector('veg_fraction',veg_fraction) call print_vector('veg_scale', veg_scale); call print_matrix('frac', frac); - call print_vector('norm_perim', norm_perim) + call print_vector('norm_perim', norm_perim(:,jlay) call print_matrix('f_exchange',f_exchange) call print_vector('tan_ang',lg%tan_ang) call print_matrix('gamma0',gamma0(1,:,:)) @@ -647,14 +609,14 @@ subroutine spartacus_forest_sw(config, & sw_norm_dir%clear_air_abs(:,ilay) = sw_norm_dir%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & & * (int_flux_dir(:,1) & ! / cos_sza & - & + sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,nsw,1), 2)) + & + sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,1,nsw), 2)) do jreg = 2,nreg ! Absorption by clear-air in the vegetated regions sw_norm_dir%veg_air_abs(:,ilay) = sw_norm_dir%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * (int_flux_dir(:,jreg) & ! / cos_sza & & + sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2)) + & * spread(1.0_jprb/lg%mu,1,nsw), 2)) sw_norm_dir%veg_abs_dir(:,ilay) = sw_norm_dir%veg_abs_dir(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * int_flux_dir(:,jreg) * od_scaling(jreg,jlay) @@ -662,7 +624,7 @@ subroutine spartacus_forest_sw(config, & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * (int_flux_dir(:,jreg) & ! / cos_sza & & + sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2)) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nsw), 2)) * od_scaling(jreg,jlay) end do ! Compute sunlit fraction. First the layer transmittance in @@ -721,7 +683,7 @@ subroutine spartacus_forest_sw(config, & ! weights flux_dn_dir_above = 0.0_jprb ! No direct calculation now needed below flux_dn_diff_above = 0.0_jprb - flux_dn_diff_above(:,1:ns) = spread(lg%hweight,nsw,1) + flux_dn_diff_above(:,1:ns) = spread(lg%hweight,1,nsw) sw_norm_diff%top_dn_dir(:,icol) = 0.0_jprb sw_norm_diff%top_dn(:,icol) = 1.0_jprb @@ -763,17 +725,17 @@ subroutine spartacus_forest_sw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 sw_norm_diff%clear_air_abs(:,ilay) = sw_norm_diff%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,nsw,1), 2) + & * sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,1,nsw), 2) do jreg = 2,nreg ! Absorption by clear-air in the vegetated regions sw_norm_diff%veg_air_abs(:,ilay) = sw_norm_diff%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2) + & * spread(1.0_jprb/lg%mu,1,nsw), 2) sw_norm_diff%veg_abs(:,ilay) = sw_norm_diff%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nsw), 2) * od_scaling(jreg,jlay) end do #ifdef PRINT_ARRAYS diff --git a/radsurf/radsurf_interface.F90 b/radsurf/radsurf_interface.F90 index 80df8b5..e723801 100644 --- a/radsurf/radsurf_interface.F90 +++ b/radsurf/radsurf_interface.F90 @@ -26,10 +26,11 @@ subroutine radsurf(config, canopy_props, & use parkind1, only : jpim, jprb use yomhook, only : lhook, dr_hook - use radiation_io, only : nulout + use radiation_io, only : nulout, nulerr, radiation_abort use radsurf_config, only : config_type use radsurf_canopy_properties, only : ITileFlat, ITileForest, & & ITileUrban, ITileVegetatedUrban, & + & ITileSimpleUrban, ITileInfiniteStreet, & & canopy_properties_type use radsurf_sw_spectral_properties, only : sw_spectral_properties_type use radsurf_lw_spectral_properties, only : lw_spectral_properties_type @@ -39,6 +40,8 @@ subroutine radsurf(config, canopy_props, & use radsurf_forest_lw, only : spartacus_forest_lw use radsurf_urban_sw, only : spartacus_urban_sw use radsurf_urban_lw, only : spartacus_urban_lw + use radsurf_simple_urban_sw, only : simple_urban_sw + use radsurf_simple_urban_lw, only : simple_urban_lw implicit none @@ -73,6 +76,8 @@ subroutine radsurf(config, canopy_props, & ! Direct ground shortwave albedo, in case not provided by user real(kind=jprb), pointer :: ground_sw_albedo_dir(:,:) ! (nswinterval,ncol) + logical :: is_infinite_street + real(jprb) :: hook_handle if (lhook) call dr_hook('radiation_interface:radsurf',0,hook_handle) @@ -264,6 +269,45 @@ subroutine radsurf(config, canopy_props, & & lw_internal, lw_norm) end if + case (ITileSimpleUrban : ITileInfiniteStreet) + is_infinite_street = (irep == ITileInfiniteStreet) + if (config%iverbose >= 4) then + if (is_infinite_street) then + write(nulout,'(i5,a)') jcol, ': Simple urban - infinite street model' + else + write(nulout,'(i5,a)') jcol, ': Simple urban - exponential street model' + end if + end if + if (canopy_props%nlay(jcol) > 1) then + write(nulerr, '(a)') '*** Error: simple urban representations must have only one layer' + call radiation_abort('Attempt to use simple urban representation with more than one layer') + end if + + if (config%do_sw) then + if (canopy_props%cos_sza(jcol) > 0.0_jprb) then + call simple_urban_sw(config, is_infinite_street, & + & config%nswinternal, & + & jcol, ilay1, canopy_props%cos_sza(jcol), & + & canopy_props, sw_spectral_props, & + & sw_spectral_props%ground_albedo(:,jcol), & + & ground_sw_albedo_dir(:,jcol), & + & bc_out%sw_albedo(:,jcol), bc_out%sw_albedo_dir(:,jcol), & + & sw_norm_dir, sw_norm_diff) + else + call sw_norm_dir%zero(jcol,ilay1,ilay2) + call sw_norm_diff%zero(jcol,ilay1,ilay2) + end if + end if + + if (config%do_lw) then + call simple_urban_lw(config, is_infinite_street, & + & config%nlwinternal, & + & jcol, ilay1, & + & canopy_props, lw_spectral_props, & + & bc_out%lw_emissivity(:,jcol), bc_out%lw_emission(:,jcol), & + & lw_internal, lw_norm) + end if + end select end do diff --git a/radsurf/radsurf_lw_spectral_properties.F90 b/radsurf/radsurf_lw_spectral_properties.F90 index a85744d..daa942f 100644 --- a/radsurf/radsurf_lw_spectral_properties.F90 +++ b/radsurf/radsurf_lw_spectral_properties.F90 @@ -66,7 +66,8 @@ subroutine allocate_spectral(this, config, nspec, ncol, ntotlay, & use radsurf_config, only : config_type use radsurf_canopy_properties, only : ITileFlat, ITileForest, & - & ITileUrban, ITileVegetatedUrban + & ITileUrban, ITileVegetatedUrban, & + & ITileSimpleUrban, ITileInfiniteStreet class(lw_spectral_properties_type), intent(inout) :: this type(config_type), intent(in) :: config @@ -93,7 +94,9 @@ subroutine allocate_spectral(this, config, nspec, ncol, ntotlay, & do_vegetation = .false. end if if (.not. any(i_representation == ITileUrban & - & .or. i_representation == ITileVegetatedUrban)) then + & .or. i_representation == ITileVegetatedUrban & + & .or. i_representation == ITileSimpleUrban & + & .or. i_representation == ITileInfiniteStreet)) then do_urban = .false. end if end if diff --git a/radsurf/radsurf_norm_perim.F90 b/radsurf/radsurf_norm_perim.F90 new file mode 100644 index 0000000..15dff87 --- /dev/null +++ b/radsurf/radsurf_norm_perim.F90 @@ -0,0 +1,283 @@ +! radsurf_norm_perim.F90 - Compute normalized perimeter length between regions +! +! (C) Copyright 2020- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +! Author: Robin Hogan +! Email: r.j.hogan@ecmwf.int +! + +module radsurf_norm_perim + +contains + + !--------------------------------------------------------------------- + ! This routine computes the normalized perimeter length (perimeter + ! length divided by domain area), in m-1, between regions in + ! forests. "nreg" is the number of permeable regions per layer, + ! which can be 1 (clear), 2 (clear and vegetated) or 3 (clear and + ! two vegetated). "norm_perim" has nreg elements per layer: if + ! nreg=1 then norm_perim is unused, if nreg=2 then norm_perim(1,:) + ! is the length between the two regions and if nreg=3 then + ! norm_perim(i,:) is the length between regions i and i+1 except for + ! norm_perim(3,:) which is the length between regions 1 and 3. + subroutine calc_norm_perim_forest(config, nlay, nreg, & + & veg_fraction, veg_scale, norm_perim) + + use parkind1, only : jpim, jprb + use yomhook, only : lhook, dr_hook + use radsurf_config, only : config_type + + implicit none + + ! Algorithm configuration + type(config_type), intent(in) :: config + + ! Number of layers and permeable regions + integer(jpim), intent(in) :: nlay, nreg + + ! Vegetation area fraction, and the horizontal scale of the + ! vegetation (m), which are converted to edge length using Eqs. 19 + ! or 20 of Hogan et al. (GMD 2018) + real(jprb), dimension(nlay), intent(in) :: veg_fraction, veg_scale + + ! Normalized perimeter length between regions (m-1) + real(jprb), dimension(nreg,nlay), intent(out) :: norm_perim + + ! Layer index + integer(jpim) :: jlay + + real(jprb) :: hook_handle + + if (lhook) call dr_hook('radsurf_norm_perim:calc_norm_perim_forest',0,hook_handle) + + norm_perim = 0.0_jprb + + do jlay = 1,nlay + if (nreg > 1) then + if (veg_fraction(jlay) > config%min_vegetation_fraction) then + ! Compute the normalized vegetation perimeter length + if (config%use_symmetric_vegetation_scale_forest) then + ! If S=veg scale, v=veg fraction and c=clear fraction then + ! normal formula for normalized perimeter length is + ! L=4*v*c/S + norm_perim(1,jlay) = 4.0_jprb * veg_fraction(jlay) & + & * max(0.0_jprb, 1.0_jprb - veg_fraction(jlay)) & + & / veg_scale(jlay) + else + ! The Jensen et al. (JClim 2008) effective diameter "D" is + ! used in a simpler formula for normalized perimeter + ! length L=4v/D + norm_perim(1,jlay) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) + end if + + if (nreg > 2) then + ! Share the clear-air/vegetation perimeter between the two + ! vegetated regions + norm_perim(nreg,jlay) = 0.5_jprb*config%vegetation_isolation_factor_forest * norm_perim(1,jlay) + norm_perim(1,jlay) = (1.0_jprb - 0.5_jprb*config%vegetation_isolation_factor_forest) & + & * norm_perim(1,jlay) + ! We assume that the horizontal scale of the vegetation + ! inhomogeneities is the same as the scale of the tree + ! crowns themselves. Therefore, to compute the interface + ! between the two vegetated regions, we use the same + ! formula as before but with the fraction associated with + ! one of the two vegetated regions, which is half the + ! total vegetation fraction. + if (config%use_symmetric_vegetation_scale_forest) then + norm_perim(2,jlay) = (1.0_jprb - config%vegetation_isolation_factor_forest) & + & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & + & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay))) & + & / veg_scale(jlay) + else + ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_forest) & + ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) + ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) + norm_perim(2,jlay) = (1.0_jprb - config%vegetation_isolation_factor_forest) & + & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) + end if + else + ! Only one vegetated region so the other column of + ! norm_perim is unused + norm_perim(2:,jlay) = 0.0_jprb + end if + end if + end if + end do + + if (lhook) call dr_hook('radsurf_norm_perim:calc_norm_perim_forest',1,hook_handle) + + end subroutine calc_norm_perim_forest + + + !--------------------------------------------------------------------- + ! This routine computes the normalized perimeter lengths (perimeter + ! length divided by domain area), in m-1, between regions and walls + ! in an urban environment. "nreg" is the number of permeable regions + ! per layer, which can be 1 (clear), 2 (clear and vegetated) or 3 + ! (clear and two vegetated). "norm_perim" has nreg elements per + ! layer: if nreg=1 then norm_perim is unused, if nreg=2 then + ! norm_perim(1,:) is the length between the two regions and if + ! nreg=3 then norm_perim(i,:) is the length between regions i and + ! i+1 except for norm_perim(3,:) which is the length between regions + ! 1 and 3. "norm_perim_wall(i,:)" is the length of the interface + ! between a wall and region i. + subroutine calc_norm_perim_urban(config, nlay, nreg, building_fraction, & + & building_scale, veg_fraction, veg_scale, veg_contact_fraction, & + & norm_perim, norm_perim_wall) + + use parkind1, only : jpim, jprb + use yomhook, only : lhook, dr_hook + use radsurf_config, only : config_type + + implicit none + + ! Algorithm configuration + type(config_type), intent(in) :: config + + ! Number of layers and permeable regions + integer(jpim), intent(in) :: nlay, nreg + + ! Building area fraction and the effective diameter of the + ! buildings (m), and vegetation area fraction and the horizontal + ! scale of the vegetation (m). The latter two are converted to + ! vegetation edge length using Eqs. 19 or 20 of Hogan et al. (GMD + ! 2018). The former two use Eq. 19 of this paper. + real(jprb), dimension(nlay), intent(in) & + & :: building_fraction, building_scale, & + & veg_fraction, veg_scale, veg_contact_fraction + + ! Normalized perimeter length between regions, and between regions + ! and walls (m-1) + real(jprb), dimension(nreg,nlay), intent(out) & + & :: norm_perim, norm_perim_wall + + ! Layer index + integer(jpim) :: jlay + + real(jprb) :: hook_handle + + if (lhook) call dr_hook('radsurf_norm_perim:calc_norm_perim_urban',0,hook_handle) + + norm_perim = 0.0_jprb + norm_perim_wall = 0.0_jprb + + do jlay = 1,nlay + ! First compute the perimeter length between permeable regions + if (nreg > 1) then + if (veg_fraction(jlay) > config%min_vegetation_fraction) then + ! Compute the normalized vegetation perimeter length + if (config%use_symmetric_vegetation_scale_urban) then + ! If S=veg scale, v=veg fraction and c=clear fraction then + ! normal formula for normalized perimeter length is + ! L=4*v*c/S. But there are buildings present too with + ! fraction b, and v+c+b=1. So we are dealing only with the + ! veg+clear fraction, and need to normalize quantities by + ! v+c: L/(v+c)=4*(v/(v+c))*(c/(v+c))/S leading to + ! L=4*v*c/(S*(v+c)). Note that this is the length of the + ! vegetation-clear interface and cannot be reassigned to + ! the veg-building or clear-building interface. + norm_perim(1,jlay) = 4.0_jprb * veg_fraction(jlay) & + & * max(0.0_jprb, 1.0_jprb - veg_fraction(jlay) - building_fraction(jlay)) & + & / (max(config%min_building_fraction, & + & 1.0_jprb - building_fraction(jlay)) * veg_scale(jlay)) + else + ! The Jensen et al. (JClim 2008) effective diameter "D" is + ! used in a simpler formula for normalized perimeter + ! length L=4v/D. In this case if we normalize L and v by + ! (v+c) they cancel leaving the same formula: + norm_perim(1,jlay) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) + end if + + if (nreg > 2) then + ! Share the clear-air/vegetation perimeter between the two + ! vegetated regions + norm_perim(nreg,jlay) = 0.5_jprb*config%vegetation_isolation_factor_urban * norm_perim(1,jlay) + norm_perim(1,jlay) = (1.0_jprb - 0.5_jprb*config%vegetation_isolation_factor_urban) & + & * norm_perim(1,jlay) + ! We assume that the horizontal scale of the vegetation + ! inhomogeneities is the same as the scale of the tree + ! crowns themselves. Therefore, to compute the interface + ! between the two vegetated regions, we use the same + ! formula as before but with the fraction associated with + ! one of the two vegetated regions, which is half the + ! total vegetation fraction. + if (config%use_symmetric_vegetation_scale_urban) then + norm_perim(2,jlay) = (1.0_jprb - config%vegetation_isolation_factor_urban) & + & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & + & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay)) - building_fraction(jlay)) & + & / (max(config%min_building_fraction, & + & 1.0_jprb - building_fraction(jlay)) * veg_scale(jlay)) + else + ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & + ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) + ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) + norm_perim(2,jlay) = (1.0_jprb - config%vegetation_isolation_factor_urban) & + & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) + end if + else + ! Only one vegetated region so the other column of + ! norm_perim is unused + norm_perim(2:,jlay) = 0.0_jprb + end if + end if + end if + + ! Second, compute the normalized length of the interface + ! between each region and a building wall + if (building_fraction(jlay) > config%min_building_fraction) then + + ! By default the only region in contact with walls is the + ! clear region + norm_perim_wall(1,jlay) = 4.0_jprb * building_fraction(jlay) / building_scale(jlay) + + if (nreg > 1) then + if (1.0_jprb - veg_fraction(jlay) - building_fraction(jlay) & + & <= config%min_vegetation_fraction) then + ! There is no clear region (region 1), so all walls must + ! be in contact with vegetation (region 2 and possibly + ! 3) + if (nreg == 2) then + norm_perim_wall(2,jlay) = norm_perim_wall(1,jlay) + else + norm_perim_wall(2,jlay) = norm_perim_wall(1,jlay) & + & * (1.0_jprb - config%vegetation_isolation_factor_urban) + norm_perim_wall(3,jlay) = norm_perim_wall(1,jlay) & + & * config%vegetation_isolation_factor_urban + end if + norm_perim_wall(1,jlay) = 0.0_jprb + else if (veg_fraction(jlay) > config%min_vegetation_fraction) then + ! Nominal case: clear and vegetated regions are present + if (veg_contact_fraction(jlay) > 0.0_jprb) then + ! Compute normalized length of interface between wall + ! and any vegetation + if (nreg == 2) then + norm_perim_wall(2,jlay) = norm_perim_wall(1,jlay)*veg_contact_fraction(jlay) + else + norm_perim_wall(2,jlay) = norm_perim_wall(1,jlay)*veg_contact_fraction(jlay) & + & * (1.0_jprb - config%vegetation_isolation_factor_urban) + norm_perim_wall(3,jlay) = norm_perim_wall(1,jlay)*veg_contact_fraction(jlay) & + & * config%vegetation_isolation_factor_urban + end if + ! Reduce length of interface between wall and clear-air + norm_perim_wall(1,jlay) = norm_perim_wall(1,jlay) & + & * (1.0_jprb - veg_contact_fraction(jlay)) + end if + end if + ! else no significant vegetation so norm_perim_wall(2:,jlay) = 0 + end if + end if + + end do + + if (lhook) call dr_hook('radsurf_norm_perim:calc_norm_perim_urban',1,hook_handle) + + end subroutine calc_norm_perim_urban + +end module radsurf_norm_perim diff --git a/radsurf/radsurf_save.F90 b/radsurf/radsurf_save.F90 index bb1d345..ae577bf 100644 --- a/radsurf/radsurf_save.F90 +++ b/radsurf/radsurf_save.F90 @@ -56,21 +56,21 @@ subroutine save_canopy_fluxes(file_name, config, canopy_props, & end if if (config%do_sw) then - do_spectral_sw = (config%do_save_spectral_flux & - & .and. flux_sw%nspec > 1) + do_spectral_sw = config%do_save_spectral_flux + ! .and. flux_sw%nspec > 1 do_broadband_sw = config%do_save_broadband_flux else - do_spectral_sw = .false. + do_spectral_sw = .false. do_broadband_sw = .false. end if if (config%do_lw) then - do_spectral_lw = (config%do_save_spectral_flux & - & .and. flux_lw%nspec > 1) + do_spectral_lw = config%do_save_spectral_flux + ! .and. flux_lw%nspec > 1 do_broadband_sw = config%do_save_broadband_flux else - do_spectral_lw = .false. - do_broadband_sw = .false. + do_spectral_lw = .false. + do_broadband_lw = .false. end if ncol = canopy_props%ncol @@ -99,7 +99,7 @@ subroutine save_canopy_fluxes(file_name, config, canopy_props, & & title_str="Radiative fluxes from the SPARTACUS-Surface radiation model", & & references_str="Hogan, R. J., T. Quaife and R. Braghiere, 2018: Fast matrix treatment of 3-D radiative" & & //" transfer in vegetation canopies: SPARTACUS-Vegetation 1.1. Geosci. Model Dev., 11, 339-350." & - & //NEW_LINE('A')//"Hogan, R. J., 2019b: Flexible treatment of radiative transfer in complex urban" & + & //NEW_LINE('A')//"Hogan, R. J., 2019: Flexible treatment of radiative transfer in complex urban" & & // " canopies for use in weather and climate models. Boundary-Layer Meteorol., 173, 53-78.", & & source_str="SPARTACUS-Surface offline radiation model", & & comment_str="All fluxes and absorption rates are in terms of power per unit horizontal area of the domain. " & @@ -116,7 +116,9 @@ subroutine save_canopy_fluxes(file_name, config, canopy_props, & & "0: Flat"//NEW_LINE('A') & & //"1: Forest"//NEW_LINE('A') & & //"2: Unvegetated urban"//NEW_LINE('A') & - & //"3: Vegetated urban") + & //"3: Vegetated urban"//NEW_LINE('A') & + & //"4: Simple urban"//NEW_LINE('A') & + & //"5: Infinite street") call out_file%define_variable("nlayer", data_type_name="short", & & dim1_name="column", long_name="Number of active layers") @@ -174,113 +176,243 @@ subroutine define_canopy_flux_variables(out_file, band_name, band_long_name, & type(canopy_flux_type), intent(in) :: flux logical, intent(in) :: do_broadband, do_spectral - call out_file%define_variable("ground_flux_dn_"//band_name, units_str="W m-2", & - & long_name="Downwelling "//band_long_name//" flux at ground", & - & dim1_name="column") - call out_file%define_variable("ground_flux_net_"//band_name, units_str="W m-2", & - & long_name="Net "//band_long_name//" flux at ground", & - & dim1_name="column") + ! Define wavelength-independent variables if (allocated(flux%ground_dn_dir)) then - call out_file%define_variable("ground_flux_dn_direct_"//band_name, units_str="W m-2", & - & long_name="Downwelling direct "//band_long_name//" flux at ground", & - & dim1_name="column") - call out_file%define_variable("ground_flux_vertical_diffuse_"//band_name, units_str="W m-2", & - & long_name="Diffuse "//band_long_name//" flux into a vertical surface at ground level", & - & dim1_name="column") call out_file%define_variable("ground_sunlit_fraction", units_str="1", & & long_name="Fraction of ground in direct sunlight", dim1_name="column") - else - call out_file%define_variable("ground_flux_vertical_"//band_name, units_str="W m-2", & - & long_name="Flux in "//band_long_name//" into a vertical surface at ground level", & - & dim1_name="column") end if - call out_file%define_variable("top_flux_dn_"//band_name, units_str="W m-2", & - & long_name="Downwelling "//band_long_name//" flux at top of canopy", & - & dim1_name="column") - call out_file%define_variable("top_flux_net_"//band_name, units_str="W m-2", & - & long_name="Net "//band_long_name//" flux at top of canopy", & - & dim1_name="column") - if (allocated(flux%top_dn_dir)) then - call out_file%define_variable("top_flux_dn_direct_"//band_name, units_str="W m-2", & - & long_name="Downwelling direct "//band_long_name//" flux at top of canopy", & - & dim1_name="column") + if (allocated(flux%roof_in_dir)) then + call out_file%define_variable("roof_sunlit_fraction", units_str="1", & + & long_name="Fraction of roof in direct sunlight", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) end if - if (allocated(flux%roof_in)) then - call out_file%define_variable("roof_flux_in_"//band_name, units_str="W m-2", & - & long_name="Incoming "//band_long_name//" flux at roofs", & + if (allocated(flux%wall_in_dir)) then + call out_file%define_variable("wall_sunlit_fraction", units_str="1", & + & long_name="Fraction of wall in direct sunlight", & & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - if (allocated(flux%roof_in_dir)) then - call out_file%define_variable("roof_flux_in_direct_"//band_name, units_str="W m-2", & - & long_name="Direct incoming "//band_long_name//" flux at roofs", & + end if + if (allocated(flux%veg_abs_dir)) then + call out_file%define_variable("veg_sunlit_fraction", units_str="1", & + & long_name="Fraction of vegetation in direct sunlight", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + + ! Define broadband variables + if (do_broadband) then + call out_file%define_variable("ground_flux_dn_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" flux at ground", & + & dim1_name="column") + call out_file%define_variable("ground_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" flux at ground", & + & dim1_name="column") + if (allocated(flux%ground_dn_dir)) then + call out_file%define_variable("ground_flux_dn_direct_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" flux at ground", & + & dim1_name="column") + call out_file%define_variable("ground_flux_vertical_diffuse_"//band_name, units_str="W m-2", & + & long_name="Diffuse "//band_long_name//" flux into a vertical surface at ground level", & + & dim1_name="column") + else + call out_file%define_variable("ground_flux_vertical_"//band_name, units_str="W m-2", & + & long_name="Flux in "//band_long_name//" into a vertical surface at ground level", & + & dim1_name="column") + end if + call out_file%define_variable("top_flux_dn_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" flux at top of canopy", & + & dim1_name="column") + call out_file%define_variable("top_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" flux at top of canopy", & + & dim1_name="column") + if (allocated(flux%top_dn_dir)) then + call out_file%define_variable("top_flux_dn_direct_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" flux at top of canopy", & + & dim1_name="column") + end if + if (allocated(flux%roof_in)) then + call out_file%define_variable("roof_flux_in_"//band_name, units_str="W m-2", & + & long_name="Incoming "//band_long_name//" flux at roofs", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + if (allocated(flux%roof_in_dir)) then + call out_file%define_variable("roof_flux_in_direct_"//band_name, units_str="W m-2", & + & long_name="Direct incoming "//band_long_name//" flux at roofs", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + call out_file%define_variable("roof_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" flux at roofs", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + call out_file%define_variable("wall_flux_in_"//band_name, units_str="W m-2", & + & long_name="Incoming "//band_long_name//" flux at walls", & & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("roof_sunlit_fraction", units_str="1", & - & long_name="Fraction of roof in direct sunlight", & + if (allocated(flux%wall_in_dir)) then + call out_file%define_variable("wall_flux_in_direct_"//band_name, units_str="W m-2", & + & long_name="Direct incoming "//band_long_name//" flux at walls", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + call out_file%define_variable("wall_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" flux at walls", & & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) end if - call out_file%define_variable("roof_flux_net_"//band_name, units_str="W m-2", & - & long_name="Net "//band_long_name//" flux at roofs", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("wall_flux_in_"//band_name, units_str="W m-2", & - & long_name="Incoming "//band_long_name//" flux at walls", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - if (allocated(flux%wall_in_dir)) then - call out_file%define_variable("wall_flux_in_direct_"//band_name, units_str="W m-2", & - & long_name="Direct incoming "//band_long_name//" flux at walls", & + if (allocated(flux%clear_air_abs)) then + call out_file%define_variable("clear_air_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" in clear air", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + + if (allocated(flux%veg_abs)) then + call out_file%define_variable("veg_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" by vegetation", & & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("wall_sunlit_fraction", units_str="1", & - & long_name="Fraction of wall in direct sunlight", & + call out_file%define_variable("veg_air_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" by air in vegetated regions", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + if (allocated(flux%veg_abs_dir)) then + call out_file%define_variable("veg_absorption_direct_"//band_name, units_str="W m-2", & + & long_name="Absorbed direct "//band_long_name//" by vegetation", & & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) end if - call out_file%define_variable("wall_flux_net_"//band_name, units_str="W m-2", & - & long_name="Net "//band_long_name//" flux at walls", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - end if - if (allocated(flux%clear_air_abs)) then - call out_file%define_variable("clear_air_absorption_"//band_name, units_str="W m-2", & - & long_name="Absorbed "//band_long_name//" in clear air", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - end if - if (allocated(flux%veg_abs)) then - call out_file%define_variable("veg_absorption_"//band_name, units_str="W m-2", & - & long_name="Absorbed "//band_long_name//" by vegetation", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("veg_air_absorption_"//band_name, units_str="W m-2", & - & long_name="Absorbed "//band_long_name//" by air in vegetated regions", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - end if - if (allocated(flux%veg_abs_dir)) then - call out_file%define_variable("veg_absorption_direct_"//band_name, units_str="W m-2", & - & long_name="Absorbed direct "//band_long_name//" by vegetation", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("veg_sunlit_fraction", units_str="W m-2", & - & long_name="Fraction of vegetation in direct sunlight", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + if (allocated(flux%flux_dn_layer_top)) then + call out_file%define_variable("flux_dn_layer_top_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" flux at top of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + if (allocated(flux%flux_dn_dir_layer_top)) then + call out_file%define_variable("flux_dn_direct_layer_top_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" flux at top of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + call out_file%define_variable("flux_up_layer_top_"//band_name, units_str="W m-2", & + & long_name="Upwelling "//band_long_name//" flux at top of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + call out_file%define_variable("flux_dn_layer_base_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" flux at base of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + if (allocated(flux%flux_dn_dir_layer_base)) then + call out_file%define_variable("flux_dn_direct_layer_base_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" flux at base of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if + call out_file%define_variable("flux_up_layer_base_"//band_name, units_str="W m-2", & + & long_name="Upwelling "//band_long_name//" flux at base of layer", & + & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + end if end if - if (allocated(flux%flux_dn_layer_top)) then - call out_file%define_variable("flux_dn_layer_top_"//band_name, units_str="W m-2", & - & long_name="Downwelling "//band_long_name//" flux at top of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - if (allocated(flux%flux_dn_dir_layer_top)) then - call out_file%define_variable("flux_dn_direct_layer_top_"//band_name, units_str="W m-2", & - & long_name="Downwelling direct "//band_long_name//" flux at top of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + ! Define spectral fluxes + if (do_spectral) then + call out_file%define_variable("ground_spectral_flux_dn_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" spectral flux at ground", & + & dim2_name="column", dim1_name="band_"//band_name) + call out_file%define_variable("ground_spectral_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" spectral flux at ground", & + & dim2_name="column", dim1_name="band_"//band_name) + if (allocated(flux%ground_dn_dir)) then + call out_file%define_variable("ground_spectral_flux_dn_direct_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" spectral flux at ground", & + & dim2_name="column", dim1_name="band_"//band_name) + call out_file%define_variable("ground_spectral_flux_vertical_diffuse_"//band_name, units_str="W m-2", & + & long_name="Diffuse "//band_long_name//" spectral flux into a vertical surface at ground level", & + & dim2_name="column", dim1_name="band_"//band_name) + else + call out_file%define_variable("ground_spectral_flux_vertical_"//band_name, units_str="W m-2", & + & long_name="Flux in "//band_long_name//" into a vertical surface at ground level", & + & dim2_name="column", dim1_name="band_"//band_name) end if - call out_file%define_variable("flux_up_layer_top_"//band_name, units_str="W m-2", & - & long_name="Upwelling "//band_long_name//" flux at top of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - call out_file%define_variable("flux_dn_layer_base_"//band_name, units_str="W m-2", & - & long_name="Downwelling "//band_long_name//" flux at base of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) - if (allocated(flux%flux_dn_dir_layer_base)) then - call out_file%define_variable("flux_dn_direct_layer_base_"//band_name, units_str="W m-2", & - & long_name="Downwelling direct "//band_long_name//" flux at base of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) + call out_file%define_variable("top_spectral_flux_dn_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" spectral flux at top of canopy", & + & dim2_name="column", dim1_name="band_"//band_name) + call out_file%define_variable("top_spectral_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" spectral flux at top of canopy", & + & dim2_name="column", dim1_name="band_"//band_name) + if (allocated(flux%top_dn_dir)) then + call out_file%define_variable("top_spectral_flux_dn_direct_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" spectral flux at top of canopy", & + & dim2_name="column", dim1_name="band_"//band_name) + end if + if (allocated(flux%roof_in)) then + call out_file%define_variable("roof_spectral_flux_in_"//band_name, units_str="W m-2", & + & long_name="Incoming "//band_long_name//" spectral flux at roofs", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + if (allocated(flux%roof_in_dir)) then + call out_file%define_variable("roof_spectral_flux_in_direct_"//band_name, units_str="W m-2", & + & long_name="Direct incoming "//band_long_name//" spectral flux at roofs", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + call out_file%define_variable("roof_spectral_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" spectral flux at roofs", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + call out_file%define_variable("wall_spectral_flux_in_"//band_name, units_str="W m-2", & + & long_name="Incoming "//band_long_name//" spectral flux at walls", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + if (allocated(flux%wall_in_dir)) then + call out_file%define_variable("wall_spectral_flux_in_direct_"//band_name, units_str="W m-2", & + & long_name="Direct incoming "//band_long_name//" spectral flux at walls", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + call out_file%define_variable("wall_spectral_flux_net_"//band_name, units_str="W m-2", & + & long_name="Net "//band_long_name//" spectral flux at walls", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + if (allocated(flux%clear_air_abs)) then + call out_file%define_variable("clear_air_spectral_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" in clear air", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + + if (allocated(flux%veg_abs)) then + call out_file%define_variable("veg_spectral_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" by vegetation", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + call out_file%define_variable("veg_air_spectral_absorption_"//band_name, units_str="W m-2", & + & long_name="Absorbed "//band_long_name//" by air in vegetated regions", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + if (allocated(flux%veg_abs_dir)) then + call out_file%define_variable("veg_spectral_absorption_direct_"//band_name, units_str="W m-2", & + & long_name="Absorbed direct "//band_long_name//" by vegetation", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + + if (allocated(flux%flux_dn_layer_top)) then + call out_file%define_variable("spectral_flux_dn_layer_top_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" spectral flux at top of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + if (allocated(flux%flux_dn_dir_layer_top)) then + call out_file%define_variable("spectral_flux_dn_direct_layer_top_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" spectral flux at top of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + call out_file%define_variable("spectral_flux_up_layer_top_"//band_name, units_str="W m-2", & + & long_name="Upwelling "//band_long_name//" spectral flux at top of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + call out_file%define_variable("spectral_flux_dn_layer_base_"//band_name, units_str="W m-2", & + & long_name="Downwelling "//band_long_name//" spectral flux at base of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + if (allocated(flux%flux_dn_dir_layer_base)) then + call out_file%define_variable("spectral_flux_dn_direct_layer_base_"//band_name, units_str="W m-2", & + & long_name="Downwelling direct "//band_long_name//" spectral flux at base of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) + end if + call out_file%define_variable("spectral_flux_up_layer_base_"//band_name, units_str="W m-2", & + & long_name="Upwelling "//band_long_name//" spectral flux at base of layer", & + & dim3_name="column", dim2_name="layer", dim1_name="band_"//band_name, & + & fill_value=FillValueFlux) end if - call out_file%define_variable("flux_up_layer_base_"//band_name, units_str="W m-2", & - & long_name="Upwelling "//band_long_name//" flux at base of layer", & - & dim2_name="column", dim1_name="layer", fill_value=FillValueFlux) end if end subroutine define_canopy_flux_variables @@ -301,99 +433,197 @@ subroutine write_canopy_flux_variables(out_file, band_name, nmaxlay, & ! Temporary variable at layer interfaces real(kind=jprb) :: tmp(nmaxlay, flux%ncol) + real(kind=jprb) :: tmp_spec(flux%nspec, nmaxlay, flux%ncol) - call out_file%put("ground_flux_dn_"//band_name, sum(flux%ground_dn,1)) - call out_file%put("ground_flux_net_"//band_name, sum(flux%ground_net,1)) + ! Wavelength-independent quantities if (allocated(flux%ground_dn_dir)) then - call out_file%put("ground_flux_dn_direct_"//band_name, & - & sum(flux%ground_dn_dir,1)) - call out_file%put("ground_flux_vertical_diffuse_"//band_name, & - & sum(flux%ground_vertical_diff,1)) call out_file%put("ground_sunlit_fraction", flux%ground_sunlit_frac) - else - call out_file%put("ground_flux_vertical_"//band_name, & - & sum(flux%ground_vertical_diff,1)) - end if - call out_file%put("top_flux_dn_"//band_name, sum(flux%top_dn,1)) - call out_file%put("top_flux_net_"//band_name, sum(flux%top_net,1)) - if (allocated(flux%top_dn_dir)) then - call out_file%put("top_flux_dn_direct_"//band_name, & - & sum(flux%top_dn_dir,1)) - end if - if (allocated(flux%roof_in)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%roof_in, tmp) - call out_file%put("roof_flux_in_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%roof_net, tmp) - call out_file%put("roof_flux_net_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%wall_in, tmp) - call out_file%put("wall_flux_in_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%wall_net, tmp) - call out_file%put("wall_flux_net_"//band_name, tmp) - if (allocated(flux%roof_in_dir)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%roof_in_dir, tmp) - call out_file%put("roof_flux_in_direct_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%wall_in_dir, tmp) - call out_file%put("wall_flux_in_direct_"//band_name, tmp) - call unpack_variable(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%roof_sunlit_frac, tmp) - call out_file%put("roof_sunlit_fraction", tmp) - call unpack_variable(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%wall_sunlit_frac, tmp) - call out_file%put("wall_sunlit_fraction", tmp) - end if - end if - if (allocated(flux%clear_air_abs)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%clear_air_abs, tmp) - call out_file%put("clear_air_absorption_"//band_name, tmp) end if - if (allocated(flux%veg_abs)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%veg_abs, tmp) - call out_file%put("veg_absorption_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%veg_air_abs, tmp) - call out_file%put("veg_air_absorption_"//band_name, tmp) + if (allocated(flux%roof_in_dir)) then + call unpack_variable(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%roof_sunlit_frac, tmp) + call out_file%put("roof_sunlit_fraction", tmp) + call unpack_variable(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%wall_sunlit_frac, tmp) + call out_file%put("wall_sunlit_fraction", tmp) end if if (allocated(flux%veg_abs_dir)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%veg_abs_dir, tmp) - call out_file%put("veg_absorption_direct_"//band_name, tmp) call unpack_variable(flux%ncol, nmaxlay, nlay, FillValueFlux, & & flux%veg_sunlit_frac, tmp) call out_file%put("veg_sunlit_fraction", tmp) end if - if (allocated(flux%flux_dn_layer_top)) then - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_dn_layer_top, tmp) - call out_file%put("flux_dn_layer_top_"//band_name, tmp) - if (allocated(flux%flux_dn_dir_layer_top)) then + + ! Broadband fluxes + if (do_broadband) then + call out_file%put("ground_flux_dn_"//band_name, sum(flux%ground_dn,1)) + call out_file%put("ground_flux_net_"//band_name, sum(flux%ground_net,1)) + if (allocated(flux%ground_dn_dir)) then + call out_file%put("ground_flux_dn_direct_"//band_name, & + & sum(flux%ground_dn_dir,1)) + call out_file%put("ground_flux_vertical_diffuse_"//band_name, & + & sum(flux%ground_vertical_diff,1)) + else + call out_file%put("ground_flux_vertical_"//band_name, & + & sum(flux%ground_vertical_diff,1)) + end if + call out_file%put("top_flux_dn_"//band_name, sum(flux%top_dn,1)) + call out_file%put("top_flux_net_"//band_name, sum(flux%top_net,1)) + if (allocated(flux%top_dn_dir)) then + call out_file%put("top_flux_dn_direct_"//band_name, & + & sum(flux%top_dn_dir,1)) + end if + if (allocated(flux%roof_in)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%roof_in, tmp) + call out_file%put("roof_flux_in_"//band_name, tmp) + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%roof_net, tmp) + call out_file%put("roof_flux_net_"//band_name, tmp) call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_dn_dir_layer_top, tmp) - call out_file%put("flux_dn_direct_layer_top_"//band_name, tmp) + & flux%wall_in, tmp) + call out_file%put("wall_flux_in_"//band_name, tmp) + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%wall_net, tmp) + call out_file%put("wall_flux_net_"//band_name, tmp) + if (allocated(flux%roof_in_dir)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%roof_in_dir, tmp) + call out_file%put("roof_flux_in_direct_"//band_name, tmp) + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%wall_in_dir, tmp) + call out_file%put("wall_flux_in_direct_"//band_name, tmp) + end if + end if + if (allocated(flux%clear_air_abs)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%clear_air_abs, tmp) + call out_file%put("clear_air_absorption_"//band_name, tmp) end if - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_up_layer_top, tmp) - call out_file%put("flux_up_layer_top_"//band_name, tmp) - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_dn_layer_base, tmp) - call out_file%put("flux_dn_layer_base_"//band_name, tmp) - if (allocated(flux%flux_dn_dir_layer_base)) then + if (allocated(flux%veg_abs)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%veg_abs, tmp) + call out_file%put("veg_absorption_"//band_name, tmp) call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_dn_dir_layer_base, tmp) - call out_file%put("flux_dn_direct_layer_base_"//band_name, tmp) + & flux%veg_air_abs, tmp) + call out_file%put("veg_air_absorption_"//band_name, tmp) + end if + if (allocated(flux%veg_abs_dir)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%veg_abs_dir, tmp) + call out_file%put("veg_absorption_direct_"//band_name, tmp) + end if + if (allocated(flux%flux_dn_layer_top)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_dn_layer_top, tmp) + call out_file%put("flux_dn_layer_top_"//band_name, tmp) + if (allocated(flux%flux_dn_dir_layer_top)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_dn_dir_layer_top, tmp) + call out_file%put("flux_dn_direct_layer_top_"//band_name, tmp) + end if + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_up_layer_top, tmp) + call out_file%put("flux_up_layer_top_"//band_name, tmp) + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_dn_layer_base, tmp) + call out_file%put("flux_dn_layer_base_"//band_name, tmp) + if (allocated(flux%flux_dn_dir_layer_base)) then + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_dn_dir_layer_base, tmp) + call out_file%put("flux_dn_direct_layer_base_"//band_name, tmp) + end if + call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & + & flux%flux_up_layer_base, tmp) + call out_file%put("flux_up_layer_base_"//band_name, tmp) end if - call unpack_variable_broadband(flux%ncol, nmaxlay, nlay, FillValueFlux, & - & flux%flux_up_layer_base, tmp) - call out_file%put("flux_up_layer_base_"//band_name, tmp) end if - + + ! Spectral fluxes + if (do_spectral) then + call out_file%put("ground_spectral_flux_dn_"//band_name, flux%ground_dn) + call out_file%put("ground_spectral_flux_net_"//band_name, flux%ground_net) + if (allocated(flux%ground_dn_dir)) then + call out_file%put("ground_spectral_flux_dn_direct_"//band_name, & + & flux%ground_dn_dir) + call out_file%put("ground_spectral_flux_vertical_diffuse_"//band_name, & + & flux%ground_vertical_diff) + else + call out_file%put("ground_spectral_flux_vertical_"//band_name, & + & flux%ground_vertical_diff) + end if + call out_file%put("top_spectral_flux_dn_"//band_name, flux%top_dn) + call out_file%put("top_spectral_flux_net_"//band_name, flux%top_net) + if (allocated(flux%top_dn_dir)) then + call out_file%put("top_spectral_flux_dn_direct_"//band_name, & + & flux%top_dn_dir) + end if + if (allocated(flux%roof_in)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%roof_in, tmp_spec) + call out_file%put("roof_spectral_flux_in_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%roof_net, tmp_spec) + call out_file%put("roof_spectral_flux_net_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%wall_in, tmp_spec) + call out_file%put("wall_spectral_flux_in_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%wall_net, tmp_spec) + call out_file%put("wall_spectral_flux_net_"//band_name, tmp_spec) + if (allocated(flux%roof_in_dir)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%roof_in_dir, tmp_spec) + call out_file%put("roof_spectral_flux_in_direct_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%wall_in_dir, tmp_spec) + call out_file%put("wall_spectral_flux_in_direct_"//band_name, tmp_spec) + end if + end if + if (allocated(flux%clear_air_abs)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%clear_air_abs, tmp_spec) + call out_file%put("clear_air_spectral_absorption_"//band_name, tmp_spec) + end if + if (allocated(flux%veg_abs)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%veg_abs, tmp_spec) + call out_file%put("veg_spectral_absorption_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%veg_air_abs, tmp_spec) + call out_file%put("veg_air_spectral_absorption_"//band_name, tmp_spec) + end if + if (allocated(flux%veg_abs_dir)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%veg_abs_dir, tmp_spec) + call out_file%put("veg_spectral_absorption_direct_"//band_name, tmp_spec) + end if + if (allocated(flux%flux_dn_layer_top)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_dn_layer_top, tmp_spec) + call out_file%put("spectral_flux_dn_layer_top_"//band_name, tmp_spec) + if (allocated(flux%flux_dn_dir_layer_top)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_dn_dir_layer_top, tmp_spec) + call out_file%put("spectral_flux_dn_direct_layer_top_"//band_name, tmp_spec) + end if + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_up_layer_top, tmp_spec) + call out_file%put("spectral_flux_up_layer_top_"//band_name, tmp_spec) + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_dn_layer_base, tmp_spec) + call out_file%put("spectral_flux_dn_layer_base_"//band_name, tmp_spec) + if (allocated(flux%flux_dn_dir_layer_base)) then + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_dn_dir_layer_base, tmp_spec) + call out_file%put("spectral_flux_dn_direct_layer_base_"//band_name, tmp_spec) + end if + call unpack_variable_spectral(flux%ncol, nmaxlay, nlay, flux%nspec, FillValueFlux, & + & flux%flux_up_layer_base, tmp_spec) + call out_file%put("spectral_flux_up_layer_base_"//band_name, tmp_spec) + end if + end if + + end subroutine write_canopy_flux_variables subroutine unpack_variable(ncol, nmaxlay, nlay, fill_value, var_in, var_out) @@ -440,5 +670,27 @@ subroutine unpack_variable_broadband(ncol, nmaxlay, nlay, fill_value, var_in, va end subroutine unpack_variable_broadband + subroutine unpack_variable_spectral(ncol, nmaxlay, nlay, nspec, fill_value, var_in, var_out) + + integer(kind=jpim), intent(in) :: ncol, nmaxlay, nlay(:), nspec + real(kind=jprb), intent(in) :: fill_value + real(kind=jprb), intent(in) :: var_in(:,:) + real(kind=jprb), intent(out) :: var_out(nspec,nmaxlay,ncol) + + integer :: jcol, jlay, itotlay + + var_out = fill_value + + itotlay = 1 + + do jcol = 1,ncol + do jlay = 1,nlay(jcol) + var_out(:,jlay,jcol) = var_in(:,itotlay) + itotlay = itotlay + 1 + end do + end do + + end subroutine unpack_variable_spectral + end module radsurf_save diff --git a/radsurf/radsurf_simple_spectrum.F90 b/radsurf/radsurf_simple_spectrum.F90 index 1fb271b..59b5c0a 100644 --- a/radsurf/radsurf_simple_spectrum.F90 +++ b/radsurf/radsurf_simple_spectrum.F90 @@ -21,7 +21,7 @@ subroutine calc_simple_spectrum_lw(config, canopy_props, lw_spectral_props, & & istartcol, iendcol) use parkind1, only : jpim, jprb - use yomhook, only : lhook, dr_hook + !use yomhook, only : lhook, dr_hook use radiation_io, only : radiation_abort use radsurf_config, only : config_type use radsurf_canopy_properties, only : canopy_properties_type diff --git a/radsurf/radsurf_simple_urban_lw.F90 b/radsurf/radsurf_simple_urban_lw.F90 new file mode 100644 index 0000000..0dd97a8 --- /dev/null +++ b/radsurf/radsurf_simple_urban_lw.F90 @@ -0,0 +1,260 @@ +! radsurf_simple_urban_lw.F90 - Longwave solver for unvegetated single-layer urban canopy +! +! (C) Copyright 2021- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +! Author: Robin Hogan +! Email: r.j.hogan@ecmwf.int +! + +module radsurf_simple_urban_lw + +contains + + ! -------------------------------------------------------- + ! Single-layer solar urban radiative transfer (i.e. the assumption + ! that all buildings are the same height) using the Harman et + ! al. (BLM 2004) method of solving a 2x2 matrix problem, but with + ! the option of two different models for urban geometry: the + ! original "infinite street" of constant width, and the more recent + ! "exponential model" for the distribution of wall-to-wall + ! separation distances + subroutine simple_urban_lw(config, is_infinite_street, & + & nlw, icol, ilay, & + & canopy_props, lw_spectral_props, & + & top_emissivity, top_emission, & + & lw_internal, lw_norm) + + use parkind1, only : jpim, jprb + use yomhook, only : lhook, dr_hook + use radiation_io, only : radiation_abort + use radsurf_config, only : config_type + use radsurf_canopy_properties, only : canopy_properties_type + use radsurf_lw_spectral_properties, only : lw_spectral_properties_type + use radsurf_canopy_flux, only : canopy_flux_type + use radiation_constants, only : Pi + use radsurf_norm_perim, only : calc_norm_perim_urban + use radsurf_view_factor, only : calc_view_factors_inf, & + & calc_view_factors_exp + use radtool_matrix, only : solve_vec + + implicit none + + ! Inputs + + ! Algorithm configuration + type(config_type), intent(in) :: config + ! Do we use the infinite-street or exponential model? + logical, intent(in) :: is_infinite_street + ! Number of spectral intervals + integer(kind=jpim), intent(in) :: nlw + ! Index of current column and layer + integer(kind=jpim), intent(in) :: icol, ilay + ! Geometric and other spectrally independent properties of the canopy + type(canopy_properties_type), intent(in) :: canopy_props + ! Spectral properties of the air, vegetation and urban facets + type(lw_spectral_properties_type), intent(in) :: lw_spectral_props + + ! Outputs + + ! Top-of-canopy spectral emissivity and emission (W m-2) + real(kind=jprb), dimension(nlw),intent(out):: top_emissivity, & + & top_emission + ! Flux outputs + type(canopy_flux_type), intent(inout), optional & + & :: lw_internal, & ! LW fluxes from internal emission + & lw_norm ! LW fluxes normalized by top-of-canopy diffuse + + ! Local variables + + ! view_A_B is the fraction of radiaion emanating from facet A that + ! intercepts facet B + real(kind=jprb) :: view_ground_sky, view_wall_wall + real(kind=jprb) :: view_wall_ground, view_ground_wall + + ! Normalized perimeter length between regions (unused), and + ! between air and walls (m-1) + real(jprb) :: norm_perim(1), norm_perim_wall(1) + + ! Dummy variables for calc_norm_perim_urban + real(kind=jprb) :: veg_fraction(1), veg_scale(1), veg_contact_fraction(1) + + ! The "X" in Hogan (BLM 2019a, exponential), metres + real(kind=jprb) :: building_separation_scale + + ! The street width in the infinite-street assumption, metres + real(kind=jprb) :: street_width + + ! Fundamentally the Harman et al. (BLM 2004) method solves a 2x2 + ! matrix problem of the form + ! interaction_matrix*solution_vector=source_vector, which here + ! includes an additional dimension for the number of spectral + ! intervals + real(kind=jprb) :: interaction_matrix(nlw,2,2) + real(kind=jprb) :: solution_vector(nlw,2), source_vector(nlw,2) + + real(jprb) :: hook_handle + + if (lhook) call dr_hook('radsurf_simple_urban_lw:simple_urban_lw',0,hook_handle) + + associate( & + & dz => canopy_props%dz(ilay), & + & building_fraction => canopy_props%building_fraction(ilay), & + & building_scale => canopy_props%building_scale(ilay), & + & ground_emissivity => lw_spectral_props%ground_emissivity(:,icol), & + & ground_emission => lw_spectral_props%ground_emission(:,icol), & + & roof_emissivity => lw_spectral_props%roof_emissivity(:,ilay), & + & roof_emission => lw_spectral_props%roof_emission(:,ilay), & + & wall_emissivity => lw_spectral_props%wall_emissivity(:,ilay), & + & wall_emission => lw_spectral_props%wall_emission(:,ilay) ) + + ! Compute normalized perimeter length of walls, noting that + ! calc_norm_perim_urban accepts vectors of inputs but we only + ! want to compute a single value, and dummy values are entered + ! for the unused vegetation variables + veg_fraction = 0.0_jprb + veg_scale = 1.0_jprb + veg_contact_fraction = 0.0_jprb + call calc_norm_perim_urban(config, 1, 1, spread(building_fraction,1,1), & + & spread(building_scale,1,1), veg_fraction, veg_scale, & + & veg_contact_fraction, norm_perim, norm_perim_wall) + + ! Compute length scales and view factors + if (is_infinite_street) then + ! Hogan (BLM 2019b, radiative transfer), Eq. 7 + street_width = 2.0_jprb * (1.0_jprb - building_fraction) / norm_perim_wall(1) + call calc_view_factors_inf(dz / street_width, & + & view_ground_sky, view_wall_wall); + else + ! Hogan (BLM 2019b, radiative transfer), Eq. 8 + building_separation_scale = Pi * (1.0_jprb - building_fraction) & + & / norm_perim_wall(1) + call calc_view_factors_exp(dz / building_separation_scale, & + & view_ground_sky, view_wall_wall); + end if + + ! Compute extra view factors + view_wall_ground = 0.5_jprb * (1.0_jprb - view_wall_wall) + view_ground_wall = 1.0_jprb - view_ground_sky + + ! Set to the flux components to zero initially + call lw_norm%zero(icol, ilay, ilay) + call lw_internal%zero( icol, ilay, ilay) + + ! First the fluxes due to internal emission + + ! The elements of the interaction matrix are common for direct + ! and diffuse input fluxes + interaction_matrix(:,1,1) = 1.0_jprb + interaction_matrix(:,1,2) = -view_wall_ground*(1.0_jprb-wall_emissivity) + interaction_matrix(:,2,1) = -view_ground_wall*(1.0_jprb-ground_emissivity) + interaction_matrix(:,2,2) = 1.0_jprb - view_wall_wall*(1.0_jprb-ground_emissivity) + + ! Incoming radiation at ground and walls due to emission from + ! the other facet + source_vector(:,1) = view_wall_ground * wall_emission * norm_perim_wall(1) * dz + source_vector(:,2) = view_ground_wall * ground_emission * (1.0_jprb-building_fraction) & + & + view_wall_wall * wall_emission * norm_perim_wall(1) * dz + + ! Solve 2x2 matrix problem + solution_vector = solve_vec(nlw,nlw,2,interaction_matrix,source_vector) + + ! Ground fluxes + lw_internal%ground_dn(:,icol) = solution_vector(:,1) + lw_internal%ground_net(:,icol) & + & = solution_vector(:,1) * ground_emissivity & + & - ground_emission * (1.0_jprb - building_fraction) + ! vertical flux??? + + ! Roof fluxes + lw_internal%roof_in(:,ilay) = 0.0_jprb + lw_internal%roof_net(:,ilay) = - building_fraction * roof_emission + + ! Wall fluxes + lw_internal%wall_in(:,ilay) = solution_vector(:,2) + lw_internal%wall_net(:,ilay) & + & = solution_vector(:,2) * wall_emissivity & + & - wall_emission * norm_perim_wall(1) * dz + + ! Top-of-canopy fluxes + lw_internal%top_dn(:,icol) = 0.0_jprb + lw_internal%top_net(:,icol) = - building_fraction*roof_emission & + & - (lw_internal%ground_dn(:,ilay) - lw_internal%ground_net(:,ilay)) & + & * view_ground_sky & + & - (lw_internal%wall_in(:,ilay) - lw_internal%wall_net(:,ilay)) & + & * view_wall_ground + + ! Flux "profiles" + if (allocated(lw_internal%flux_dn_layer_top)) then + lw_internal%flux_dn_layer_top(:,ilay) = 0.0_jprb + lw_internal%flux_up_layer_top(:,ilay) & + & = (lw_internal%ground_dn(:,ilay) - lw_internal%ground_net(:,ilay)) & + & * view_ground_sky & + & + (lw_internal%wall_in(:,ilay) - lw_internal%wall_net(:,ilay)) & + & * view_wall_ground + lw_internal%flux_dn_layer_base(:,ilay) = lw_internal%ground_dn(:,ilay) + lw_internal%flux_up_layer_base(:,ilay) & + & = lw_internal%ground_dn(:,ilay) - lw_internal%ground_net(:,ilay) + end if + + ! Second the fluxes normalized by the diffuse downwelling flux + ! at canopy top. + + ! Incoming radiation at ground and walls due to incoming diffuse + ! radiation at top-of-canopy + source_vector(:,1) = view_ground_sky * (1.0_jprb-building_fraction) + source_vector(:,2) = view_ground_wall* (1.0_jprb-building_fraction) + + ! Solve 2x2 matrix problem + solution_vector = solve_vec(nlw,nlw,2,interaction_matrix,source_vector) + + ! Ground fluxes + lw_norm%ground_dn(:,ilay) = solution_vector(:,1) + lw_norm%ground_net(:,ilay) & + & = lw_norm%ground_dn(:,ilay) * ground_emissivity + ! vertical flux??? + + ! Roof fluxes + lw_norm%roof_in(:,ilay) = building_fraction + lw_norm%roof_net(:,ilay) = building_fraction * roof_emissivity + + ! Wall fluxes + lw_norm%wall_in(:,ilay) = solution_vector(:,2) + lw_norm%wall_net(:,ilay) & + & = lw_norm%wall_in(:,ilay) * wall_emissivity + + ! Top-of-canopy fluxes + lw_norm%top_dn(:,icol) = 1.0_jprb + lw_norm%top_net(:,icol) = 1.0_jprb - building_fraction*(1.0_jprb-roof_emissivity) & + & - (lw_norm%ground_dn(:,ilay) - lw_norm%ground_net(:,ilay)) & + & * view_ground_sky & + & - (lw_norm%wall_in(:,ilay) - lw_norm%wall_net(:,ilay)) & + & * view_wall_ground + + ! Flux "profiles" + if (allocated(lw_norm%flux_dn_layer_top)) then + lw_norm%flux_dn_layer_top(:,ilay) = 1.0_jprb - building_fraction + lw_norm%flux_up_layer_top(:,ilay) & + & = (lw_norm%ground_dn(:,ilay) - lw_norm%ground_net(:,ilay)) & + & * view_ground_sky & + & + (lw_norm%wall_in(:,ilay) - lw_norm%wall_net(:,ilay)) & + & * view_wall_ground + lw_norm%flux_dn_layer_base(:,ilay) = lw_norm%ground_dn(:,ilay) + lw_norm%flux_up_layer_base(:,ilay) & + & = lw_norm%ground_dn(:,ilay) - lw_norm%ground_net(:,ilay) + end if + + end associate + + if (lhook) call dr_hook('radsurf_simple_urban_lw:simple_urban_lw',1,hook_handle) + + end subroutine simple_urban_lw + + +end module radsurf_simple_urban_lw diff --git a/radsurf/radsurf_simple_urban_sw.F90 b/radsurf/radsurf_simple_urban_sw.F90 new file mode 100644 index 0000000..42d1539 --- /dev/null +++ b/radsurf/radsurf_simple_urban_sw.F90 @@ -0,0 +1,297 @@ +! radsurf_simple_urban_sw.F90 - Shortwave solver for unvegetated single-layer urban canopy +! +! (C) Copyright 2021- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +! Author: Robin Hogan +! Email: r.j.hogan@ecmwf.int +! + +module radsurf_simple_urban_sw + +contains + + ! -------------------------------------------------------- + ! Single-layer solar urban radiative transfer (i.e. the assumption + ! that all buildings are the same height) using the Harman et + ! al. (BLM 2004) method of solving a 2x2 matrix problem, but with + ! the option of two different models for urban geometry: the + ! original "infinite street" of constant width, and the more recent + ! "exponential model" for the distribution of wall-to-wall + ! separation distances + subroutine simple_urban_sw(config, is_infinite_street, & + & nsw, icol, ilay, cos_sza, & + & canopy_props, sw_spectral_props, & + & ground_albedo_diff, ground_albedo_dir, & + & top_albedo_diff, top_albedo_dir, & + & sw_norm_dir, sw_norm_diff) + + use parkind1, only : jpim, jprb + use yomhook, only : lhook, dr_hook + use radiation_io, only : radiation_abort + use radsurf_config, only : config_type + use radsurf_canopy_properties, only : canopy_properties_type + use radsurf_sw_spectral_properties, only : sw_spectral_properties_type + use radsurf_canopy_flux, only : canopy_flux_type + use radiation_constants, only : Pi + use radsurf_norm_perim, only : calc_norm_perim_urban + use radsurf_view_factor, only : calc_view_factors_inf, & + & calc_view_factors_exp + use radtool_matrix, only : solve_vec + + implicit none + + ! Inputs + + ! Algorithm configuration + type(config_type), intent(in) :: config + ! Do we use the infinite-street or exponential model? + logical, intent(in) :: is_infinite_street + ! Number of spectral intervals + integer(kind=jpim), intent(in) :: nsw + ! Index of current column and layer + integer(kind=jpim), intent(in) :: icol, ilay + ! Cosine of the solar zenith angle + real(kind=jprb), intent(in) :: cos_sza + ! Geometric and other spectrally independent properties of the canopy + type(canopy_properties_type), intent(in) :: canopy_props + ! Spectral properties of the air, vegetation and urban facets + type(sw_spectral_properties_type), intent(in) :: sw_spectral_props + ! Spectral albedo of the ground to diffuse and direct radiation + real(kind=jprb), dimension(nsw),intent(in) :: ground_albedo_diff, & + & ground_albedo_dir + + ! Outputs + + ! Top-of-canopy spectral albedo to diffuse and direct radiation + real(kind=jprb), dimension(nsw),intent(out):: top_albedo_diff, & + & top_albedo_dir + ! Flux outputs + type(canopy_flux_type), intent(inout), optional & + & :: sw_norm_dir, & ! SW fluxes normalized by top-of-canopy direct + & sw_norm_diff ! SW fluxes normalized by top-of-canopy diffuse + + ! Local variables + + ! view_A_B is the fraction of radiaion emanating from facet A that + ! intercepts facet B, where "dir" is direct radiation emanating + ! from the sky and all other "A" facets refer to diffuse radiation + real(kind=jprb) :: view_dir_ground, view_dir_wall + real(kind=jprb) :: view_ground_sky, view_wall_wall + real(kind=jprb) :: view_wall_ground, view_ground_wall + + ! Normalized perimeter length between regions (unused), and + ! between air and walls (m-1) + real(jprb) :: norm_perim(1), norm_perim_wall(1) + + ! Dummy variables for calc_norm_perim_urban + real(kind=jprb) :: veg_fraction(1), veg_scale(1), veg_contact_fraction(1) + + ! The "X" in Hogan (BLM 2019a, exponential), metres + real(kind=jprb) :: building_separation_scale + + ! The street width in the infinite-street assumption, metres + real(kind=jprb) :: street_width + + ! Tangent of solar zenith angle + real(kind=jprb) :: tan_sza + + ! Fundamentally the Harman et al. (BLM 2004) method solves a 2x2 + ! matrix problem of the form + ! interaction_matrix*solution_vector=source_vector, which here + ! includes an additional dimension for the number of spectral + ! intervals + real(kind=jprb) :: interaction_matrix(nsw,2,2) + real(kind=jprb) :: solution_vector(nsw,2), source_vector(nsw,2) + + real(jprb) :: hook_handle + + if (lhook) call dr_hook('radsurf_simple_urban_sw:simple_urban_sw',0,hook_handle) + + associate( & + & dz => canopy_props%dz(ilay), & + & building_fraction => canopy_props%building_fraction(ilay), & + & building_scale => canopy_props%building_scale(ilay), & + & roof_albedo => sw_spectral_props%roof_albedo(:,ilay), & + & wall_albedo => sw_spectral_props%wall_albedo(:,ilay), & + & wall_specular_frac => sw_spectral_props%wall_specular_frac(:,ilay)) + + ! Compute normalized perimeter length of walls, noting that + ! calc_norm_perim_urban accepts vectors of inputs but we only + ! want to compute a single value, and dummy values are entered + ! for the unused vegetation variables + veg_fraction = 0.0_jprb + veg_scale = 1.0_jprb + veg_contact_fraction = 0.0_jprb + call calc_norm_perim_urban(config, 1, 1, spread(building_fraction,1,1), & + & spread(building_scale,1,1), veg_fraction, veg_scale, & + & veg_contact_fraction, norm_perim, norm_perim_wall) + + ! Compute length scales and view factors + if (is_infinite_street) then + ! Hogan (BLM 2019b, radiative transfer), Eq. 7 + street_width = 2.0_jprb * (1.0_jprb - building_fraction) / norm_perim_wall(1) + call calc_view_factors_inf(dz / street_width, & + & view_ground_sky, view_wall_wall, & + & cos_sza=cos_sza, view_dir_ground=view_dir_ground); + else + ! Hogan (BLM 2019b, radiative transfer), Eq. 8 + building_separation_scale = Pi * (1.0_jprb - building_fraction) & + & / norm_perim_wall(1) + call calc_view_factors_exp(dz / building_separation_scale, & + & view_ground_sky, view_wall_wall, & + & cos_sza=cos_sza, view_dir_ground=view_dir_ground); + end if + + ! Compute extra view factors + view_dir_wall = 1.0_jprb - view_dir_ground + view_wall_ground = 0.5_jprb * (1.0_jprb - view_wall_wall) + view_ground_wall = 1.0_jprb - view_ground_sky + + ! Set to the flux components to zero initially + call sw_norm_diff%zero(icol, ilay, ilay) + call sw_norm_dir%zero( icol, ilay, ilay) + + ! First the fluxes normalized by the direct downwelling flux at + ! canopy top. + + ! The elements of the interaction matrix are common for direct + ! and diffuse input fluxes + interaction_matrix(:,1,1) = 1.0_jprb + interaction_matrix(:,1,2) = -view_wall_ground*wall_albedo + interaction_matrix(:,2,1) = -view_ground_wall*ground_albedo_diff + interaction_matrix(:,2,2) = 1.0_jprb - view_wall_wall*wall_albedo + + ! Incoming radiation at ground and walls due to incoming direct + ! radiation at top-of-canopy. Note that because the ground + ! albedo is separated into diffuse and direct parts, but the + ! wall albedo is not, we cannot solve for the sum of these terms + ! at the ground. Rather, solution_vector(:,1) is the diffuse + ! downwelling flux at the ground, while solution_vector(:,2) is + ! the total flux (direct plus diffuse) into the walls. Thus, the + ! source into the walls (source_vector(:,2)) contains the direct + ! flux into the walls plus the direct flux incident on the + ! ground and scattered once into the walls. + source_vector(:,1) = 0.0_jprb + source_vector(:,2) = (view_dir_wall + ground_albedo_dir*view_dir_ground*view_ground_wall) & + * (1.0_jprb-building_fraction) + + ! Solve 2x2 matrix problem + solution_vector = solve_vec(nsw,nsw,2,interaction_matrix,source_vector) + + ! Ground fluxes + sw_norm_dir%ground_dn_dir(:,icol) = view_dir_ground & + * (1.0_jprb-building_fraction) + sw_norm_dir%ground_dn(:,icol) = sw_norm_dir%ground_dn_dir(:,icol) + solution_vector(:,1) + sw_norm_dir%ground_net(:,icol) & + & = sw_norm_dir%ground_dn_dir(:,ilay) * (1.0_jprb-ground_albedo_dir) & + & + solution_vector(:,1) * (1.0_jprb-ground_albedo_diff) + sw_norm_dir%ground_sunlit_frac(icol) = view_dir_ground + ! vertical flux??? + + ! Roof fluxes + sw_norm_dir%roof_in_dir(:,ilay) = building_fraction + sw_norm_dir%roof_in(:,ilay) = building_fraction + sw_norm_dir%roof_net(:,ilay) = building_fraction * (1.0_jprb-roof_albedo) + sw_norm_dir%roof_sunlit_frac(ilay) = 1.0_jprb + + ! Wall fluxes + sw_norm_dir%wall_in_dir(:,ilay) = view_dir_wall & + * (1.0_jprb-building_fraction) + sw_norm_dir%wall_in(:,ilay) = solution_vector(:,2) + sw_norm_dir%wall_net(:,ilay) & + & = sw_norm_dir%wall_in(:,ilay) * (1.0_jprb-wall_albedo) + tan_sza = sqrt(1.0_jprb / (cos_sza*cos_sza) - 1.0_jprb) + sw_norm_dir%wall_sunlit_frac(ilay) = 0.5_jprb * view_dir_wall & + & / (max(tan_sza,1.0e-6_jprb) * norm_perim_wall(1)*dz & + & / (Pi*(1.0_jprb - building_fraction))) + + ! Top-of-canopy fluxes + sw_norm_dir%top_dn_dir(:,icol) = 1.0_jprb + sw_norm_dir%top_dn(:,icol) = 1.0_jprb + sw_norm_dir%top_net(:,icol) = 1.0_jprb - building_fraction*roof_albedo & + & - (sw_norm_dir%ground_dn(:,ilay) - sw_norm_dir%ground_net(:,ilay)) & + & * view_ground_sky & + & - (sw_norm_dir%wall_in(:,ilay) - sw_norm_dir%wall_net(:,ilay)) & + & * view_wall_ground + + ! Flux "profiles" + if (allocated(sw_norm_dir%flux_dn_layer_top)) then + sw_norm_dir%flux_dn_dir_layer_top(:,ilay) = (1.0_jprb-building_fraction) + sw_norm_dir%flux_dn_layer_top(:,ilay) = (1.0_jprb-building_fraction) + sw_norm_dir%flux_up_layer_top(:,ilay) & + & = (sw_norm_dir%ground_dn(:,ilay) - sw_norm_dir%ground_net(:,ilay)) & + & * view_ground_sky & + & + (sw_norm_dir%wall_in(:,ilay) - sw_norm_dir%wall_net(:,ilay)) & + & * view_wall_ground + sw_norm_dir%flux_dn_dir_layer_base(:,ilay) = sw_norm_dir%ground_dn_dir(:,ilay) + sw_norm_dir%flux_dn_layer_base(:,ilay) = sw_norm_dir%ground_dn(:,ilay) + sw_norm_dir%flux_up_layer_base(:,ilay) & + & = sw_norm_dir%ground_dn(:,ilay) - sw_norm_dir%ground_net(:,ilay) + end if + + ! Second the fluxes normalized by the diffuse downwelling flux + ! at canopy top. + + ! Incoming radiation at ground and walls due to incoming diffuse + ! radiation at top-of-canopy. This time we do not need to + ! separate the incoming and scattered radiation at the surface, + ! so solution_vector(:,1) is the total flux into the ground. + source_vector(:,1) = view_ground_sky * (1.0_jprb-building_fraction) + source_vector(:,2) = view_ground_wall* (1.0_jprb-building_fraction) + + ! Solve 2x2 matrix problem + solution_vector = solve_vec(nsw,nsw,2,interaction_matrix,source_vector) + + ! Ground fluxes + sw_norm_diff%ground_dn_dir(:,ilay) = 0.0_jprb + sw_norm_diff%ground_dn(:,ilay) = solution_vector(:,1) + sw_norm_diff%ground_net(:,ilay) & + & = sw_norm_diff%ground_dn(:,ilay) * (1.0_jprb-ground_albedo_diff) + ! vertical flux??? + + ! Roof fluxes + sw_norm_diff%roof_in(:,ilay) = building_fraction + sw_norm_diff%roof_net(:,ilay) = building_fraction * (1.0_jprb-roof_albedo) + + ! Wall fluxes + sw_norm_diff%wall_in(:,ilay) = solution_vector(:,2) + sw_norm_diff%wall_net(:,ilay) & + & = sw_norm_diff%wall_in(:,ilay) * (1.0_jprb-wall_albedo) + + ! Top-of-canopy fluxes + sw_norm_diff%top_dn_dir(:,icol) = 0.0_jprb + sw_norm_diff%top_dn(:,icol) = 1.0_jprb + sw_norm_diff%top_net(:,icol) = 1.0_jprb - building_fraction*roof_albedo & + & - (sw_norm_diff%ground_dn(:,ilay) - sw_norm_diff%ground_net(:,ilay)) & + & * view_ground_sky & + & - (sw_norm_diff%wall_in(:,ilay) - sw_norm_diff%wall_net(:,ilay)) & + & * view_wall_ground + + ! Flux "profiles" + if (allocated(sw_norm_diff%flux_dn_layer_top)) then + sw_norm_diff%flux_dn_layer_top(:,ilay) = (1.0_jprb-building_fraction) + sw_norm_diff%flux_up_layer_top(:,ilay) & + & = (sw_norm_diff%ground_dn(:,ilay) - sw_norm_diff%ground_net(:,ilay)) & + & * view_ground_sky & + & + (sw_norm_diff%wall_in(:,ilay) - sw_norm_diff%wall_net(:,ilay)) & + & * view_wall_ground + sw_norm_diff%flux_dn_layer_base(:,ilay) = sw_norm_diff%ground_dn(:,ilay) + sw_norm_diff%flux_up_layer_base(:,ilay) & + & = sw_norm_diff%ground_dn(:,ilay) - sw_norm_diff%ground_net(:,ilay) + end if + + end associate + + if (lhook) call dr_hook('radsurf_simple_urban_sw:simple_urban_sw',1,hook_handle) + + end subroutine simple_urban_sw + + +end module radsurf_simple_urban_sw diff --git a/radsurf/radsurf_sw_spectral_properties.F90 b/radsurf/radsurf_sw_spectral_properties.F90 index 3d0d7ba..28b8d49 100644 --- a/radsurf/radsurf_sw_spectral_properties.F90 +++ b/radsurf/radsurf_sw_spectral_properties.F90 @@ -59,7 +59,8 @@ subroutine allocate_spectral(this, config, ncol, ntotlay, nspec, & use radsurf_config, only : config_type use radsurf_canopy_properties, only : ITileFlat, ITileForest, & - & ITileUrban, ITileVegetatedUrban + & ITileUrban, ITileVegetatedUrban, & + & ITileSimpleUrban, ITileInfiniteStreet class(sw_spectral_properties_type), intent(inout) :: this type(config_type), intent(in) :: config @@ -86,7 +87,9 @@ subroutine allocate_spectral(this, config, ncol, ntotlay, nspec, & do_vegetation = .false. end if if (.not. any(i_representation == ITileUrban & - & .or. i_representation == ITileVegetatedUrban)) then + & .or. i_representation == ITileVegetatedUrban & + & .or. i_representation == ITileSimpleUrban & + & .or. i_representation == ITileInfiniteStreet)) then do_urban = .false. end if end if diff --git a/radsurf/radsurf_urban_lw.F90 b/radsurf/radsurf_urban_lw.F90 index 00af83e..d898edd 100644 --- a/radsurf/radsurf_urban_lw.F90 +++ b/radsurf/radsurf_urban_lw.F90 @@ -54,6 +54,7 @@ subroutine spartacus_urban_lw(config, & & rect_mat_x_expandedmat, rect_expandedmat_x_vec, solve_vec, & & solve_rect_mat, rect_mat_x_singlemat, rect_singlemat_x_vec use radsurf_overlap, only : calc_overlap_matrices_urban + use radsurf_norm_perim, only : calc_norm_perim_urban !#define PRINT_ARRAYS 1 @@ -125,21 +126,17 @@ subroutine spartacus_urban_lw(config, & ! Normalized vegetation perimeter length (perimeter length divided ! by domain area), m-1. If nreg=2 then there is a clear-sky and a - ! vegetation region, and norm_perim(1) is the normalized length - ! between the two regions, while norm_perim(2) is unused. If - ! nreg=3 then region 1 is clear-sky, region 2 is low optical depth - ! vegetation and region 3 is high optical depth - ! vegetation. norm_perim(1) is the normalized length between - ! regions 1 and 2, norm_perim(2) is that between regions 2 and 3, - ! and norm_perim(3) is that between regions 3 and 1. - real(kind=jprb) :: norm_perim(nreg) + ! vegetation region, and norm_perim(1,jlay) is the normalized + ! length between the two regions, while norm_perim(2,jlay) is + ! unused. If nreg=3 then region 1 is clear-sky, region 2 is low + ! optical depth vegetation and region 3 is high optical depth + ! vegetation. norm_perim(1,jlay) is the normalized length between + ! regions 1 and 2, norm_perim(2,jlay) is that between regions 2 + ! and 3, and norm_perim(3,jlay) is that between regions 3 and 1. + real(kind=jprb) :: norm_perim(nreg,nlay) ! Normalized perimeter between each region and the wall, m-1. - real(kind=jprb) :: norm_perim_wall(nreg) - - ! Normalized perimeter length between air or wall and any - ! vegetation, m-1 - real(kind=jprb) :: norm_perim_air_veg, norm_perim_wall_veg + real(kind=jprb) :: norm_perim_wall(nreg,nlay) ! Rate of exchange between regions, excluding the tangent term, ! where the dimensions are in the sense of @@ -282,6 +279,15 @@ subroutine spartacus_urban_lw(config, & call print_array3('v_overlap',v_overlap) #endif + ! Compute normalized lengths + call calc_norm_perim_urban(config,nlay,nreg, & + & canopy_props%building_fraction(ilay1:ilay2), & + & canopy_props%building_scale(ilay1:ilay2), & + & canopy_props%veg_fraction(ilay1:ilay2), & + & canopy_props%veg_scale(ilay1:ilay2), & + & canopy_props%veg_contact_fraction(ilay1:ilay2), & + & norm_perim, norm_perim_wall) + ! -------------------------------------------------------- ! Section 3: First loop over layers ! -------------------------------------------------------- @@ -340,102 +346,6 @@ subroutine spartacus_urban_lw(config, & end if - norm_perim = 0.0_jprb - if (nreg > 1) then - associate (veg_fraction => canopy_props%veg_fraction(ilay1:ilay2)) - if (veg_fraction(jlay) > config%min_vegetation_fraction) then - ! Compute the normalized vegetation perimeter length - associate (veg_scale => canopy_props%veg_scale(ilay1:ilay2)) - if (config%use_symmetric_vegetation_scale_urban) then - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) & - & * max(0.0_jprb, 1.0_jprb - veg_fraction(jlay) - building_fraction(jlay)) & - & / veg_scale(jlay) - else - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) - end if - end associate - - norm_perim_air_veg = norm_perim(1) - - if (nreg > 2) then - ! Share the clear-air/vegetation perimeter between the two - ! vegetated regions - norm_perim(nreg) = config%vegetation_isolation_factor_urban * norm_perim(1) - norm_perim(1) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * norm_perim(1) - ! We assume that the horizontal scale of the vegetation - ! inhomogeneities is the same as the scale of the tree - ! crowns themselves. Therefore, to compute the interface - ! between the two vegetated regions, we use the same - ! formula as before but with the fraction associated - ! with one of the two vegetated regions, which is half - ! the total vegetation fraction. - associate (veg_scale => canopy_props%veg_scale(ilay1:ilay2)) - if (config%use_symmetric_vegetation_scale_urban) then - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & - & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay))) & - & / veg_scale(jlay) - else - ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) - ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) - end if - end associate - else - ! Only one vegetated region so the other column of - ! norm_perim is unused - norm_perim(2:) = 0.0_jprb - end if - end if - end associate - end if - - ! Compute the normalized length of the interface between each - ! region and a building wall - norm_perim_wall = 0.0_jprb - if (building_fraction(jlay) > config%min_building_fraction) then - norm_perim_wall(1) = 4.0_jprb * building_fraction(jlay) / building_scale(jlay) - if (nreg > 1) then - associate ( veg_contact_fraction => canopy_props%veg_contact_fraction(ilay1:ilay2) ) - if (veg_contact_fraction(jlay) > 0.0_jprb) then - ! Compute normalized length of interface between wall - ! and any vegetation - norm_perim_wall_veg = min(norm_perim_air_veg*veg_contact_fraction(jlay), & - & norm_perim_wall(1)) - if (nreg == 2) then - norm_perim_wall(2) = norm_perim_wall_veg - norm_perim(1) = norm_perim(1) - norm_perim_wall_veg - else - norm_perim_wall(2) = norm_perim_wall_veg & - & * (1.0_jprb - config%vegetation_isolation_factor_urban) - norm_perim(1) = norm_perim(1) - norm_perim_wall(2) - norm_perim_wall(3) = norm_perim_wall_veg & - & * config%vegetation_isolation_factor_urban - norm_perim(3) = norm_perim(3) - norm_perim_wall(3) - end if - ! Reduce length of interface between wall and clear-air - norm_perim_wall(1) = norm_perim_wall(1) - norm_perim_wall_veg - else if (frac(1,jlay) <= config%min_vegetation_fraction) then - ! There is no clear region (region 1), so all walls must - ! be in contact with vegetation (region 2 and possibly - ! 3) - if (nreg == 2) then - norm_perim_wall(2) = norm_perim_wall(1) - else - norm_perim_wall(2) = norm_perim_wall(1) & - & * (1.0_jprb - config%vegetation_isolation_factor_urban) - norm_perim_wall(3) = norm_perim_wall(1) & - & * config%vegetation_isolation_factor_urban - end if - norm_perim_wall(1) = 0.0_jprb - end if - end associate - end if - end if - ! Compute the rates of exchange between regions, excluding the ! tangent term f_exchange = 0.0_jprb @@ -445,18 +355,18 @@ subroutine spartacus_urban_lw(config, & f_exchange(jreg+1,jreg) = 0.0_jprb f_exchange(jreg,jreg+1) = 0.0_jprb else - f_exchange(jreg+1,jreg) = norm_perim(jreg) / (Pi * frac(jreg,jlay)) - f_exchange(jreg,jreg+1) = norm_perim(jreg) / (Pi * frac(jreg+1,jlay)) + f_exchange(jreg+1,jreg) = norm_perim(jreg,jlay) / (Pi * frac(jreg,jlay)) + f_exchange(jreg,jreg+1) = norm_perim(jreg,jlay) / (Pi * frac(jreg+1,jlay)) end if end do - if (nreg > 2 .and. norm_perim(nreg) > 0.0_jprb) then + if (nreg > 2 .and. norm_perim(nreg,jlay) > 0.0_jprb) then if (frac(3,jlay) <= config%min_vegetation_fraction & & .or. frac(1,jlay) <= config%min_vegetation_fraction) then f_exchange(1,3) = 0.0_jprb f_exchange(3,1) = 0.0_jprb else - f_exchange(1,3) = norm_perim(jreg) / (Pi * frac(3,jlay)) - f_exchange(3,1) = norm_perim(jreg) / (Pi * frac(1,jlay)) + f_exchange(1,3) = norm_perim(jreg,jlay) / (Pi * frac(3,jlay)) + f_exchange(3,1) = norm_perim(jreg,jlay) / (Pi * frac(1,jlay)) end if end if @@ -466,7 +376,7 @@ subroutine spartacus_urban_lw(config, & if (frac(jreg,jlay) <= config%min_vegetation_fraction) then f_wall(jreg,jlay) = 0.0_jprb else - f_wall(jreg,jlay) = norm_perim_wall(jreg) * lg%vadjustment2 & + f_wall(jreg,jlay) = norm_perim_wall(jreg,jlay) * lg%vadjustment2 & & / (Pi * frac(jreg,jlay)) end if end do @@ -538,7 +448,7 @@ subroutine spartacus_urban_lw(config, & do jreg = 1,nreg volume_emiss = frac(jreg,jlay) * (ext_reg(:,jreg) * (1.0_jprb - ssa_reg(:,jreg)) & & * planck_reg(:,jreg)) - wall_emiss = norm_perim_wall(jreg) * lg%vadjustment & + wall_emiss = norm_perim_wall(jreg,jlay) * lg%vadjustment & & * wall_emission(:,jlay) do js = 1,ns ifr = js + (jreg-1)*ns @@ -563,7 +473,7 @@ subroutine spartacus_urban_lw(config, & end if end do - emiss_wall(:,jlay) = (sum(norm_perim_wall) * lg%vadjustment) * wall_emission(:,jlay) + emiss_wall(:,jlay) = (sum(norm_perim_wall(:,jlay)) * lg%vadjustment) * wall_emission(:,jlay) #ifdef PRINT_ARRAYS @@ -572,7 +482,7 @@ subroutine spartacus_urban_lw(config, & call print_vector('ssa_reg',ssa_reg(1,:)) call print_matrix('f_exchange',f_exchange) call print_vector('norm_perim', norm_perim) - call print_vector('norm_perim_wall', norm_perim_wall) + call print_vector('norm_perim_wall', norm_perim_wall(:,jlay)) call print_matrix('gamma1',gamma1(1,:,:)) call print_matrix('gamma2',gamma2(1,:,:)) call print_vector('emiss_rate',emiss_rate(1,:)) @@ -790,7 +700,7 @@ subroutine spartacus_urban_lw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 lw_internal%clear_air_abs(:,ilay) = lw_internal%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,nlw,1), 2) & + & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,1,nlw), 2) & & - emiss_reg(:,1,jlay)*dz(jlay) if (do_vegetation) then associate ( veg_ext => canopy_props%veg_ext(ilay1:ilay2), & @@ -800,12 +710,12 @@ subroutine spartacus_urban_lw(config, & lw_internal%veg_air_abs(:,ilay) = lw_internal%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) & + & * spread(1.0_jprb/lg%mu,1,nlw), 2) & & - emiss_air(:,jreg,jlay)*dz(jlay) lw_internal%veg_abs(:,ilay) = lw_internal%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) * od_scaling(jreg,jlay) & + & * spread(1.0_jprb/lg%mu,1,nlw), 2) * od_scaling(jreg,jlay) & & - emiss_veg(:,jreg,jlay)*dz(jlay) end do end associate @@ -816,7 +726,7 @@ subroutine spartacus_urban_lw(config, & lw_internal%wall_in(:,ilay) = lw_internal%wall_in(:,ilay) & & + f_wall(jreg,jlay) & & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(lg%tan_ang,1,nlw)) + & * spread(lg%tan_ang,1,nlw),2) end do lw_internal%wall_net(:,ilay) = lw_internal%wall_in(:,ilay) & & * wall_emissivity(:,jlay) - emiss_wall(:,jlay)*dz(jlay) @@ -848,7 +758,7 @@ subroutine spartacus_urban_lw(config, & ! each spectral interval, so use the Legendre-Gauss horizontal ! weights flux_dn_above = 0.0_jprb - flux_dn_above(:,1:ns) = spread(lg%hweight,nlw,1) + flux_dn_above(:,1:ns) = spread(lg%hweight,1,nlw) lw_norm%top_dn(:,icol) = 1.0_jprb lw_norm%top_net(:,icol) = top_emissivity @@ -899,7 +809,7 @@ subroutine spartacus_urban_lw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 lw_norm%clear_air_abs(:,ilay) = lw_norm%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,nlw,1), 2) + & * sum(int_flux(:,1:ns) * spread(1.0_jprb/lg%mu,1,nlw), 2) if (do_vegetation) then associate ( veg_ext => canopy_props%veg_ext(ilay1:ilay2), & & veg_ssa => lw_spectral_props%veg_ssa(:,ilay1:ilay2) ) @@ -908,11 +818,11 @@ subroutine spartacus_urban_lw(config, & lw_norm%veg_air_abs(:,ilay) = lw_norm%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) + & * spread(1.0_jprb/lg%mu,1,nlw), 2) lw_norm%veg_abs(:,ilay) = lw_norm%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nlw,1), 2) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nlw), 2) * od_scaling(jreg,jlay) end do end associate end if @@ -922,7 +832,7 @@ subroutine spartacus_urban_lw(config, & lw_norm%wall_in(:,ilay) = lw_norm%wall_in(:,ilay) & & + f_wall(jreg,jlay) & & * (sum(int_flux(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(lg%tan_ang,1,nlw))) + & * spread(lg%tan_ang,1,nlw),2)) end do lw_norm%wall_net(:,ilay) = lw_norm%wall_in(:,ilay) & & * wall_emissivity(:,jlay) diff --git a/radsurf/radsurf_urban_sw.F90 b/radsurf/radsurf_urban_sw.F90 index be6e197..030aa77 100644 --- a/radsurf/radsurf_urban_sw.F90 +++ b/radsurf/radsurf_urban_sw.F90 @@ -56,6 +56,7 @@ subroutine spartacus_urban_sw(config, & & rect_mat_x_expandedmat, rect_expandedmat_x_vec, solve_vec, & & solve_rect_mat, rect_mat_x_singlemat, rect_singlemat_x_vec use radsurf_overlap, only : calc_overlap_matrices_urban + use radsurf_norm_perim, only : calc_norm_perim_urban !#define PRINT_ARRAYS 1 @@ -125,21 +126,17 @@ subroutine spartacus_urban_sw(config, & ! Normalized vegetation perimeter length (perimeter length divided ! by domain area), m-1. If nreg=2 then there is a clear-sky and a - ! vegetation region, and norm_perim(1) is the normalized length - ! between the two regions, while norm_perim(2) is unused. If - ! nreg=3 then region 1 is clear-sky, region 2 is low optical depth - ! vegetation and region 3 is high optical depth - ! vegetation. norm_perim(1) is the normalized length between - ! regions 1 and 2, norm_perim(2) is that between regions 2 and 3, - ! and norm_perim(3) is that between regions 3 and 1. - real(kind=jprb) :: norm_perim(nreg) + ! vegetation region, and norm_perim(1,jlay) is the normalized + ! length between the two regions, while norm_perim(2,jlay) is + ! unused. If nreg=3 then region 1 is clear-sky, region 2 is low + ! optical depth vegetation and region 3 is high optical depth + ! vegetation. norm_perim(1,jlay) is the normalized length between + ! regions 1 and 2, norm_perim(2,jlay) is that between regions 2 + ! and 3, and norm_perim(3,jlay) is that between regions 3 and 1. + real(kind=jprb) :: norm_perim(nreg,nlay) ! Normalized perimeter between each region and the wall, m-1. - real(kind=jprb) :: norm_perim_wall(nreg) - - ! Normalized perimeter length between air or wall and any - ! vegetation, m-1 - real(kind=jprb) :: norm_perim_air_veg, norm_perim_wall_veg + real(kind=jprb) :: norm_perim_wall(nreg,nlay) ! Tangent, sine of solar zenith angle real(kind=jprb) :: tan0, sin0 @@ -321,6 +318,15 @@ subroutine spartacus_urban_sw(config, & call print_array3('v_overlap',v_overlap) #endif + ! Compute normalized lengths + call calc_norm_perim_urban(config,nlay,nreg, & + & canopy_props%building_fraction(ilay1:ilay2), & + & canopy_props%building_scale(ilay1:ilay2), & + & canopy_props%veg_fraction(ilay1:ilay2), & + & canopy_props%veg_scale(ilay1:ilay2), & + & canopy_props%veg_contact_fraction(ilay1:ilay2), & + & norm_perim, norm_perim_wall) + ! -------------------------------------------------------- ! Section 3: First loop over layers ! -------------------------------------------------------- @@ -362,103 +368,6 @@ subroutine spartacus_urban_sw(config, & end associate end if - norm_perim = 0.0_jprb - if (nreg > 1) then - associate ( veg_fraction => canopy_props%veg_fraction(ilay1:ilay2) ) - if (veg_fraction(jlay) > config%min_vegetation_fraction) then - ! Compute the normalized vegetation perimeter length - associate (veg_scale => canopy_props%veg_scale(ilay1:ilay2)) - if (config%use_symmetric_vegetation_scale_urban) then - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) & - & * max(0.0_jprb, 1.0_jprb - veg_fraction(jlay) - building_fraction(jlay)) & - & / veg_scale(jlay) - else - norm_perim(1) = 4.0_jprb * veg_fraction(jlay) / veg_scale(jlay) - end if - end associate - norm_perim_air_veg = norm_perim(1) - - if (nreg > 2) then - ! Share the clear-air/vegetation perimeter between the two - ! vegetated regions - norm_perim(nreg) = config%vegetation_isolation_factor_urban * norm_perim(1) - norm_perim(1) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * norm_perim(1) - ! We assume that the horizontal scale of the vegetation - ! inhomogeneities is the same as the scale of the tree - ! crowns themselves. Therefore, to compute the interface - ! between the two vegetated regions, we use the same - ! formula as before but with the fraction associated - ! with one of the two vegetated regions, which is half - ! the total vegetation fraction. - associate (veg_scale => canopy_props%veg_scale(ilay1:ilay2)) - if (config%use_symmetric_vegetation_scale_urban) then - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) & - & * (1.0_jprb - (0.5_jprb*veg_fraction(jlay))) & - & / veg_scale(jlay) - else - ! norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - ! & * 4.0_jprb * (0.5_jprb*veg_fraction(jlay)) / veg_scale(jlay) - ! Lollipop model - see Hogan, Quaife and Braghiere (2018) explaining sqrt(2) - norm_perim(2) = (1.0_jprb - config%vegetation_isolation_factor_urban) & - & * 4.0_jprb * veg_fraction(jlay) / (sqrt(2.0_jprb)*veg_scale(jlay)) - end if - end associate - else - ! Only one vegetated region so the other column of - ! norm_perim is unused - norm_perim(2:) = 0.0_jprb - end if - end if - end associate - end if - - ! Compute the normalized length of the interface between each - ! region and a building wall - norm_perim_wall = 0.0_jprb - - if (building_fraction(jlay) > config%min_building_fraction) then - norm_perim_wall(1) = 4.0_jprb * building_fraction(jlay) / building_scale(jlay) - - if (nreg > 1) then - associate (veg_contact_fraction => canopy_props%veg_contact_fraction(ilay1:ilay2)) - if (veg_contact_fraction(jlay) > 0.0_jprb) then - ! Compute normalized length of interface between wall - ! and any vegetation - norm_perim_wall_veg = min(norm_perim_air_veg*veg_contact_fraction(jlay), & - & norm_perim_wall(1)) - if (nreg == 2) then - norm_perim_wall(2) = norm_perim_wall_veg - norm_perim(1) = norm_perim(1) - norm_perim_wall_veg - else - norm_perim_wall(2) = norm_perim_wall_veg & - & * (1.0_jprb - config%vegetation_isolation_factor_urban) - norm_perim(1) = norm_perim(1) - norm_perim_wall(2) - norm_perim_wall(3) = norm_perim_wall_veg & - & * config%vegetation_isolation_factor_urban - norm_perim(3) = norm_perim(3) - norm_perim_wall(3) - end if - ! Reduce length of interface between wall and clear-air - norm_perim_wall(1) = norm_perim_wall(1) - norm_perim_wall_veg - else if (frac(1,jlay) <= config%min_vegetation_fraction) then - ! There is no clear region (region 1), so all walls must - ! be in contact with vegetation (region 2 and possibly - ! 3) - if (nreg == 2) then - norm_perim_wall(2) = norm_perim_wall(1) - else - norm_perim_wall(2) = norm_perim_wall(1) & - & * (1.0_jprb - config%vegetation_isolation_factor_urban) - norm_perim_wall(3) = norm_perim_wall(1) & - & * config%vegetation_isolation_factor_urban - end if - norm_perim_wall(1) = 0.0_jprb - end if - end associate - end if - end if - ! Compute the rates of exchange between regions, excluding the ! tangent term f_exchange = 0.0_jprb @@ -468,18 +377,18 @@ subroutine spartacus_urban_sw(config, & f_exchange(jreg+1,jreg) = 0.0_jprb f_exchange(jreg,jreg+1) = 0.0_jprb else - f_exchange(jreg+1,jreg) = norm_perim(jreg) / (Pi * frac(jreg,jlay)) - f_exchange(jreg,jreg+1) = norm_perim(jreg) / (Pi * frac(jreg+1,jlay)) + f_exchange(jreg+1,jreg) = norm_perim(jreg,jlay) / (Pi * frac(jreg,jlay)) + f_exchange(jreg,jreg+1) = norm_perim(jreg,jlay) / (Pi * frac(jreg+1,jlay)) end if end do - if (nreg > 2 .and. norm_perim(nreg) > 0.0_jprb) then + if (nreg > 2 .and. norm_perim(nreg,jlay) > 0.0_jprb) then if (frac(3,jlay) <= config%min_vegetation_fraction & & .or. frac(1,jlay) <= config%min_vegetation_fraction) then f_exchange(1,3) = 0.0_jprb f_exchange(3,1) = 0.0_jprb else - f_exchange(1,3) = norm_perim(jreg) / (Pi * frac(3,jlay)) - f_exchange(3,1) = norm_perim(jreg) / (Pi * frac(1,jlay)) + f_exchange(1,3) = norm_perim(jreg,jlay) / (Pi * frac(3,jlay)) + f_exchange(3,1) = norm_perim(jreg,jlay) / (Pi * frac(1,jlay)) end if end if @@ -489,14 +398,14 @@ subroutine spartacus_urban_sw(config, & if (frac(jreg,jlay) <= config%min_vegetation_fraction) then f_wall(jreg,jlay) = 0.0_jprb else - f_wall(jreg,jlay) = norm_perim_wall(jreg) / (Pi * frac(jreg,jlay)) + f_wall(jreg,jlay) = norm_perim_wall(jreg,jlay) / (Pi * frac(jreg,jlay)) end if end do if (non_building_fraction(jlay) <= config%min_building_fraction) then f_wall_dir_clear(jlay) = 0.0_jprb else - f_wall_dir_clear(jlay) = sum(norm_perim_wall(1:nreg)) & + f_wall_dir_clear(jlay) = sum(norm_perim_wall(1:nreg,jlay)) & & / (Pi * non_building_fraction(jlay)) end if @@ -589,8 +498,8 @@ subroutine spartacus_urban_sw(config, & call print_vector('ext_reg',ext_reg(1,:)) call print_vector('ssa_reg',ssa_reg(1,:)) call print_matrix('f_exchange',f_exchange) - call print_vector('norm_perim', norm_perim) - call print_vector('norm_perim_wall', norm_perim_wall) + call print_vector('norm_perim', norm_perim(:,jlay)) + call print_vector('norm_perim_wall', norm_perim_wall(:,jlay)) call print_matrix('gamma0',gamma0(1,:,:)) call print_matrix('gamma1',gamma1(1,:,:)) call print_matrix('gamma2',gamma2(1,:,:)) @@ -855,7 +764,7 @@ subroutine spartacus_urban_sw(config, & sw_norm_dir%clear_air_abs(:,ilay) = sw_norm_dir%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & & * (int_flux_dir(:,1) & ! / zcos_sza & - & + sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,nsw,1), 2)) + & + sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,1,nsw), 2)) if (do_vegetation) then associate (veg_ext => canopy_props%veg_ext(ilay1:ilay2), & & veg_ssa => sw_spectral_props%veg_ssa(:,ilay1:ilay2) ) @@ -865,7 +774,7 @@ subroutine spartacus_urban_sw(config, & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * (int_flux_dir(:,jreg) & ! / zcos_sza & & + sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2)) + & * spread(1.0_jprb/lg%mu,1,nsw), 2)) sw_norm_dir%veg_abs_dir(:,ilay) = sw_norm_dir%veg_abs_dir(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * int_flux_dir(:,jreg) * od_scaling(jreg,jlay) @@ -873,7 +782,7 @@ subroutine spartacus_urban_sw(config, & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * (int_flux_dir(:,jreg) & ! / zcos_sza & & + sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2)) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nsw), 2)) * od_scaling(jreg,jlay) end do end associate end if @@ -887,7 +796,7 @@ subroutine spartacus_urban_sw(config, & do jreg = 1,nreg sw_norm_dir%wall_in(:,ilay) = sw_norm_dir%wall_in(:,ilay) & & + f_wall(jreg,jlay) * sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(lg%tan_ang,1,nsw)) + & * spread(lg%tan_ang,1,nsw),2) end do sw_norm_dir%wall_net(:,ilay) = sw_norm_dir%wall_in(:,ilay) & & * (1.0_jprb - wall_albedo(:,jlay)) @@ -974,7 +883,7 @@ subroutine spartacus_urban_sw(config, & ! weights flux_dn_dir_above = 0.0_jprb ! No direct calculation now needed below flux_dn_diff_above = 0.0_jprb - flux_dn_diff_above(:,1:ns) = spread(lg%hweight,nsw,1) + flux_dn_diff_above(:,1:ns) = spread(lg%hweight,1,nsw) sw_norm_diff%top_dn_dir(:,icol) = 0.0_jprb sw_norm_diff%top_dn(:,icol) = 1.0_jprb @@ -1025,7 +934,7 @@ subroutine spartacus_urban_sw(config, & ! Absorption by clear-air region - see Eqs. 29 and 30 sw_norm_diff%clear_air_abs(:,ilay) = sw_norm_diff%clear_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & - & * sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,nsw,1), 2) + & * sum(int_flux_diff(:,1:ns) * spread(1.0_jprb/lg%mu,1,nsw), 2) if (do_vegetation) then associate (veg_ext => canopy_props%veg_ext(ilay1:ilay2), & & veg_ssa => sw_spectral_props%veg_ssa(:,ilay1:ilay2) ) @@ -1034,11 +943,11 @@ subroutine spartacus_urban_sw(config, & sw_norm_diff%veg_air_abs(:,ilay) = sw_norm_diff%veg_air_abs(:,ilay) & & + air_ext(:,jlay)*(1.0_jprb-air_ssa(:,jlay)) & ! Use clear-air properties & * sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2) + & * spread(1.0_jprb/lg%mu,1,nsw), 2) sw_norm_diff%veg_abs(:,ilay) = sw_norm_diff%veg_abs(:,ilay) & & + veg_ext(jlay)*(1.0_jprb-veg_ssa(:,jlay)) & ! Use vegetation properties & * sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(1.0_jprb/lg%mu,nsw,1), 2) * od_scaling(jreg,jlay) + & * spread(1.0_jprb/lg%mu,1,nsw), 2) * od_scaling(jreg,jlay) end do end associate end if @@ -1048,7 +957,7 @@ subroutine spartacus_urban_sw(config, & sw_norm_diff%wall_in(:,ilay) = sw_norm_diff%wall_in(:,ilay) & & + f_wall(jreg,jlay) & & * (sum(int_flux_diff(:,(jreg-1)*ns+1:jreg*ns) & - & * spread(lg%tan_ang,1,nsw))) + & * spread(lg%tan_ang,1,nsw),2)) end do sw_norm_diff%wall_net(:,ilay) = sw_norm_diff%wall_in(:,ilay) & & * (1.0_jprb - wall_albedo(:,jlay)) diff --git a/radsurf/radsurf_view_factor.F90 b/radsurf/radsurf_view_factor.F90 new file mode 100644 index 0000000..6ccf3a5 --- /dev/null +++ b/radsurf/radsurf_view_factor.F90 @@ -0,0 +1,140 @@ +! radsurf_view_factor.F90 - Compute view factors for single-layer urban canopy +! +! (C) Copyright 2021- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! +! Author: Robin Hogan +! Email: r.j.hogan@ecmwf.int +! + +! Equation numbers in this file refer to Hogan (BLM 2019) "An +! exponential model of urban geometry for use in radiative transfer +! applications" + +module radsurf_view_factor + +contains + + !--------------------------------------------------------------------- + ! Calculate view factors making the single-layer infinite street + ! assumption + ! elemental + subroutine calc_view_factors_inf(height_width_ratio, & + & view_ground_sky, view_wall_wall, cos_sza, view_dir_ground) + + use parkind1, only : jpim, jprb + use radiation_constants, only : Pi + + implicit none + + ! Ratio of building height to street width in the single-layer + ! infinite street canyon assumption (H/W) + real(kind=jprb), intent(in) :: height_width_ratio + ! Fraction of diffuse radiation emanating from the ground that + ! reaches the sky and fraction emanating from a wall that reaches + ! another wall + real(kind=jprb), intent(out) :: view_ground_sky, view_wall_wall + ! Cosine of solar zenith angle + real(kind=jprb), intent(in), optional :: cos_sza + ! Fraction of direct radiation at the top-of-canopy that + ! penetrates to the ground unscattered + real(kind=jprb), intent(out), optional :: view_dir_ground + + ! Direct penetration factor, defined as (H/W)*tan(sza) - see Eq. 2 + real(kind=jprb) :: norm_x0 + ! Ratio of two variables in Eq. 16 + real(kind=jprb) :: y_over_w + + view_ground_sky = sqrt(height_width_ratio * height_width_ratio + 1.0_jprb) & + & - height_width_ratio + view_wall_wall = sqrt(1.0_jprb / (height_width_ratio * height_width_ratio) + 1.0_jprb) & + & - 1.0_jprb / height_width_ratio + + if (present(cos_sza) .and. present(view_dir_ground)) then + ! The sqrt term is tan(sza) + norm_x0 = (Pi*0.5_jprb) * height_width_ratio * sqrt(1.0_jprb / (cos_sza*cos_sza) - 1.0_jprb) + y_over_w = sqrt(max(norm_x0*norm_x0 - 1.0_jprb, 0.0_jprb)) + if (y_over_w > 0.0_jprb) then + view_dir_ground = (2.0_jprb/Pi) * (y_over_w - norm_x0 + atan(1.0_jprb / y_over_w)) + else + view_dir_ground = 1.0_jprb - 2.0_jprb*norm_x0/Pi + end if + end if + + end subroutine calc_view_factors_inf + + + !--------------------------------------------------------------------- + ! Calculate view factors assuming the exponential model of urban + ! geometry + elemental subroutine calc_view_factors_exp(height_separation_ratio, & + & view_ground_sky, view_wall_wall, cos_sza, view_dir_ground) + + use parkind1, only : jpim, jprb + use radiation_constants, only : Pi + + implicit none + + ! Parameters + integer, parameter :: nw = 8 ! Number of weights + real(kind=jprb), parameter :: weights(nw) & + & = [0.0506142681451884_jprb, 0.111190517226687_jprb, & + & 0.156853322938944_jprb, 0.181341891689181_jprb, & + & 0.181341891689181_jprb, 0.156853322938944_jprb, & + & 0.111190517226687_jprb, 0.0506142681451884_jprb ] + real(kind=jprb), parameter :: nodes(nw) & + & = [0.0198550717512319_jprb, 0.101666761293187_jprb, & + & 0.237233795041836_jprb, 0.408282678752175_jprb, & + & 0.591717321247825_jprb, 0.762766204958164_jprb, & + & 0.898333238706813_jprb, 0.980144928248768_jprb ] + + ! Ratio of building height to the building horizontal separation + ! scale in the exponential-urban-geometry assumption (H/X) + real(kind=jprb), intent(in) :: height_separation_ratio + ! Fraction of diffuse radiation emanating from the ground that + ! reaches the sky and fraction emanating from a wall that reaches + ! another wall + real(kind=jprb), intent(out) :: view_ground_sky, view_wall_wall + ! Cosine of solar zenith angle + real(kind=jprb), intent(in), optional :: cos_sza + ! Fraction of direct radiation at the top-of-canopy that + ! penetrates to the ground unscattered + real(kind=jprb), intent(out), optional :: view_dir_ground + + ! Direct penetration factor, defined as (H/X)*tan(sza) - see Eq. 2 + real(kind=jprb) :: norm_x0 + + real(kind=jprb) :: tk(nw), exp_tk(nw) + + real(kind=jprb) :: hweight(nw), vweight(nw) + + ! Eqs. 12 and 17 + hweight = weights * nodes / sum(weights * nodes) + vweight = weights * sqrt(1.0_jprb - nodes*nodes) + vweight = vweight / sum(vweight) + + ! The sqrt term is tan(zenith angle) since node is the cosine of + ! the zenith angle + tk = height_separation_ratio * sqrt(1.0_jprb / (nodes*nodes) - 1.0_jprb) + exp_tk = exp(-tk) + + ! Eqs. 41 and 42 (note that there is a mistake in the latter + ! equation in the paper) + view_ground_sky = sum(hweight * exp_tk) + view_wall_wall = 1.0_jprb - sum(vweight * (1.0_jprb-exp_tk) / tk) + + if (present(cos_sza) .and. present(view_dir_ground)) then + ! The sqrt term is tan(sza) + norm_x0 = height_separation_ratio * sqrt(1.0_jprb / (cos_sza*cos_sza) - 1.0_jprb) + view_dir_ground = exp(-norm_x0) + end if + + end subroutine calc_view_factors_exp + +end module radsurf_view_factor diff --git a/radtool/radtool_calc_matrices_sw_eig.F90 b/radtool/radtool_calc_matrices_sw_eig.F90 index 66de82f..99d73e2 100644 --- a/radtool/radtool_calc_matrices_sw_eig.F90 +++ b/radtool/radtool_calc_matrices_sw_eig.F90 @@ -165,8 +165,7 @@ subroutine calc_matrices_sw_eig(nmat, ndiff, ndir, dz, mu0, & real(kind=jprb), dimension(nmat,ndiff,ndiff) :: gamma1i, gamma2i real(kind=jprb), dimension(nmat,ndiff,ndir) :: gamma3i - ! Temporary vector and matrix - real(kind=jprb), dimension(nmat,ndiff) :: tmp_vec + ! Temporary matrix real(kind=jprb), dimension(nmat,ndiff,ndiff) :: tmp_mat ! Loop index over matrix elements diff --git a/radtool/radtool_matrix.F90 b/radtool/radtool_matrix.F90 index 307a597..058ab10 100644 --- a/radtool/radtool_matrix.F90 +++ b/radtool/radtool_matrix.F90 @@ -54,6 +54,12 @@ module radtool_matrix module procedure fast_expm_exchange_2, fast_expm_exchange_3 end interface fast_expm_exchange + ! The routines in this module can be called millions of times, so + ! calling Dr Hook for each one may be a significant overhead. + ! Uncomment the following to turn Dr Hook on. + +!#define DO_DR_HOOK_MATRIX + contains ! --- MATRIX-VECTOR MULTIPLICATION --- @@ -64,7 +70,9 @@ module radtool_matrix ! multiplications on first iend pairs function mat_x_vec(n,iend,m,A,b,do_top_left_only_in) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend real(jprb), intent(in), dimension(:,:,:) :: A @@ -72,12 +80,14 @@ function mat_x_vec(n,iend,m,A,b,do_top_left_only_in) logical, intent(in), optional :: do_top_left_only_in real(jprb), dimension(iend,m):: mat_x_vec - integer :: j1, j2 + integer :: j1, j2, jn logical :: do_top_left_only +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:mat_x_vec',0,hook_handle) +#endif if (present(do_top_left_only_in)) then do_top_left_only = do_top_left_only_in @@ -88,18 +98,22 @@ function mat_x_vec(n,iend,m,A,b,do_top_left_only_in) ! Array-wise assignment mat_x_vec = 0.0_jprb - if (do_top_left_only) then - mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1) - else + if (.not. do_top_left_only) then do j1 = 1,m do j2 = 1,m - mat_x_vec(1:iend,j1) = mat_x_vec(1:iend,j1) & - & + A(1:iend,j1,j2)*b(1:iend,j2) + do jn = 1,iend + mat_x_vec(jn,j1) = mat_x_vec(jn,j1) & + & + A(jn,j1,j2)*b(jn,j2) + end do end do end do + else + mat_x_vec(1:iend,1) = A(1:iend,1,1)*b(1:iend,1) end if +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:mat_x_vec',1,hook_handle) +#endif end function mat_x_vec @@ -110,7 +124,9 @@ end function mat_x_vec ! multiplications on all n pairs function rect_mat_x_vec(n,k,l,A,b) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, k, l real(jprb), intent(in), dimension(n,k,l) :: A @@ -118,9 +134,12 @@ function rect_mat_x_vec(n,k,l,A,b) real(jprb), dimension(n,k) :: rect_mat_x_vec integer :: j1, j2 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_mat_x_vec',0,hook_handle) +#endif ! Array-wise assignment rect_mat_x_vec = 0.0_jprb @@ -133,7 +152,9 @@ function rect_mat_x_vec(n,k,l,A,b) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_mat_x_vec',1,hook_handle) +#endif end function rect_mat_x_vec @@ -144,7 +165,9 @@ end function rect_mat_x_vec ! multiplications on first iend pairs function singlemat_x_vec(n,iend,m,A,b) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend real(jprb), intent(in), dimension(m,m) :: A @@ -152,9 +175,12 @@ function singlemat_x_vec(n,iend,m,A,b) real(jprb), dimension(iend,m) :: singlemat_x_vec integer :: j1, j2 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:single_mat_x_vec',0,hook_handle) +#endif ! Array-wise assignment singlemat_x_vec = 0.0_jprb @@ -166,7 +192,9 @@ function singlemat_x_vec(n,iend,m,A,b) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:single_mat_x_vec',1,hook_handle) +#endif end function singlemat_x_vec @@ -177,7 +205,9 @@ end function singlemat_x_vec ! multiplications on all pairs function rect_singlemat_x_vec(n,m,k,A,b) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, k real(jprb), intent(in), dimension(m,k) :: A @@ -185,9 +215,12 @@ function rect_singlemat_x_vec(n,m,k,A,b) real(jprb), dimension(n,m) :: rect_singlemat_x_vec integer :: j1, j2 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_single_mat_x_vec',0,hook_handle) +#endif ! Array-wise assignment rect_singlemat_x_vec = 0.0_jprb @@ -199,7 +232,9 @@ function rect_singlemat_x_vec(n,m,k,A,b) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_single_mat_x_vec',1,hook_handle) +#endif end function rect_singlemat_x_vec @@ -212,19 +247,24 @@ end function rect_singlemat_x_vec ! all n matrix pairs function mat_x_mat(n,iend,m,A,B,i_matrix_pattern) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend integer, intent(in), optional :: i_matrix_pattern real(jprb), intent(in), dimension(:,:,:) :: A, B real(jprb), dimension(iend,m,m) :: mat_x_mat - integer :: j1, j2, j3 + integer :: j1, j2, j3, jn integer :: mblock, m2block integer :: i_actual_matrix_pattern + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:mat_x_mat',0,hook_handle) +#endif if (present(i_matrix_pattern)) then i_actual_matrix_pattern = i_matrix_pattern @@ -235,7 +275,19 @@ function mat_x_mat(n,iend,m,A,B,i_matrix_pattern) ! Array-wise assignment mat_x_mat = 0.0_jprb - if (i_actual_matrix_pattern == IMatrixPatternShortwave) then + if (i_actual_matrix_pattern /= IMatrixPatternShortwave) then + ! Ordinary dense matrix + do j2 = 1,m + do j3 = 1,m + do j1 = 1,m + do jn = 1,iend + mat_x_mat(jn,j1,j2) = mat_x_mat(jn,j1,j2) & + & + A(jn,j1,j3)*B(jn,j3,j2) + end do + end do + end do + end do + else ! Matrix has a sparsity pattern ! (C D E) ! A = (F G H) @@ -267,19 +319,11 @@ function mat_x_mat(n,iend,m,A,B,i_matrix_pattern) end do end do end do - else - ! Ordinary dense matrix - do j2 = 1,m - do j1 = 1,m - do j3 = 1,m - mat_x_mat(1:iend,j1,j2) = mat_x_mat(1:iend,j1,j2) & - & + A(1:iend,j1,j3)*B(1:iend,j3,j2) - end do - end do - end do end if +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:mat_x_mat',1,hook_handle) +#endif end function mat_x_mat @@ -290,7 +334,9 @@ end function mat_x_mat ! all n matrix pairs function rect_mat_x_mat(n,k,l,m,A,B) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, k, l, m real(jprb), intent(in), dimension(n,k,l) :: A @@ -298,9 +344,12 @@ function rect_mat_x_mat(n,k,l,m,A,B) real(jprb), dimension(n,k,m) :: rect_mat_x_mat integer :: j1, j2, j3 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_mat_x_mat',0,hook_handle) +#endif ! Array-wise assignment rect_mat_x_mat = 0.0_jprb @@ -315,7 +364,9 @@ function rect_mat_x_mat(n,k,l,m,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_mat_x_mat',1,hook_handle) +#endif end function rect_mat_x_mat @@ -326,7 +377,9 @@ end function rect_mat_x_mat ! multiplications on the first iend matrix pairs function singlemat_x_mat(n,iend,m,A,B) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend real(jprb), intent(in), dimension(m,m) :: A @@ -334,9 +387,12 @@ function singlemat_x_mat(n,iend,m,A,B) real(jprb), dimension(iend,m,m) :: singlemat_x_mat integer :: j1, j2, j3 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:singlemat_x_mat',0,hook_handle) +#endif ! Array-wise assignment singlemat_x_mat = 0.0_jprb @@ -350,7 +406,9 @@ function singlemat_x_mat(n,iend,m,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:singlemat_x_mat',1,hook_handle) +#endif end function singlemat_x_mat @@ -361,7 +419,9 @@ end function singlemat_x_mat ! multiplications on the first iend matrix pairs function mat_x_singlemat(n,iend,m,A,B) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend real(jprb), intent(in), dimension(:,:,:) :: A @@ -369,9 +429,12 @@ function mat_x_singlemat(n,iend,m,A,B) real(jprb), dimension(iend,m,m) :: mat_x_singlemat integer :: j1, j2, j3 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:mat_x_singlemat',0,hook_handle) +#endif ! Array-wise assignment mat_x_singlemat = 0.0_jprb @@ -385,7 +448,9 @@ function mat_x_singlemat(n,iend,m,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:mat_x_singlemat',1,hook_handle) +#endif end function mat_x_singlemat @@ -395,7 +460,10 @@ end function mat_x_singlemat ! (with the n dimension varying fastest) and perform matrix ! multiplications on all matrix pairs function rect_mat_x_singlemat(n,m,o,p,A,B) + +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, o, p real(jprb), intent(in), dimension(:,:,:) :: A @@ -403,9 +471,12 @@ function rect_mat_x_singlemat(n,m,o,p,A,B) real(jprb), dimension(n,m,p) :: rect_mat_x_singlemat integer :: j1, j2, j3 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_mat_x_singlemat',0,hook_handle) +#endif ! Array-wise assignment rect_mat_x_singlemat = 0.0_jprb @@ -419,7 +490,9 @@ function rect_mat_x_singlemat(n,m,o,p,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_mat_x_singlemat',1,hook_handle) +#endif end function rect_mat_x_singlemat @@ -431,7 +504,9 @@ end function rect_mat_x_singlemat ! replaced by A(i,j)*Is, where Is is the s-by-s identity matrix. function rect_expandedmat_x_mat(n,m,o,s,p,A,B) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, o, s, p real(jprb), intent(in), dimension(m,o) :: A @@ -441,9 +516,12 @@ function rect_expandedmat_x_mat(n,m,o,s,p,A,B) integer :: j1, j3 ! Indices of the unexpanded A integer :: jj1, jj2 ! Indices of the output matrix integer :: offset2 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_expandedmat_x_mat',0,hook_handle) +#endif ! Array-wise assignment rect_expandedmat_x_mat = 0.0_jprb @@ -463,12 +541,13 @@ function rect_expandedmat_x_mat(n,m,o,s,p,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_expandedmat_x_mat',1,hook_handle) +#endif end function rect_expandedmat_x_mat - !--------------------------------------------------------------------- ! Treat B as an m-by-o matrix and A as n p-by-m*s matrices (with the ! n dimension varying fastest) and perform matrix multiplications on @@ -476,7 +555,9 @@ end function rect_expandedmat_x_mat ! replaced by B(i,j)*Is, where Is is the s-by-s identity matrix. function rect_mat_x_expandedmat(n,m,o,s,p,A,B) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, o, s, p real(jprb), intent(in), dimension(:,:,:) :: A @@ -486,9 +567,12 @@ function rect_mat_x_expandedmat(n,m,o,s,p,A,B) integer :: j2, j3 ! Indices of the unexpanded B integer :: jj1, jj2 ! Indices of the output matrix integer :: offset3 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_mat_x_expandedmat',0,hook_handle) +#endif ! Array-wise assignment rect_mat_x_expandedmat = 0.0_jprb @@ -507,7 +591,9 @@ function rect_mat_x_expandedmat(n,m,o,s,p,A,B) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_mat_x_expandedmat',1,hook_handle) +#endif end function rect_mat_x_expandedmat @@ -521,7 +607,9 @@ end function rect_mat_x_expandedmat ! matrix. function rect_expandedmat_x_vec(n,m,k,s,A,b) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, k, s real(jprb), intent(in), dimension(m,k) :: A @@ -531,9 +619,12 @@ function rect_expandedmat_x_vec(n,m,k,s,A,b) integer :: j1, j3 ! Indices of the unexpanded A integer :: jj1 ! Indices of the output vector integer :: offset2 + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:rect_expandedmat_x_vec',0,hook_handle) +#endif ! Array-wise assignment rect_expandedmat_x_vec = 0.0_jprb @@ -551,7 +642,9 @@ function rect_expandedmat_x_vec(n,m,k,s,A,b) end do end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:rect_expandedmat_x_vec',1,hook_handle) +#endif end function rect_expandedmat_x_vec @@ -561,7 +654,9 @@ end function rect_expandedmat_x_vec ! m-by-m square matrices function identity_minus_mat_x_mat(n,iend,m,A,B,i_matrix_pattern) +#ifdef DO_DR_HOOK_MATRIX use yomhook, only : lhook, dr_hook +#endif integer, intent(in) :: n, m, iend integer, intent(in), optional :: i_matrix_pattern @@ -569,9 +664,12 @@ function identity_minus_mat_x_mat(n,iend,m,A,B,i_matrix_pattern) real(jprb), dimension(iend,m,m) :: identity_minus_mat_x_mat integer :: j + +#ifdef DO_DR_HOOK_MATRIX real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:identity_mat_x_mat',0,hook_handle) +#endif if (present(i_matrix_pattern)) then identity_minus_mat_x_mat = mat_x_mat(n,iend,m,A,B,i_matrix_pattern) @@ -585,7 +683,9 @@ function identity_minus_mat_x_mat(n,iend,m,A,B,i_matrix_pattern) & = 1.0_jprb + identity_minus_mat_x_mat(1:iend,j,j) end do +#ifdef DO_DR_HOOK_MATRIX if (lhook) call dr_hook('radtool_matrix:identity_mat_x_mat',1,hook_handle) +#endif end function identity_minus_mat_x_mat @@ -820,8 +920,6 @@ pure subroutine diag_mat_right_divide_3(n,iend,A,B,X) real(jprb), dimension(iend) :: U22, U23, U33 real(jprb), dimension(iend) :: y2, y3 - integer :: j - ! associate (U11 => A(:,1,1), U12 => A(:,1,2), U13 => A(1,3)) ! LU decomposition of the *transpose* of A: ! ( 1 ) (U11 U12 U13) @@ -1112,8 +1210,6 @@ function invert(n,iend,m,A) real(jprb) :: invert(iend,m,m) real(jprb) :: LU(iend,m,m) - integer :: j - real(jprb) :: hook_handle if (lhook) call dr_hook('radtool_matrix:invert',0,hook_handle) diff --git a/test/rami5/Makefile b/test/rami5/Makefile new file mode 100644 index 0000000..4d82380 --- /dev/null +++ b/test/rami5/Makefile @@ -0,0 +1,85 @@ +# This Makefile is for running SPARTACUS-Surface on the RAMI-V +# "actual" test scenes. The variables required by SPARTACUS are +# provided in the NetCDF files in the scene_nc directory. Typing +# "make" will run SPARTACUS on them to produce outputs in the out_nc +# directory. The Matlab script "process_spartacus_scenes.m" produces +# the ASCII files for submission in the "mes" directory. + +BASE = rami5 +SPSURF = ../../bin/spartacus_surface +CONFIG = config.nam +CONFTMP = config_tmp.nam +CHANGE_NL = ./change_namelist.sh +INDIR = scene_nc +OUTDIR = out_nc + +INSUFFIX = _scene.nc +OUTSUFFIX = _out.nc +LOGSUFFIX = _out.log +BSOUTSUFFIX = _blacksoil_out.nc +BSLOGSUFFIX = _blacksoil_out.log + +# Default target when you run "make": run the five actual actual cases +# with solar configurations required by RAMI-V +test: rami5 +rami5: HET09_JBS_SUM HET07_JPS_SUM HET08_OPS_WIN HET14_WCO_UND HET15_JBS_WIN + +# For a larger number of runs when you run "make all": also includes +# overhead sun and the RAMI-VI sun angles +all: rami5 overhead rami4 + +# Individual targets consisting of - where +# is either "diffuse" indicating the incoming solar +# radiation at top-of-canopy is isotropic, or -direct where SZA +# is the solar zenith angle in degrees + +# Jarvselja Birch Stand - Summer +HET09_JBS_SUM: HET09_JBS_SUM-diffuse HET09_JBS_SUM-56-direct HET09_JBS_SUM-41-direct +# Jarvselja Birch Stand - Winter +HET15_JBS_WIN: HET15_JBS_WIN-diffuse HET15_JBS_WIN-76-direct HET15_JBS_WIN-56-direct +# Jarvselja Pine Stand - Summer +HET07_JPS_SUM: HET07_JPS_SUM-diffuse HET07_JPS_SUM-56-direct HET07_JPS_SUM-41-direct +# Offenpass Pine Stand - Winter +HET08_OPS_WIN: HET08_OPS_WIN-diffuse HET08_OPS_WIN-76-direct HET08_OPS_WIN-56-direct +# Wellington Citrus Orchard +HET14_WCO_UND: HET14_WCO_UND-diffuse HET14_WCO_UND-42-direct HET14_WCO_UND-60-direct HET14_WCO_UND-67-direct + +# Run the five scenes with overhead sun, from which the penetration of +# direct sunlight is computed and can be compared with values on the +# RAMI-V web site +overhead: HET09_JBS_SUM-00-direct HET15_JBS_WIN-00-direct HET07_JPS_SUM-00-direct HET08_OPS_WIN-00-direct HET14_WCO_UND-00-direct + +# Solar zenith angles use by the same scenes from the RAMI-IV +# intercomparison +rami4: HET09_JBS_SUM-37-direct HET15_JBS_WIN-54-direct HET07_JPS_SUM-37-direct HET08_OPS_WIN-47-direct HET14_WCO_UND-00-direct HET14_WCO_UND-20-direct HET14_WCO_UND-50-direct + +# Run SPARTACUS-Surface on scene with diffuse top-of-canopy solar +# illumination, both with the real soil albedo and a "black soil" +# configuration +%-diffuse: + mkdir -p out_nc + set -o pipefail && $(SPSURF) $(CONFIG) $(INDIR)/$(BASE)_$*$(INSUFFIX) \ + $(OUTDIR)/$(BASE)_$*-diffuse$(OUTSUFFIX) | tee $(OUTDIR)/$(BASE)_$*-diffuse$(LOGSUFFIX) + $(CHANGE_NL) $(CONFIG) $(CONFTMP) ground_sw_albedo=0.0 + set -o pipefail && $(SPSURF) $(CONFTMP) $(INDIR)/$(BASE)_$*$(INSUFFIX) \ + $(OUTDIR)/$(BASE)_$*-diffuse$(BSOUTSUFFIX) | tee $(OUTDIR)/$(BASE)_$*-diffuse$(BSLOGSUFFIX) + +# Run SPARTACUS-Surface on scene with direct top-of-canopy solar +# illumination. First create config_tmp.nam with the required solar +# zenith angle, then run SPARTACUS-Surface, in both cases using awk to +# extract parts of the "stem" represented by the "%" character in GNU +# make. +%-direct: + mkdir -p out_nc + $(CHANGE_NL) $(CONFIG) $(CONFTMP) top_flux_dn_direct_sw=1.0 \ + solar_zenith_angle=$(shell echo $* | awk -F- '{print $$2}') + set -o pipefail && $(SPSURF) $(CONFTMP) $(INDIR)/$(BASE)_$(shell echo $* | awk -F- '{print $$1}')$(INSUFFIX) \ + $(OUTDIR)/$(BASE)_$*$(OUTSUFFIX) | tee $(OUTDIR)/$(BASE)_$*$(LOGSUFFIX) + $(CHANGE_NL) $(CONFIG) $(CONFTMP) top_flux_dn_direct_sw=1.0 \ + solar_zenith_angle=$(shell echo $* | awk -F- '{print $$2}') \ + ground_sw_albedo=0.0 + set -o pipefail && $(SPSURF) $(CONFTMP) $(INDIR)/$(BASE)_$(shell echo $* | awk -F- '{print $$1}')$(INSUFFIX) \ + $(OUTDIR)/$(BASE)_$*$(BSOUTSUFFIX) | tee $(OUTDIR)/$(BASE)_$*$(BSLOGSUFFIX) + +clean: + rm -rf $(CONFTMP) out_nc/$(BASE)*.nc out_nc/$(BASE)*.log mes/*.mes mes/*.png diff --git a/test/rami5/README b/test/rami5/README new file mode 100644 index 0000000..434162a --- /dev/null +++ b/test/rami5/README @@ -0,0 +1,44 @@ +Running "make" will run SPARTACUS-Surface on five "actual" scenes from +the RAMI-V intercomparison: + https://rami-benchmark.jrc.ec.europa.eu/_www/phase_descr.php?strPhase=RAMI5 + +Note that the "urban" surface type is used to represent forests, with +the tree trunks treated as buildings and other woody material +(branches) merged into the vegetation properties. The output netCDF +files are placed in the out_nc directory. The Matlab script +process_spartacus_scenes.m then converts the outputs into ASCII files +for the RAMI-V submission in the "mes" directory. + +Typing "make overhead" runs the cases with overhead sun (solar zenith +angle of 0 degrees), and the matlab script check_fractional_cover.m +uses the direct flux at the surface +(ground_spectral_flux_dn_direct_sw) to diagnose the fractional scene +coverage, and compare it with the values provided on the RAMI-V web +site. + +An updated submission to the intercomparison was provided on 30 Nov +2021, involving the following changes: + + - The canopy radius, which in the RAMI-V scene description data is + provided for each tree as a profile of the maximum dimension of a + leaf/branch element from the tree axis, is now multiplied by 0.9 to + provide a more reasonable envelope for the actual tree crowns. + + - Hogan et al. (2018) found that it was necessary to project the + crown regions down to the surface, in order to improve the impacts + of shadows on the upwelling radiation and preventing excessive + "entrapment" of radiation. Many of the RAMI-V trees are very tall + and the foliage starts very high above the ground, for which this + adjustment would not be necessary. But in case it is important for + the shorter trees, any tree with a crown base less than 2 m above + the ground now has its crown projected down to the surface. + + - Previously a fixed vegetation fractional standard deviation was + specified via the namelist as 0.9. In real trees the branches are + much more heterogeneously distributed than the leaves. Therefore + we assume a value of 0.7 for the leaves and 1.4 for the branches, + and the profile of veg_fsd is provided in the scene netCDF files as + the average of the leaf and branch values, weighting by the + extinction of these two parts of the vegetation. + + diff --git a/test/rami5/change_namelist.sh b/test/rami5/change_namelist.sh new file mode 100755 index 0000000..cecf2ee --- /dev/null +++ b/test/rami5/change_namelist.sh @@ -0,0 +1,42 @@ +#!/bin/bash +# +# (C) Copyright 2014- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + +# Change entries in a Fortran namelist file +# Usage: change_namelist.sh infile.nam outfile.nam key1=value1 key2=value2 ... + +INFILE=$1 +OUTFILE=$2 +shift +shift + +SEDLINE="" +while [ "$1" ] +do + FOUND=$(echo $1 | grep '=') + if [ ! "$FOUND" ] + then + echo "Error in $0: argument '$1' not of the form key=value" + exit 1 + fi + KEY=$(echo $1 | awk -F= '{print $1}') + VALUE=$(echo $1 | awk -F= '{print $2}') + FOUND=$(grep $KEY $INFILE) + if [ ! "$FOUND" ] + then + echo "Error: $KEY not found in $INFILE" + exit 1 + fi + + SEDLINE="$SEDLINE -e s|^[[:space:]!]*"$KEY".*|"$KEY"="$VALUE",|" + shift +done +#echo sed $SEDLINE $INFILE ">" $OUTFILE +sed $SEDLINE $INFILE > $OUTFILE diff --git a/test/rami5/check_fractional_cover.m b/test/rami5/check_fractional_cover.m new file mode 100644 index 0000000..19447f6 --- /dev/null +++ b/test/rami5/check_fractional_cover.m @@ -0,0 +1,28 @@ +% This Matlab script should be run after typing "make overhead": it +% uses the direct flux at the surface +% (ground_spectral_flux_dn_direct_sw) to diagnose the fractional scene +% coverage, and compare it with the values provided on the RAMI-V web +% site. + +cases = {'HET07_JPS_SUM',... + 'HET08_OPS_WIN',... + 'HET09_JBS_SUM',... + 'HET14_WCO_UND',... + 'HET15_JBS_WIN'}; + +% "True" values from the RAMI-V website +fractional_scene_coverage = [0.406 0.1248 0.5044 0.392 0.2510]; + +% Load SPARTACUS overhead results +for ic = 1:length(cases) + d=loadnc(['out_nc/rami5_' cases{ic} '-00_out.nc']); + fsc_spartacus(ic) = 1.0 - d.ground_spectral_flux_dn_direct_sw(end); +end + +% Compare to "truth" +for ic = 1:length(cases) + disp([cases{ic} ' FSCtrue=' num2str(fractional_scene_coverage(ic)) ... + ', FSCspartacus=' num2str(fsc_spartacus(ic)) ' (' ... + num2str(100.*(fsc_spartacus(ic)-fractional_scene_coverage(ic)) ... + ./ fractional_scene_coverage(ic)) '%)']); +end diff --git a/test/rami5/config.nam b/test/rami5/config.nam new file mode 100644 index 0000000..b561494 --- /dev/null +++ b/test/rami5/config.nam @@ -0,0 +1,28 @@ +&radsurf_driver +do_parallel = true, +iverbose = 3, +do_conservation_check = true, +top_flux_dn_direct_sw = 0.0, +!solar_zenith_angle = 60, +!vegetation_fsd = 0.9, +!ground_sw_albedo = 0.0, +/ + +&radsurf +iverbose = 3, +do_sw = true, +do_lw = false, +use_sw_direct_albedo = false, +do_vegetation = true, +do_urban = true, +n_vegetation_region_forest = 2, +n_vegetation_region_urban = 2, +nsw = 14, +nlw = 1, +n_stream_sw_forest = 1, +n_stream_sw_urban = 4, +do_save_broadband_flux = false, +do_save_spectral_flux = true, +do_save_flux_profile = true, +vegetation_isolation_factor_urban = 0.0, +/ diff --git a/test/rami5/loadnc.m b/test/rami5/loadnc.m new file mode 100644 index 0000000..1745c10 --- /dev/null +++ b/test/rami5/loadnc.m @@ -0,0 +1,212 @@ +function [data, attribute, dimensions] = load_nc_struct(nc_file, names); +% load_nc_struct -- Load NetCDF variables and attributes. +% +% [data, attribute] = load_nc_struct('nc_file') loads all variables of +% 'nc_file' into structure 'data' and all attributes into structure +% 'attribute', so variable 'X' could then be accessed using 'data.X' +% and attribute 'long_name' of 'X' could be accessed with +% 'attribute.X.long_name'. + +if nargin < 1, help(mfilename), return, end + +result = []; +if nargout > 0, data = []; attribute = []; end + +rootid = netcdf.open(nc_file, 'nowrite'); +if isempty(rootid), return, end +disp(['Loading ' nc_file]); + +ver_str = version; +if str2num(ver_str(1)) >= 8 + ncid = get_science_data_group(rootid); +else + ncid = rootid; +end + +if nargout > 2 + dimids = netcdf.inqDimIDs(ncid); + for id = dimids + [dimname,dimlen] = netcdf.inqDim(ncid,id); + dimnames{id+1} = dimname; + dimensions.(dimname) = dimlen; + end +end + +if nargin < 2 + names = var_names(ncid); +end + +allnames = var_names(ncid); + +disp(['Variables:']); +for ii = 1:length(names) + if any(strcmp(names{ii},allnames)) + newname = names{ii}; + newname(find(newname == '-')) = '_'; + newname(find(newname == '.')) = '_'; + newname(find(newname == '@')) = '_'; + varid = netcdf.inqVarID(ncid, names{ii}); + + [varname, xtype,vdimids,natts] = netcdf.inqVar(ncid, varid); + if xtype == 12 + continue; + end + [add_offset, scale_factor] = get_scaling(ncid, varid); + + if xtype == netcdf.getConstant('NC_FLOAT') | ~isempty(add_offset) | ~isempty(scale_factor) + missing_value = double(get_missing_value(ncid, varid)); + data.(newname) = double(netcdf.getVar(ncid, varid)); + else + missing_value = get_missing_value(ncid, varid); + data.(newname) = netcdf.getVar(ncid, varid); + end + + if ~isempty(missing_value) + data.(newname)(find(data.(newname) == missing_value)) = NaN; + end + + if ~isempty(scale_factor) + data.(newname) = data.(newname) .* scale_factor; + else + scale_factor = 1.0; + end + if ~isempty(add_offset) + data.(newname) = data.(newname) + add_offset; + else + add_offset = 0.0; + end + + if nargout > 1 + % Do attributes + for jj = 1:natts + % Check for underscore starting attribute name + attname = netcdf.inqAttName(ncid, varid, jj-1); + attname_mod = attname; + if strcmp(attname,'_FillValue') + attname_mod = 'FillValue_'; + elseif attname(1) == '_' + warning([newname '.' attname ' changed to ' names{ii} ':X' attname]); + attname_mod = ['X' attname]; + end + eval(['attribute.' names{ii} '.' attname_mod ' = netcdf.getAtt(ncid, varid, attname);']); + if nargout > 2 + attribute.(names{ii}).dimensions = dimnames(vdimids+1); + end + end + end + + the_size = size(data.(newname)); + if the_size(end) == 1; + the_size = the_size(1:end-1); + end + + long_name = ''; + try + long_name = netcdf.getAtt(ncid, varid, 'long_name'); + long_name = clean_up_string(long_name); + long_name = ['"' long_name '"']; + end + units = ''; + try + units = netcdf.getAtt(ncid, varid, 'units'); + units = clean_up_string(units); + units = [' (' units ')']; + end + + names{ii} = newname; + + + size_str = num2str(the_size(1)); + for ii = 2:length(the_size); + size_str = [size_str ',' num2str(the_size(ii))]; + end + + newname = [newname ' (' size_str ')']; + + namefill = blanks(max(0,30-length(newname))); + + + if add_offset ~= 0.0 | scale_factor ~= 1.0 + scale_str = ' scaled'; + else + scale_str = ''; + end + disp([namefill newname ': ' long_name units scale_str]); + + end +end + +if nargout > 1 + % Do global attributes + disp('Global attributes:'); + [ndims,nvars,ngatts,unlimdimid] = netcdf.inq(ncid); + for ii = 1:ngatts + attname = netcdf.inqAttName(ncid,netcdf.getConstant('NC_GLOBAL'),ii-1); + + newattname = attname; + if attname(1) == '_'; + newattname = [attname(2:end) '_']; + end + attribute.global.(newattname) = netcdf.getAtt(ncid,netcdf.getConstant('NC_GLOBAL'),attname); + +% if isempty(find(attnames{ii} == '/' | attnames{ii} == '-' | attnames{ii} == '+' | attnames{ii} == ' ') > 0) +% eval(['attr = f.' attnames{ii} '(:);']); +% if ischar(attr) +% attr = clean_up_string(attr); +% end +% eval(['attribute.global.' attnames{ii} ' = attr;']); + namefill = blanks(max(0,14-length(attname))); + disp([namefill newattname ': ' num2str(attribute.global.(newattname))]); +% else +% disp(['Attribute name ' attnames{ii} ' incompatible with Matlab - not loaded.']) +% end + end +end +netcdf.close(rootid) + +function newstr = clean_up_string(oldstr) +newstr = num2str(oldstr); +if length(newstr) > 1 + if newstr(end-1) == '\' & newstr(end) == '0' + newstr = deblank(newstr(1:end-2)); + end +end + +function names = var_names(ncid) + [ndims,nvars,ngatts,unlimdimid] = netcdf.inq(ncid); + for ii = 0:nvars-1 + names{ii+1} = netcdf.inqVar(ncid, ii); + end + +function missing_value = get_missing_value(ncid, varid) + missing_value = []; + try + missing_value = netcdf.getAtt(ncid, varid, 'missing_value'); + catch exception + try + missing_value = netcdf.getAtt(ncid, varid, '_FillValue'); + end + end + +function [add_offset,scale_factor] = get_scaling(ncid, varid) + add_offset = []; + scale_factor = []; + try + add_offset = netcdf.getAtt(ncid, varid, 'add_offset'); + end + try + scale_factor = netcdf.getAtt(ncid, varid, 'scale_factor'); + end + +function sciid = get_science_data_group(ncid) + group_id = netcdf.inqGrps(ncid); + sciid = ncid; + if ~isempty(group_id) + for ii = 1:length(group_id) + if strcmp(netcdf.inqGrpName(group_id(ii)),'ScienceData') + sciid = group_id(ii); + return; + end + end + end + diff --git a/test/rami5/process_spartacus.m b/test/rami5/process_spartacus.m new file mode 100644 index 0000000..74c481b --- /dev/null +++ b/test/rami5/process_spartacus.m @@ -0,0 +1,139 @@ +% This Matlab script processes the output of SPARTACUS-Surface run on +% a single RAMI-V scene, producing ASCII files suitable for submission +% to the intercomparison in the "mes" directory. You can call this +% script directly (optionally specifying the scene by predefining the +% "iscene" variable) or run the process_spartacus_scene.m script to +% run them all. + +% Scene number in range 0 to 4 +if ~exist('iscene','var') + iscene = 1; +end + +% Optionally use the RAMI-IV solar zenith angles +if ~exist('is_rami4','var') + is_rami4 = 0; +end + +% Obtain scene ID string and other information from the "iscene" +% variable +if iscene == 0 + scene_id = 'HET15_JBS_WIN'; zmax = 30.5130; solar_ids = {'diffuse', '76','56'}; + if is_rami4 + solar_ids = {'diffuse','54'}; + end +elseif iscene == 1 + scene_id = 'HET09_JBS_SUM'; zmax = 30.5130; solar_ids = {'diffuse', '56','41'}; + if is_rami4 + solar_ids = {'diffuse','37'}; + end +elseif iscene == 2 + scene_id = 'HET07_JPS_SUM'; zmax = 18.56; solar_ids = {'diffuse', '56','41'}; + if is_rami4 + solar_ids = {'diffuse','37'}; + end +elseif iscene == 3 + scene_id = 'HET14_WCO_UND'; zmax = 4.12; solar_ids = {'diffuse', '42','60','67'}; + if is_rami4 + solar_ids = {'diffuse','00','20','50'}; + end +elseif iscene == 4 + scene_id = 'HET08_OPS_WIN'; zmax = 15.0213; solar_ids = {'diffuse', '76','56'}; + if is_rami4 + solar_ids = {'diffuse','47'}; + end +else + error(['iscene=' num2str(iscene) ' not recognised']); +end + +% Band names +bands = {'O03','O04','O06','O08','O10','O11','O12','M08','O17','MD5','M11','MD7','M12'}; + +% Some outputs are only required in the photosynthetically active +% range +bands_par = bands(1:5); +iband_black = length(bands)+1; % 14th band is for black surfaces + +% Filenames are tagged with the model name +model = 'spartacus'; + +% Make output directory +mkdir mes + +% Loop over the solar configurations for this scene +for sid = 1:length(solar_ids) + solar_id = solar_ids{sid}; + + % Load the netCDF files + in = loadnc(['scene_nc/rami5_' scene_id '_scene.nc']); + out= loadnc(['out_nc/rami5_' scene_id '-' solar_id '_out.nc']); + bs = loadnc(['out_nc/rami5_' scene_id '-' solar_id '_blacksoil_out.nc']); + + % If wavelengths are provided then write_ascii will attempt to plot + % the results + %wav = in.wavelength(1:13); + wav = []; + + residual = out.ground_spectral_flux_net_sw ... + + sum(out.wall_spectral_flux_net_sw,2) ... + + sum(out.roof_spectral_flux_net_sw,2) ... + + sum(out.veg_spectral_absorption_sw,2) ... + - out.top_spectral_flux_net_sw; + + if strcmp(solar_id, 'diffuse') + % White-sky albedo + write_ascii(scene_id, bands, solar_id, 'bhr', model, out.top_spectral_flux_dn_sw - out.top_spectral_flux_net_sw, ... + 'White-sky albedo', wav); + else + % Black-sky albedo + write_ascii(scene_id, bands, solar_id, 'dhr', model, out.top_spectral_flux_dn_sw - out.top_spectral_flux_net_sw, ... + 'Black-sky albedo', wav); + end + + % Absorption by all vegetation (foliage and wood) + write_ascii(scene_id, bands_par, solar_id, 'fabs_tot', model, ... + sum(out.veg_spectral_absorption_sw+out.wall_spectral_flux_net_sw+out.roof_spectral_flux_net_sw, 2), ... + 'Vegetation absorption', wav); + + % Absorption by foliage only + foliage_ratio = (ones(14,1)*in.foliage_extinction').*in.foliage_sw_ssa ... + ./ ((ones(14,1)*in.veg_extinction').*in.veg_sw_ssa); + foliage_ratio(find(isnan(foliage_ratio))) = 0; + write_ascii(scene_id, bands_par, solar_id, 'fabs_fol', model, ... + sum(out.veg_spectral_absorption_sw.*foliage_ratio, 2),... + 'Foliage absorption', wav); + + % Transmission scattered one or more times by vegetation but not by + % soil + if strcmp(solar_id, 'diffuse') + write_ascii(scene_id, bands_par, solar_id, 'ftran_coco', model, ... + bs.ground_spectral_flux_dn_sw - bs.ground_spectral_flux_dn_sw(iband_black), ... + 'Canopy-only collided transmission', wav); + else + write_ascii(scene_id, bands_par, solar_id, 'ftran_coco', model, ... + bs.ground_spectral_flux_dn_sw - bs.ground_spectral_flux_dn_direct_sw, ... + 'Canopy-only collided transmission', wav); + end + + % Unscattered transmission + write_ascii(scene_id, bands_par, solar_id, 'ftran_uc', model, ... + bs.ground_spectral_flux_dn_sw(iband_black).*ones(size(bs.ground_spectral_flux_dn_sw)), ... + 'Uncollided transmission', wav); + + % Total transmission + write_ascii(scene_id, bands_par, solar_id, 'ftran_tot', model, out.ground_spectral_flux_dn_sw, ... + 'Total transmission', wav); + + % Flux profile is average of layer top and layer base values, which + % are slightly different at the interfaces because of the stepped + % nature of the trunk description + flux_up = [out.spectral_flux_up_layer_base_sw zeros(14,1)] ... + + [zeros(14,1) out.spectral_flux_up_layer_top_sw]; + flux_up(:,2:end-1) = 0.5.*flux_up(:,2:end-1); + flux_dn = [out.spectral_flux_dn_layer_base_sw zeros(14,1)] ... + + [zeros(14,1) out.spectral_flux_dn_layer_top_sw]; + flux_dn(:,2:end-1) = 0.5.*flux_dn(:,2:end-1); + + write_ascii_profile(scene_id, bands_par, solar_id, 'ftran_tot_vprof', model, ... + zmax, out.height, flux_up, flux_dn); +end diff --git a/test/rami5/process_spartacus_scenes.m b/test/rami5/process_spartacus_scenes.m new file mode 100644 index 0000000..2f125fe --- /dev/null +++ b/test/rami5/process_spartacus_scenes.m @@ -0,0 +1,6 @@ +% Matlab script to process the outputs of SPARTACUS-Surface run on +% five "actual" RAMI-V scenes numbered 0-4 +is_rami4 = 0; +for iscene = 0:4 + process_spartacus +end diff --git a/test/rami5/scene_nc/rami5_HET07_JPS_SUM_scene.nc b/test/rami5/scene_nc/rami5_HET07_JPS_SUM_scene.nc new file mode 100644 index 0000000..3aa0f74 Binary files /dev/null and b/test/rami5/scene_nc/rami5_HET07_JPS_SUM_scene.nc differ diff --git a/test/rami5/scene_nc/rami5_HET08_OPS_WIN_scene.nc b/test/rami5/scene_nc/rami5_HET08_OPS_WIN_scene.nc new file mode 100644 index 0000000..619688b Binary files /dev/null and b/test/rami5/scene_nc/rami5_HET08_OPS_WIN_scene.nc differ diff --git a/test/rami5/scene_nc/rami5_HET09_JBS_SUM_scene.nc b/test/rami5/scene_nc/rami5_HET09_JBS_SUM_scene.nc new file mode 100644 index 0000000..9b5c741 Binary files /dev/null and b/test/rami5/scene_nc/rami5_HET09_JBS_SUM_scene.nc differ diff --git a/test/rami5/scene_nc/rami5_HET14_WCO_UND_scene.nc b/test/rami5/scene_nc/rami5_HET14_WCO_UND_scene.nc new file mode 100644 index 0000000..88e8388 Binary files /dev/null and b/test/rami5/scene_nc/rami5_HET14_WCO_UND_scene.nc differ diff --git a/test/rami5/scene_nc/rami5_HET15_JBS_WIN_scene.nc b/test/rami5/scene_nc/rami5_HET15_JBS_WIN_scene.nc new file mode 100644 index 0000000..dd08560 Binary files /dev/null and b/test/rami5/scene_nc/rami5_HET15_JBS_WIN_scene.nc differ diff --git a/test/rami5/write_ascii.m b/test/rami5/write_ascii.m new file mode 100644 index 0000000..3752f83 --- /dev/null +++ b/test/rami5/write_ascii.m @@ -0,0 +1,41 @@ +function write_ascii(scene, bands, zenith, meas, model, values, varname, wavelength) + if nargin < 7 + wavelength = []; + end + + nband = length(bands); + + if strcmp(zenith,'diffuse') + illum = 'DIFFUSE'; + else + zen = str2num(zenith); + azim = zeros(1,91); + azim([56 41 76 42 60 67]+1) = [153 147 155 76 45 41]; + illum = sprintf('z%02da%03d', zen, azim(zen+1)); + end + + for iband = 1:nband + filename = ['mes/' scene '_' bands{iband} '_' illum '-' meas '_' model '.mes']; + disp(['Writing ' filename]); + fid = fopen(filename,'w'); + fprintf(fid,'%.6f\t%.6f\n', values(iband), -1); + fclose(fid); + end + + if ~isempty(wavelength) & length(values(:)) > 1 + for iw = 1:length(wavelength) + wl{iw} = num2str(round(wavelength(iw))); + end + clf + set(gcf,'paperposition',[0.5 0.5 18 12]); + plot(values,'k') + set(gca,'xticklabel',wl,'xtick',[1:length(wl)]); + xlabel('Wavelength (nm)'); + h=ylabel([varname ' (' meas ')']); + set(h,'interpreter','none'); + h=title([scene ' ' illum ' ' model]); + set(h,'interpreter','none'); + drawnow + filename = ['mes/' scene '_' illum '-' meas '_' model '.png']; + print_png(filename, '150'); + end diff --git a/test/rami5/write_ascii_profile.m b/test/rami5/write_ascii_profile.m new file mode 100644 index 0000000..31bf0f0 --- /dev/null +++ b/test/rami5/write_ascii_profile.m @@ -0,0 +1,24 @@ +function write_ascii_profile(scene, bands, zenith, meas, model, zmax, z, flux_up, flux_dn); + for iband = 1:length(bands) + if strcmp(zenith,'diffuse') + illum = 'DIFFUSE'; + else + zen = str2num(zenith); + azim = zeros(1,91); + azim([56 41 76 42 60 67]+1) = [153 147 155 76 45 41]; + illum = sprintf('z%02da%03d', zen, azim(zen+1)); + end + + zint = linspace(zmax, 0, 11); + fup = interp1(z, flux_up(iband,:), zint); + fdn = interp1(z, flux_dn(iband,:), zint); + + filename = ['mes/' scene '_' bands{iband} '_' illum '-' meas '_' model '.mes']; + disp(['Writing ' filename]); + fid = fopen(filename,'w'); + fprintf(fid,'%4d %4d\t%.6f\n', 11, 3, zmax/10); + for iz = 1:11 + fprintf(fid,'%.6f\t%.6f\t%.6f\n', zint(iz), fup(iz), fdn(iz)); + end + fclose(fid); + end diff --git a/test/single_layer/Makefile b/test/single_layer/Makefile new file mode 100644 index 0000000..0203511 --- /dev/null +++ b/test/single_layer/Makefile @@ -0,0 +1,23 @@ +SPSURF = ../../bin/spartacus_surface +CONFIG = config.nam +CONFIG_TMP = config_tmp.nam +CHANGE_NL = ./change_namelist.sh +BASENAME = test_single_layer +INPUT = $(BASENAME).nc + +test: test_sp test_exp test_inf + +test_sp: + $(CHANGE_NL) $(CONFIG) $(CONFIG_TMP) isurfacetype=2 + $(SPSURF) $(CONFIG_TMP) $(INPUT) $(BASENAME)_sp_out.nc + +test_exp: + $(CHANGE_NL) $(CONFIG) $(CONFIG_TMP) isurfacetype=4 + $(SPSURF) $(CONFIG_TMP) $(INPUT) $(BASENAME)_exp_out.nc + +test_inf: + $(CHANGE_NL) $(CONFIG) $(CONFIG_TMP) isurfacetype=5 + $(SPSURF) $(CONFIG_TMP) $(INPUT) $(BASENAME)_inf_out.nc + +clean: + rm -f $(BASENAME)_*_out.nc $(CONFIG_TMP) diff --git a/test/single_layer/README b/test/single_layer/README new file mode 100644 index 0000000..7c1c844 --- /dev/null +++ b/test/single_layer/README @@ -0,0 +1,16 @@ +Calling make in this directory runs SPARTACUS-Surface on the +test_single_layer.nc file containing a single-layer description of an +urban canopy (i.e. all buildings the same height), with each column +increasing the mean building height so as to cover a very wide range +of street height-to-width ratios. Three solvers are applied, +controlled by the isurfacetype namelist parameter: + + Urban: the SPARTACUS solver with 8 diffuse streams per hemisphere + + InfiniteStreet: the Harman et al. (2004) method of performing the + radiative transfer by solving a 2x2 matrix problem, and describing + the urban canopy as a single-layer infinite street + + SimpleUrban: the Harman et al. (2004) method of solving a 2x2 matrix + problem, but assuming exponential model of urban geometry (Hogan + 2019) as in the SPARTACUS method diff --git a/test/single_layer/change_namelist.sh b/test/single_layer/change_namelist.sh new file mode 100755 index 0000000..cecf2ee --- /dev/null +++ b/test/single_layer/change_namelist.sh @@ -0,0 +1,42 @@ +#!/bin/bash +# +# (C) Copyright 2014- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + +# Change entries in a Fortran namelist file +# Usage: change_namelist.sh infile.nam outfile.nam key1=value1 key2=value2 ... + +INFILE=$1 +OUTFILE=$2 +shift +shift + +SEDLINE="" +while [ "$1" ] +do + FOUND=$(echo $1 | grep '=') + if [ ! "$FOUND" ] + then + echo "Error in $0: argument '$1' not of the form key=value" + exit 1 + fi + KEY=$(echo $1 | awk -F= '{print $1}') + VALUE=$(echo $1 | awk -F= '{print $2}') + FOUND=$(grep $KEY $INFILE) + if [ ! "$FOUND" ] + then + echo "Error: $KEY not found in $INFILE" + exit 1 + fi + + SEDLINE="$SEDLINE -e s|^[[:space:]!]*"$KEY".*|"$KEY"="$VALUE",|" + shift +done +#echo sed $SEDLINE $INFILE ">" $OUTFILE +sed $SEDLINE $INFILE > $OUTFILE diff --git a/test/single_layer/config.nam b/test/single_layer/config.nam new file mode 100644 index 0000000..582f077 --- /dev/null +++ b/test/single_layer/config.nam @@ -0,0 +1,26 @@ +&radsurf_driver +do_parallel = true, +!top_flux_dn_sw = 1000.0, +!top_flux_dn_direct_sw = 0.0, +cos_solar_zenith_angle = 0.5, +!do_conservation_check = true, +nrepeat = 1, +iverbose = 2, +nblocksize = 100, +isurfacetype = 2, +/ + +&radsurf +iverbose = 2, +do_sw = true, +do_lw = true, +!use_sw_direct_albedo = false, +do_vegetation = false, +do_urban = true, +n_vegetation_region_urban = 0, +nsw = 1, +nlw = 1, +n_stream_sw_urban = 8, +n_stream_lw_urban = 8, +do_save_flux_profile = false, +/ diff --git a/test/single_layer/test_single_layer.nc b/test/single_layer/test_single_layer.nc new file mode 100644 index 0000000..65b6128 Binary files /dev/null and b/test/single_layer/test_single_layer.nc differ